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

interface

procedure scene_project;

implementation

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

const
icosa_vertex=12; icosa_faces=20;
icosahedron_v: array[0..icosa_vertex*3-1] of shortint = (
    0,    0, -127,
   92,  -67,  -57,
  -35, -108,  -57,
 -114,    0,  -57,
  -35,  108,  -57,
   92,   67,  -57,
   35, -108,   57,
  -92,  -67,   57,
  -92,   67,   57,
   35,  108,   57,
  114,    0,   57,
    0,    0,  127);
icosahedron_f: array[0..icosa_faces*3-1] of byte = (
 0, 1, 2,
 1, 0, 5,
 0, 2, 3,
 0, 3, 4,
 0, 4, 5,
 1, 5, 10,
 2, 1, 6,
 3, 2, 7,
 4, 3, 8,
 5, 4, 9,
 1, 10, 6,
 2, 6, 7,
 3, 7, 8,
 4, 8, 9,
 5, 9, 10,
 6, 10, 11,
 7, 6, 11,
 8, 7, 11,
 9, 8, 11,
 10, 9, 11);

football_vertex=60; football_faces=116;
football_v: array[0..football_vertex*3-1] of shortint = (
39, 91, 0, 56, 75, -32, 34, 67, -65, -5, 75, -65, -22, 91, -32, 0, 100, 0
, -58, 75, -28, -73, 67, 8, -51, 75, 40, -14, 91, 36, 49, 78, 36, 76, 49, 40
, 94, 32, 8, 84, 46, -28, -64, 49, -58, -84, 14, -51, -98, 6, -15, -93, 32, 15
, 47, 32, -81, 21, 6, -97, -17, 14, -97, -31, 49, -81, -57, 46, 67, -26, 32, 90
, 10, 49, 86, 16, 78, 59, 37, 19, 90, 70, 19, 67, -37, -19, -90, -70, -19, -67
, 78, 19, -58, 83, -19, -51, 57, -46, -67, 26, -32, -90, -83, 19, 51, -78, -19, 58
, -47, -32, 81, -21, -6, 97, 17, -14, 97, 31, -49, 81, 64, -49, 58, 84, -14, 51
, 98, -6, 15, 93, -32, -15, -94, -32, -8, -84, -46, 28, -34, -67, 65, 5, -75, 65
, 58, -75, 28, 73, -67, -8, -76, -49, -40, -49, -78, -36, -39, -91, 0
, -56, -75, 32, -10, -49, -86, -16, -78, -59, 51, -75, -40, 14, -91, -36
, 22, -91, 32, 0, -100, 0);

football_f: array[0..football_faces*3-1] of byte = (
 1, 2, 3, 1, 3, 5, 3, 4, 5, 0, 1, 5, 35, 36, 37, 35, 37, 22, 37, 23, 22
, 35, 22, 34, 40, 48, 49, 40, 49, 42, 49, 43, 42, 40, 42, 41, 55, 51, 50
, 55, 50, 28, 50, 29, 28, 55, 28, 54, 4, 6, 7, 4, 7, 9, 7, 8, 9, 4, 9, 5
, 31, 32, 33, 31, 33, 18, 33, 19, 18, 31, 18, 30, 39, 40, 41, 39, 41, 26
, 41, 27, 26, 39, 26, 38, 51, 52, 53, 51, 53, 44, 53, 45, 44, 51, 44, 50
, 11, 12, 13, 0, 11, 13, 0, 13, 1, 11, 0, 10, 15, 16, 17, 15, 17, 6
, 17, 7, 6, 15, 6, 14, 36, 46, 47, 36, 47, 38, 47, 39, 38, 36, 38, 37
, 57, 55, 54, 57, 54, 32, 54, 33, 32, 57, 32, 56, 19, 20, 21, 19, 21, 2
, 21, 3, 2, 19, 2, 18, 24, 26, 27, 24, 27, 10, 27, 11, 10, 24, 10, 25
, 45, 35, 34, 45, 34, 16, 34, 17, 16, 45, 16, 44, 48, 58, 59, 48, 59, 56
, 59, 57, 56, 48, 56, 49, 23, 24, 25, 23, 25, 8, 25, 9, 8, 23, 8, 22
, 20, 28, 29, 20, 29, 14, 29, 15, 14, 20, 14, 21, 43, 31, 30, 43, 30, 12
, 30, 13, 12, 43, 12, 42, 52, 59, 58, 52, 58, 46, 58, 47, 46, 52, 46, 53
, 0, 25, 10, 25, 0, 9, 0, 5, 9, 21, 14, 6, 21, 6, 3, 6, 4, 3, 30, 18, 2
, 30, 2, 13, 2, 1, 13, 34, 22, 8, 34, 8, 17, 8, 7, 17, 37, 38, 26
, 37, 26, 23, 26, 24, 23, 41, 42, 12, 41, 12, 27, 12, 11, 27, 50, 44, 16
, 50, 16, 29, 16, 15, 29, 54, 28, 20, 54, 20, 33, 20, 19, 33, 49, 56, 32
, 49, 32, 43, 32, 31, 43, 53, 46, 36, 53, 36, 45, 36, 35, 45, 58, 48, 40
, 58, 40, 47, 40, 39, 47, 57, 59, 52, 57, 52, 55, 52, 51, 55);


type
  xyz_s = record
  x,y,z : single;
  end;

var

  Aantal, T1: longint;


 var
 cubeDc1, cubeDc2:array[0..60*3] of single;

 g_scale, p199,p200, p320,p319,p640,p960,p1280:longint;


procedure triangle_asm(ax,ay,bx,by,cx,cy:longint; c, add_c, hei_p:byte;shift,where:word);
var
color1, color2, move:byte;
sy,x1,x2:integer;
clockwise, temp, 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 if (CX<>BX) then delta3 := ((CX - BX) shl 8) div (CY - BY)
                     else delta3 := 255 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>200 then CY:=200;
 if BY>200 then BY:=200;

 move:=byte(shift+ay);
 color1:=c;
 color2:=c+add_c;

if clockwise>=0 then
    asm
    mov es, where
    mov ch, move

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

    mov dl, color2
    mov dh, dl
    mov bx, dx
    db $66; shl bx, 16
    mov bx, dx

