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

interface


procedure set_rubik_buffers(buff_320,buff_160,history_buff:word);
procedure set_rubik_colors(c1,c2,c3, c_dither,  c_add, mask: byte);
procedure set_rubik_mode(m:byte);
function columns(q, count_column, height_column, speed, per:word; where:word): byte;
function Mosaik(q, tip, gradient, where:word):byte;


implementation

uses math2;

TYPE
  screen_type = record
  segm : word;
  rez  : byte;
  color: byte;
  end;

CONST
 REZ160 = 160;
 REZ320 = 0;


var
  screeen:array[0..1] of screen_type;
  MODE:byte;
  BUFFER_160, BUFFER_320, HISTORY_BUFFER:word;
  LEFT_BUFFER, RIGHT_BUFFER:word;
  LEFT_REZ, RIGHT_REZ:byte;
  col1,col2,col3:byte;
  COL_DITHER_320:byte;
  COL_ADD_160:byte;
  DITHER_MASK_160:byte;


PROCEDURE DitherLineH(X1,X2,Y1:integer; bright, col1,col2:Byte;where:word);
var pattern_seg, pattern_ofs:word;
BEGIN
if (y1<0) or (y1>199) then exit;
if (x1<0) then x1:=0;
if (x2>319) then x2:=319;
     ASM
       {-------- create dither pattern in EAX----------}
        mov  ax, y1
        and  ax, 3; jnz @sk0
              db $66; mov bx, 0A02h; dw $0800 {0,8,2,10} jmp @go
        @sk0: cmp al, 1; jne @sk1
              db $66; mov bx, 060Eh; dw $040C {12,4,14,6}jmp @go
        @sk1: cmp al, 2; jne @sk2
              db $66; mov bx, 0901h; dw $0B03 {3,11,1,9} jmp @go
        @sk2: db $66; mov bx, 050Dh; dw $070F {15,7,13,5}
        @go:
        mov  cx, x1
        and  cx, 3
        shl  cx, 3
        db $66; ror bx, cl
        mov  dl, bright
        mov  cl, col1
        mov  ch, col2
        mov dh, 3
        @dith:
             mov al, cl
             cmp bl, dl; jl @skipd
                 mov al, ch
             @skipd:
             db $66; ror ax, 8
             db $66; ror bx, 8
        dec dh
        jns @dith
       {-----------------------------------}
        mov  es, where
        mov  bx, y1
        mov  di, bx
        xchg bh, bl     {y*256}
        shl  di, 6      {y*64}
        add  di, bx
        mov  bx, x1
        mov  dx, x2
        add  di, bx     {start offset}

        inc  dx
        sub  dx, bx   {length}

        mov  cx, dx
        shr  cx, 2
        db $66; rep stosw

        @length_less_four:
           test dx, 2
           jz @one_pix
           mov es:[di], ax
           add di, 2
           db $66; shr ax, 8*2
        @one_pix:
           test dx, 1
           jz @exit
           mov es:[di], al
     @exit:
  END;
END;

PROCEDURE TextureHorline(xbeg,xend,y:integer; c1,c2, yt:word; col,bright, resolution:byte; texture,where : word);
var delta : word;
begin
if (y<0) or (y>199) then exit;

if resolution=REZ320 then begin

   if (Xend<>Xbeg) then delta := ((longint(c2-c1+1) shl 9) div (Xend-Xbeg))
                   else delta := 0;
   if xend>319 then xend:=319;

