unit dswf;

{$MODE FPC}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

uses
  dbitmem,
  dswf_primitives;

type
TSwfRECT = dswf_primitives.TSwfRECT;
TSwfMATRIX = dswf_primitives.TSwfMATRIX;

function SwfLoad(Data: Pointer;
                 DataLen: SizeUInt): Boolean; overload;
function SwfLoad(Data, DataEnd: Pointer): Boolean; overload;

implementation

function Error(Code: LongInt; Msg: PAnsiChar): Boolean;
begin
  Writeln(stderr, Code, ' ', Msg);
  Exit(Code = 0);
end;

type
TFastIndex = object
      // Implements fast random access to encoded arrays
      // Can be used in two ways:
      //    1. Preallocate with some known size and Put all elements
      //    2. Preallocate with 0 and Add all elements
      // After parsing, use Get in both cases.
private
  // simplest implementation
  FArray: array of Pointer;
public
  procedure Init();
  procedure Done; inline;
  procedure Add(P: Pointer); inline;
  procedure Put(Index: LongInt; P: Pointer); inline;
  function Get(Index: LongInt): Pointer; inline;
end;

procedure TFastIndex.Init;
begin
  SetLength(FArray, 0);
end;

procedure TFastIndex.Done;
begin
  SetLength(FArray, 0);
end;

procedure TFastIndex.Add(P: Pointer);
begin
  SetLength(FArray, Length(FArray) + 1);
  FArray[High(FArray)] := P;
end;

procedure TFastIndex.Put(Index: LongInt; P: Pointer);
begin
  FArray[Index] := P;
end;

function TFastIndex.Get(Index: LongInt): Pointer;
begin
  Result := FArray[Index];
end;

type
TSwfFILLSTYLEARRAY = object
private
  FData: PByte;
  FShape: LongInt;
public
  procedure Init(Data: Pointer; Shape: LongInt);
      // Shape must be in 1..4
  procedure Done; inline;
  function Validate(DataEnd: Pointer): Boolean; inline;
  function _Type: PtrUInt; inline;
end;

function SwfFILLSTYLEARRAYValidate(Data: Pointer;
                                   DataEnd: Pointer;
                                   Shape: LongInt;
                                   out NextData: Pointer): Boolean;
begin
  Result := True;
end;

procedure TSwfFILLSTYLEARRAY.Init(Data: Pointer; Shape: LongInt);
begin
  FData := Data;
  FShape := Shape;
end;

procedure TSwfFILLSTYLEARRAY.Done;
begin
end;

function TSwfFILLSTYLEARRAY.Validate(DataEnd: Pointer): Boolean;
var
  Temp: Pointer;
begin
  Exit(SwfFILLSTYLEARRAYValidate(FData, DataEnd, FShape, Temp));
end;

function TSwfFILLSTYLEARRAY._Type: PtrUInt;
begin
  Exit(PByte(FData)^);
end;

function AsUInt16(Data: Pointer): UInt16; inline;
begin
  Result := {$IF Defined(ENDIAN_BIG)}SwapEndian{$ENDIF}(UInt16(Data^));
end;

function AsUInt32(Data: Pointer): UInt32; inline;
begin
  Result := {$IF Defined(ENDIAN_BIG)}SwapEndian{$ENDIF}(UInt32(Data^));
end;

function SwfFILLSTYLEARRAY(Data: Pointer;
                           DataEnd: Pointer;
                           out NewData: Pointer): Boolean;
var
  FillStyleCount: SizeUInt;
  I: SizeInt;
  T: UInt8;
