Unit WriteAVI;
{ ---------------------------------------------------------------- }
{ Unit to handle saving to .AVI files.  Only handles 8-bit         }
{ uncompressed and RLE-compressed 8-bit .AVI files.                }
{ ---------------------------------------------------------------- }

Interface

Uses AVI,Base;

Type
  TAVIExpand      = (exNone,exHorz2x);
  TAVICompression = (acNone,acRLE);
  TAVIFile = Object
  Private
    F         : File;
    Width     : LongInt;
    Height    : LongInt;
    Comp      : TAVICompression;
    FileName  : String;
    NumFrames : LongInt;
    Expand    : TAVIExpand;
    Palette   : TPalette;
    { ------------- Internal WriteFrame variables -------------- }
    RIFF      : TRIFF;
    StrL      : TStreamList;
    MovI      : TMovI;
    DV        : TChunk;
    RLE       : Pointer;
  Public
    Opened    : Boolean;
    Procedure Init;
    Procedure Open(Const AFileName: String; AWidth,AHeight: LongInt;
                   AComp: TAVICompression; AExpand: TAVIExpand;
                   Var Pal: TPalette);
    Procedure WriteFrame(P: Pointer; VFlip: Boolean);
    Procedure Close;
  End;

Implementation

Uses Windows;

Type
  PRLERec = ^TRLERec;
  TRLERec = Packed Record
    Count : Byte;
    Num   : Byte;
  End;