asm
  mov es, where
  mov di, xbeg
  mov bx, Xend
  mov si, c1

  xor ax, ax

  { if xbeg<0 then begin c1:=sar_(-xbeg*delta, 9)+c1;  xbeg:=0; end;}
  cmp di, 0
  jge @sk
    mov ax, delta
    neg di
    db $66,$0f,$bf,$ff {movsx edi, di}
    db $66,$98         {cwde}
    db $66,$0f,$af,$f8 {imul edi, eax}
    db $66; sar di, 9
    add si, di
    xor di, di
  @sk:

  {-------- create dither pattern in EBX -----------------------}
  mov   ax, y
  and   ax, 3; jnz @sk0
        db $66; mov ax, 0A02h; dw $0800 {0,8,2,10} jmp @go
  @sk0: cmp al, 1; jne @sk1
        db $66; mov ax, 060Eh; dw $040C {12,4,14,6}jmp @go
  @sk1: cmp al, 2; jne @sk2
        db $66; mov ax, 0901h; dw $0B03 {3,11,1,9} jmp @go
  @sk2: db $66; mov ax, 050Dh; dw $070F {15,7,13,5}
  @go:
  mov cx, di  {cals start position for dither pattern}
  and cx, 3
  shl cx, 3
  db $66; ror ax, cl

  mov dl, bright {make "dither bright" mask}
  mov dh, dl
  mov cx, dx
  db $66; shl dx, 16
  mov dx, cx
  db $66; sub ax, dx
  db $66; and ax, 8080h; dw $8080
  db $66; shr ax, 7
  db $66; add ax, 7f7fh; dw $7f7f
  db $66; xor ax, 7f7fh; dw $7f7f
 {-------------------------------------------------------------}

  inc bx
  sub bx, di     {call length}
  js @close
  jz @close
  mov cx, bx
  db $66; shl cx, 16 {store lenght in hi-part ECX}
  mov cx, bx

  {call start texture offset (yt*320+c1)}
  mov  bx, yt
  xchg bh, bl
  add  si, bx
  shr  bx, 2
  add  si, bx

  {---------------self-modify---------------}
  mov bl, col {shadow col}
  mov bh, bl
  mov dx, bx
  db $66; shl bx, 16
  mov bx, dx
  db $66; mov dx, ax {dither masking}
  db $66; not dx
  db $66; and bx, dx
  db $66; mov cs:[offset @col1+2], bx
  mov cs:[offset @col2+1], bx
  test cx, 2; jz @skip_this; db $66; ror bx, 16; @skip_this:
  mov cs:[offset @col3+1], bl
  mov cs:[offset @si1+2], si
  mov cs:[offset @si2+2], si
  mov cs:[offset @si3+2], si
  mov cs:[offset @si4+2], si
  mov cs:[offset @si5+2], si
  mov cs:[offset @si6+2], si
  mov cs:[offset @si7+2], si
  jmp @clear_prefetch2; @clear_prefetch2:
  {-----------------------------------------}

  {call start screen offset (y*320+xbeg)}
  mov  bx, y
  xchg bh, bl
  add  di, bx
  shr  bx, 2
  add  di, bx

  db $66; xor si, si
  mov si, delta

  push ds
  push bp
  mov ds, texture
  db $66; mov bp, ax

  db $66; xor dx, dx
  db $66; xor bx, bx

  shr cx, 2; jz @length_less_four
 @l_d:
  @si1: mov al, ds:[bx+1234h]
  db $66; add dx, si
  db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}

  @si2: mov ah, ds:[bx+1234h]
  db $66; add dx, si
  db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}

  db $66; shl ax, 16

  @si3: mov al, ds:[bx+1234h]
  db $66; add dx, si
  db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}

  @si4: mov ah, ds:[bx+1234h]
  db $66; add dx, si
  db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}

  db $66; rol ax, 16

  db $66; and ax, bp  {dither-shadow}
  @col1: db $66; or ax, 1234h; dw $5678
  db $66; mov es:[di], ax
  add di, 4
  dec cx
jnz @l_d

    @length_less_four:
       db $66; shr cx, 16  {restore original length}
       test cl, 2; jz @length_less_two
       @si5: mov al, ds:[bx+1234h]
       db $66; add dx, si
       db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}
       @si6: mov ah, ds:[bx+1234h]
       db $66; add dx, si
       db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}
       and ax, bp
       @col2: or ax, 1234h
       mov es:[di], ax
       add di, 2
       db $66; ror bp, 16

    @length_less_two:
       test cl, 1; jz @exit
       @si7: mov al, ds:[bx+1234h]  {draw last pixel}
       and ax, bp
       @col3: or al, 12h
       mov es:[di], al

@exit:
pop bp
pop ds
@close:
end;
end else begin

 if (Xend<>Xbeg) then delta := ((longint(c2-c1+1) shl 9) div (Xend-Xbeg)) shr 1
                 else delta := 0;
 if xend>319 then xend:=319;

