CD-X 1/cdx_01.iso/demodisc/tyrant/morph/morph2.pas

Pascal/Delphi Source File | 1995-03-17 | 9.3 KB | 598 lines

{ Ez csak az elv miatt van itt, de ennél lehet 10-szer jobbat csinalni!
                                         by TyRaNT / MurmidoneS }
Const dots = 1800;
      Mdb  = 32;
      P1X  = 160;
      P1Y  = 110;
      P2X  = 160;
      P2Y  = 110;


Var     X,Y : Word;

        Ok  : Byte;

        Px1  : Array[0..dots] of Integer;
        Py1  : Array[0..dots] of Integer;
        Px2  : Array[0..dots] of Integer;
        Py2  : Array[0..dots] of Integer;
        Pa   : Array[0..dots] of Longint;
        Pb   : Array[0..dots] of Longint;
        Ps1  : Array[0..dots] of Longint;
        Ps2  : Array[0..dots] of Longint;

procedure vblank; assembler;
asm
        push    ax
        push    dx
    MOV    DX,03DAh
@VBL0:
    IN    AL,DX
    TEST    AL,8
    JZ    @VBL0
@VBL1:
    IN    AL,DX
    TEST    AL,8
    JNZ    @VBL1
        pop     dx
        pop     ax
end;

Procedure MORPH; External; {$L MORPH.Obj}
Procedure Pcx_Tomorito; Assembler;
ASM
        PUSH DS;
        push cs
        pop  ds
        push 09000h
        pop  es
        lea si,MORPH
        ADD SI,127
        XOR DI,DI;
        XOR BX,BX;
        XOR CX,CX;
@DataIn:  XOR BX,BX;
          LODSB;
          TEST AL,128;
          JE @@AzAs1;
          INC BX;
@@AzAs1:  TEST AL,64;
          JE @@AzAs2;
          INC BX;
@@AzAs2:  CMP BX,2;
          JE @@Duplazas;
          STOSB;
          CMP DI,5*320;
          JA @@AzAs3;
          JMP @DataIn;
@@AzAs3:  CMP DI,64000;
          JA @@DispEnd;
          JMP @DataIn;
@@Duplazas: AND AL,63;
            XOR AH,AH;
            MOV CX,AX;
            CMP CX,$0;
            JNE @@Mehtt;
            INC CX;
@@Mehtt:    LODSB;
            REPNZ STOSB;
            CMP DI,64000;
            JA @@DispEnd;
            JMP @DataIn;
@@DispEnd:  POP DS;
End;

Procedure Pontki; assembler;
asm
mov ax,09000h
mov es,ax
mov di,x
mov ax,y

    push di
    push bx
    push ax
    mov bx,80
    mul bx
    mov bx,di
    shr di,3
    add di,ax
    mov al,010000000b
    shr bx,1
    jnc  @t1
    shr al,1
@t1:
    shr bx,1
    jnc  @t2
    shr al,2
@t2:
    shr bx,1
    jnc  @t3
    shr al,4
@t3:
    or es:[di],al
    pop ax
    pop bx
    pop di
end;

Procedure Pontbe; assembler;
asm
mov di,x
mov ax,y

    push di
    push bx
    push ax
    push cx
    mov bx,80
    mul bx
    mov cx,di
    shr di,3
    mov bx,di
    add di,ax
    mov al,es:[di];
    shl bx,3
    sub cx,bx
    mov bx,000000010000000b
    shr bx,cl
    test al,bl
    mov  ok,0
    jz @z
    inc  ok
@z:
{A zero flag 1 lesz ha egyenlo}
    pop cx
    pop ax
    pop bx
    pop di
end;

Begin
asm
   call Pcx_tomorito;

        mov cs:word ptr @AK,0;
@C1:
        mov cs:word ptr @AJ,0;
@C2:
        mov cs:word ptr @AI,0;
