PC Underground/UNDERGROUND.ISO/memory/flat/gifunit.pas

Pascal/Delphi Source File | 1995-07-28 | 8.3 KB | 518 lines

unit gifunit;

interface uses dos;

const clr=256;              {gif}
            eof=257;
      pakt : byte = 0;
Const Maxsprites=14;
            o_dtx=4; o_dty=6;
      sampr : integer = 22;

var palette:Array[0..767] of Byte;
Var Handle:Word;
        Buf:Array[0..767] of Byte;
    BufInd:Word;
    Stack:Array[0..1280] of byte;
    ab_prfx,ab_tail:Array[0..4096] of word;
    Byt:Byte;
    free,width1,max,
        stackp,restbits,restbyte,specialcase,
    code,old_code,readbyt,bits,bits2get:Word;
    lbyte:Word;
    mask:Word;
    zseg,zofs,
    GifName:String[15];
    VScreen:Pointer;

Procedure LoadGif(name:String;var destinationvar:Pointer;startaddr:word;seek:Longint);
Procedure SetPal;
procedure Blackpal;
Procedure p13_2_modex(start,pic_size:word);
Procedure Split(row:byte);
Procedure Start(Ofst:Word);
Procedure Init_ModeX;
Procedure Init_Mode13;
Procedure WaitRetrace;

implementation

Procedure SetPal;assembler;
asm
  mov si,offset palette
  mov cx,256*3
  xor al,al
  mov dx,03c8h
  out dx,al
  inc dx
@lp:
  rep outsb
End;

procedure Blackpal;
begin;
  fillchar(palette,768,0);
  setpal;
end;

Procedure GifOpen;assembler;
asm
    mov ax,03d00h
  lea dx,gifname + 1
  int 21h
  mov handle,ax
End;
Procedure GifRead(n:Word);assembler;
asm
    mov ax,03f00h
  mov bx,handle
  mov cx,n
  lea dx,buf
    int 21h
end;
Procedure GifSeekdelta(delta:Longint);assembler;
asm
    mov ax,04200h
  mov bx,handle
  mov cx,word ptr delta + 2
  mov dx,word ptr delta
  int 21h
End;
Procedure GifClose;Assembler;
asm
    mov ax,03e00h
  mov bx,handle
  int 21h
End;
Procedure ShiftPal;assembler;
asm
    push ds
  pop es
  mov si,offset Buf
  mov di,offset Palette
  mov cx,768
@l1:
    lodsb
  shr al,2
  stosb
  loop @l1
End;
Procedure FillBuf;
Begin
    GifRead(1);
  restbyte:=buf[0];
  GifRead(restbyte);
End;

Function GetPhysByte:Byte;assembler;
asm
    push bx
    cmp restbyte,0
  ja @restthere
  pusha
  call fillbuf
  popa
    mov bufind,0
@restthere:
  mov bx,BufInd
  mov al,byte ptr Buf[bx]
  inc bufind
  pop bx
End;

Function GetLogByte:Word;assembler;
asm
  push si
    mov ax,width1
    mov si,ax
  mov dx,restbits
  mov cx,8
  sub cx,dx
  mov ax,lByte
  shr ax,cl
  mov code,ax
  sub si,dx
@nextbyte:
  call getphysbyte
  xor ah,ah
  mov lByte,ax
  dec restbyte

  mov bx,1
  mov cx,si
  shl bx,cl
  dec bx
  and ax,bx

  mov cx,dx
  shl ax,cl
  add code,ax

  sbb dx,width1
  add dx,8
  jns @positive
  add dx,8
@positive:
  sub si,8
  jle @finished       { <= 0 }
    add dx,width1
  sub dx,8
  jmp @nextbyte
@finished:
    mov restbits,dx
  mov ax,code
    pop si
End;

Procedure p13_2_modex(start,pic_size:word);assembler;
Var   Plane_l:Byte;
            Plane_Pos:Word;
asm
        mov plane_l,1
    mov plane_pos,0
    push ds
    lds si,vscreen
    mov plane_pos,si
    mov ax,0a000h
    mov es,ax
    mov di,start
    mov cx,pic_size
@lpplane:
    mov al,02h
    mov ah,plane_l
    mov dx,3c4h
    out dx,ax

    @lp1:
    movsb
    add si,3
    loop @lp1
{        dec cx
    jne @lp1}


        mov di,start
    inc plane_pos
    mov si,plane_pos
    mov cx,pic_size
    shl plane_l,1
    cmp plane_l,10h
    jne @lpplane

    pop ds
End;

Procedure LoadGif(name:String;var destinationvar:Pointer;startaddr:word;seek:Longint);
Var destination,
    source,qseg:Word;
{        pic_size,pic_height,pic_width:word;}
         x_count:Word;
    destinationvarloc:Pointer;