asm
  mov es, where
  mov di, xbeg
  mov bx, Xend
  mov si, c1
  shr si, 1

  xor ax, ax

  { if xbeg<0 then begin c1:=sar_(-xbeg*delta, 9)+c1;  xbeg:=0; end;}
  cmp di, 0
  jge @sk
    mov ax, delta
    neg di
    db $66,$0f,$bf,$ff {movsx edi, di}
    db $66,$98         {cwde}
    db $66,$0f,$af,$f8 {imul edi, eax}
    db $66; sar di, 9
    add si, di
    xor di, di
  @sk:

  {-------- create dither pattern in EBX -----------------------}
  mov   ax, y
  and   ax, 3; jnz @sk0
        db $66; mov ax, 0A02h; dw $0800 {0,8,2,10} jmp @go
  @sk0: cmp al, 1; jne @sk1
        db $66; mov ax, 060Eh; dw $040C {12,4,14,6}jmp @go
  @sk1: cmp al, 2; jne @sk2
        db $66; mov ax, 0901h; dw $0B03 {3,11,1,9} jmp @go
  @sk2: db $66; mov ax, 050Dh; dw $070F {15,7,13,5}
  @go:
  mov cx, di  {cals start position for dither pattern}
  and cx, 3
  shl cx, 3
  db $66; ror ax, cl

  mov dl, bright  {change pattern for bright imitation}
  mov cx, 4
  @ll:
     add al, dl
     db $66; ror ax, 8
  dec cx
  jnz @ll
 {-------------------------------------------------------------}

  inc bx
  sub bx, di     {call length}
  js @close
  jz @close
  mov cx, bx
  db $66; shl cx, 16 {store lenght in hi-part ECX}
  mov cx, bx

  {call start texture offset (yt*160+c1)}
  mov  bx, yt
  mov  dx, bx
  shl  dx, 7
  shl  bx, 5
  add  si, dx
  add  si, bx
  {---------------self-modify---------------}
  mov bl, col {additive col}
  mov bh, bl
  mov dx, bx
  db $66; shl bx, 16
  mov bx, dx
  db $66; mov cs:[offset @col1+2], bx
  mov cs:[offset @col2+1], bx
  mov cs:[offset @col3+1], bl
  mov cs:[offset @si1+2], si
  mov cs:[offset @si2+2], si
  mov cs:[offset @si3+2], si
  mov cs:[offset @si4+2], si
  mov cs:[offset @si5+2], si
  mov cs:[offset @si6+2], si
  mov cs:[offset @si7+2], si
  mov bl, DITHER_MASK_160 {masked bytes after sub}
  mov bh, bl
  mov dx, bx
  db $66; shl bx, 16
  mov bx, dx
  db $66; mov cs:[offset @mask1+2], bx
  mov cs:[offset @mask2+1], bx
  mov cs:[offset @mask3+1], bl
  jmp @clear_prefetch2; @clear_prefetch2:
  {-----------------------------------------}

  {call start screen offset (y*320+xbeg)}
  mov  bx, y
  xchg bh, bl
  add  di, bx
  shr  bx, 2
  add  di, bx

  db $66; xor si, si
  mov si, delta

  push ds
  push bp
  mov ds, texture
  db $66; mov bp, ax

  db $66; xor dx, dx
  db $66; xor bx, bx

  shr cx, 2; jz @length_less_four
 @l_d:
  @si1: mov al, ds:[bx+1234h]
  db $66; add dx, si
  db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}

  @si2: mov ah, ds:[bx+1234h]
  db $66; add dx, si
  db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}

  db $66; shl ax, 16

  @si3: mov al, ds:[bx+1234h]
  db $66; add dx, si
  db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}

  @si4: mov ah, ds:[bx+1234h]
  db $66; add dx, si
  db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}

  db $66; rol ax, 16

  db $66; sub ax, bp  {dithering}
  @mask1:db $66; and ax, 8080h; dw $8080
  @col1: db $66; add ax, 1234h; dw $5678
  db $66; mov es:[di], ax
  add di, 4
  dec cx
jnz @l_d

    @length_less_four:
       db $66; shr cx, 16  {restore original length}
       test cl, 2; jz @length_less_two
       @si5: mov al, ds:[bx+1234h]
       db $66; add dx, si
       db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}
       @si6: mov ah, ds:[bx+1234h]
       db $66; add dx, si
       db $66,$0f,$a4,$d3,$17 {shld ebx, edx, 32-9} {mov ebx, edx; shr ebx, 9}
       sub ax, bp
       @mask2: and ax, 8080h
       @col2: add ax, 1234h
       mov es:[di], ax
       add di, 2
       db $66; ror bp, 16

    @length_less_two:
       test cl, 1; jz @exit
       @si7: mov al, ds:[bx+1234h]  {draw last pixel}
       sub ax, bp
       @mask3: and al, 80h
       @col3: add al, 12h
       mov es:[di], al

@exit:
pop bp
pop ds
@close:
end;
end;
end;