@C3:
        mov ax,word ptr @AI;
        mov X,ax
        mov ax,word ptr @AJ;
        mov Y,ax
        call pontbe;

        cmp ok,0
        je @to

        mov si,offset Px1;
        mov di,cs:word ptr @AK;
        shl di,1
        add si,di
        mov bx,cs:word ptr @AI;
        add bx,P1X
        mov [si],bx

        mov si,offset Py1;
        mov di,cs:word ptr @AK;
        shl di,1
        add si,di
        mov bx,cs:word ptr @AJ;
        add bx,P1Y
        mov [si],bx

        inc cs:word ptr @AK
@to:
        inc cs:word ptr @AI
        cmp cs:word ptr @AK,dots;
        ja @to2
        cmp cs:word ptr @AI,639;
        ja @to2
        jmp @c3
@to2:
        inc cs:word ptr @AJ
        cmp cs:word ptr @AK,dots;
        ja @to3
        cmp cs:word ptr @AJ,31;
        ja @to3
        jmp @c2
@to3:
        cmp cs:word ptr @AK,dots;
        ja @to4
        jmp @c1
@to4:

jmp @quit
@AI: dw 0
@AJ: dw 0
@AK: dw 0
@Quit:
end;

asm
        mov cs:word ptr @AK,0
@C1:
        mov cs:word ptr @AJ,0
@C2:
        mov cs:word ptr @AI,0
@C3:
        mov ax,word ptr @AI;
        mov X,ax
        mov ax,word ptr @AJ;
        add ax,32               {Y kord +}
        mov Y,ax
        call pontbe;

        cmp ok,0
        je @to

        mov si,offset Px2;
        mov di,cs:word ptr @AK;
        shl di,1
        add si,di
        mov bx,cs:word ptr @AI;
        add bx,P2X
        mov [si],bx

        mov si,offset Py2;
        mov di,cs:word ptr @AK;
        shl di,1
        add si,di
        mov bx,cs:word ptr @AJ;
        add bx,P2Y
        mov [si],bx

        inc cs:word ptr @AK
@to:
        inc cs:word ptr @AI
        cmp cs:word ptr @AK,dots;
        ja @to2
        cmp cs:word ptr @AI,639
        je @to2
        jmp @c3
@to2:
        inc cs:word ptr @AJ
        cmp cs:word ptr @AK,dots;
        ja @to3
        cmp cs:word ptr @AJ,32
        je @to3
        jmp @c2
@to3:
        cmp cs:word ptr @AK,dots;
        ja @to4
        jmp @c1
@to4:

jmp @quit
@AI: dw 0
@AJ: dw 0
@AK: dw 0
@Quit:
end;

asm
mov ax,010h;
int 10h;
push 09000h
pop es
xor di,di
xor ax,ax
mov cx,32000
rep stosw;
end;

asm
        mov cs:word ptr @AK,0

        mov ax,dots
        shl ax,2
        mov cs:word ptr @dots2,ax

@C1:
db $66
        xor ax,ax
        mov di,cs:word ptr @AK
        add di,offset ps1
db $66
        mov [di],ax
        mov di,cs:word ptr @AK
        add di,offset ps2
db $66
        mov [di],ax


        mov di,cs:word ptr @AK
        shr di,1
        add di,offset px1
{db $66}
        mov ax,[di]

        mov si,cs:word ptr @AK
        shr si,1
        add si,offset px2
{db $66}
        mov bx,[si]

db $66
        shl ax,16
db $66
        shl bx,16

db $66
        cmp ax,bx
        jae @nz1

db $66
        sub bx,ax
db $66
        mov ax,bx
db $66
        shr ax,5
db $66
        neg ax

        jmp @nz2
@nz1:

db $66
        sub ax,bx
db $66
        shr ax,5

@nz2:

        mov di,cs:word ptr @AK
        add di,offset pa
db $66
        mov [di],ax


        mov di,cs:word ptr @AK
        shr di,1
        add di,offset py1
{db $66}
        mov ax,[di]

        mov si,cs:word ptr @AK
        shr si,1
        add si,offset py2
{db $66}
        mov bx,[si]

db $66
        shl ax,16
db $66
        shl bx,16

db $66
        cmp ax,bx
        jae @nz3

db $66
        sub bx,ax
db $66
        mov ax,bx
db $66
        shr ax,5
db $66
        neg ax

        jmp @nz4
