Pascal Anm file format  RTCM v11-22-99
-from the util .ANM File Viewer - Version 2.0
by Samiel.

PROGRAM ANMA(INPUT, OUTPUT);


CONST
  Bit7 =$80;            { 1000 0000 }
  NoBit7 = $7F;         { 0111 1111 }
  Bit15 = $8000;        { 1000 0000 0000 0000 }
  NoBit15 = $7FFF;      { 0111 1111 1111 1111 }


{
  1 Byte = | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | = 8 bits
  Notice the numbering system...
}


TYPE
  CycleStructure = { 8 bytes }
    record
      count : word;
      rate : word;
      flags : word;
      low, hight : byte;
    end;


  ANMHeader = { 256 bytes }
    record
      id : array [1..4] of char; { "LPF " }
      maxLps : word; { max # Lps allowed = 256 }
      nLps : word; { # Lps in this file }
      nRecords : longint; { # records in this file }
      maxRecsPerLp : word; { # records allowed per Lp = 256 }
      lpfTableOffset : word; { absolute seek position = 1280 }
      contentType : array [1..4] of char; { "ANIM" }
      width : word; { 320 ? }
      height : word; { 200 ? }
      variant : byte; { 0 = ANIM }
      version : byte; { 0 = 18 cyc/sec, 1 = 70 cyc/sec (multiple) }
      hasLastDelta : byte; { 1 = last record is last-to-first frame }
      lastDeltaValid : byte; { 0 = ignore deltta frame }
      pixelType : byte; { 0 = 256 colors }
      compressionType : byte; { 1 = RunSkipDump }
      otherRecsPerFrm : byte; { 0 ? }
      bitmapType : byte; { 1 = 320x200x256c }
      recordTypes : array [1..32] of byte; { 0's ? }
      nFrames : longint; { # of frames }
      framesPerSecond : word; { frames to play per second }
      pad2 : array [1..29] of word; { padding to 128 }
      cycles : array [1..16] of CycleStructure; { color cycling information }
    end;


  PaletteType = { 4 bytes }
    record
      b, g, r, u : byte;
    end;


  Palette = array [0..255] of PaletteType; { 256 colors }
 
  LPHeader = { 6 bytes }
    record
      baseRecord : word; { first record of this Lp }
      nRecords : word; { # records in Lp }
      nBytes : word; { # bytes }
    end;


  LPCopies = array [1..256] of LPHeader; { 256 LPHeaders }


  RecordSizes = array [0..255] of word; { 256 records, starting with 0 }
  RecPtr = ^RecordSizes;


  LPOffsets = array [1..256] of longint; { 65536 byte offsets for LPs }
  LPOffPtr = ^LPOffsets;


  Buffer = array [0..65534] of byte; { Record/Frame buffer }
  BufPtr = ^Buffer;




{ Function 00h of int 10h, sets the video mode to Mode }
Procedure SetMode(Mode : byte); Assembler;
Asm
  mov   ah, 00h
  mov   al, [Mode]
  int   10h
End;


{ Produces an error message and perhaps some numeric information }
Procedure Error(str : string;
                num : longint);
Begin
  SetMode($03);


  writeln;
  write('Error : ', str);
  if num <> -1 then     { If -1, then don't write the number }
    writeln(' ', num)
  else
    writeln;
  Halt;
End;


{ Checks to see if a file exists }
Function Exist(FN : string) : Boolean;
Var
  F : File;
Begin
  {$I-}
  assign(F, FN);
  reset(F);
  close(F);
  {$I+}
  Exist := (IOResult = 0) and (FN <> '');
End;


{ Check to see if a key is pressed }
Function KeyPressed : Boolean; Assembler;
Asm
  mov   ah, 01h
  int   16h
  mov   al, 00h { NOTE : xor al, al will change the flag, so don't use it }
  jz    @exit
  inc   al
@exit:
End;


{ Returns the keypressed or just gets a key }
Function GetKey : Word; Assembler;
Asm
  mov   ah, 00h
  int   16h
End;


{ Sets the palette... Pascal version }
Procedure SetPal(c, r, g, b : byte);
Begin
  Port[$3C8] := c;


  Port[$3C9] := r;
  Port[$3C9] := g;
  Port[$3C9] := b;
End;


{ Waits for the vertical retrace, assembler version }
Procedure Retrace; Assembler;
Asm
  mov   dx, 03DAh


@l1:
  in    al, dx
  test  al, 08h
  jz    @l1


@l2:
  in    al, dx
  test  al, 08h
  jnz   @l2
End;


{ Assign variables after procedures to make sure no global ones are used }
{ One of the reasons I like Turbo Pascal... }


VAR
  F : File; { The file to read from }
  Head : ANMHeader; { The .ANM file header }
  Res, j, LPNum, tmpw, FrmNum, Key, RecSize, pixel, count : word;
  Pal : Palette; { The palette }
  LP : LPHeader; { LP header }
  tmpLP : LPCopies; { LP copies }
  LPOff : LPOffPtr; { LP offsets }
  B : BufPtr; { Record/Frame buffer }
  Rec : RecPtr; { Record sizes }  
  tmpl : longint;
  tmpb : byte;
  Done : boolean;
  VRNum, C : integer; { 2nd command line parameter }
  RAM1, RAM2 : Pointer; { Memory markers }


BEGIN
  if paramcount in  [1, 2] then
    begin
      if Not Exist(paramstr(1)) then    { Does file exist? }
        Error(paramstr(1) + ' Does Not Exist', -1);


      if paramcount = 2 then    { Get VR_Num, if not there or invalid, = 5 }
        begin
          Val(paramstr(2), VRNum, C);
          if (C <> 0) or Not (VRNum in [0..10]) then
            VRNum := 5
        end
      else
        VRNum := 5;


      assign(F, paramstr(1));   { Assign the file, the first parameter }
      reset(F, 1);      { Reset the file using 1 byte records }


      BlockRead(F, Head, SizeOf(Head), Res);
      if Res <> SizeOf(Head) then
        Error('EOF (Header) - Read', Res);


      BlockRead(F, Pal, SizeOf(Pal), Res);
      if Res <> SizeOf(Pal) then
        Error('EOF (Palette) - Read', Res);


      BlockRead(F, tmpLP, SizeOf(tmpLP), Res);
      if Res <> SizeOf(tmpLP) then
        Error('EOF (LP Copies) - Read', Res);


      Mark(RAM1);       { Mark the first memory allocated }
      GetMem(LPOff, SizeOf(tmpl) * Head.nLps);
      
      tmpl := FilePos(F);       { Offset 2816 }
      for j := 0 to (Head.nLps - 1) do
        LPOff^[j + 1] := tmpl + (65536 * j);    { Get offsets of LPs}


      SetMode($13);     { Set the video mode, 13h = 320x200x256c }


      for j := 0 to 255 do      { Set the palette, SHR 2 = div 4, for 0..63 }
        SetPal(j, Pal[j].r SHR 2, Pal[j].g SHR 2, Pal[j].b SHR 2);


      FrmNum := 0;
      if Head.nFrames > 0 then
        repeat
          { ---- Show Frame ---- }
          
          { **** [1] Get LP # **** }
          LPNum := 0;
                    
          for j := 1 to Head.nLps do
            begin
              if (tmpLP[j].baseRecord <= FrmNum) and ((tmpLP[j].baseRecord + tmpLP[j].nRecords) > FrmNum) then
                LPNum := j;
            end;


          if LPNum = 0 then
            Error('LP Not Found', -1);


          { **** [2] Get Record Offset **** }
          Seek(F, LPOff^[LPNum]);


          BlockRead(F, LP, SizeOf(LP), Res);
          if Res <> SizeOf(LP) then
            Error('EOF (LP) - Read', Res);


          BlockRead(F, tmpw, SizeOf(tmpw), Res);
          if Res <> SizeOf(tmpw) then
            Error('EOF (Bytes Continued) - Read', Res);


          Mark(RAM2);   { Mark the second allocated memory }
          GetMem(Rec, SizeOf(tmpw) * LP.nRecords);
          
          BlockRead(F, Rec^, SizeOf(tmpw) * LP.nRecords, Res);
          if Res <> (SizeOf(tmpw) * LP.nRecords) then
            Error('EOF (Record Sizes) - Read', Res);
          
          tmpl := FilePos(F);
          if FrmNum <> 0 then   { Get the record offset }
            for j := LP.baseRecord to (FrmNum - 1) do
              tmpl := tmpl + Rec^[j - LP.baseRecord];


          RecSize := Rec^[FrmNum - LP.baseRecord];


          Release(RAM2);        { Free the second allocated memory }
          
          { **** [3] Read The Record **** }
          Seek(F, tmpl);
          
          BlockRead(F, tmpb, SizeOf(tmpb), Res);
          if Res <> SizeOf(tmpb) then
            Error('EOF (ID #) - Read', Res);
          if tmpb <> 66 then
            Error('Wrong ID (Not 66) - Found', tmpb);


          BlockRead(F, tmpb, SizeOf(tmpb), Res);
          if Res <> SizeOf(tmpb) then
            Error('EOF (Flags) - Read', Res);
          if tmpb <> 0 then
            Error('Flags =', tmpb);


          { The documentation I have says not to read this word if Flags = 0 }
          { I tried that, but it didn't work out well, so read it... }
          BlockRead(F, tmpw, SizeOf(tmpw), Res);
          if Res <> SizeOf(tmpw) then
            Error('EOF (Extra Bytes) - Read', Res);
          if tmpw <> 1 then     { Should be 1, to include itself }
            Error('Extra Bytes =', tmpw);


          { **** [4] Display The Frame **** }
          RecSize := RecSize - 4;  { Record length minus 4 bytes just read }


          GetMem(B, RecSize);   { Get buffer memory }


          BlockRead(F, B^, RecSize, Res);


          { Commented out so it doesn't halt when the record is short bytes }
{
          if Res <> RecSize then
            Error('EOF (Frame) - Read', Res);
}
          pixel := 0;   { Start in the upper, left-hand corner }
          count := 0;   { Buffer counter (position) }
          Done := FALSE;


          if VRNum in [1..9] then { Do some retraces to pause a little }
            for j := 1 to VRNum do
              Retrace;


          { Actual decoding here }
          repeat
            tmpb := B^[count];  { Get the "instruction" }
            inc(count);


            if (tmpb AND Bit7) = Bit7 then      { If bit 7 is set... }
              begin
                tmpb := tmpb AND NoBit7;        { Remove bit 7 }


                if tmpb = 0 then 
                  begin
                    { Get the next word }
                    tmpw := B^[count];
                    inc(count);
                    tmpw := tmpw + (256 * B^[count]);
                    inc(count);


                    if (tmpw AND Bit15) = Bit15 then    { Check bit 15 }
                      begin
                        tmpw := tmpw AND NoBit15;       { Remove bit 15 }


                        if tmpw >= $4000 then           { "Run" }
                          begin
                            tmpw := tmpw - $4000;


                            for j := 1 to tmpw do       { Plot one color }
                              begin
                                mem[$A000 : pixel] := B^[count];
                                inc(pixel);
                              end;
                            inc(count);
                          end
                        else    { "Dump" }
                          begin
                            for j := 1 to tmpw do       { Raw plots }
                              begin
                                mem[$A000 : pixel] := B^[count];
                                inc(pixel);
                                inc(count);
                              end;
                          end;
                      end
                    else if tmpw > 0 then       { "Skip" }
                      begin
                        pixel := pixel + tmpw;
                      end
                    else if tmpw = 0 then       { We're done! }
                      begin
                        Done := TRUE;
                      end;
                  end
                else    { "Skip" }
                  begin
                    pixel := pixel + tmpb;
                  end;
              end
            else if tmpb > 0 then       { "Dump" }
              begin
                for j := 1 to tmpb do   { Raw plots }
                  begin
                    mem[$A000 : pixel] := B^[count];
                    inc(pixel);
                    inc(count);
                  end;
              end
            else        { "Run" }
              begin
                tmpb := B^[count];      { Get the next byte }
                inc(count);


                for j := 1 to tmpb do   { Plot one color }
                  begin
                    mem[$A000 : pixel] := B^[count];
                    inc(pixel);
                  end;
                inc(count);
              end;
          until Done;   { Done decoding this frame }
          
          FreeMem(B, RecSize);  { Free buffer memory }


          { ---- Show Frame ---- }


          inc(FrmNum);  { Increment the frame }
          
          if FrmNum = (Head.nFrames - 1) then   { Is it the last frame? }
            begin
              if (Head.hasLastDelta = 1) and (Head.lastDeltaValid = 0) then
                FrmNum := 0;    { If delta is invalid, then goto frame 0 }
            end;


          if FrmNum = Head.nFrames then { If processed all frames }
            begin
              if Head.nFrames = 1 then  { If only one frame... }
                FrmNum := 0
              else if (Head.hasLastDelta = 1) and (Head.lastDeltaValid = 1) then
                FrmNum := 1     { Skip frame 0 on last delta }
              else
                FrmNum := 0;    { Otherwise goto frame 0 }
            end;


          if KeyPressed or (VRNum = 10) then    { Check for a keypress }
            Key := GetKey;
        until Key = $011B; { <Esc> }


      SetMode($03);     { Set the text mode }
      
      Release(RAM1);    { Free the first allocated memory, LPOff }


      close(F); { Close the file }
    end
  else  { If invalid command line parameters }
    begin
      writeln;
      writeln('By Samiel - samiel@fastlane.net');
      writeln('http://www.fastlane.net/~samiel');
      writeln('Version 1.0 - Public Domain');
      writeln;
      writeln('USAGE :');
      writeln;
      writeln('  ANMA10 <ANMFile.ANM> [VR_Num]');
      writeln;
      writeln('NOTES :');
      writeln;
      writeln('  [VR_Num] is a number in the range 0 to 10.  It is for');
      writeln('  timing purposes among other things.  A value of 10 will');
      writeln('  wait for user input after each frame.  Smaller values');
      writeln('  will result in faster animation.  The default is 5.');
      writeln;
      writeln('  <Esc> exits the program.');
    end;
END.