procedure copyline(x1,x2,y:integer; col, resolution:byte; from, where:word);
begin
if x1<0 then x1:=0;
if x2>319 then x2:=319;
if (x1=x2) or (x2<x1) then exit;

if resolution=REZ320 then
asm
   push ds
   mov  es, where
   mov  di, x1
   mov  cx, x2
   inc  cx
   sub  cx, di {calc length}
   mov  bx, y
   xchg bh, bl {calc start offset  (y*320+x1)}
   add  di, bx
   shr  bx, 2
   add  di, bx
   mov  si, di
   mov  dx, cx
   and  dx, 3
   shr  cx, 2
   mov  ds, from
   db $66; rep movsw
   mov  cx, dx
   rep movsb
   pop ds
end
else
asm
       {-------- create dither pattern in EBX -----------------------}
        mov  ax, y
        and  ax, 3; jnz @sk0
              db $66; mov bx, 0A02h; dw $0800 {0,8,2,10} jmp @go
        @sk0: cmp al, 1; jne @sk1
              db $66; mov bx, 060Eh; dw $040C {12,4,14,6}jmp @go
        @sk1: cmp al, 2; jne @sk2
              db $66; mov bx, 0901h; dw $0B03 {3,11,1,9} jmp @go
        @sk2: db $66; mov bx, 050Dh; dw $070F {15,7,13,5}
        @go:
       {-------------------------------------------------------------}

   push ds
   push bp
   mov  es, where
   mov  di, x1

   add  di, 3
   and  di, 508

   mov  si, di
   mov  cx, x2

   inc  cx
   sub  cx, di; jz @exit; js @exit {calc length}

   mov  dx, y
   xchg dh, dl {calc start offset  (y*320+x1)}
   add  di, dx
   shr  dx, 2
   add di, dx

   mov dx, y
   shr dx, 1

   {imul dx, dx, 160}
   mov ax, dx
   shl ax, 7 {*128}
   shl dx, 5 {*32}
   add dx, ax

   shr si, 1
   add si, dx

   mov al, DITHER_MASK_160 {masked bytes after sub}
   mov ah, al
   mov dx, ax
   db $66; shl ax, 16
   mov ax, dx
   db $66; push ax

   mov al, col
   mov ah, al
   mov dx, ax
   db $66; shl ax, 16
   mov ax, dx

   mov dx, x1

   mov ds, from
   db $66; pop bp {mov bp, 8080h; dw $8080}

{--------------------- first 1-3 pixels -----------------------}
   push di
   push si
   push cx
   mov cx, dx
   and cx, 3
   shl cx, 3
   db $66; ror bx, cl
   mov cx, 4
   and dx, 3; jz @skip0
   sub cx, dx
   sub di, cx
     test cx, 2; jz @byte
     db $66; mov dx, ds:[si]
     sub dx, bx
     and dx, bp {8080h}
     add dx, ax
     mov es:[di], dx
     add di, 2
     db $66; ror bx, 16
   @byte:
     test cx, 1; jz @skip0
     db $66; shr dx, 16
     sub dl, bl
     and dx, bp {80h}
     add dl, al
     mov es:[di], dl
     db $66; ror bx, 8
   @skip0:
   pop cx
   pop si
   pop di
{------------------------------------------------------------}

   push cx
   shr  cx, 3;  {/8} jz @less_eight
   @l:
     db $66; mov dx, ds:[si]
     db $66; sub dx, bx
     db $66; and dx, bp {8080h; dw $8080}
     db $66; add dx, ax
     db $66; mov es:[di], dx

     db $66; mov dx, ds:[si+2]
     db $66; sub dx, bx
     db $66; and dx, bp {8080h; dw $8080}
     db $66; add dx, ax
     db $66; mov es:[di+4], dx
     add si, 4
     add di, 8
   dec cl
   jnz @l

   @less_eight:
     pop cx
     test cl, 4; jz @less_four
     db $66; mov dx, ds:[si]
     db $66; sub dx, bx
     db $66; and dx, bp {8080h; dw $8080}
     db $66; add dx, ax
     db $66; mov es:[di], dx
     add si, 2
     add di, 4
   @less_four:
     test cl, 2; jz @less_two
     mov dx, ds:[si]
     sub dx, bx
     and dx, bp {8080h}
     add dx, ax
     mov es:[di], dx
     add si, 1
     add di, 2
     db $66; ror bx, 16
   @less_two:
     test cl, 1; jz @exit
     mov dl, ds:[si]
     sub dl, bl
     and dx, bp {80h}
     add dl, al
     mov es:[di], dl

   @exit:
   pop bp
   pop ds