begin
  FillStyleCount := PByte(Data)^;
  if FillStyleCount = $ff then begin
    FillStyleCount := AsUInt16(Data + 1);
    Inc(Data, 3);
  end else
    Inc(Data, 1);
  for I := 0 to SizeInt(FillStyleCount) - 1 do begin
    T := PByte(Data)^;
    Writeln('  FILLSTYLE[', I, '].FillStyleType: ', T);
    case T of
      $00: begin
        Write('    Color (RGB or RGBA): ');
        // TODO different for Shape1, Shape2, Shape3
        //      (now it uses Shape3 encoding)
        Writeln('#', HexStr(PByte(Data)[1], 2),
                     HexStr(PByte(Data)[2], 2),
                     HexStr(PByte(Data)[3], 2),
                     HexStr(PByte(Data)[4], 2));
        Inc(Data, 5);
      end;
      $10: begin
        Writeln('    GradientMatrix');
        Writeln('    Gradient');
      end;
      $12: begin
        Writeln('    GradientMatrix');
        Writeln('    Gradient');
      end;
      $13: begin
        Writeln('    GradientMatrix');
      end;
      $40, $41, $42, $43: begin
        Writeln('    BitmapId');
        Writeln('    BitmapMatrix');
      end;
    else
      Writeln(stderr, 'WARNING: unknown FILLSTYLE type');
    end;
  end;

  NewData := Data;
  Exit(True);
end;

function SwfLINESTYLEARRAY(Data: Pointer;
                           DataEnd: Pointer;
                           out NewData: Pointer): Boolean;
var
  LineStyleCount: SizeUInt;
  I: SizeInt;
  T: UInt8;
  JoinStyle, HasFillFlag: Byte;
begin
  LineStyleCount := PByte(Data)^;
  if LineStyleCount = $ff then begin
    LineStyleCount := AsUInt16(Data + 1);
    Inc(Data, 3);
  end else
    Inc(Data, 1);

  for I := 0 to SizeInt(LineStyleCount) - 1 do begin
    // TODO LINESTYLE for Shape1, Shape2, Shape3
    Writeln('  LINESTYLE[', I, ']: ');
    Writeln('    Width: ', AsUInt16(Data));
    Inc(Data, 2);
    Writeln('    ',
            'StartCapStyle=', (PByte(Data)^ shr 6) and 3, ' ',
            'JoinStyle=',     (PByte(Data)^ shr 4) and 3, ' ',
            'HasFillFlag=',   (PByte(Data)^ shr 3) and 1, ' ',
            'NoHScaleFlag=',  (PByte(Data)^ shr 2) and 1, ' ',
            'NoVScaleFlag=',  (PByte(Data)^ shr 1) and 1, ' ',
            'PixelHintingFlag=',  (PByte(Data)^ shr 0) and 1
           );
    JoinStyle := (PByte(Data)^ shr 4) and 3;
    HasFillFlag := (PByte(Data)^ shr 3) and 1;
    Inc(Data);
    Writeln('    ',
            'NoClose=',     (PByte(Data)^ shr 2) and 1, ' ',
            'EndCapStyle=', (PByte(Data)^ shr 0) and 3
           );
    Inc(Data);
    if JoinStyle = 2 then begin
      Writeln('    MiterLimitFactor: ', AsUInt16(Data));
      Inc(Data, 2);
    end;
    if HasFillFlag = 0 then begin
      Writeln('    Color: #', HexStr(PByte(Data)[0], 2),
                              HexStr(PByte(Data)[1], 2),
                              HexStr(PByte(Data)[2], 2),
                              HexStr(PByte(Data)[3], 2));
      Inc(Data, 4);
    end;
    if HasFillFlag = 1 then begin
      Writeln('    TODO FILLSTYLE');
    end;
  end;

  NewData := Data;
  Exit(True);
end;

function SwfSHAPEWITHSTYLE(Data: Pointer;
                           DataEnd: Pointer;
                           Shape: LongInt;
                           out NewData: Pointer): Boolean;
var
  NumFillBits, NumLineBits: LongInt;
begin
  if not SwfFILLSTYLEARRAY(Data, DataEnd, Data) then
    Exit(False);
  if not SwfLINESTYLEARRAY(Data, DataEnd, Data) then
    Exit(False);

  NumFillBits := (PByte(Data)^ shr 4) and $f;
  NumLineBits := (PByte(Data)^ shr 0) and $f;
  Writeln('  NumFillBits=', NumFillBits, ' NumLineBits=', NumLineBits);

  NewData := Data;
  Exit(True);
end;

function SwfUncompressed(Data, DataEnd: Pointer): Boolean;
var
  FrameSize: TSwfRECT;
  FrameCount: UInt16;
  TagCodeAndLength: UInt16;
  Length: UInt32;
  I: SizeInt;
  SceneCount: SizeUInt;
  FrameLabelCount: SizeUInt;
  Temp, EOS: Pointer;
  ShapeBounds, EdgeBounds: TSwfRECT;