Procedure TAVIFile.Init;
Begin
  FileName  := '';
  NumFrames := 0;
  Width     := 320;
  Height    := 200;
  Comp      := acNone;
  Expand    := exNone;
  Opened    := False;
  FillChar(Palette,SizeOf(Palette),#0);
End; { TAVIFile.Init }

Procedure TAVIFile.Open(Const AFileName: String; AWidth,AHeight: LongInt;
                        AComp: TAVICompression; AExpand: TAVIExpand;
                        Var Pal: TPalette);
Var I: Integer;
Begin
  If Not Opened Then
  Begin
    FileName  := AFileName;
    NumFrames := 0;
    Width     := AWidth;
    Height    := AHeight;
    Comp      := AComp;
    Expand    := AExpand;
    Opened    := True;
    Palette   := Pal;
    Assign(F,FileName);
    ReWrite(F,1);
    GetMem(RLE,Width * 2 + 2);   { Leave room for the end-of-line specifier }
    RIFF.Chunk.FourCC                                      := CC_RIFF;
    RIFF.Chunk.dwSize                                      := 0;           { Will fix on close }
    RIFF.AVI                                               := CC_AVI;
    RIFF.HeaderList.Chunk.FourCC                           := CC_LIST;
    RIFF.HeaderList.Chunk.dwSize                           := SizeOf(RIFF.HeaderList) + SizeOf(StrL) - SizeOf(TChunk);
    RIFF.HeaderList.hdrl                                   := CC_hdrl;
    RIFF.HeaderList.AVIHeader.Chunk.FourCC                 := CC_avih;
    RIFF.HeaderList.AVIHeader.Chunk.dwSize                 := SizeOf(RIFF.HeaderList.AVIHeader.Header);
    RIFF.HeaderList.AVIHeader.Header.dwMicroSecPerFrame    := 33367;
    RIFF.HeaderList.AVIHeader.Header.dwMaxBytesPerSec      := 3728000;
    RIFF.HeaderList.AVIHeader.Header.dwPaddingGranularity  := 0;
    RIFF.HeaderList.AVIHeader.Header.dwFlags               := $810;
    RIFF.HeaderList.AVIHeader.Header.dwTotalFrames         := NumFrames;        { Will fix on close }
    RIFF.HeaderList.AVIHeader.Header.dwInitialFrames       := 0;
    RIFF.HeaderList.AVIHeader.Header.dwStreams             := 1;
    RIFF.HeaderList.AVIHeader.Header.dwSuggestedBufferSize := 120000;
    If Expand = exHorz2x
     Then RIFF.HeaderList.AVIHeader.Header.dwWidth         := Width * 2
     Else RIFF.HeaderList.AVIHeader.Header.dwWidth         := Width;
    RIFF.HeaderList.AVIHeader.Header.dwHeight              := Height;
    RIFF.HeaderList.AVIHeader.Header.dwReserved[0]         := 0;
    RIFF.HeaderList.AVIHeader.Header.dwReserved[1]         := 0;
    RIFF.HeaderList.AVIHeader.Header.dwReserved[2]         := 0;
    RIFF.HeaderList.AVIHeader.Header.dwReserved[3]         := 0;

    StrL.Chunk.FourCC                                      := CC_LIST;
    StrL.Chunk.dwSize                                      := SizeOf(StrL) - SizeOf(TChunk);
    StrL.strl                                              := CC_strl;
    StrL.StreamHeader.Chunk.FourCC                         := CC_strh;
    StrL.StreamHeader.Chunk.dwSize                         := SizeOf(StrL.StreamHeader) - SizeOf(TChunk);
    StrL.StreamHeader.StreamHeader.fccType                 := CC_vids;
    If Comp = acNone
     Then StrL.StreamHeader.StreamHeader.fccHandler        := CC_DIB
     Else StrL.StreamHeader.StreamHeader.fccHandler        := CC_RLE;
    StrL.StreamHeader.StreamHeader.dwFlags                 := 0;
    StrL.StreamHeader.StreamHeader.wPriority               := 0;
    StrL.StreamHeader.StreamHeader.wLanguage               := 0;
    StrL.StreamHeader.StreamHeader.dwInitialFrames         := 0;
    StrL.StreamHeader.StreamHeader.dwScale                 := 100;  { 60 frames/sec }
    StrL.StreamHeader.StreamHeader.dwRate                  := 6000;
    StrL.StreamHeader.StreamHeader.dwStart                 := 0;
    StrL.StreamHeader.StreamHeader.dwLength                := NumFrames;      { Will fix on close }
    StrL.StreamHeader.StreamHeader.dwSuggestedBufferSize   := 120000;
    StrL.StreamHeader.StreamHeader.dwQuality               := 0;
    StrL.StreamHeader.StreamHeader.dwSampleSize            := 0;
    StrL.StreamHeader.StreamHeader.rcFrame.Left            := 0;
    StrL.StreamHeader.StreamHeader.rcFrame.Top             := 0;
    If Expand = exHorz2x
     Then StrL.StreamHeader.StreamHeader.rcFrame.Right     := Width * 2
     Else StrL.StreamHeader.StreamHeader.rcFrame.Right     := Width;
    StrL.StreamHeader.StreamHeader.rcFrame.Bottom          := Height;
    StrL.StreamFormat.Chunk_2.FourCC                       := CC_strf;
    StrL.StreamFormat.Chunk_2.dwSize                       := SizeOf(StrL.StreamFormat) - SizeOf(TChunk);
    StrL.StreamFormat.BI.bmiHeader.biSize                  := SizeOf(BITMAPINFOHEADER);
    If Expand = exHorz2x
     Then StrL.StreamFormat.BI.bmiHeader.biWidth           := Width * 2
     Else StrL.StreamFormat.BI.bmiHeader.biWidth           := Width;
    StrL.StreamFormat.BI.bmiHeader.biHeight                := Height;
    StrL.StreamFormat.BI.bmiHeader.biPlanes                := 1;
    StrL.StreamFormat.BI.bmiHeader.biBitCount              := 8;
    StrL.StreamFormat.BI.bmiHeader.biCompression           := BI_RGB;
    StrL.StreamFormat.BI.bmiHeader.biSizeImage             := 0;
    StrL.StreamFormat.BI.bmiHeader.biXPelsPerMeter         := 0;
    StrL.StreamFormat.BI.bmiHeader.biYPelsPerMeter         := 0;
    StrL.StreamFormat.BI.bmiHeader.biClrUsed               := 0;
    StrL.StreamFormat.BI.bmiHeader.biClrImportant          := 0;
    StrL.StreamFormat.DVInfo_2.dwDVAAuxSrc                 := 0;
    StrL.StreamFormat.DVInfo_2.dwDVAAuxCtl                 := 0;
    StrL.StreamFormat.DVInfo_2.dwDVAAuxSrc1                := 0;
    StrL.StreamFormat.DVInfo_2.dwDVAAuxCtl1                := 0;
    StrL.StreamFormat.DVInfo_2.dwDVVAuxSrc                 := 0;
    StrL.StreamFormat.DVInfo_2.dwDVVAuxCtl                 := 0;
    StrL.StreamFormat.DVInfo_2.dwDVReserved[0]             := 0;
    StrL.StreamFormat.DVInfo_2.dwDVReserved[1]             := 0;
    FillChar(StrL.StreamFormat.BI.bmiColors,SizeOf(StrL.StreamFormat.BI.bmiColors),#0);
    For I := 0 To 255 Do
    Begin
      StrL.StreamFormat.BI.bmiColors[I].R  := Palette[I].R;
      StrL.StreamFormat.BI.bmiColors[I].G  := Palette[I].G;
      StrL.StreamFormat.BI.bmiColors[I].B  := Palette[I].B;
    End; { For I }

    BlockWrite(F,RIFF,SizeOf(RIFF));
    BlockWrite(F,StrL,SizeOf(StrL));
    MovI.Chunk.FourCC := CC_List;
    MovI.Chunk.dwSize := 0;            { Will fix on close }
    MovI.movi         := CC_movi;
    BlockWrite(F,MovI,SizeOf(MovI));
  End;
End; { TAVIFile.Open }

Procedure TAVIFile.Close;
Var
  FPIndex : LongInt;
  Posn    : LongInt;
  Frame   : Integer;
  FP1     : LongInt;
  Index   : TIndex;

Begin
  If Opened Then
  Begin
    { Write frame index header }

    DV.FourCC := CC_idx1;
    DV.dwSize := NumFrames * SizeOf(TIndex);
    BlockWrite(F,DV,SizeOf(DV));
    FPIndex := FilePos(F);

    { Now go back to the top of the file and correct the header values }

    Seek(F,0);
    RIFF.Chunk.dwSize := FPIndex + NumFrames * SizeOf(TIndex) - SizeOf(TChunk);
    RIFF.HeaderList.AVIHeader.Header.dwTotalFrames := NumFrames;
    BlockWrite(F,RIFF,SizeOf(RIFF));
    StrL.StreamHeader.StreamHeader.dwLength        := NumFrames;
    BlockWrite(F,StrL,SizeOf(StrL));
    FP1 := FilePos(F);
    MovI.Chunk.dwSize := FPIndex - FP1 - 2 * SizeOf(TChunk);
    BlockWrite(F,MovI,SizeOf(MovI));

    { Walk through the frames and write the index entries }

    Posn := 4;
    For Frame := 1 To NumFrames Do
    Begin
      FP1 := FilePos(F);
      BlockRead(F,DV,SizeOf(DV));
      Inc(FP1,DV.dwSize + SizeOf(DV));
      Seek(F,FPIndex);
      If Comp = acNone
       Then Index.FourCC := CC_00db
       Else Index.FourCC := CC_00dc;
      Index.L1     := 0;
      Index.L2     := Posn;
      Index.L3     := DV.dwSize;
      BlockWrite(F,Index,SizeOf(Index));
      Inc(Posn,DV.dwSize + SizeOf(DV));
      FPIndex := FilePos(F);
      Seek(F,FP1);
    End; { For Frame }

    System.Close(F);
    FreeMem(RLE,Width * 2 + 2);
    Opened := False;
  End;
End; { TAVIFile.Close }

Procedure TAVIFile.WriteFrame(P: Pointer; VFlip: Boolean);
Type BPtr = ^Byte;
Var
  Line     : LongInt;
  RLERec   : TRLERec;
  RLELen   : LongInt;
  FP1      : LongInt;
  FP2      : LongInt;
  P1       : Pointer;

  Function CompressLine(Line: LongInt): LongInt;
  { ------------------------------------------------------------------------------- }
  { Note that this procedure is written specifically for the Atari 2600 screen and  }
  { (1) takes advantage of the fact that odd and even pixels contain equal values   }
  {     for 320-column modes, and                                                   }
  { (2) doubles the count for 160-column modes.                                     }
  { ------------------------------------------------------------------------------- }
  Var
    Addr  : LongInt;
    Dest  : LongInt;
    P1    : BPtr;
    P2    : PRLERec;
    Wid   : LongInt;
    Expd  : TAVIExpand;

  Begin
    Dest := 0;
    Addr := Line * Width;
    P1   := P;                      { Make local copies to the stack }
    P2   := RLE;
    Wid  := Width;
    Expd := Expand;

    Asm
      CLD
      PUSHAD
      MOV   EDX,DWORD PTR Wid       { Copy the line width }
      MOV   EDI,DWORD PTR P1        { Copy the buffer address }
      ADD   EDI,DWORD PTR Addr
      MOV   ESI,DWORD PTR P2        { Copy the address of the destination buffer }
      CMP   BYTE PTR Expd,exHorz2x  { Do we need to double up the pixels? }
      JE    @Expand2x

{ =============================================================================== }
{ Handle 320-width modes                                                          }
{ =============================================================================== }

@L1:
      MOV   AX,WORD PTR [EDI]
      MOV   ECX,127
      CMP   ECX,EDX
      JBE   @NoCopy
      MOV   ECX,EDX
@NoCopy:
      MOV   EBX,EDI
      REPE  SCASW
      JE    @NoDec
      SUB   EDI,2
@NoDec:
      MOV   ECX,EDI
      SUB   ECX,EBX
      SUB   EDX,ECX
      MOV   AL,CL
      MOV   WORD PTR [ESI],AX
      ADD   ESI,2
      ADD   DWORD PTR Dest,2
      CMP   EDX,0
      JG    @L1
      JMP   @GetOut

{ =============================================================================== }
{ Handle 160-width modes: look at every pixel but count each twice                }
{ =============================================================================== }

@Expand2x:
      MOV   AL,BYTE PTR [EDI]
      MOV   AH,AL
      MOV   ECX,127
      CMP   ECX,EDX
      JBE   @NoCopy1
      MOV   ECX,EDX
@NoCopy1:
      MOV   EBX,EDI
      REPE  SCASB
      JE    @NoDec1
      DEC   EDI
@NoDec1:
      MOV   ECX,EDI
      SUB   ECX,EBX
      SUB   EDX,ECX
      ADD   ECX,ECX
      MOV   AL,CL
      MOV   WORD PTR [ESI],AX
      ADD   ESI,2
      ADD   DWORD PTR Dest,2
      CMP   EDX,0
      JG    @Expand2x
@GetOut:
      MOV   WORD PTR [ESI],0
      POPAD
    End; { Asm }
    CompressLine := Dest;
  End; { CompressLine }

  Procedure ExpandLine(Line: LongInt);
  Var
    Addr  : LongInt;
    P1    : BPtr;
    P2    : BPtr;
    Wid   : LongInt;

  Begin
    Addr := Line * Width;
    P1   := P;                      { Make local copies to the stack }
    P2   := RLE;
    Wid  := Width;
    Asm
      CLD
      PUSHAD
      MOV   ECX,DWORD PTR Wid       { Copy the line width }
      MOV   EDI,DWORD PTR P2        { Copy the address of the destination buffer }
      MOV   ESI,DWORD PTR P1        { Copy the buffer address }
      ADD   ESI,DWORD PTR Addr
      TEST  ECX,1
      JZ    @Even
@L1:
      LODSB
      MOV   AH,AL
      STOSW
      DEC   ECX
      JNZ   @L1
      JMP   @GetOut
@Even:
      SHR   ECX,1
@L2:
      SUB   EAX,EAX
      LODSW
      MOV   EBX,EAX
      MOV   AH,AL
      MOV   BL,BH
      SHL   EBX,16
      OR    EAX,EBX
      STOSD
      DEC   ECX
      JNZ   @L2
@GetOut:
      POPAD
    End; { Asm }
  End; { ExpandLine }

Begin
  { Write screen data }

  FP1 := FilePos(F);
  If Comp = acNone
   Then DV.FourCC := CC_00db
   Else DV.FourCC := CC_00dc;
  If Comp = acRLE Then
  Begin
    DV.dwSize := 0;                         { Will change afterwards }
    BlockWrite(F,DV,SizeOf(DV));
    If VFlip Then
    Begin
      For Line := Height - 1 DownTo 0 Do
      Begin
        RLELen := CompressLine(Line);         { Compression routine automatically places }
        BlockWrite(F,RLE^,RLELen + 2);        {  an end-of-line specifier afterward }
      End; { For Line }
    End
    Else
    Begin
      For Line := 0 To Height - 1 Do
      Begin
        RLELen := CompressLine(Line);         { Compression routine automatically places }
        BlockWrite(F,RLE^,RLELen + 2);        {  an end-of-line specifier afterward }
      End; { For Line }
    End;
    RLERec.Count := 0;
    RLERec.Num   := 1;                      { End-of-frame specifier }
    BlockWrite(F,RLERec,SizeOf(RLERec));

    { Correct the frame length specifier }

    FP2 := FilePos(F);
    Seek(F,FP1);
    DV.dwSize := FP2 - FP1 - SizeOf(DV);
    BlockWrite(F,DV,SizeOf(DV));
    Seek(F,FP2);
  End
  Else
  Begin
    DV.dwSize := Height * Width;            { Will change afterwards }
    If Expand = exHorz2x Then DV.dwSize := DV.dwSize * 2;
    BlockWrite(F,DV,SizeOf(DV));
    If VFlip Then
    Begin
      For Line := Height - 1 DownTo 0 Do
      Begin
        If Expand = exHorz2x Then
        Begin
          ExpandLine(Line);
          BlockWrite(F,RLE^,Width * 2);
        End
        Else
        Begin
          P1 := P;
          Inc(LongInt(P1),Line * Width);
          BlockWrite(F,P1^,Width);
        End;
      End;
    End
    Else
    Begin
      For Line := 0 To Height - 1 Do
      Begin
        If Expand = exHorz2x Then
        Begin
          ExpandLine(Line);
          BlockWrite(F,RLE^,Width * 2);
        End
        Else
        Begin
          P1 := P;
          Inc(LongInt(P1),Line * Width);
          BlockWrite(F,P1^,Width);
        End;
      End;
    End;
  End;
  Inc(NumFrames);
End; { TAVIFile.WriteFrame }

End.

// ----------------------------------------------------------------------
// IntvWin - Mattel Intellivision Emulator
// Copyright (C) 2000 John Dullea
//
//  This program is free software; you can redistribute it and/or modify
//  it under the terms of the GNU General Public License as published by
//  the Free Software Foundation; either version 2 of the License, or
//  (at your option) any later version.
//
//  This program is distributed in the hope that it will be useful,
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//  GNU General Public License for more details.
//
//  You should have received a copy of the GNU General Public License
//  along with this program; if not, write to the Free Software
//  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
// ----------------------------------------------------------------------