end;
end;


procedure copyblock10(x,y:integer; col, resolution:byte; from, where:word);
begin
if resolution=REZ320 then
asm
   push ds
   mov  es, where
   mov  si, x
   mov  cx, y
   xchg ch, cl {calc start offset  (y*320+x1)}
   add  si, cx
   shr  cx, 2
   add  si, cx
   mov  di, si

   mov  ds, from

   mov  dx, 20
   @y:
        {db $66; mov ax, ds:[si]
        db $66; mov es:[si], ax
        db $66; mov ax, ds:[si+4]
        db $66; mov es:[si+4], ax
        db $66; mov ax, ds:[si+8]
        db $66; mov es:[si+8], ax
        db $66; mov ax, ds:[si+12]
        db $66; mov es:[si+12], ax
        db $66; mov ax, ds:[si+16]
        db $66; mov es:[si+16], ax}
        mov cx, 5; db $66; rep movsw;

   add si, 320-20
   add di, 320-20
   dec dx
   jnz @y
   pop ds
end
else
asm
   push ds
   push bp
   mov  es, where
   mov  di, x
   mov  si, di

  {-------------self-modding----------------}
           {fix for last column}
{   mov al, 66h {prefix for opcode}
{   cmp di, 300; jl @write {if x>=300 then}
{     mov al, 90h {nope}
{   @write:
{   mov cs:[offset @fix], al
   {jmp @clear_prefetch; @clear_prefetch:}
  {-----------------------------------------}

   mov  dx, y
   xchg dh, dl {calc start offset  (y*320+x1)}
   add  di, dx
   shr  dx, 2
   add  di, dx

   mov dx, y
   shr dx, 1
   {imul dx, dx, 160}
   mov ax, dx
   shl ax, 7 {*128}
   shl dx, 5 {*32}
   add dx, ax
   shr si, 1
   add si, dx

   mov cl, DITHER_MASK_160
   mov ch, cl
   mov dx, cx
   db $66; shl cx, 16
   mov cx, dx

   mov al, col
   mov ah, al
   mov dx, ax
   db $66; shl ax, 16
   mov ax, dx

   mov ds, from
   db $66; mov bp, cx {8080h; dw $8080}
   mov cx, 20
   @y:
        {select dither pattern}
        mov  bl, ch
        and  bl, 3; jnz @sk0
              db $66; mov bx, 0A02h; dw $0800 {0,8,2,10} jmp @go
        @sk0: cmp bl, 1; jne @sk1
              db $66; mov bx, 060Eh; dw $040C {12,4,14,6}jmp @go
        @sk1: cmp bl, 2; jne @sk2
              db $66; mov bx, 0901h; dw $0B03 {3,11,1,9} jmp @go
        @sk2: db $66; mov bx, 050Dh; dw $070F {15,7,13,5}
        @go:

     db $66; mov dx, ds:[si]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di], dx
     db $66; mov dx, ds:[si+2]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di+4], dx
     db $66; mov dx, ds:[si+4]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di+8], dx
     db $66; mov dx, ds:[si+6]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di+12], dx
     @fix: db $66; mov dx, ds:[si+8]
     db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
     db $66; mov es:[di+16], dx
     add di, 320
     inc ch
     jp @add_si
     dec cl; jnz @y; jmp @exit
     @add_si: add si, 160; dec cl; jnz @y
   @exit:
   pop bp
   pop ds
end;
end;


procedure copyblock10_pazl(x,y:integer; col, resolution:byte; pazl:longint; from1, from2, where:word);
begin
asm
   push ds
   push bp
   mov  es, where
   mov  ax, from2
   db   $8e,$e0 {mov fs, ax}


   mov  si, x
   mov  di, si
   mov  cx, y
   xchg ch, cl {calc start offset  (y*320+x1)}
   add  si, cx
   shr  cx, 2
   add  si, cx

   mov cx, y
   shr cx, 1
   mov ax, cx
   shl ax, 7 {*128}
   shl cx, 5 {*32}
   add cx, ax
   shr di, 1
   add di, cx

   mov cl, DITHER_MASK_160
   mov ch, cl
   mov dx, cx
   db $66; shl cx, 16
   mov cx, dx

   mov al, col
   mov ah, al
   mov dx, ax
   db $66; shl ax, 16
   mov ax, dx

   db $66; mov dx, word ptr pazl
{   db $66; mov dx, 0000h; dw $0000{}
{   db $66; mov dx, 0000h; dw $0001{}
{   db $66; mov dx, 0200h; dw $0202{}
{   db $66; mov dx, 0404h; dw $0404{}

   mov  ds, from1
   db $66; mov bp, cx {8080h; dw $8080}

   mov ch, 5
   @stroka:

  {-------------self-modding----------------}
   db $66; push dx
           test dl, dl;jnz @skip0; mov word ptr cs:[offset @dx+1], offset @x0; jmp @go
   @skip0: test dl, 1; jz @skip1;  mov word ptr cs:[offset @dx+1], offset @x1; jmp @go
   @skip1: test dl, 2; jz @skip2;  mov word ptr cs:[offset @dx+1], offset @x2; jmp @go
   @skip2:                         mov word ptr cs:[offset @dx+1], offset @x3; jmp @go
   @go:
  {-----------------------------------------}

   mov cl, 4
   @y:

        @dx: mov dx, 1234h
        test  cl, 3; jnz @sk0 {select dither pattern 4x4}
              db $66; mov bx, 0A02h; dw $0800 {0,8,2,10} jmp dx
        @sk0: cmp cl, 1; jne @sk1
              db $66; mov bx, 060Eh; dw $040C {12,4,14,6}jmp dx
        @sk1: cmp cl, 2; jne @sk2
              db $66; mov bx, 0901h; dw $0B03 {3,11,1,9} jmp dx
        @sk2: db $66; mov bx, 050Dh; dw $070F {15,7,13,5}jmp dx


        @x0:
              db $64; db $66; mov dx, [di]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si],    dx
              db $64; db $66; mov dx, [di+2]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si+4],  dx
              db $64; db $66; mov dx, [di+4]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si+8],  dx
              db $64; db $66; mov dx, [di+6]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si+12], dx
              db $64; db $66; mov dx, [di+8]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si+16], dx
              add si, 320; test cl, 1; jp @skip_add_di0; add di, 160;
              @skip_add_di0: dec cl; jnz @y; jmp @next
        @x1:
              db $64; db $66; mov dx, [di]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si],    dx
              db $64; db $66; mov dx, [di+2]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si+4],  dx
              db $66; mov dx, ds:[si+8]
              db $66; mov     es:[si+8], dx
              db $64; db $66; mov dx, [di+6]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si+12], dx
              db $64; db $66; mov dx, [di+8]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si+16], dx
              add si, 320; test cl, 1; jp @skip_add_di1; add di, 160;
              @skip_add_di1: dec cl; jnz @y; jmp @next
        @x2:
              db $64; db $66; mov dx, [di]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si],    dx
              db $66; mov dx, ds:[si+4]
              db $66; mov     es:[si+4],  dx
              db $66; mov dx, ds:[si+8]
              db $66; mov     es:[si+8],  dx
              db $66; mov dx, ds:[si+12]
              db $66; mov     es:[si+12], dx
              db $64; db $66; mov dx, [di+8]
              db $66; sub dx, bx; db $66; and dx, bp; db $66; add dx, ax{}
              db $66; mov          es:[si+16], dx
              add si, 320; test cl, 1; jp @skip_add_di2; add di, 160;
              @skip_add_di2: dec cl; jnz @y; jmp @next
        @x3:
              db $66; mov dx, ds:[si]
              db $66; mov     es:[si],    dx
              db $66; mov dx, ds:[si+4]
              db $66; mov     es:[si+4],  dx
              db $66; mov dx, ds:[si+8]
              db $66; mov     es:[si+8],  dx
              db $66; mov dx, ds:[si+12]
              db $66; mov     es:[si+12], dx
              db $66; mov dx, ds:[si+16]
              db $66; mov     es:[si+16], dx
              add si, 320; test cl, 1; jp @skip_add_di3; add di, 160;
              @skip_add_di3: dec cl; jnz @y;
   @next:
   db $66; pop dx
   db $66; ror dx, 8

   dec ch
   jnz @stroka

   pop bp
   pop ds