begin
  // Header
  if not SwfRECT(Data, DataEnd, FrameSize, Data) then
    Exit(Error(1, 'could not read FrameSize'));
  Writeln('FrameSize: Xmin=', FrameSize.Xmin,
                    ' Xmax=', FrameSize.Xmax,
                    ' Ymin=', FrameSize.Ymin,
                    ' Ymax=', FrameSize.Ymax);
  Writeln('FrameRate: ', SwfFIXED8ToSingle(SwfFIXED8(Data)));
  Inc(Data, 2);
  FrameCount := AsUInt16(Data);
  Writeln('FrameCount: ', FrameCount);
  Inc(Data, 2);

  // Tagged data blocks
  while Data + 2 <= DataEnd do begin
    TagCodeAndLength := AsUInt16(Data);
    Length := TagCodeAndLength and $3f;
    Inc(Data, SizeOf(UInt16));
    if Length = $3f then begin
      Length := AsUInt32(Data);
      Inc(Data, SizeOf(UInt32));
    end;
    case TagCodeAndLength shr 6 of
      TAG_PlaceObject: begin
        Writeln('TAG_PlaceObject');
      end;
      TAG_PlaceObject2: begin
        Writeln('TAG_PlaceObject2');
      end;
      TAG_PlaceObject3: begin
        Writeln('TAG_PlaceObject3');
      end;
      TAG_RemoveObject: begin
        Writeln('TAG_RemoveObject');
      end;
      TAG_RemoveObject2: begin
        Writeln('TAG_RemoveObject2');
      end;
      TAG_ShowFrame: begin
        Writeln('TAG_ShowFrame');
      end;
      TAG_SetBackgroundColor: begin
        Writeln('SetBackgroundColor = #', HexStr(PByte(Data)[0], 2),
                                          HexStr(PByte(Data)[1], 2),
                                          HexStr(PByte(Data)[2], 2));
      end;
      TAG_FrameLabel: begin
        Writeln('TAG_FrameLabel');
      end;
      TAG_Protect: begin
        Writeln('TAG_Protect');
      end;
      TAG_End: begin
        Writeln('End');
      end;
      TAG_ExportAssets: begin
        Writeln('TAG_ExportAssets');
      end;
      TAG_ImportAssets: begin
        Writeln('TAG_ImportAssets');
      end;
      TAG_EnableDebugger: begin
        Writeln('TAG_EnableDebugger');
      end;
      TAG_EnableDebugger2: begin
        Writeln('TAG_EnableDebugger2');
      end;
      TAG_ScriptLimits: begin
        Writeln('TAG_ScriptLimits');
      end;
      TAG_SetTabIndex: begin
        Writeln('TAG_SetTabIndex');
      end;
      TAG_FileAttributes: begin
        Write('FileAttributes:');
        Write(' Reserved=', (PByte(Data)^ shr 7) and 1);
        Write(' UseDirectBlit=', (PByte(Data)^ shr 6) and 1);
        Write(' UseGPU=', (PByte(Data)^ shr 5) and 1);
        Write(' HasMetadata=', (PByte(Data)^ shr 4) and 1);
        Write(' ActionScript3=', (PByte(Data)^ shr 3) and 1);
        Write(' Reserved=', (PByte(Data)^ shr 1) and 3);
        Write(' UseNetwork=', (PByte(Data)^ shr 0) and 1);
        Write(' Reserved=', PByte(Data)[1], ' ', PByte(Data)[2], ' ', PByte(Data)[3], ' ');
        Writeln;
      end;
      TAG_ImportAssets2: begin
        Writeln('TAG_ImportAssets2');
      end;
      TAG_SymbolClass: begin
        Writeln('TAG_SymbolClass');
      end;
      TAG_Metadata: begin
        if PByte(Data)[Length - 1] <> 0 then begin
          Writeln(stderr, 'WARNING: metadata is not null-terminated string');
        end else
          Writeln('Metadata: ', PAnsiChar(Data));
      end;
      TAG_DefineScalingGrid: begin
        Writeln('TAG_DefineScalingGrid');
      end;
      TAG_DefineSceneAndFrameLabelData: begin
        Writeln('DefineSceneAndFrameLabelData:');
        Temp := Data;
        SceneCount := SwfEncodedU32(Temp, DataEnd, Temp);
        Writeln('  SceneCount: ', SceneCount);
        for I := 0 to SizeInt(SceneCount) - 1 do begin
          Writeln('  Offset', I, ':    ', SwfEncodedU32(Temp, DataEnd, Temp));
          if not SwfSTRING(Temp, DataEnd, EOS) then begin
            Writeln(stderr, 'WARNING: could not find end of name');
            continue;
          end;
          Writeln('  Name', I, ':      ', PAnsiChar(Temp));
          Temp := EOS + 1;
        end;
        FrameLabelCount := SwfEncodedU32(Temp, DataEnd, Temp);
        Writeln('  FrameLabelCount: ', FrameLabelCount);
        for I := 0 to SizeInt(FrameLabelCount) - 1 do begin
          Writeln('  FrameNum', I, ':    ', SwfEncodedU32(Temp, DataEnd, Temp));
          if not SwfSTRING(Temp, DataEnd, EOS) then begin
            Writeln(stderr, 'WARNING: could not find end of name');
            continue;
          end;
          Writeln('  FrameLabel', I, ':      ', PAnsiChar(Temp));
          Temp := EOS + 1;
        end;
      end;
      TAG_DoAction: begin
        Writeln('TAG_DoAction');
      end;
      TAG_DoInitAction: begin
        Writeln('TAG_DoInitAction');
      end;
      TAG_DoABC: begin
        Writeln('TAG_DoABC');
      end;
      TAG_DefineShape: begin
        Writeln('TAG_DefineShape');
      end;
      TAG_DefineShape2: begin
        Writeln('TAG_DefineShape2');
      end;
      TAG_DefineShape3: begin
        Writeln('TAG_DefineShape3');
      end;
      TAG_DefineShape4: begin
        Writeln('DefineShape4:');
        Temp := Data;
        Writeln('  ShapeId: ', AsUInt16(Temp));
        Inc(Temp, 2);
        if not SwfRECT(Temp, DataEnd, ShapeBounds, Temp) then
          Exit(Error(1, 'could not read ShapeBounds'));
        Writeln('  ShapeBounds: ', ShapeBounds.Xmin, ' ', ShapeBounds.Xmax, ' ', ShapeBounds.Ymin, ' ', ShapeBounds.Ymax);
        if not SwfRECT(Temp, DataEnd, EdgeBounds, Temp) then
          Exit(Error(1, 'could not read EdgeBounds'));
        Writeln('  EdgeBounds: ', EdgeBounds.Xmin, ' ', EdgeBounds.Xmax, ' ', EdgeBounds.Ymin, ' ', EdgeBounds.Ymax);
        Writeln('  UsesFillWindingRule=', PByte(Temp)^ and (1 shl 2) <> 0,
                 ' UsesNonScalingStrokes=', PByte(Temp)^ and (1 shl 1) <> 0,
                 ' UsesScalingStrokes=', PByte(Temp)^ and (1 shl 0) <> 0);
        Inc(Temp);
        if not SwfSHAPEWITHSTYLE(Temp, DataEnd, 4, Temp) then
          Exit(False);
      end;
      TAG_DefineBits: begin
        Writeln('TAG_DefineBits');
      end;
      TAG_JPEGTables: begin
        Writeln('TAG_JPEGTables');
      end;
      TAG_DefineBitsJPEG2: begin
        Writeln('TAG_DefineBitsJPEG2');
      end;
      TAG_DefineBitsJPEG3: begin
        Writeln('TAG_DefineBitsJPEG3');
      end;
      TAG_DefineBitsLossless: begin
        Writeln('TAG_DefineBitsLossless');
      end;
      TAG_DefineBitsLossless2: begin
        Writeln('TAG_DefineBitsLossless2');
      end;
      TAG_DefineBitsJPEG4: begin
        Writeln('TAG_DefineBitsJPEG4');
      end;
      TAG_DefineMorphShape: begin
        Writeln('TAG_DefineMorphShape');
      end;
      TAG_DefineMorphShape2: begin
        Writeln('TAG_DefineMorphShape2');
      end;
      TAG_DefineFont: begin
        Writeln('TAG_DefineFont');
      end;
      TAG_DefineFontInfo: begin
        Writeln('TAG_DefineFontInfo');
      end;
      TAG_DefineFontInfo2: begin
        Writeln('TAG_DefineFontInfo2');
      end;
      TAG_DefineFont2: begin
        Writeln('TAG_DefineFont2');
      end;
      TAG_DefineFont3: begin
        Writeln('TAG_DefineFont3');
      end;
      TAG_DefineFontAlignZones: begin
        Writeln('TAG_DefineFontAlignZones');
      end;
      TAG_DefineFontName: begin
        Writeln('TAG_DefineFontName');
      end;
      TAG_DefineText: begin
        Writeln('TAG_DefineText');
      end;
      TAG_DefineText2: begin
        Writeln('TAG_DefineText2');
      end;
      TAG_DefineEditText: begin
        Writeln('TAG_DefineEditText');
      end;
      TAG_CSMTextSettings: begin
        Writeln('TAG_CSMTextSettings');
      end;
      TAG_DefineFont4: begin
        Writeln('TAG_DefineFont4');
      end;
      TAG_DefineSound: begin
        Writeln('TAG_DefineSound');
      end;
      TAG_StartSound: begin
        Writeln('TAG_StartSound');
      end;
      TAG_StartSound2: begin
        Writeln('TAG_StartSound2');
      end;
      TAG_SoundStreamHead: begin
        Writeln('TAG_SoundStreamHead');
      end;
      TAG_SoundStreamHead2: begin
        Writeln('TAG_SoundStreamHead2');
      end;
      TAG_SoundStreamBlock: begin
        Writeln('TAG_SoundStreamBlock');
      end;
      TAG_DefineButton: begin
        Writeln('TAG_DefineButton');
      end;
      TAG_DefineButton2: begin
        Writeln('TAG_DefineButton2');
      end;
      TAG_DefineButtonCxform: begin
        Writeln('TAG_DefineButtonCxform');
      end;
      TAG_DefineButtonSound: begin
        Writeln('TAG_DefineButtonSound');
      end;
      TAG_DefineSprite: begin
        Writeln('TAG_DefineSprite');
      end;
      TAG_DefineVideoStream: begin
        Writeln('TAG_DefineVideoStream');
      end;
      TAG_VideoFrame: begin
        Writeln('TAG_VideoFrame');
      end;
      TAG_EnableTelemetry: begin
        Writeln('TAG_EnableTelemetry');
      end;
      TAG_DefineBinaryData: begin
        Writeln('TAG_DefineBinaryData');
      end;
    else
      Writeln('Error: unknown tag ', TagCodeAndLength shr 6);
    end;
    Inc(Data, Length);
  end;

  Exit(True);
end;

function SwfLoad(Data: Pointer;
                 DataLen: SizeUInt): Boolean;
begin
  Result := SwfLoad(Data, Data + DataLen);
end;

type
  UI32 = Cardinal;

function SwfLoad(Data, DataEnd: Pointer): Boolean;
begin
  if DataEnd - Data < 8 then
    Exit(Error(1, 'swf must contain at least 8 bytes'));
  if (PAnsiChar(Data)[1] <> 'W') or
     (PAnsiChar(Data)[2] <> 'S') then
    Exit(Error(1, 'bad signature'));
  if PByte(Data)[3] > 19 then
    Exit(Error(1, 'version is too high'));
  case PAnsiChar(Data)[0] of
    'F': begin // uncompressed
      if UI32((Data + 4)^) <> (DataEnd - Data) then
        Exit(Error(1, 'bad size'));
      Exit(SwfUncompressed(Data + 8, DataEnd));
    end;
    'C': Exit(Error(1, 'zlib is not implemented yet')); // zlib
    'Z': Exit(Error(1, 'LZMA is not implemented yet')); // LZMA
  else
    Exit(Error(1, 'bad signature'));
  end;
  Exit(True);
end;

end.