Begin
  gifName:=Name+#0;
     if destinationvar = Nil Then
        getMem(destinationvar,64000);
    GifOpen;
    gifseekdelta(seek+13);
    gifread(768);
  Shiftpal;
    gifread(1);
  While Buf[0] = $21 do Begin  {read over Erw - Block}
    gifread(2);
    gifread(buf[1]+1);
  End;
  GifRead(10);
{  pic_width:=buf[4]+buf[5]*256;
  pic_height:=buf[6]+buf[7]*256;
  pic_size:=pic_width div 4 * pic_height;}
  If Buf[8] and 128 = 128 Then Begin
    gifread(768);
      Shiftpal;
  End;
  lByte:=0;
  Destinationvarloc:=Destinationvar;
    asm
    les di,destinationvarloc

    mov free,258        {1st free position in alphabet}
    mov width1,9        {character width in bits}
    mov max,511         {maximum displayable value with current width}
    mov stackp,0
    mov restbits,0
    mov restbyte,0
  @mainloop:
    call getlogByte
        cmp ax,eof
    je @abort
    cmp ax,clr
    je @clear
      mov readbyt,ax
    cmp ax,free
    jb @code_in_ab
    mov ax,old_code
    mov code,ax
    mov bx,stackp
    mov cx,specialcase
    mov word ptr stack[bx],cx
    inc stackp
  @code_in_ab:
      cmp ax,clr
      jb @concrete
  @fillstack_loop:
    mov bx,code
    shl bx,1
    push bx
    mov ax,word ptr ab_tail[bx]
    mov bx,stackp
    shl bx,1
    mov word ptr stack[bx],ax
    inc stackp
    pop bx
    mov ax,word ptr ab_prfx[bx]
    mov code,ax
    cmp ax,clr
    ja @fillstack_loop
  @concrete:
      mov bx,stackp
    shl bx,1
    mov word ptr stack[bx],ax
    mov specialcase,ax
    inc stackp
    mov bx,stackp
    dec bx
    shl bx,1
  @readstack_loop:
      mov ax,word ptr stack[bx]

        stosb
      or di,di
    jne @noovl1
    push startaddr
    push 16384
    add startaddr,16384
    call p13_2_modex
    les di,destinationvarloc

@noovl1:
{    add si,4
    and si,12
    or di,di
    jne @rsnc
    mov ax,es
    add ax,1000h
    mov es,ax
    @rsnc:}
        dec bx
    dec bx
    jns @readstack_loop
    mov stackp,0
    mov bx,free
    shl bx,1
    mov ax,old_code
    mov word ptr ab_prfx[bx],ax
    mov ax,code
    mov word ptr ab_tail[bx],ax
    mov ax,readbyt
    mov old_code,ax
    inc free
    mov ax,free
    cmp ax,max
    jbe @mainloop
    cmp byte ptr width1,12
    jae @mainloop
    inc width1
    mov cl,byte ptr width1
    mov ax,1
    shl ax,cl
    dec ax
    mov max,ax
    jmp @mainloop
  @clear:
    mov width1,9
    mov max,511
    mov free,258
    call getlogbyte
    mov specialcase,ax
    mov old_code,ax

        stosb
      or di,di
    jne @noovl2
    push startaddr
    push 16384
    add startaddr,16384
    call p13_2_modex
    les di,destinationvarloc

@noovl2:
{    add si,4
    and si,12

    or di,di
    jne @mainloop
    mov ax,es
    add ax,1000h
    mov es,ax    }

    jmp @mainloop
  @abort:
  End;
  gifclose;
End;

procedure disable4; assembler;
asm;
    mov dx,3c4h
  mov ax,0f02h
  out dx,ax

  mov dx,3ceh
  mov ax,4005h
  out dx,ax
end;

Procedure ShowPic;assembler;
asm
    push ds
    mov di,0a000h
  mov es,di
  xor di,di
  mov si,word ptr VScreen
  mov ax,word ptr Vscreen + 2
  mov ds,ax
  mov cx,32000
  rep movsw
  pop ds
End;
Procedure ClearPic(Size:Word);assembler;
asm
    mov ax,word ptr vscreen + 2
  mov es,ax
  mov di,word ptr vscreen
  mov cx,Size
  xor ax,ax
  rep stosw
End;

Procedure WaitRetrace;assembler;
asm
    mov dx,3dah
@wait1:
    in al,dx
  test al,8h
    jz @wait1
@wait2:
    in al,dx
  test al,8h
  jnz @wait2
End;

Procedure Init_Mode13;assembler;
    asm
      mov ax,13h
    int 10h
  End;

Procedure Init_ModeX;assembler;
asm
    mov ax,0013h     { set normal mode 13h }
  int 10h

  mov dx,3c4h      { cancel association/link, enable }
  mov al,4         { single access                          }
  out dx,al
  inc dx
  in al,dx
  and al,0f7h
  or al,4h
  out dx,al
  dec dx
  mov ax,0f02h
  out dx,ax

    mov ax,0a000h    { clear video memory }
  mov es,ax
  xor di,di
  xor ax,ax
  mov cx,8000h
  cld
  rep stosw

  mov dx,3d4h
  mov al,14h
  out dx,al
  inc dx
  in al,dx
  and al,0bfh
  out dx,al
  dec dx
  mov al,17h
  out dx,al
  inc dx
  in al,dx
  or al,40h
  out dx,al
End;

Procedure Start(Ofst:Word);assembler;
asm
    mov dx,3d4h
  mov al,0ch
  mov ah,byte ptr ofst + 1
  out dx,ax
  inc al
  mov ah,byte ptr ofst
  out dx,ax
End;

Procedure Split(row:byte);assembler;
asm
    mov bl,row
  xor bh,bh
    shl bx,1
  mov cx,bx

    mov dx,3d4h
  mov al,07h
  out dx,al
  inc dx
  in al,dx
    and al,11101111b
  shr cx,4
  and cl,16
  or al,cl
  out dx,al

  dec dx
  mov al,09h
  out dx,al
  inc dx
  in al,dx
  and al,10111111b
  shr bl,3
  and bl,64
  or al,bl
  out dx,al

  dec dx
  mov al,18h
  mov ah,row
  shl ah,1
  out dx,ax
End;

Procedure enable4;assembler;
asm
    mov dx,3c4h
  mov ax,0f02h
  out dx,ax

  mov dx,3ceh
  mov ax,4105h
  out dx,ax
End;


begin;
end.