{----------------------self_modify------------------------}
    db $66; mov cs:[offset @col1+2], ax
    db $66; mov cs:[offset @col1_2+2], ax
    db $66; mov cs:[offset @col2+2], bx
    db $66; mov cs:[offset @col2_2+2], bx
    mov bl, hei_p
    mov cs:[offset @hei_p1+2], bl
    mov cs:[offset @hei_p2+2], bl
    jmp @clear_prefetch; @clear_prefetch:
{---------------------------------------------------------}

    db $66; mov bx, word ptr Xit1
    db $66; mov dx, word ptr Xit2
    db $66; mov si, word ptr Delta1
    push bp
    mov cl, byte ptr BY
    imul di, word ptr AY, 320 {di = AY*320}
    db $8e,$ef       {mov gs, di}

    sub cl, byte ptr AY       {BY-AY}
    jz @exit_tri1

   {---------------------AY-BY part-----------------------------------}
    db $66; mov bp, word ptr Delta2
    @y1:{for SY:=AY to BY-1 do begin}
        db $66; push bx
        db $66; push dx
        db $66; shr bx, 8 {x1:=Xit1 shr 8;}
        db $66; shr dx, 8 {x2:=Xit2 shr 8;}
        {if (x2>=0) and (x1<320) then}
        {cmp dx, 0;  jl @exit; cmp bx, 319; jg @exit}
        {if x1<0 then x1:=0; if x2>319 then x2:=319;}
        cmp bx, 0; jge @sk_x1_to_zero; xor bx, bx; @sk_x1_to_zero:
        cmp dx, 320;jl @sk_x2_to_w; mov dx, 319; @sk_x2_to_w:
             {if (x2>x1) then drawlineh(x1,x2,sy, c, where);}
             sub dx, bx {lenght}; js @exit; jz @exit
             inc dx; add  di, bx;

             inc ch
             @col1: db $66; mov ax, 1111h; dw $1111
             @hei_p1: test ch, 16
             jz @skip_bar
             @col2: db $66; mov ax, 0101h; dw $0101
             @skip_bar:

                 test dx, 65520
                 jz @length_less_sixteen
                 mov  bx, dx
                 shr  bx, 4
                 @l16:
                    db $66; mov es:[di], ax
                    db $66; mov es:[di+4], ax
                    db $66; mov es:[di+8], ax
                    db $66; mov es:[di+12], ax
                    add di, 16
                    dec bx
                 jnz @l16
             @length_less_sixteen:
                 mov bx, dx
                 and bx, 15
                 shr bx, 2
                 jz @length_less_four
                 @l4:
                    db $66; mov es:[di], ax
                    add di, 4
                    dec bx
                 jnz @l4
             @length_less_four:
                 test dx, 2
                 jz @length_less_two
                    mov es:[di], ax
                    add di, 2
             @length_less_two:
                 test dx, 1
                 jz @exit
                    mov es:[di], al
             @exit:
        db $8c, $ef {mov  di, gs}
        add di, 320
        db $8e,$ef {mov gs, di}
        db $66; pop dx
        db $66; pop bx
        db $66,$01,$f3 {add ebx, esi {Xit1:=Xit1+delta1}
        db $66,$01,$ea {add edx, ebp {Xit2:=Xit2+delta2}
     dec cl
     jnz @y1
     @exit_tri1:
     pop bp
   {---------------------BY-CY part-----------------------------------}
    mov cl, byte ptr CY
    sub cl, byte ptr BY       {CY-BY}
    jz @exit_tri2
    push bp
    db $66; mov bp, word ptr Delta3
    @y2:{for SY:=AY to BY-1 do begin}
        db $66; push bx
        db $66; push dx
        db $66; shr bx, 8 {x1:=Xit1 shr 8;}
        db $66; shr dx, 8 {x2:=Xit2 shr 8;}
        {if (x2>=0) and (x1<320) then}
        {cmp dx, 0;  jl @exit2; cmp bx, 319; jg @exit2}
        {if x1<0 then x1:=0; if x2>319 then x2:=319;}
        cmp bx, 0; jge @sk_x1_to_zero2; xor bx, bx; @sk_x1_to_zero2:
        cmp dx, 320;jl @sk_x2_to_w2; mov dx, 319; @sk_x2_to_w2:
             {if (x2>x1) then drawlineh(x1,x2,sy, c, where);}
             sub dx, bx {lenght}; js @exit2; jz @exit2
             inc dx; add  di, bx;

             inc ch
             @col1_2: db $66; mov ax, 1111h; dw $1111
             @hei_p2: test ch, 16
             jz @skip_bar2
             @col2_2: db $66; mov ax, 0101h; dw $0101
             @skip_bar2:

                 test dx, 65520
                 jz @length_less_sixteen_2
                 mov  bx, dx
                 shr  bx, 4
                 @l16_2:
                    db $66; mov es:[di], ax
                    db $66; mov es:[di+4], ax
                    db $66; mov es:[di+8], ax
                    db $66; mov es:[di+12], ax
                    add di, 16
                    dec bx
                 jnz @l16_2
             @length_less_sixteen_2:
                 mov bx, dx
                 and bx, 15
                 shr bx, 2
                 jz @length_less_four_2
                 @l4_2:
                    db $66; mov es:[di], ax
                    add di, 4
                    dec bx
                 jnz @l4_2
             @length_less_four_2:
                 test dx, 2
                 jz @length_less_two_2
                    mov es:[di], ax
                    add di, 2
             @length_less_two_2:
                 test dx, 1
                 jz @exit2
                    mov es:[di], al
             @exit2:
        db $8c, $ef {mov  di, gs}
        add di, 320
        db $8e,$ef {mov gs, di}
        db $66; pop dx
        db $66; pop bx
        db $66,$01,$f3 {add ebx, esi {Xit1:=Xit1+delta1}
        db $66,$01,$ea {add edx, ebp {Xit2:=Xit2+delta3}
     dec cl
     jnz @y2
     pop bp
     @exit_tri2:
    end
    else
    asm
    mov es, where
    mov ch, move

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

    mov dl, color2
    mov dh, dl
    mov bx, dx
    db $66; shl bx, 16
    mov bx, dx

{----------------------self_modify------------------------}
    db $66; mov cs:[offset @col1+2], ax
    db $66; mov cs:[offset @col1_2+2], ax
    db $66; mov cs:[offset @col2+2], bx
    db $66; mov cs:[offset @col2_2+2], bx
    mov bl, hei_p
    mov cs:[offset @hei_p1+2], bl
    mov cs:[offset @hei_p2+2], bl
    jmp @clear_prefetch; @clear_prefetch:
{---------------------------------------------------------}



    db $66; mov bx, word ptr Xit2
    db $66; mov dx, word ptr Xit1
    db $66; mov si, word ptr Delta1
    push bp
    mov cl, byte ptr BY
    imul di, word ptr AY, 320 {di = AY*320}
    db $8e,$ef       {mov gs, di}
    sub cl, byte ptr AY       {BY-AY}
    jz @exit_tri1
   {---------------------AY-BY part-----------------------------------}
    db $66; mov bp, word ptr Delta2
    @y1:{for SY:=AY to BY-1 do begin}
        db $66; push bx
        db $66; push dx
        db $66; shr bx, 8 {x2:=Xit2 shr 8;}
        db $66; shr dx, 8 {x1:=Xit1 shr 8;}
        {if (x2>=0) and (x1<320) then}
        {cmp dx, 0;  jl @exit; cmp bx, 319; jg @exit}
        {if x1<0 then x1:=0; if x2>319 then x2:=319;}
        cmp bx, 0; jge @sk_x1_to_zero; xor bx, bx; @sk_x1_to_zero:
        cmp dx, 320;jl @sk_x2_to_w; mov dx, 319; @sk_x2_to_w:
             {if (x2>x1) then drawlineh(x1,x2,sy, c, where);}
             sub dx, bx {lenght}; js @exit; jz @exit
             inc dx; add  di, bx;

             inc ch
             @col1: db $66; mov ax, 1111h; dw $1111
             @hei_p1: test ch, 16
             jz @skip_bar
             @col2: db $66; mov ax, 0101h; dw $0101
             @skip_bar:

                 test dx, 65520
                 jz @length_less_sixteen
                 mov  bx, dx
                 shr  bx, 4
                 @l16:
                    db $66; mov es:[di], ax
                    db $66; mov es:[di+4], ax
                    db $66; mov es:[di+8], ax
                    db $66; mov es:[di+12], ax
                    add di, 16
                    dec bx
                 jnz @l16
             @length_less_sixteen:
                 mov bx, dx
                 and bx, 15
                 shr bx, 2
                 jz @length_less_four
                 @l4:
                    db $66; mov es:[di], ax
                    add di, 4
                    dec bx
                 jnz @l4
             @length_less_four:
                 test dx, 2
                 jz @length_less_two
                    mov es:[di], ax
                    add di, 2
             @length_less_two:
                 test dx, 1
                 jz @exit
                    mov es:[di], al
             @exit:
        db $8c, $ef {mov  di, gs}
        add di, 320
        db $8e,$ef {mov gs, di}
        db $66; pop dx
        db $66; pop bx
        db $66,$01,$eb {add ebx, ebp {Xit2:=Xit1+delta2}
        db $66,$01,$f2 {add edx, esi {Xit1:=Xit2+delta1}
     dec cl
     jnz @y1
     @exit_tri1:
     pop bp
   {---------------------BY-CY part-----------------------------------}
    mov cl, byte ptr CY
    sub cl, byte ptr BY       {CY-BY}
    jz @exit_tri2
    push bp
    db $66; mov bp, word ptr Delta3
    @y2:{for SY:=AY to BY-1 do begin}
        db $66; push bx
        db $66; push dx
        db $66; shr bx, 8 {x1:=Xit1 shr 8;}
        db $66; shr dx, 8 {x2:=Xit2 shr 8;}
        {if (x2>=0) and (x1<320) then}
        {cmp dx, 0;  jl @exit2; cmp bx, 319; jg @exit2}
        {if x1<0 then x1:=0; if x2>319 then x2:=319;}
        cmp bx, 0; jge @sk_x1_to_zero2; xor bx, bx; @sk_x1_to_zero2:
        cmp dx, 320;jl @sk_x2_to_w2; mov dx, 319; @sk_x2_to_w2:
             {if (x2>x1) then drawlineh(x1,x2,sy, c, where);}
             sub dx, bx {lenght}; js @exit2; jz @exit2
             inc dx; add  di, bx;

             inc ch
             @col1_2: db $66; mov ax, 1111h; dw $1111
             @hei_p2: test ch, 16
             jz @skip_bar2
             @col2_2: db $66; mov ax, 0101h; dw $0101
             @skip_bar2:

                 test dx, 65520
                 jz @length_less_sixteen_2
                 mov  bx, dx
                 shr  bx, 4
                 @l16_2:
                    db $66; mov es:[di], ax
                    db $66; mov es:[di+4], ax
                    db $66; mov es:[di+8], ax
                    db $66; mov es:[di+12], ax
                    add di, 16
                    dec bx
                 jnz @l16_2
             @length_less_sixteen_2:
                 mov bx, dx
                 and bx, 15
                 shr bx, 2
                 jz @length_less_four_2
                 @l4_2:
                    db $66; mov es:[di], ax
                    add di, 4
                    dec bx
                 jnz @l4_2
             @length_less_four_2:
                 test dx, 2
                 jz @length_less_two_2
                    mov es:[di], ax
                    add di, 2
             @length_less_two_2:
                 test dx, 1
                 jz @exit2
                    mov es:[di], al
             @exit2:
        db $8c, $ef {mov  di, gs}
        add di, 320
        db $8e,$ef {mov gs, di}
        db $66; pop dx
        db $66; pop bx
        db $66,$01,$eb {add ebx, ebp {Xit1:=Xit1+delta1}
        db $66,$01,$f2 {add edx, esi {Xit2:=Xit2+delta2}
     dec cl
     jnz @y2
     pop bp
     @exit_tri2:
    end;
end;



var visible:array[0..5] of byte;
procedure main_cube_draw(adding_color, hei_p:byte;shift:word;xx,yy:integer; scale:single; per:longint; from, where:word);
var p,n,v:word;
c:byte;
x0,y0,z0, x1,y1,z1, x2,y2,z2 :longint;
pom, nx,ny,nz:longint;
begin
 for n:=0 to 5 do visible[n]:=0;
 scale:=g_scale / scale;

for n:=0 to 11 do
    begin
    p:=n*44+4;
          x0:=meml[from:p]      * per div (per-meml[from:p+8]);
          y0:=meml[from:p+4]    * per div (per-meml[from:p+8]);
          z0:=meml[from:p+8];
          x1:=meml[from:p+12]   * per div (per-meml[from:p+12+8]);
          y1:=meml[from:p+12+4] * per div (per-meml[from:p+12+8]);
          z1:=meml[from:p+12+8];
          x2:=meml[from:p+24]   * per div (per-meml[from:p+24+8]);
          y2:=meml[from:p+24+4] * per div (per-meml[from:p+24+8]);
          z2:=meml[from:p+24+8];

          nx:=(y2-y0)*(z1-z0)-(z2-z0)*(y1-y0);
          ny:=(z2-z0)*(x1-x0)-(x2-x0)*(z1-z0);
          nz:=(x2-x0)*(y1-y0)-(y2-y0)*(x1-x0);
          pom:=nz*-4+nx*(x2-x0)+ny*(y2-y0)+nz*(z2-z0);
       if pom>0 then
          begin
                triangle_asm(round(x0/scale+xx),round(y0/scale+yy),
                             round(x1/scale+xx),round(y1/scale+yy),
                             round(x2/scale+xx),round(y2/scale+yy), byte(mem[from:p+36]),adding_color, hei_p, shift,where);

                visible[mem[from:p+40]]:=1;
          end;
  end;
end;

procedure mesh_draw_2(adding_color, hei_p:byte; shift:word; xx,yy:integer; scale:single; per:longint; from:word; where:word);
var p,n,v, count_faces:word;
c:byte;
x0,y0,z0, x1,y1,z1, x2,y2,z2 :longint;
begin

scale:=g_scale / scale;
count_faces:=memw[from:0];

for n:=12 to count_faces-1 do
    begin
          p:=n*44+4;

          {if visible[mem[from:p+40]]=1  then{}
          begin

          {x0:=meml[from:p]      * per div (per-meml[from:p+8]);
          y0:=meml[from:p+4]    * per div (per-meml[from:p+8]);
          x1:=meml[from:p+12]   * per div (per-meml[from:p+12+8]);
          y1:=meml[from:p+12+4] * per div (per-meml[from:p+12+8]);
          x2:=meml[from:p+24]   * per div (per-meml[from:p+24+8]);
          y2:=meml[from:p+24+4] * per div (per-meml[from:p+24+8]);}
          asm
          mov es, from
          db $66; mov di, word ptr per
          mov si, p

          {x0:=meml[from:p]      * per div (per-meml[from:p+8]);}
          db $66; mov ax, es:[si]
          db $66,$0f,$af,$c7 {imul eax, edi  { * per}
          db $66; mov bx, di
          db $66; sub bx, es:[si+8]
          db $66; cwd
          db $66; idiv bx
          db $66; mov word ptr x0, ax
          {y0:=meml[from:p+4]    * per div (per-meml[from:p+8]);}
          db $66; mov ax, es:[si+4]
          db $66,$0f,$af,$c7 {imul eax, edi  { * per}
          db $66; cwd
          db $66; idiv bx
          db $66; mov word ptr y0, ax

          {x1:=meml[from:p+12]   * per div (per-meml[from:p+12+8]);}
          db $66; mov ax, es:[si+12]
          db $66,$0f,$af,$c7 {imul eax, edi  { * per}
          db $66; mov bx, di
          db $66; sub bx, es:[si+12+8]
          db $66; cwd
          db $66; idiv bx
          db $66; mov word ptr x1, ax
          {y1:=meml[from:p+12+4] * per div (per-meml[from:p+12+8]);}
          db $66; mov ax, es:[si+12+4]
          db $66,$0f,$af,$c7 {imul eax, edi  { * per}
          db $66; cwd
          db $66; idiv bx
          db $66; mov word ptr y1, ax

          {x2:=meml[from:p+24]   * per div (per-meml[from:p+24+8]);}
          db $66; mov ax, es:[si+24]
          db $66,$0f,$af,$c7 {imul eax, edi  { * per}
          db $66; mov bx, di
          db $66; sub bx, es:[si+24+8]
          db $66; cwd
          db $66; idiv bx
          db $66; mov word ptr x2, ax
          {y2:=meml[from:p+24+4] * per div (per-meml[from:p+24+8]);}
          db $66; mov ax, es:[si+24+4]
          db $66,$0f,$af,$c7 {imul eax, edi  { * per}
          db $66; cwd
          db $66; idiv bx
          db $66; mov word ptr y2, ax
          end;

          triangle_asm(round(x0/scale+xx),round(y0/scale+yy),
               round(x1/scale+xx),round(y1/scale+yy),
               round(x2/scale+xx),round(y2/scale+yy), byte(mem[from:p+36]),adding_color, hei_p,shift,where);
          end;
  end;
end;


procedure Main_cube_rotate(xx,yy,zz:longint; xr,yr,zr:single; where:word);
var x,y,z,X1,Y1,Z1:longint;
CosX, CosY, CosZ, SinX,SinY,SinZ:longint;
n,p,v:integer;
rotate_data_seg:word;
begin
rotate_data_seg:=where{+2048};

CosX:=round(cos(Xr)*256); SinX:=round(sin(Xr)*256);
CosY:=round(cos(Yr)*256); SinY:=round(sin(Yr)*256);
CosZ:=round(cos(Zr)*256); SinZ:=round(sin(Zr)*256);
asm
  {----self-modifing code------------------}
  db $66; mov ax, word ptr siny
  db $66; mov cs:[offset @siny1+3], ax
  db $66; mov cs:[offset @siny2+3], ax
  db $66; mov ax, word ptr cosy
  db $66; mov cs:[offset @cosy1+3], ax
  db $66; mov cs:[offset @cosy2+3], ax
  db $66; mov ax, word ptr sinz
  db $66; mov cs:[offset @sinz1+3], ax
  db $66; mov cs:[offset @sinz2+3], ax
  db $66; mov ax, word ptr cosz
  db $66; mov cs:[offset @cosz1+3], ax
  db $66; mov cs:[offset @cosz2+3], ax
  db $66; mov ax, word ptr sinx
  db $66; mov cs:[offset @sinx1+3], ax
  db $66; mov cs:[offset @sinx2+3], ax
  db $66; mov ax, word ptr cosx
  db $66; mov cs:[offset @cosx1+3], ax
  db $66; mov cs:[offset @cosx2+3], ax
  jmp @clear_prefetch; @clear_prefetch:
  {-----------------------------------}
mov es, where
mov ax, rotate_data_seg
db $8E,$E8 {mov gs, ax}

mov si, 4
mov cx, 12 {es:[0]}
@n: {for n:=0 to meml[from:0]-1 do begin}
push cx

{p:=n*40+4;}
mov cx, 3
@v:
{  for v:=0 to 2 do begin}
{  x:=meml[from:p+v*12]+xx;}
{  y:=meml[from:p+v*12+4]+yy;}
{  z:=meml[from:p+v*12+8]+zz;}

  {x1:=sar_(cosy*x-siny*z, 8);}
  db $66; mov ax, word ptr es:[si]   {X}
  db $66; add ax, word ptr xx
  db $66; mov bx, word ptr es:[si+8] {Z}
  db $66; add bx, word ptr zz
  db $66; mov dx, ax
  db $66; mov di, bx
  @siny1: db $66,$69,$db,$78,$56,$34,$12  {imul ebx, siny}
  @cosy1: db $66,$69,$c0,$78,$56,$34,$12  {imul eax, cosy}
  db $66; sub ax, bx
  db $66; sar ax, 8

  {z1:=sar_(siny*x+cosy*z, 8);}
  @cosy2: db $66,$69,$ff,$78,$56,$34,$12  {imul edi, cosy}
  @siny2: db $66,$69,$d2,$78,$56,$34,$12  {imul edx, siny}
  db $66; add dx, di
  db $66; sar dx, 8
  db $66; push dx

  {x:=cosz*x1+sinz*y;}
  db $66; mov dx, ax  {edx=X1}
  db $66; mov bx, word ptr es:[si+4] {Y}
  db $66; add bx, word ptr yy
  db $66; mov di, bx  {edi=y}
  @sinz1: db $66,$69,$db,$78,$56,$34,$12  {imul ebx, sinz}
  @cosz1: db $66,$69,$c0,$78,$56,$34,$12  {imul eax, cosz}
  db $66; add ax, bx
  db $66; sar ax, 8
  db $65; db $66; mov word ptr [si], ax

  {y1:=sar_(cosz*y-sinz*x1, 8);}
  @sinz2: db $66,$69,$d2,$78,$56,$34,$12  {imul edx, sinz}
  @cosz2: db $66,$69,$ff,$78,$56,$34,$12  {imul edi, cosz}
  db $66; sub di, dx
  db $66; sar di, 8

  {z:=cosx*z1-sinx*y1;}
  db $66; pop ax
  db $66; mov bx, ax {EBX=z1}
  db $66; mov dx, di {EDX=y1}
  @sinx1: db $66,$69,$ff,$78,$56,$34,$12  {imul edi, sinx}
  @cosx1: db $66,$69,$c0,$78,$56,$34,$12  {imul eax, cosx}
  db $66; sub ax, di
  db $66; sar ax, 8
  db $65; db $66; mov word ptr [si+8], ax

  {y:=sinx*z1+cosx*y1;}
  @sinx2: db $66,$69,$db,$78,$56,$34,$12  {imul ebx, sinx}
  @cosx2: db $66,$69,$d2,$78,$56,$34,$12  {imul edx, cosx}
  db $66; add bx, dx
  db $66; sar bx, 8
  db $65; db $66; mov word ptr [si+4], bx

  {meml[where:p+v*12]  :=x;}
  {meml[where:p+v*12+4]:=y;}
  {meml[where:p+v*12+8]:=z;}
  add si, 12
  dec cx
  jnz @v {end;}

{meml[where:p+36]:=meml[from:p+36]; {color}
{db $66; mov bx, word ptr es:[si]
db $65; db $66; mov word ptr [si], bx
{meml[where:p+36]:=meml[from:p+40]; {projection}
{db $66; mov bx, word ptr es:[si+4]
db $65; db $66; mov word ptr [si+4], bx}

add si, 8
pop cx
dec cx
jnz @n
{meml[where:0]:=meml[from:0];       {count of polygons}
{db $65; db $66; mov word ptr [0], 12; dw $0;}

end;
end;

procedure mesh_rotate_2(xx,yy,zz:longint; xr,yr,zr:single; where:word);
var x,y,z,X1,Y1,Z1:longint;
CosX, CosY, CosZ, SinX,SinY,SinZ:longint;
n,p,v:integer;
rotate_data_seg:word;
begin
rotate_data_seg:=where{+2048};
CosX:=round(cos(Xr)*256); SinX:=round(sin(Xr)*256);
CosY:=round(cos(Yr)*256); SinY:=round(sin(Yr)*256);
CosZ:=round(cos(Zr)*256); SinZ:=round(sin(Zr)*256);
asm
  {----self-modifing code------------------}
  db $66; mov ax, word ptr siny
  db $66; mov cs:[offset @siny1+3], ax
  db $66; mov cs:[offset @siny2+3], ax
  db $66; mov ax, word ptr cosy
  db $66; mov cs:[offset @cosy1+3], ax
  db $66; mov cs:[offset @cosy2+3], ax
  db $66; mov ax, word ptr sinz
  db $66; mov cs:[offset @sinz1+3], ax
  db $66; mov cs:[offset @sinz2+3], ax
  db $66; mov ax, word ptr cosz
  db $66; mov cs:[offset @cosz1+3], ax
  db $66; mov cs:[offset @cosz2+3], ax
  db $66; mov ax, word ptr sinx
  db $66; mov cs:[offset @sinx1+3], ax
  db $66; mov cs:[offset @sinx2+3], ax
  db $66; mov ax, word ptr cosx
  db $66; mov cs:[offset @cosx1+3], ax
  db $66; mov cs:[offset @cosx2+3], ax
  db $66; mov ax, word ptr xx
  db $66; mov cs:[offset @xx+2], ax
  db $66; mov ax, word ptr yy
  db $66; mov cs:[offset @yy+3], ax
  db $66; mov ax, word ptr zz
  db $66; mov cs:[offset @zz+3], ax
  jmp @clear_prefetch; @clear_prefetch:
  {-----------------------------------}

mov es, where
mov ax, rotate_data_seg
db $8E,$E8 {mov gs, ax}

mov si, 4 + 44*12 {skip big cube faces}
mov cx, es:[0]
cmp cx, 12
jbe @exit
sub cx, 12 {sub count of cube faces}

@n: {for n:=0 to meml[from:0]-1 do begin}

push cx
mov cx, 3
{p:=n*40+4;}
@v:
{  for v:=0 to 2 do begin}
{  x:=meml[from:p+v*12]+xx;}
{  y:=meml[from:p+v*12+4]+yy;}
{  z:=meml[from:p+v*12+8]+zz;}

  {x1:=sar_(cosy*x-siny*z, 8);}
  db $66; mov ax, word ptr es:[si]   {X}
  @xx: db $66; add ax, 1234h; dw $5678 {word ptr xx}
  db $66; mov bx, word ptr es:[si+8] {Z}
  @zz: db $66; add bx, 1234h; dw $5678 {word ptr zz}
  db $66; mov dx, ax
  db $66; mov di, bx
  @siny1: db $66,$69,$db,$78,$56,$34,$12  {imul ebx, siny}
  @cosy1: db $66,$69,$c0,$78,$56,$34,$12  {imul eax, cosy}
  db $66; sub ax, bx
  db $66; sar ax, 8

  {z1:=sar_(siny*x+cosy*z, 8);}
  @cosy2: db $66,$69,$ff,$78,$56,$34,$12  {imul edi, cosy}
  @siny2: db $66,$69,$d2,$78,$56,$34,$12  {imul edx, siny}
  db $66; add dx, di
  db $66; sar dx, 8
  db $66; push dx

  {x:=cosz*x1+sinz*y;}
  db $66; mov dx, ax  {edx=X1}
  db $66; mov bx, word ptr es:[si+4] {Y}
  @yy: db $66; add bx, 1234h; dw $5678 {word ptr yy}
  db $66; mov di, bx  {edi=y}
  @sinz1: db $66,$69,$db,$78,$56,$34,$12  {imul ebx, sinz}
  @cosz1: db $66,$69,$c0,$78,$56,$34,$12  {imul eax, cosz}
  db $66; add ax, bx
  db $66; sar ax, 8
  db $65; db $66; mov word ptr [si], ax

  {y1:=sar_(cosz*y-sinz*x1, 8);}
  @sinz2: db $66,$69,$d2,$78,$56,$34,$12  {imul edx, sinz}
  @cosz2: db $66,$69,$ff,$78,$56,$34,$12  {imul edi, cosz}
  db $66; sub di, dx
  db $66; sar di, 8

  {z:=cosx*z1-sinx*y1;}
  db $66; pop ax
  db $66; mov bx, ax {EBX=z1}
  db $66; mov dx, di {EDX=y1}
  @sinx1: db $66,$69,$ff,$78,$56,$34,$12  {imul edi, sinx}
  @cosx1: db $66,$69,$c0,$78,$56,$34,$12  {imul eax, cosx}
  db $66; sub ax, di
  db $66; sar ax, 8
  db $65; db $66; mov word ptr [si+8], ax

  {y:=sinx*z1+cosx*y1;}
  @sinx2: db $66,$69,$db,$78,$56,$34,$12  {imul ebx, sinx}
  @cosx2: db $66,$69,$d2,$78,$56,$34,$12  {imul edx, cosx}
  db $66; add bx, dx
  db $66; sar bx, 8
  db $65; db $66; mov word ptr [si+4], bx

  {meml[where:p+v*12]  :=x;}
  {meml[where:p+v*12+4]:=y;}
  {meml[where:p+v*12+8]:=z;}
  add si, 12
  dec cx
  jnz @v {end;}

  {meml[where:p+36]:=meml[from:p+36]; {color}
{  db $66; mov bx, word ptr es:[si]
  db $65; db $66; mov word ptr [si], bx}
  {meml[where:p+40]:=meml[from:p+40]; {projection}
{  db $66; mov bx, word ptr es:[si+4]
  db $65; db $66; mov word ptr [si+4], bx}
add si, 8
pop cx
dec cx
jnz @n
@exit:
{db $66; mov bx, word ptr es:[0]
db $65; db $66; mov word ptr [0], bx}
end;
end;


procedure mesh_triangle_add(ax,ay,az, bx,by,bz, cx,cy,cz, projection, c:longint; where:word);
var pcount:word;
begin
pcount:=memw[where:0]*44;
meml[where:4+   + pcount]:=ax;
meml[where:4+4  + pcount]:=ay;
meml[where:4+8  + pcount]:=az;

meml[where:4+12 + pcount]:=bx;
meml[where:4+16 + pcount]:=by;
meml[where:4+20 + pcount]:=bz;

meml[where:4+24 + pcount]:=cx;
meml[where:4+28 + pcount]:=cy;
meml[where:4+32 + pcount]:=cz;

meml[where:4+36 + pcount]:=c;
meml[where:4+40 + pcount]:=projection;

meml[where:0]:=meml[where:0]+1;
end;




procedure proj_triangle_cut(ax,ay,bx,by,cx,cy:longint; c, projection:byte; where:word);

    procedure draw_triangle(ax,ay,bx,by,cx,cy:longint; c:byte);
    begin
       if (projection=0) and (visible[0]=1) then
       mesh_triangle_add(ax,ay,0,       bx,by,0,          cx,cy,0,                  projection, c, where);
       if (projection=1) and (visible[1]=1) then
       mesh_triangle_add(p319,ay,-ax,   p319,by,-bx,      p319,cy,-cx,              projection, c, where);
       if (projection=2) and (visible[2]=1) then
       mesh_triangle_add(p320-ax,ay,   -p319, p320-bx,by, -p319, p320-cx,cy,-p319,  projection, c, where);
       if (projection=3) and (visible[3]=1) then
       mesh_triangle_add(0,ay,ax-p320,  0,by,bx-p320,     0,cy,cx-p320,             projection, c, where);
    end;

procedure triangle_cut_y(ax,ay,bx,by,cx,cy:longint; c:byte);

var dx, delta1,delta2:longint;
begin

 if ((ay>=0) and (by>=0) and (cy>=0)) and ((ay<p200) and (by<p200) and (cy<p200))
  then
         draw_triangle(ax,ay,bx,by,cx,cy, c)
 else begin
      if (ay<0) and (by>=0) and (cy>=0) then begin
         delta1 := shl_(AY , 8) div (AY-BY);
         delta2 := shl_(AY , 8) div (AY-CY);
         dx:=AX + sar_(delta2*(CX-AX) , 8);
         ax:=AX + sar_(delta1*(BX-AX) , 8);
         draw_triangle(ax,0, bx,by, cx,cy, c);
         draw_triangle(ax,0, cx,cy, dx, 0, c);
         exit;
      end;
      if (by<0) and (ay>=0) and (cy>=0) then begin
         delta1 := shl_(BY , 8) div (BY-CY);
         delta2 := shl_(BY , 8) div (BY-AY);
         dx:=BX + sar_(delta2*(AX-BX) , 8);
         bx:=BX + sar_(delta1*(CX-BX) , 8);
         draw_triangle(ax,ay, bx,0, cx,cy, c);
         draw_triangle(ax,ay, dx,0, bx, 0, c);
         exit;
      end;
      if (cy<0) and (ay>=0) and (by>=0) then begin
         delta1 := shl_(CY , 8) div (CY-AY);
         delta2 := shl_(CY , 8) div (CY-BY);
         dx:=CX + sar_(delta2*(BX-CX), 8);
         cx:=CX + sar_(delta1*(AX-CX), 8);
         draw_triangle(ax,ay, bx,by, cx,0,  c);
         draw_triangle(dx,0,  cx,0,  bx,by, c);
         exit;
      end;

      if (by<0) and (cy<0) and (ay>=0) then begin
         delta1 := shl_(CY , 8) div (CY-AY);
         delta2 := shl_(BY , 8) div (BY-AY);
         dx:=BX + sar_(delta2*(AX-BX), 8);
         cx:=CX + sar_(delta1*(AX-CX), 8);
         draw_triangle(ax,ay, dx,0, cx,0, c);
         exit;
      end;
      if (ay<0) and (cy<0) and (by>=0) then begin
         delta1 := shl_(AY , 8) div (AY-BY);
         delta2 := shl_(CY , 8) div (CY-BY);
         dx:=CX + sar_(delta2*(BX-CX), 8);
         ax:=AX + sar_(delta1*(BX-AX), 8);
         draw_triangle(ax,0, bx,by, dx,0, c);
         exit;
      end;
      if (ay<0) and (by<0) and (cy>=0) then begin
         delta1 := shl_(BY , 8) div (BY-CY);
         delta2 := shl_(AY , 8) div (AY-CY);
         dx:=AX + sar_(delta2*(CX-AX), 8);
         bx:=BX + sar_(delta1*(CX-BX), 8);
         draw_triangle(dx,0, bx,0, cx,cy, c);
         exit;
      end;
 {--------------------------------------------------------}
      if (ay>p199) and (by<p200) and (cy<p200) then begin
         delta1 := shl_((AY-p199) , 8) div (AY-CY);
         delta2 := shl_((AY-p199) , 8) div (AY-BY);
         dx:=AX + sar_(delta2*(BX-AX), 8);
         ax:=AX + sar_(delta1*(CX-AX), 8);
         draw_triangle(cx,cy, ax,p199,  bx,  by, c);
         draw_triangle(bx,by, ax,p199,  dx, p199, c);
         exit;
      end;
      if (by>p199) and (ay<p200) and (cy<p200) then begin
         delta1 := shl_((BY-p199) , 8) div (BY-AY);
         delta2 := shl_((BY-p199) , 8) div (BY-CY);
         dx:=BX + sar_(delta2*(CX-BX), 8);
         bx:=BX + sar_(delta1*(AX-BX), 8);
         draw_triangle(ax,ay, bx,p199,  cx, cy , c);
         draw_triangle(cx,cy, bx,p199,  dx, p199, c);
         exit;
      end;
      if (cy>p199) and (by<p200) and (ay<p200) then begin
         delta1 := shl_((CY-p199) , 8) div (CY-BY);
         delta2 := shl_((CY-p199) , 8) div (CY-AY);
         dx:=CX + sar_(delta2*(AX-CX), 8);
         cx:=CX + sar_(delta1*(BX-CX), 8);
         draw_triangle(ax,ay, bx,by,  cx,p199,  c);
         draw_triangle(ax,ay, cx,p199, dx,p199,  c);
         exit;
      end;

      if (ay>p199) and (cy>p199) and (by<p200) then begin
         delta1 := shl_((AY-p199) , 8) div (AY-BY);
         delta2 := shl_((CY-p199) , 8) div (CY-BY);
         dx:=CX + sar_(delta2*(BX-CX), 8);
         ax:=AX + sar_(delta1*(BX-AX), 8);
         draw_triangle(ax,p199, bx,by, dx,p199, c);
         exit;
      end;
      if (by>p199) and (cy>p199) and (ay<p200) then begin
         delta1 := shl_((CY-p199) , 8) div (CY-AY);
         delta2 := shl_((BY-p199) , 8) div (BY-AY);
         dx:=BX + sar_(delta2*(AX-BX), 8);
         cx:=CX + sar_(delta1*(AX-CX), 8);
         draw_triangle(ax,ay, dx,p199, cx,p199, c);
         exit;
      end;
      if (ay>p199) and (by>p199) and (cy<p200) then begin
         delta1 := shl_((BY-p199) , 8) div (BY-CY);
         delta2 := shl_((AY-p199) , 8) div (AY-CY);
         dx:=AX + sar_(delta2*(CX-AX), 8);
         bx:=BX + sar_(delta1*(CX-BX), 8);
         draw_triangle(dx,p199, bx,p199, cx,cy, c);
         exit;
      end;
 end;
end;



var dy, delta1,delta2:longint;
begin
 if ((ax<0) and (bx<0) and (cx<0))
 or ((ay<0) and (by<0) and (cy<0))
 or ((ax>p319) and (bx>p319) and (cx>p319))
 or ((ay>p199) and (by>p199) and (cy>p199)) then exit;


 if ((ax>=0) and (bx>=0) and (cx>=0)) and ((ax<p320) and (bx<p320) and (cx<p320))
  then
         triangle_cut_y(ax,ay,bx,by,cx,cy, c)
 else begin
      if (ax<0) and (bx>=0) and (cx>=0) then begin
         delta1 := shl_(AX , 8) div (AX-BX);
         delta2 := shl_(AX , 8) div (AX-CX);
         dy:=AY + sar_(delta2*(CY-AY) , 8);
         ay:=AY + sar_(delta1*(BY-AY) , 8);
         triangle_cut_y(0,ay, bx,by, cx,cy, c);
         triangle_cut_y(0,ay, cx,cy, 0, dy, c);
         exit;
      end;
      if (bx<0) and (ax>=0) and (cx>=0) then begin
         delta1 := shl_(BX , 8) div (BX-CX);
         delta2 := shl_(BX , 8) div (BX-AX);
         dy:=BY + sar_(delta2*(AY-BY) , 8);
         by:=BY + sar_(delta1*(CY-BY) , 8);
         triangle_cut_y(ax,ay, 0,by, cx,cy, c);
         triangle_cut_y(ax,ay, 0,dy, 0, by, c);
         exit;
      end;
      if (cx<0) and (ax>=0) and (bx>=0) then begin
         delta1 := shl_(CX , 8) div (CX-AX);
         delta2 := shl_(CX , 8) div (CX-BX);
         dy:=CY + sar_(delta2*(BY-CY) , 8);
         cy:=CY + sar_(delta1*(AY-CY) , 8);
         triangle_cut_y(ax,ay, bx,by, 0,cy, c);
         triangle_cut_y(0,dy, 0,cy, bx, by, c);
         exit;
      end;

      if (bx<0) and (cx<0) and (ax>=0) then begin
         delta1 := shl_(CX , 8) div (CX-AX);
         delta2 := shl_(BX , 8) div (BX-AX);
         dy:=BY + sar_(delta2*(AY-BY) , 8);
         cy:=CY + sar_(delta1*(AY-CY) , 8);
         triangle_cut_y(ax,ay, 0,dy, 0,cy, c);
         exit;
      end;
      if (ax<0) and (cx<0) and (bx>=0) then begin
         delta1 := shl_(AX , 8) div (AX-BX);
         delta2 := shl_(CX , 8) div (CX-BX);
         dy:=CY + sar_(delta2*(BY-CY) , 8);
         ay:=AY + sar_(delta1*(BY-AY) , 8);
         triangle_cut_y(0,ay, bx,by, 0,dy, c);
         exit;
      end;
      if (ax<0) and (bx<0) and (cx>=0) then begin
         delta1 := shl_(BX , 8) div (BX-CX);
         delta2 := shl_(AX , 8) div (AX-CX);
         dy:=AY + sar_(delta2*(CY-AY) , 8);
         by:=BY + sar_(delta1*(CY-BY) , 8);
         triangle_cut_y(0,dy, 0,by, cx,cy, c);
         exit;
      end;
 {--------------------------------------------------------}
      if (ax>p319) and (bx<p320) and (cx<p320) then begin
         delta1 := shl_((AX-p319) , 8) div (AX-CX);
         delta2 := shl_((AX-p319) , 8) div (AX-BX);
         dy:=AY + sar_(delta2*(BY-AY) , 8);
         ay:=AY + sar_(delta1*(CY-AY) , 8);
         triangle_cut_y(cx,cy, p319,ay,  bx, by, c);
         triangle_cut_y(bx,by, p319,ay, p319, dy, c);
         exit;
      end;
      if (bx>p319) and (ax<p320) and (cx<p320) then begin
         delta1 := shl_((BX-p319) , 8) div (BX-AX);
         delta2 := shl_((BX-p319) , 8) div (BX-CX);
         dy:=BY + sar_(delta2*(CY-BY) , 8);
         by:=BY + sar_(delta1*(AY-BY) , 8);
         triangle_cut_y(ax,ay, p319,by,  cx, cy, c);
         triangle_cut_y(cx,cy, p319,by, p319, dy, c);
         exit;
      end;
      if (cx>p319) and (bx<p320) and (ax<p320) then begin
         delta1 := shl_((CX-p319) , 8) div (CX-BX);
         delta2 := shl_((CX-p319) , 8) div (CX-AX);
         dy:=CY + sar_(delta2*(AY-CY) , 8);
         cy:=CY + sar_(delta1*(BY-CY) , 8);
         triangle_cut_y(ax,ay, bx,by,  p319, cy, c);
         triangle_cut_y(ax,ay, p319,cy, p319, dy, c);
         exit;
      end;

      if (ax>p319) and (cx>p319) and (bx<p320) then begin
         delta1 := shl_((AX-p319) , 8) div (AX-BX);
         delta2 := shl_((CX-p319) , 8) div (CX-BX);
         dy:=CY + sar_(delta2*(BY-CY) , 8);
         ay:=AY + sar_(delta1*(BY-AY) , 8);
         triangle_cut_y(p319,ay, bx,by, p319,dy, c);
         exit;
      end;
      if (bx>p319) and (cx>p319) and (ax<p320) then begin
         delta1 := shl_((CX-p319) , 8) div (CX-AX);
         delta2 := shl_((BX-p319) , 8) div (BX-AX);
         dy:=BY + sar_(delta2*(AY-BY) , 8);
         cy:=CY + sar_(delta1*(AY-CY) , 8);
         triangle_cut_y(ax,ay, p319,dy, p319,cy, c);
         exit;
      end;
      if (ax>p319) and (bx>p319) and (cx<p320) then begin
         delta1 := shl_((BX-p319) , 8) div (BX-CX);
         delta2 := shl_((AX-p319) , 8) div (AX-CX);
         dy:=AY + sar_(delta2*(CY-AY) , 8);
         by:=BY + sar_(delta1*(CY-BY) , 8);
         triangle_cut_y(p319,dy, p319,by, cx,cy, c);
         exit;
      end;
 end;
end;

procedure put_to_projections(ax,ay,bx,by,cx,cy:longint; c:byte;out1:word);
begin
   {Если трегольник попадает целиком в одну плоскость - создаем один треуг.}
   if (ax>=-p320) and (bx>=-p320) and (cx>=-p320) and
      (ax<0)  and (bx<0)  and (cx<0) then begin
      proj_Triangle_cut(ax+p320,ay,bx+p320,by,cx+p320,cy,   c+0,    3, out1);
      exit;
      end;
   if (ax>=0) and (bx>=0) and (cx>=0) and
      (ax<p320) and (bx<p320) and (cx<p320) then begin
      proj_Triangle_cut(ax,ay,bx,by,cx,cy,                  c+12,   0, out1);
      exit;
      end;
   if (ax>=p320) and (bx>=p320) and (cx>=p320) and
      (ax<=p640) and (bx<=p640) and (cx<=p640) then begin
      proj_Triangle_cut(ax-p320,ay,bx-p320,by,cx-p320,cy,   c+0,    1, out1);
      exit;
      end;
   if (ax> p640) and (bx> p640) and (cx> p640) and
      (ax<=p960) and (bx<=p960) and (cx<=p960) then begin
      proj_Triangle_cut(ax-p640,ay,bx-p640,by,cx-p640,cy,   c+12,    2, out1);
      exit;
      end;
   if (ax> p960)  and (bx> p960)  and (cx> p960)  and
      (ax<=p1280) and (bx<=p1280) and (cx<=p1280) then begin
      proj_Triangle_cut(ax-p960,ay,bx-p960,by,cx-p960,cy,   c+0,    3, out1);
      exit;
      end;

   {Если треугольник попадает сразу в две плоскости - создаем треугольники
   для каждой плоскости}

   if ((ax>=-p320) and (bx>=-p320) and (cx>=-p320)) and
      (ax<0)  or (bx<0)  or (cx<0) then begin
      proj_Triangle_cut(ax,ay,bx,by,cx,cy,                   c+12, 0, out1);
      proj_Triangle_cut(ax+p320,ay,bx+p320,by,cx+p320,cy,    c+0,  3, out1);
      exit;
      end;
   if ((ax>=0) and (bx>=0) and (cx>=0))   and
      (ax<p320) or (bx<p320) or (cx<p320) then begin
      proj_Triangle_cut(ax,ay,bx,by,cx,cy,                   c+12,    0, out1);
      proj_Triangle_cut(ax-p320,ay,bx-p320,by,cx-p320,cy,    c+0,     1, out1);
      exit;
      end;
   if ((ax>=p320) and (bx>=p320) and (cx>=p320)) and
      ((ax<=p640) or  (bx<=p640)  or (cx<=p640)) then begin
      proj_Triangle_cut(ax-p320,ay,bx-p320,by,cx-p320,cy,    c+0,     1, out1);
      proj_Triangle_cut(ax-p640,ay,bx-p640,by,cx-p640,cy,    c+12,    2, out1);
      exit;
      end;
   if ((ax>p640) and (bx>p640) and (cx>p640)) and
      ((ax<=p960) or  (bx<=p960)  or (cx<=p960)) then begin
      proj_Triangle_cut(ax-p640,ay,bx-p640,by,cx-p640,cy,    c+12,    2, out1);
      proj_Triangle_cut(ax-p960,ay,bx-p960,by,cx-p960,cy,    c+0,     3, out1);
      exit;
      end;
   if ((ax>p960) and (bx>p960) and (cx>p960)) and
      ((ax<=p1280) or  (bx<=p1280)  or (cx<=p1280)) then begin
      proj_Triangle_cut(ax-p960,ay,bx-p960,by,cx-p960,cy,       c+0,    3, out1);
      {proj_Triangle_cut(ax-p1280,ay,bx-p1280,by,cx-p1280,cy,    c+16,   0, out1);}
      exit;
      end;

end;

procedure drawcubic(var faces:array of byte; num_faces:word; color_mode:byte; xx,yy:longint; out1 : word);
var
p3,p:word;
sqrtp, q3, pom, axv,ayv,azv,bxv,byv,bzv,nx,ny,nz:single;
ax,ay,az,bx,by,bz,cx,cy,cz:single;
krat, real_face:integer;
col:byte;
face_color:array[0..31] of byte;
begin
for p:=0 to 31 do face_color[p]:=255;

 q3:=-4;
 for p:=0 to num_faces-1 do begin
  p3:=p*3;
  ax:=cubeDc2[faces[p3]*3];
  ay:=cubeDc2[faces[p3]*3+1];
  az:=cubeDc2[faces[p3]*3+2];
  bx:=cubeDc2[faces[p3+1]*3];
  by:=cubeDc2[faces[p3+1]*3+1];
  bz:=cubeDc2[faces[p3+1]*3+2];
  cx:=cubeDc2[faces[p3+2]*3];
  cy:=cubeDc2[faces[p3+2]*3+1];
  cz:=cubeDc2[faces[p3+2]*3+2];

  axv:=cx-ax;
  ayv:=cy-ay;
  azv:=cz-az;
  bxv:=bx-ax;
  byv:=by-ay;
  bzv:=bz-az;
  nx:=ayv*bzv-azv*byv;
  ny:=azv*bxv-axv*bzv;
  nz:=axv*byv-ayv*bxv;
  pom:=nz*q3+nx*axv+ny*ayv+nz*azv;

  if (pom>0) then begin
   {if col>14 then col:=col+3;
   if col>18 then col:=18;}
   if color_mode=1 then
               begin
                 sqrtp:=sqrt_(nx*nx+ny*ny+nz*nz);
                 col:=round((nz*q3)/(sqrtp*4)*18);{}
                 col:=col+(p and 7) shl 5;{}
               end;
   if color_mode=2 then begin
        if (p>79) then krat:=(p+1) div 12 else krat:=p div 16+1;
        if krat>7 then krat:=krat-8;
        if (p>79) then real_face:=(p-80) div 3+20 else real_face:=p div 4;
        if face_color[real_face]=255 then
               begin
                 sqrtp:=sqrt_(nx*nx+ny*ny+nz*nz);
                 col:=round((nz*q3)/(sqrtp*4)*18);{}
                 face_color[real_face]:=col+krat shl 5;
               end;
        col:=face_color[real_face];{}
        {col:=col+krat shl 5;{}
        end;
   put_to_projections(round(ax+xx),round(ay+yy),round(bx+xx),round(by+yy),
   round(cx+xx),round(cy+yy),col,out1);{}

   end;
 end;
end;

procedure copyCubic(var inp:array of shortint; var out:array of single; num_vertex:word);
var p:word;
begin
 for p:=0 to num_vertex*3-1 do out[p]:=inp[p];
end;

procedure rotateCubic_1(var inp:array of single; var out:array of single; num_vertex:word; xr,yr,zr:single);
var x,y,z,X1,Y1,Z1:single;
CosX, CosY, CosZ, SinX,SinY,SinZ:single;
p,p3:integer;
begin
CosX:=cos_(Xr);SinX:=sin_(Xr);
CosY:=cos_(Yr);SinY:=sin_(Yr);
CosZ:=cos_(Zr);SinZ:=sin_(Zr);
p3:=0;
 for p:=0 to num_vertex-1 do begin
  x:=inp[p3];
  y:=inp[p3+1];
  z:=inp[p3+2];
  x1:=cosy*x-siny*z;
  z1:=siny*x+cosy*z;
  out[p3]:=cosz*x1+sinz*y;    {x}
  y1:=cosz*y-sinz*x1;
  out[p3+2]:=cosx*z1-sinx*y1; {z}
  out[p3+1]:=sinx*z1+cosx*y1; {y}
  p3:=p3+3;
end;
end;


procedure rotateCubic_2(var vertexes:array of single; num_vertex:word; xr,yr,zr, scalec, per:single);
var
x,y,z,X1,Y1,Z1:single;
p,p3:word;
Cosxan,Sinxan,Cosyan,Sinyan,Coszan,Sinzan:single;
begin
CosXan:=cos_(Xr);SinXan:=sin_(Xr);
CosYan:=cos_(Yr);SinYan:=sin_(Yr);
CosZan:=cos_(Zr);SinZan:=sin_(Zr);
p3:=0;
  for p:=0 to num_vertex-1 do begin
   x:=vertexes[p3];
   y:=vertexes[p3+1];
   z:=vertexes[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;
   CubeDc2[p3]:=  (x*per/(z-per)*scalec);
   CubeDc2[p3+1]:=(y*per/(z-per)*scalec);
   CubeDc2[p3+2]:=(z*per/(z-per)*scalec);
   p3:=p3+3;
  end;
end;

procedure drawText(stroka:string; xx,yy:longint;interval:integer; col:byte; fontseg,out1:word);
procedure drawGlyph(ascii_code:byte; xx,yy: integer; col:byte; fontseg,out1:word);
var
g,p,n,f,size:integer;
vax,vay,vbx,vby,vcx,vcy:longint;
begin

 n:=   mem[fontseg+168+81:     ascii_code]; {ascii_index[ascii_code]}
 g:=  memw[fontseg+168+81+8:   n shl 1];    {glyph_offset[n];}
 size:=mem[fontseg+168+81+8+8: n] -1;       {glyph_size[n]-1;}

 for n:=0 to size do
 begin
     asm
     mov es, FontSeg
     mov ax, xx
     db $66,$98 {cwde}
     db $66; mov cx, ax
     mov ax, yy
     db $66,$98 {cwde}
     db $66; mov dx, ax


     {p:=(n*3 + g)*2;}
     mov ax, n
     mov si, ax
     add si, ax
     add si, ax
     add si, g
     add si, si

     {f:=memw[FontFacesSeg:  P];}
     db $66; mov di, es:[si +81*16]
     {ax:=(mem[FontVertexSeg: f]  +xx) *g_scale;}
     {ay:=(mem[FontVertexSeg: f+1]+yy) *g_scale;}
     db $66; xor ax, ax
     db $66; xor bx, bx
     mov al, es:[di]
     mov bl, es:[di+1]
     db $66; add ax, cx
     db $66; add bx, dx
     db $66; shl ax, 4
     db $66; shl bx, 4
     db $66; mov word ptr vax, ax
     db $66; mov word ptr vay, bx

     {f:=memw[FontFacesSeg:  P +2];}
     db $66; shr di, 16 {mov di, es:[si +81*16 +2]}
     {bx:=(mem[FontVertexSeg: f]  +xx) *g_scale;}
     {by:=(mem[FontVertexSeg: f+1]+yy) *g_scale;}
     db $66; xor ax, ax
     db $66; xor bx, bx
     mov al, es:[di]
     mov bl, es:[di+1]
     db $66; add ax, cx
     db $66; add bx, dx
     db $66; shl ax, 4
     db $66; shl bx, 4
     db $66; mov word ptr vbx, ax
     db $66; mov word ptr vby, bx

     {f:=memw[FontFacesSeg:  P +4];}
     mov di, es:[si +81*16 +4]
     {cx:=(mem[FontVertexSeg: f]  +xx) *g_scale;}
     {cy:=(mem[FontVertexSeg: f+1]+yy) *g_scale;}
     db $66; xor ax, ax
     db $66; xor bx, bx
     mov al, es:[di]
     mov bl, es:[di+1]
     db $66; add ax, cx
     db $66; add bx, dx
     db $66; shl ax, 4
     db $66; shl bx, 4
     db $66; mov word ptr vcx, ax
     db $66; mov word ptr vcy, bx
     end;
     put_to_projections(vax,vay, vbx,vby, vcx,vcy, col, out1);
 end;
end;

var n:integer;
x_:longint;
begin
x_:=0;
for n:=1 to length(stroka) do
begin
   if (stroka[n]<>' ') then drawGlyph(ord(stroka[n]), (xx+x_),yy, col, fontseg,out1);
   x_:=x_+interval;
   if (stroka[n]='W') or (stroka[n]='M') then x_:=x_+interval div 3;
   if stroka[n]=' ' then x_:=x_-interval div 2;
end;
end;


procedure DrawBackground(q, sintable, where:word);
var n,m,l:word;
begin
  asm
    mov es, where
    mov si, q
    push ds
    mov ds, sintable
    xor di, di
    mov dx, 199
    @n: {for n:=0 to 199 do begin}
        {l:=memw[sintable:  (q + n*8) and 1023   shl 1];}
        mov bx, dx
        shl bx, 3
        add bx, si
        and bx, 1023
        shl bx, 1
        mov ax, ds:[bx]
        {m:=l*n shr 11 +64;}
        db $0f,$af,$c2 {imul ax, dx}
        shr ax, 11
        add ax, 64
        mov ah, al
        mov bx, ax
        db $66; shl ax, 16
        mov ax, bx
        {DrawLineH(0,319, n,  m, where);}
        mov cx, 320/4
        db $66; rep stosw
    dec dx
    jns @n
    pop ds
  end;
end;



var
start_time, old_time:longint;
elapsed_time, seg_sintable:word;

jump_on:array[0..7] of word;
poloski2_blink, poloski1_blink, event, speed_pal, stage, col, poloski1,poloski2, height_poloski1, height_poloski2:byte;
x_text,xx,yy: longint;
time_lastevent,  temp, n,m,y:integer;
sub_q, q3, q2, q1,q:word;
cube_scale, xr,yr,zr:single;
cube_rotate:xyz_s;
damping, icosa_x, icosa_y, icosa_vx, icosa_vy, gravy:single;
palgreen, paldef, palgray, palcont: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 select_color_scheme(scheme, speed:word);
begin
   mem2mem(scheme,0, seg_palitra,ofs_palitra+palette2, 1536);
   init_pal2pal(seg_palitra, ofs_palitra);
   palette_process[0]:=1; palette_process[1]:=1;
   speed_pal:=speed;
end;

procedure go_event(e:word;name:string; param1:integer);
begin
  if (e=event) then begin

     if      name='jump1' then begin
                         jump_on[1]:=q;
             end
     else if name='jump2' then begin
                         jump_on[2]:=q;
             end
     else if name='cont' then begin
             select_color_scheme(palcont, param1);
             end
     else if name='gray' then begin
             select_color_scheme(palgray, param1);
             jump_on[2]:=q;
             end
     else if name='def' then begin
             select_color_scheme(paldef,param1);
             end
     else if name='green' then begin
             select_color_scheme(palgreen,param1);
             end;

  time_lastevent:=mtimer;
  inc(event);
  end;
end;




procedure scene_project;
begin
 Clear(0, 65535, vaddr);
 Clear(0, 65535, vaddr2);
 Clear(0, 65535, vaddr3);
 Clear(18, 64000, vga);

(*
{Load font to virtual buffer}
for n:=0 to 641*2-1 do  mem[vaddr3:            n]  :=round(vertex[n]*1.5);
for n:=0 to 447*3-1 do memw[vaddr3+81:         n shl 1] :=faces[n]*2;
for n:=0 to 95 do       mem[vaddr3+168+81:     n]       :=ascii_index[n];
for n:=0 to 53 do      memw[vaddr3+168+81+8:   n shl 1] :=glyph_offset[n];
for n:=0 to 53 do       mem[vaddr3+168+81+8+8: n]       :=glyph_size[n];
*)

{cals sintable for background effect}
seg_sintable:=vaddr2+3960;
for n:=0 to 1023 do
memw[seg_sintable:n shl 1]:=round( (sin_(6.283185307/1024 *n)*8+26)*8);

LoadBinUnpack('proj.bin',  {load->}vaddr,{-unpack->}vaddr3,  0);
LoadBin('proj.pal', seg_palitra,  ofs_palitra+palette1);


Clear(18, 64000, vaddr);



DitherFadeInit(vaddr);

setpalette_from_memW(palette1,seg_palitra,ofs_palitra);

palette_process[0]:=0;
palette_process[1]:=0;
speed_pal:=1;

paldef  :=vaddr3+1000;
palgray :=vaddr3+1100;
palcont :=vaddr3+1200;
palgreen:=vaddr3+1300;

g_scale:=16;

p199:=199*g_scale;
p200:=200*g_scale;
p320:=320*g_scale;
p319:=319*g_scale;
p640:=640*g_scale;
p960:=960*g_scale;
p1280:=1280*g_scale;

gravy:=0.094;
damping:=0.85;
icosa_x:=1000;
icosa_y:=-120;
icosa_vx:=2;
icosa_vy:=0;
x_text:=1300;

copyCubic(icosahedron_v, CubeDc1, icosa_vertex);
rotateCubic_1(CubeDc1, CubeDc1, icosa_vertex, 0,180,90);


event:=0;
time_lastevent:=0;
for n:=0 to 7 do jump_on[n]:=0;
stage:=0;
cube_scale:=0.565;
cube_rotate.y:=4.7;
poloski1:=0;
poloski2:=0;
height_poloski1:=16;
height_poloski2:=1;
poloski1_blink:=0;
poloski2_blink:=0;

randseed:=1;

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

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

if (elapsed_time>0) or (Aantal=0) then MP^.GetInformation(@info); {midas get info);}


DrawBackground(q shl 3, seg_sintable, vaddr);


if stage=0 then DitherFade(q*2, 18, vaddr3, vaddr);
if (stage=0) and (music_pos(13,40)) {(q>280)} then
begin
   LoadBin('font2.bin', vaddr3, 0);
   LoadBin('proj.pal',     paldef,  0);
   LoadBin('projgray.pal', palgray,  0);
   LoadBin('projcont.pal', palcont,  0);
   LoadBin('proj2.pal', palgreen, 0);
   sub_q:=q;
   stage:=1;
end;

{0}
meml[vaddr2:0]:=0;
mesh_triangle_add(0,0,0, p319,p199,0,  0,p199,0,   0,              0*6+22, vaddr2);
mesh_triangle_add(0,0,0, p319,0,0,    p319,p199,0, 0,              0*6+22, vaddr2);
{1}
mesh_triangle_add(p319,0,0,  p319,p199,-p319,  p319,p199,0,     1, 0*4+18, vaddr2);
mesh_triangle_add(p319,0,0,  p319,0,-p319,     p319,p199,-p319, 1, 0*4+18, vaddr2);
{2}
mesh_triangle_add(0,0,-p319, 0,p199,-p319,    p319,p199,-p319,  2, 0*5+22, vaddr2);
mesh_triangle_add(0,0,-p319, p319,p199,-p319,  p319,0,-p319,    2, 0*5+22, vaddr2);
{3}
mesh_triangle_add(0,0,0,    0,p199,0,       0,p199,-p319,       3, 0*2+18, vaddr2);
mesh_triangle_add(0,0,0,    0,p199,-p319,    0,0,-p319,         3, 0*2+18, vaddr2);

{4}
mesh_triangle_add(0,0,0,    p319,0,-p319,     p319,0,0,         4, 32*0+8, vaddr2);
mesh_triangle_add(0,0,0,    0,0, -p319,     p319,0,-p319,       4, 32*0+8, vaddr2);
{5}
mesh_triangle_add(0,p199,0,    p319,p199,0,     p319,p199,-p319,5, 32*0+18, vaddr2);
mesh_triangle_add(0,p199,0,    p319,p199,-p319, 0,p199, -p319,  5, 32*0+18, vaddr2);

meml[vaddr2:0]:=12;

{-Работаем с большим кубом--------------------------------------------------}
if stage>1 then cube_rotate.z:=-sin((q-q1)/16)*0.1;
{.....................................................}
if stage>2 then begin
    if stage<6 then cube_rotate.y:=4.7-sin((q-q2)/650)*6.3;
    cube_rotate.x:=0;
    if stage<6 then cube_scale:=0.56+sin((q-q2)/100)*0.05
               else if cube_scale<2.5 then cube_scale:=cube_scale+ ((q-q3)/20000)*elapsed_time;
end;

{Вычисляем и рисуем видимые грани куба, составляем их список (массив visible)}
main_cube_rotate(-160*g_scale, -100*g_scale, 160*g_scale,
            cube_rotate.x,cube_rotate.y,cube_rotate.z, vaddr2);

{poloski1:=0;}
if (jump_on[1]>0) then poloski1:=round(jump1(jump_on[1], 1, 10)) else poloski1:=0;
main_cube_draw(poloski1, height_poloski1,word(round(sin_(q/3)*10)), 160,100, cube_scale, 512*g_scale, vaddr2, vaddr);

{---------------------------------------------------------------------------}

{Добавляем в общий меш текст ...............................................}
if (stage>2) and (stage<5) then begin
  x_text:=x_text-elapsed_time*4;
  if (x_text<1280) then drawText('WE ARE BACK!',x_text, -20, 140, byte(6), vaddr3, vaddr2);{}
end;




{=========================================================================}
if elapsed_time>0 then begin

     if (stage>0) then begin
      case event of
        0:  if (q-sub_q>72)               then go_event(0, 'cont', 64);
        1:  if (mtimer-time_lastevent>10) then go_event(1, 'def', 16);
        2:  if (music_pos(14, 16))        then go_event(2, 'cont', 64);
        3:  if (mtimer-time_lastevent>20) then go_event(3, 'def', 16);
        4:  if (music_pos(14, 32))        then go_event(4, 'cont', 32);
        5:  if (mtimer-time_lastevent>10) then go_event(5, 'def', 16);
        6:  if (music_pos(14, 48))        then go_event(6, 'gray', 16);
        7:  if (mtimer-time_lastevent>20) then go_event(7, 'def', 16);
        8:  if (music_pos(15,0))          then go_event(8, 'cont', 64);
        9:  if (mtimer-time_lastevent>10) then go_event(9, 'def', 16);
        10: if (music_pos(15, 16))        then go_event(10, 'cont', 64);
        11: if (mtimer-time_lastevent>20) then go_event(11, 'def', 16);
        12: if (music_pos(15, 32))        then go_event(12, 'cont', 32);
        13: if (mtimer-time_lastevent>10) then go_event(13, 'def', 16);
        14: if (music_pos(15, 48))        then go_event(14, 'gray', 64);
        15: if (mtimer-time_lastevent>20) then go_event(15, 'def', 16);
        16: if (music_pos(16, 0))         then go_event(16, 'green', 32);
        17: if (mtimer-time_lastevent>10) then go_event(17, 'def', 16);
        18: if (music_pos(16, 15))        then go_event(18, 'green', 64);
        19: if (mtimer-time_lastevent>10) then go_event(19, 'def', 16);
       end;
     end;


     if (info^.pos>13) then begin { poloski1 blink }
         if (info^.row > 3 + poloski1_blink shl 3) and
            (info^.row < 3 + (poloski1_blink+1) shl 3)
            then begin
                   jump_on[1]:=q;
                   height_poloski1:=2 shl random(3);
                   inc(poloski1_blink);
                   poloski1_blink:=poloski1_blink and 7;
                 end;
     end;


     if (info^.pos>13) then begin { poloski2 blink }
         if (info^.row > 33) and (poloski2_blink=0) then
              begin
                jump_on[2]:=q;
                height_poloski2:=height_poloski2 xor 1;
                inc(poloski2_blink);
              end;
         if (info^.row < 33) and (poloski2_blink=1) then poloski2_blink:=0;
     end;

       {.....................................................}
       if (stage=3) and (q-sub_q>750) then begin
         stage:=4;
         icosa_x:=-160;
         icosa_y:=-100;
         icosa_vx:=0;
         icosa_vy:=3;
         copyCubic(football_v, CubeDc1, football_vertex);
         rotateCubic_1(CubeDc1, CubeDc1, football_vertex, 0,180,0);
         sub_q:=q;
       end;
       {.....................................................}
       if (stage=4) and (x_text<-1800) then stage:=5;
       {.....................................................}
       if (stage=5) and (q>1300) then begin stage:=6; q3:=q; end;
       {.....................................................}
       if (stage=6) then begin
             for n:=0 to 255 do setonecolor2memw(n, 5,5,12, palette2, seg_palitra,ofs_palitra);
             init_pal2pal(seg_palitra, ofs_palitra);
             palette_process[0]:=1;
             palette_process[1]:=1;
             speed_pal:=3;
             stage:=7;
       end;
end;{=================================================================}


{Добавяем в общий меш 3д-обект.............................................}
if ((stage>0) and (stage<4)) or ((stage>4) and (stage<8)) then {-----------}
begin

    if elapsed_time>0 then
    begin
         icosa_vy:=icosa_vy+gravy  *elapsed_time;
         icosa_x:=icosa_x+icosa_vx *elapsed_time;
         icosa_y:=icosa_y+icosa_vy *elapsed_time;

         {отскоки}
         if (icosa_x<-300) then begin icosa_vx:=-icosa_vx; icosa_x:=-300; end;
         if (icosa_x>1200) then begin icosa_vx:=-icosa_vx; icosa_x:=1200; end;
         if icosa_y>110 then begin
             if abs(icosa_vy)>3 then icosa_vy:=-icosa_vy*damping else icosa_vy:=-icosa_vy;
             icosa_y:=110;
             if stage=1 then begin stage:=2; q1:=q; end;
         end;
    end;


    if (stage=2) and (icosa_x<1100) then begin stage:=3; q2:=q; end;

    Xr:=rad(q)*3;{}
    Yr:=rad(q)*2;{}
    Zr:=rad(icosa_x/2)*4;
    xx:=round(icosa_x*g_scale);
    yy:=round(icosa_y*g_scale);

    if stage<4 then begin
       rotateCubic_1(CubeDc1, CubeDc2, icosa_vertex, xr,yr,0);
       rotateCubic_2(CubeDc2, icosa_vertex, 0,0,-zr, 0.7*g_scale, 700);
       drawcubic  (icosahedron_f, icosa_faces, 1, xx, yy, vaddr2);
    end
    else begin
       rotateCubic_2(CubeDc1, football_vertex, xr,yr,zr, 1*g_scale, 700);
       drawcubic  (football_f, football_faces, 2, xx, yy, vaddr2);
    end;
end;{-------------------------------------------------}


{Работаем с треугольниками добавленными на видимые плоскости (после куба)}
mesh_rotate_2(-160*g_scale, -100*g_scale, 160*g_scale,
            cube_rotate.x,cube_rotate.y,cube_rotate.z, vaddr2);
{poloski2:=0;}
if (jump_on[2]>0) then poloski2:=round(jump1(jump_on[2], 1, 10)) else poloski2:=0;
mesh_draw_2(poloski2,16 shl height_poloski2,word(round(sin_(q/4)*10)), 160,100, cube_scale, 512*g_scale, vaddr2, vaddr);



if Vsync_mode=1 then Midas_WaitVR;{}

if Aantal and 1 = 0 then
   begin
      if palette_process[0]=1 then
      Pal2Pal_asm(palette_process[0], 0, 127, elapsed_time*speed_pal, seg_palitra,ofs_palitra);
   end
else begin
      if palette_process[1]=1 then
      Pal2Pal_asm(palette_process[1], 128, 255, elapsed_time*speed_pal, seg_palitra,ofs_palitra);
   end;


FlipScreen(vaddr,VGA);


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

until (esc_test) or (info^.pos=17);
end;

end.