@nz3:

db $66
        sub ax,bx
db $66
        shr ax,5

@nz4:

        mov di,cs:word ptr @AK
        add di,offset pb
db $66
        mov [di],ax


        add cs:word ptr @AK,4
        mov ax,cs:word ptr @dots2;
        cmp cs:word ptr @AK,ax
        jbe @c1

jmp @quit
@AK: dw 0
@dots2: dw 0
@Quit:
end;



asm

mov cx,mdb
@sel1:
push cx

        mov cs:word ptr @AK,0

        mov ax,dots
        shl ax,2
        mov cs:word ptr @dots2,ax

@C1:

        mov di,cs:word ptr @AK
        add di,offset ps1
db $66
        mov ax,[di]
db $66
        shr ax,16

        mov si,cs:word ptr @AK
        shr si,1
        add si,offset px1
        mov bx,[si]
        sub bx,ax
        mov x,bx

        mov di,cs:word ptr @AK
        add di,offset ps2
db $66
        mov ax,[di]
db $66
        shr ax,16

        mov si,cs:word ptr @AK
        shr si,1
        add si,offset py1
        mov bx,[si]
        sub bx,ax
        mov y,bx

        call pontki


        mov di,cs:word ptr @AK
        add di,offset pa
db $66
        mov ax,[di]
        mov di,cs:word ptr @AK
        add di,offset ps1
db $66
        add [di],ax

        mov di,cs:word ptr @AK
        add di,offset pb
db $66
        mov ax,[di]
        mov di,cs:word ptr @AK
        add di,offset ps2
db $66
        add [di],ax


        add cs:word ptr @AK,4
        mov ax,cs:word ptr @dots2;
        cmp cs:word ptr @AK,ax
        jbe @c1

jmp @quit
@AK: dw 0
@dots2: dw 0
@Quit:

push ds
push 09000h
pop  ds
push 0a000h
pop  es
xor di,di
xor si,si
mov cx,20*350
db $66
rep movsw
push 09000h;
pop  es
xor di,di
db $66
xor ax,ax
mov cx,20*350
db $66
rep stosw
pop  ds
call vblank
pop cx
cmp cx,mdb
jne @tv
@tv2:
in al,060h
cmp al,1
jne @Tv2
@tv:
dec cx
cmp cx,0
jnl @sel1
@tv3:
in al,060h
cmp al,1
jne @Tv3
End;
End.

{
K:=0;
Repeat
J:=0;
repeat
I:=0;
repeat
X:=I;
Y:=J;
Pontbe;
If Ok=1 Then Begin
             Px1[K]:=I+P1X;
             Py1[K]:=J+P1Y;
             Inc(K);
             End;
Inc(I);
Until (I>639) Or (K>dots);
Inc(J);
Until (J>31) Or (K>dots);
Until K>dots;
}
{
E:=True;
K:=0;
Repeat
J:=0;
repeat
I:=639;
repeat
If E Then Begin
          E:=False;
          I:=230;
          End;
X:=I;
Y:=J+32;
Pontbe;
If Ok=1 Then Begin
             Px2[K]:=I+P2X;
             Py2[K]:=J+P2Y;
             Inc(K);
             End;
dec(I);
Until (I<0) Or (K>dots);
Inc(J);
Until (J>31) Or (K>dots);
Until K>dots;
}

{for k:=0 to dots do
begin
x:=px1[k];
y:=py1[k]+100;
pontki;
end;
for k:=0 to dots do
begin
x:=px2[k];
y:=py2[k]+100;
pontki;
end;}

{For k:=0 to Dots do
begin
Pa[k]:=((Px1[k]*65535-Px2[K]*65536) Div 16);
Pb[k]:=((Py1[k]*65535-Py2[K]*65535) Div 16);
end;}

{For K:=0 To dots do
Begin
X:=Round(Px1[k]-Ps1[k] Div 65535);
Y:=Round(Py1[k]-Ps2[k] Div 65535);
Pontki;
Ps1[k]:=Ps1[k]+Pa[k];
Ps2[k]:=Ps2[k]+Pb[k];
end;}