end;
end;




procedure TextureQuad_with_fill(resolution, top_bottom:byte; x1,x2,y1, x3,x4,y2, xt1,yt1,xt2,yt2, z1,z2:integer;
color, from, where:word);
var
Z_delta, YT_delta, X1_delta, X2_delta:longint;
iz, ix1, ix2, iyt:longint;
bright, sy1, sx1, sx3,sx4, col_z, y,x, xx1,xx2:integer;

begin

 {top or bottom part of column?}
 if top_bottom=0 then begin sx3:=x1; sx4:=x2; sx1:=x1;  sy1:=y2; end;
 if top_bottom=1 then begin sx3:=x3; sx4:=x4; sx1:=x3;  sy1:=y1; end;


 if (y1<>y2) then begin
    YT_delta  := (longint(yt2-yt1+1) shl 9) div (y2-y1);
    X1_delta  := (longint(x3-x1)     shl 9) div (y2-y1);
    X2_delta  := (longint(x4-x2)     shl 9) div (y2-y1);
    Z_delta   := (longint(z2-z1)     shl 9) div (y2-y1);
 end else begin
    YT_delta  := 0;
    X1_delta  := 0;
    X2_delta  := 0;
    Z_delta   := 0;
 end;


 if resolution=REZ160 then YT_delta:=sar_(YT_delta, 1);

 ix1 := shl_(x1,  9);
 ix2 := shl_(x2,  9);
 iyt := shl_(yt1, 9);
 iz  := shl_(z1,  9);

 if y2>199 then y2:=199;

 for y:=y1 to y2 do
    begin
      if (y>=0) then begin
          xx1:=ix1 shr 9;
          xx2:=ix2 shr 9;
          if top_bottom=(0 xor MODE) then bright:=(iz shr 11)-8 else bright:=20-(iz shr 11);
          if bright<0 then bright:=0;

          if (xx1>0) then
          if (xx1-1<sx1) then copyline(0, xx1-1, y, COL_ADD_160, LEFT_REZ, LEFT_BUFFER, where){left part screen}
                         else begin
                              copyline(0, sx3-1,  y, COL_ADD_160, LEFT_REZ, LEFT_BUFFER, where);
                              if (sx3<xx1) then begin
                                  if top_bottom=1 then col_z:=(y shr 3 - sy1 shr 3) else col_z:= -(y shr 3 - sy1 shr 3);
                                  DitherLineH(sx3,xx1-1, y, col_z, col2, col3, where);{}
                                  end;
                              end;

          if (xx2>0) and (xx1<320) then TextureHorline(xx1, xx2,y, xt1, xt2, iyt shr 9, color,bright, resolution,from,where);{}

          if (xx2+1<sx4) then begin
                              if top_bottom=1 then col_z:=(y shr 3 - sy1 shr 3) else col_z:= -(y shr 3 - sy1 shr 3);
                              DitherLineH(xx2+1, sx4, y, col_z, col2, col3, where);
                              end;

          if (xx2<=sx4)  then copyline(sx4,   319, y, COL_ADD_160, RIGHT_REZ, RIGHT_BUFFER, where)
                         else copyline(xx2+1, 319, y, COL_ADD_160, RIGHT_REZ, RIGHT_BUFFER, where);

      end;

      ix1:=ix1 + X1_delta;
      ix2:=ix2 + X2_delta;
      iyt:=iyt + YT_delta;
      iz :=iz  + Z_delta;
    end;
end;

procedure rotate(var xr,yr,zr:single; xt,yt, angle, per:single);
var
ys,zs,Cosxan,Sinxan:single;
begin
     CosXan:=cos(angle);
     SinXan:=sin(angle);
     zs:=-sinxan*yt;
     ys:=cosxan*yt;
     xr:= xt * per / (per-zs);
     yr:= ys * per / (per-zs);
     zr:= zs;
end;

procedure DrawColumn(xt1,yt1, xt2,yt2:integer; angle, per:single; where:word);
var yshift,xshift,xr,yr,zr:single;
x4,x3,y2:integer;
color1, color2, buffer1, buffer2, buffer1_rez, buffer2_rez:word;
begin

xshift:=160;{(xt2-xt1)/2 +xt1;}
yshift:=(yt2-yt1)/2 +yt1;
rotate(xr,yr, zr, xt1-xshift,yt2-yshift, angle, per);
x3:=round(xr+xshift);
y2:=round(yr+yshift);
rotate(xr,yr, zr, xt2-xshift,yt2-yshift, angle, per);
x4:=round(xr+xshift);


LEFT_REZ :=SCREEEN[1].rez; LEFT_BUFFER :=SCREEEN[1].segm;
RIGHT_REZ:=SCREEEN[0].rez; RIGHT_BUFFER:=SCREEEN[0].segm;

buffer1:=SCREEEN[1].segm; buffer1_rez:=SCREEEN[1].rez; color1:=SCREEEN[1].color;
buffer2:=SCREEEN[0].segm; buffer2_rez:=SCREEEN[0].rez; color2:=SCREEEN[0].color;


{top part}
TextureQuad_with_fill(buffer1_rez,0, xt1,xt2,yt1,  x3,x4,y2-1,  xt1,yt1, xt2,yt2-1, round(zr),0, color1,buffer1, where);{}

{bottom part}
TextureQuad_with_fill(buffer2_rez,1, x3,x4,y2,     xt1,xt2,yt2,   xt1,yt1, xt2,yt2-1,  0,round(zr), color2,buffer2, where);{}

end;



var
qsub:integer;
status:array[0..7] of byte;
function columns(q, count_column, height_column, speed, per:word; where:word): byte;
var x1,x2,y1,y2,n:integer;
a:single;
begin
y1:=0;  y2:=199;

for n:=0 to count_column-1 do begin
  x1:=height_column*n; x2:=height_column*n + (height_column-1);

  if status[n]=1 then begin
      a:=cos((q-qsub)/speed)*360;

      if a<0 then begin
         status[n]:=2;
         if n<(count_column-1) then begin status[n+1]:=1; qsub:=q; end;
         end;
  end;

  if (status[n]>0) and (status[n]<2) then DrawColumn(x1,y1, x2,y2, rad(-a), per, where);{}
end;

if status[count_column-1]=2 then begin {complite}
     for n:=0 to 199 do copyline(0,  319, n, COL_ADD_160, LEFT_REZ, LEFT_BUFFER, where);
     columns:=1;
end
else columns:=0;

end;


function Mosaik(q, tip, gradient, where:word):byte;
var x,y,xx,yy:word;
n,b,block160, block320:integer;
pazl:longint;
begin
n:=-255+q;
yy:=0;
block160:=0; block320:=0;

for y:=0 to 9 do begin
xx:=0;
  for x:=0 to 15 do begin
    b:=mem[gradient:x+y shl 4]+n;
    if b>0 then begin

         if tip=0 then begin
            if (b<16) then                  pazl:=$02020200
            else if (b>=16) and (b<32) then pazl:=$01020100
            else if (b>=32) and (b<48) then pazl:=$00010000
            else if (b>=48)            then pazl:=$00000000;
         end
         else begin
            if (b<16) then                  pazl:=$02040201
            else if (b>=16) and (b<32) then pazl:=$02020200
            else if (b>=32) and (b<48) then pazl:=$01020100
            else if (b>=48) and (b<64) then pazl:=$00010000
            else if (b>=64)            then pazl:=$00000000;
           end;
         if pazl<>0 then copyblock10_pazl(xx,yy, COL_ADD_160, REZ160, pazl, BUFFER_320, BUFFER_160, where)
                    else begin
                         block160:=block160+1;
                         copyblock10(xx,yy, COL_ADD_160, REZ160, BUFFER_160, where);
                         end;
    end
    else begin
         block320:=block320+1;
         copyblock10(xx,yy, COL_ADD_160, REZ320, BUFFER_320, where);{}
         end;
    xx:=xx+20;
 end;
yy:=yy+20;
end;

if block160>=160 then Mosaik:=0      {экран заполнен буфером_160}
else if block320>=160 then Mosaik:=1 {экран заполнен буфером_320}
else Mosaik:=2;
end;

procedure set_rubik_buffers(buff_320,buff_160,history_buff:word);
begin
BUFFER_320:=buff_320;
BUFFER_160:=buff_160;
HISTORY_BUFFER:=history_buff;
end;

procedure set_rubik_colors(c1,c2,c3, c_dither,  c_add, mask: byte);
begin
col1:=c1; col2:=c2; col3:=c3;
COL_DITHER_320:=c_dither;
COL_ADD_160:=c_add;
DITHER_MASK_160:=mask;
end;

procedure set_rubik_mode(m:byte);
var n:byte;
begin
MODE:=m;
SCREEEN[0 xor MODE].segm:=BUFFER_320;  SCREEEN[0 xor MODE].rez:=REZ320; SCREEEN[0 xor MODE].color:=COL_DITHER_320;
SCREEEN[1 xor MODE].segm:=BUFFER_160;  SCREEEN[1 xor MODE].rez:=REZ160; SCREEEN[1 xor MODE].color:=COL_ADD_160;
qsub:=0;
for n:=0 to 7 do status[n]:=0;
status[0]:=1;
end;


end.