; ============================================================
; Retro Tool PBI Header
; Datei: Formats/module_format_worm0.pbi
; SPDX-License-Identifier: MIT
; Copyright (c) 2026 Jörg Burbach, joerg-burbach.de
; Lizenz: Siehe Formats/LICENSE_MIT.txt
; Version: WORM0-26
;
; Funktion:
;   WORM0 memory-only one-resource pack container with validated own-format
;   payloads and RAW fallback.
;
;   Changelog:
;   2.2 - Production hardening without bitstream changes: header enums and
;         reserved bytes are validated, and decoded chunk geometry must sum
;         exactly to the declared resource layout.
;   2.1 - Decoder writes stored RAW and validated own-format chunks directly
;         into the final resource buffer after hash/format validation. This
;         removes one chunk-sized allocation and copy; no bitstream change.
;   2.0 - Compact single-resource layout: one 28-byte header, filename and
;         13-byte sequential chunk records. Removes redundant resource/index,
;         pack-size, data-offset and reserved fields before productive use.
;   1.2 - Crappy quality tier, Phase 4 of the codec-stack rewrite (spec
;         section H). WORM0's own Quality enum (kept separately from
;         WORM0_Media::RFXLQuality - not cross-referenced by PB) was
;         renumbered to match (Crappy=0..Lossless=4) and QualityName/
;         QualityFromText both gained "crappy". This file never re-
;         encodes pixels itself (it validates and routes already-
;         encoded payloads - see StoreValidatedPayload), so this is
;         purely the naming/routing half; actually encoding at Crappy
;         still means the caller passes WORM0_Media::#Quality_Crappy to
;         RFXL/RFXA directly. Historically this file only had a harmless
;         ".rauf" file-extension-to-audio-type mapping, not RAUF parsing;
;         that route is now inactive because pre-release RAUF was cut
;         before productive use. The history stays documented here.
;   1.3 - Decoder-only cleanup: chunk-record parsing advances a linear record
;         pointer instead of rebuilding chunkRecordPos + i * 28 for every
;         field in the resource decode loop.
;   1.1 - New codec RAW_BRIEFLZ (=1) as a general fallback before a chunk
;         is stored uncompressed as RAW_BYTES, using WORM0_LeXA::
;         BriefLZEncode/Decode. Verified by decode+compare before use,
;         falls back to RAW_BYTES otherwise. -43.8% on prose, -97.0% on
;         a repetitive block, 0% on noise/tiny blobs (correct fallback).
;
; Unterstuetzte Formate:
;   RAW bytes plus RAU, RFXL, RFXLAnim, LeXA and FormA/FMA1 resources.
;
; Dateiformat:
;   WORM header, one filename and sequential chunk records with hashes.
;
; DLL-Faehigkeit:
;   Ja; vollstaendig memory-only, ohne Host-Dateibruecke.
;
; Formatstatus:
;   lesen=ja | schreiben=ja | memory=ja | optimiert=ja | vollstaendig=WORM0-26
; ============================================================

CompilerIf Not Defined(Common_Core, #PB_Module)
  XIncludeFile "../module_common_core.pbi"
CompilerEndIf

CompilerIf Not Defined(WORM0_LeXA, #PB_Module)
  XIncludeFile "module_format_lexa.pbi"
CompilerEndIf

CompilerIf Not Defined(WORM0_FormA, #PB_Module)
  XIncludeFile "module_format_forma.pbi"
CompilerEndIf
CompilerIf Not Defined(RFXLAnim, #PB_Module)
  XIncludeFile "module_format_rfxlanim.pbi"
CompilerEndIf

CompilerIf Not Defined(WORM0, #PB_Module)

DeclareModule WORM0
  EnableExplicit

  #Version = 26
  #HeaderSize = 28
  #ChunkRecordSize = 13
  #DefaultChunkSize = 65536

  ; Mirrors WORM0_Media::RFXLQuality's numbering (Crappy=0 floor tier,
  ; renumbered so it's genuinely below Low - see that enum's comment).
  ; Not cross-referenced by PB (separate DeclareModule), kept in sync by
  ; hand - this file never re-encodes pixels itself (see QualityFromText/
  ; QualityName), Quality is purely routed-through metadata here.
  Enumeration
    #Quality_Crappy = 0
    #Quality_Low = 1
    #Quality_Mid = 2
    #Quality_High = 3
    #Quality_Lossless = 4
    #Quality_Best = 4
  EndEnumeration

  Enumeration
    #Type_Bytes = 0
    #Type_Image = 1
    #Type_Audio = 2
    #Type_Animation = 3
    #Type_Text = 4
    #Type_Font = 5
    #Type_Spatial = 6
  EndEnumeration

  Enumeration
    #Codec_RAW_BYTES = 0
    #Codec_RAW_BRIEFLZ = 1
    #Codec_RFX_IMAGE = 16
    #Codec_RAU_AUDIO = 32
    #Codec_RFXA_ANIMATION = 48
    #Codec_LEXA_TEXT = 64
    #Codec_LEXA_FONT = 65
    #Codec_FORMA_SPATIAL = 80
  EndEnumeration

  Structure PackedChunk
    codec.i
    unpackedSize.i
    packedSize.i
    hash32.l
    *data
  EndStructure

  Declare.s QualityName(Quality.i)
  Declare.s CodecName(Codec.i)
  Declare.i QualityFromText(Text.s)
  Declare.l FNV1a32(*memory, size.i)
  Declare.i EncodePackMemory(*Input, InputSize.i, ResourceName.s = "", Quality.i = #Quality_Lossless, ChunkSize.i = #DefaultChunkSize, *OutSize.Integer = #Null, ResourceType.i = #Type_Bytes)
  Declare.i DecodeFirstResourceMemory(*Pack, PackSize.i, *OutSize.Integer = #Null)
  Declare.i DecodePayloadMemory(*Packed, PackedSize.i, Codec.i, UnpackedSize.i, *OutSize.Integer = #Null)
EndDeclareModule

Module WORM0
  EnableExplicit

  Procedure.s QualityName(Quality.i)
    Select Quality
      Case #Quality_Crappy : ProcedureReturn "crappy"
      Case #Quality_Low : ProcedureReturn "low"
      Case #Quality_Mid : ProcedureReturn "mid"
      Case #Quality_High : ProcedureReturn "high"
    EndSelect
    ProcedureReturn "lossless"
  EndProcedure

  Procedure.s CodecName(Codec.i)
    Select Codec
      Case #Codec_RFX_IMAGE : ProcedureReturn "RFX_IMAGE"
      Case #Codec_RAU_AUDIO : ProcedureReturn "RAU_AUDIO"
      Case #Codec_RFXA_ANIMATION : ProcedureReturn "RFXA_ANIMATION"
      Case #Codec_LEXA_TEXT : ProcedureReturn "LEXA_TEXT"
      Case #Codec_LEXA_FONT : ProcedureReturn "LEXA_FONT"
      Case #Codec_FORMA_SPATIAL : ProcedureReturn "FORMA_SPATIAL"
    EndSelect
    ProcedureReturn "RAW_BYTES"
  EndProcedure

  Procedure.i QualityFromText(Text.s)
    Select LCase(Text)
      Case "crappy", "lossy_crappy"
        ProcedureReturn #Quality_Crappy
      Case "low", "lossy_low"
        ProcedureReturn #Quality_Low
      Case "mid", "medium", "lossy_mid"
        ProcedureReturn #Quality_Mid
      Case "high", "lossy_high"
        ProcedureReturn #Quality_High
      Case "best", "lossless"
        ProcedureReturn #Quality_Lossless
    EndSelect
    ProcedureReturn #Quality_Lossless
  EndProcedure

  Procedure.i CodecForType(ResourceType.i)
    Select ResourceType
      Case #Type_Image
        ProcedureReturn #Codec_RFX_IMAGE
      Case #Type_Audio
        ProcedureReturn #Codec_RAU_AUDIO
      Case #Type_Animation
        ProcedureReturn #Codec_RFXA_ANIMATION
      Case #Type_Text
        ProcedureReturn #Codec_LEXA_TEXT
      Case #Type_Font
        ProcedureReturn #Codec_LEXA_FONT
      Case #Type_Spatial
        ProcedureReturn #Codec_FORMA_SPATIAL
    EndSelect
    ProcedureReturn #Codec_RAW_BYTES
  EndProcedure

  Procedure.i IsKnownCodec(Codec.i)
    Select Codec
      Case #Codec_RAW_BYTES, #Codec_RAW_BRIEFLZ, #Codec_RFX_IMAGE, #Codec_RAU_AUDIO, #Codec_RFXA_ANIMATION, #Codec_LEXA_TEXT, #Codec_LEXA_FONT, #Codec_FORMA_SPATIAL
        ProcedureReturn #True
    EndSelect
    ProcedureReturn #False
  EndProcedure

  Procedure.l FNV1a32(*memory, size.i)
    Protected hash.q = 2166136261
    Protected i.i
    If *memory = 0 Or size <= 0
      ProcedureReturn 0
    EndIf
    For i = 0 To size - 1
      hash = (hash ! (PeekA(*memory + i) & $FF)) * 16777619
      hash & $FFFFFFFF
    Next
    ProcedureReturn hash & $FFFFFFFF
  EndProcedure

  Procedure.i MW_Byte(*Writer.Common_Core::MemoryWriter, Value.i)
    ProcedureReturn Common_Core::MemoryWriteByte(*Writer, Value)
  EndProcedure

  Procedure.i MW_U16(*Writer.Common_Core::MemoryWriter, Value.i)
    ProcedureReturn Common_Core::MemoryWriteWordLE(*Writer, Value)
  EndProcedure

  Procedure.i MW_U32(*Writer.Common_Core::MemoryWriter, Value.i)
    ProcedureReturn Common_Core::MemoryWriteLongLE(*Writer, Value)
  EndProcedure

  Procedure.i MW_ASCII(*Writer.Common_Core::MemoryWriter, Text.s)
    Protected *ascii
    Protected bytes.i = Len(Text)
    If bytes <= 0 : ProcedureReturn #True : EndIf
    *ascii = Ascii(Text)
    If *ascii = 0 : ProcedureReturn #False : EndIf
    If Common_Core::MemoryWriteData(*Writer, *ascii, bytes) = #False
      FreeMemory(*ascii)
      ProcedureReturn #False
    EndIf
    FreeMemory(*ascii)
    ProcedureReturn #True
  EndProcedure

  Procedure.i MW_UTF8(*Writer.Common_Core::MemoryWriter, Text.s)
    Protected *utf8
    Protected bytes.i = StringByteLength(Text, #PB_UTF8)
    If bytes <= 0 : ProcedureReturn #True : EndIf
    *utf8 = UTF8(Text)
    If *utf8 = 0 : ProcedureReturn #False : EndIf
    If Common_Core::MemoryWriteData(*Writer, *utf8, bytes) = #False
      FreeMemory(*utf8)
      ProcedureReturn #False
    EndIf
    FreeMemory(*utf8)
    ProcedureReturn #True
  EndProcedure

  Procedure.i RangeOK(Offset.q, Bytes.q, Size.q)
    ProcedureReturn Bool(Offset >= 0 And Bytes >= 0 And Offset <= Size And Bytes <= Size - Offset)
  EndProcedure

  Procedure.i ReadU16LE(*Memory, Offset.i)
    ProcedureReturn (PeekA(*Memory + Offset) & $FF) | ((PeekA(*Memory + Offset + 1) & $FF) << 8)
  EndProcedure

  Procedure.i ReadU32LE(*Memory, Offset.i)
    ProcedureReturn (PeekA(*Memory + Offset) & $FF) | ((PeekA(*Memory + Offset + 1) & $FF) << 8) | ((PeekA(*Memory + Offset + 2) & $FF) << 16) | ((PeekA(*Memory + Offset + 3) & $FF) << 24)
  EndProcedure

  Procedure.i CodecDetectsPayload(*source, sourceSize.i, Codec.i)
    If *source = 0 Or sourceSize <= 0 : ProcedureReturn #False : EndIf
    Select Codec
      Case #Codec_RFX_IMAGE
        ProcedureReturn WORM0_Media::DetectMemory(*source, sourceSize)
      Case #Codec_RAU_AUDIO
        ProcedureReturn RAU::DetectMemory(*source, sourceSize)
      Case #Codec_RFXA_ANIMATION
        ProcedureReturn RFXLAnim::DetectMemory(*source, sourceSize)
      Case #Codec_LEXA_TEXT, #Codec_LEXA_FONT
        ProcedureReturn WORM0_LeXA::DetectMemory(*source, sourceSize)
      Case #Codec_FORMA_SPATIAL
        ProcedureReturn WORM0_FormA::DetectMemory(*source, sourceSize)
    EndSelect
    ProcedureReturn #False
  EndProcedure

  Procedure.i StoreValidatedPayload(*source, sourceSize.i, *chunk.PackedChunk, Codec.i)
    If CodecDetectsPayload(*source, sourceSize, Codec) = #False
      ProcedureReturn #False
    EndIf
    *chunk\codec = Codec
    *chunk\unpackedSize = sourceSize
    *chunk\packedSize = sourceSize
    *chunk\hash32 = FNV1a32(*source, sourceSize)
    *chunk\data = AllocateMemory(sourceSize)
    If *chunk\data = 0
      ProcedureReturn #False
    EndIf
    CopyMemory(*source, *chunk\data, sourceSize)
    ProcedureReturn #True
  EndProcedure

  Procedure.i TryStoreLeXAChunk(*source, sourceSize.i, *chunk.PackedChunk, Codec.i)
    Protected packedSize.Integer
    Protected decodedSize.Integer
    Protected *packed
    Protected *decoded
    If Codec = #Codec_LEXA_FONT
      *packed = WORM0_LeXA::EncodeFontMemory(*source, sourceSize, @packedSize)
    Else
      *packed = WORM0_LeXA::EncodeUTF8Memory(*source, sourceSize, @packedSize)
    EndIf
    If *packed And packedSize\i > 0 And packedSize\i < sourceSize
      If Codec = #Codec_LEXA_FONT
        *decoded = WORM0_LeXA::DecodeFontMemory(*packed, packedSize\i, @decodedSize)
      Else
        *decoded = WORM0_LeXA::DecodeTextUTF8Memory(*packed, packedSize\i, 0, @decodedSize)
      EndIf
      If *decoded And decodedSize\i = sourceSize And CompareMemory(*source, *decoded, sourceSize)
        *chunk\codec = Codec
        *chunk\packedSize = packedSize\i
        *chunk\data = *packed
        FreeMemory(*decoded)
        ProcedureReturn #True
      EndIf
      If *decoded : FreeMemory(*decoded) : EndIf
    EndIf
    If *packed : FreeMemory(*packed) : EndIf
    ProcedureReturn #False
  EndProcedure

  ; General-purpose fallback for chunks that match none of the known
  ; resource codecs: BriefLZ (already implemented and tested inside
  ; WORM0_LeXA for its text blocks) applied directly to the raw bytes, no
  ; string/UTF8 layer involved. Previously such chunks were always stored
  ; verbatim with zero compression; this only changes the stored bytes
  ; when a verified roundtrip is smaller than the input.
  Procedure.i TryStoreBriefLZChunk(*source, sourceSize.i, *chunk.PackedChunk)
    Protected packedSize.Integer, decodedSize.Integer, *packed, *decoded
    *packed = WORM0_LeXA::BriefLZEncode(*source, sourceSize, @packedSize)
    If *packed And packedSize\i > 0 And packedSize\i < sourceSize
      *decoded = WORM0_LeXA::BriefLZDecode(*packed, packedSize\i, sourceSize, @decodedSize)
      If *decoded And decodedSize\i = sourceSize And CompareMemory(*source, *decoded, sourceSize)
        *chunk\codec = #Codec_RAW_BRIEFLZ
        *chunk\packedSize = packedSize\i
        *chunk\data = *packed
        FreeMemory(*decoded)
        ProcedureReturn #True
      EndIf
      If *decoded : FreeMemory(*decoded) : EndIf
    EndIf
    If *packed : FreeMemory(*packed) : EndIf
    ProcedureReturn #False
  EndProcedure

  Procedure.i StoreChunk(*source, sourceSize.i, *chunk.PackedChunk, Codec.i)
    Protected decodedSize.Integer, *decoded
    If *source = 0 Or sourceSize <= 0 Or *chunk = 0
      ProcedureReturn #False
    EndIf

    *chunk\codec = Codec
    *chunk\unpackedSize = sourceSize
    *chunk\packedSize = sourceSize
    *chunk\hash32 = FNV1a32(*source, sourceSize)

    Select Codec
      Case #Codec_LEXA_TEXT, #Codec_LEXA_FONT
        If StoreValidatedPayload(*source, sourceSize, *chunk, Codec)
          ProcedureReturn #True
        EndIf
        If TryStoreLeXAChunk(*source, sourceSize, *chunk, Codec)
          ProcedureReturn #True
        EndIf

      Case #Codec_RFX_IMAGE, #Codec_RAU_AUDIO, #Codec_RFXA_ANIMATION, #Codec_FORMA_SPATIAL
        If StoreValidatedPayload(*source, sourceSize, *chunk, Codec)
          ProcedureReturn #True
        EndIf
    EndSelect

    If TryStoreBriefLZChunk(*source, sourceSize, *chunk)
      ProcedureReturn #True
    EndIf

    *chunk\codec = #Codec_RAW_BYTES
    *chunk\data = AllocateMemory(sourceSize)
    If *chunk\data = 0
      ProcedureReturn #False
    EndIf
    CopyMemory(*source, *chunk\data, sourceSize)
    ProcedureReturn #True
  EndProcedure

  Procedure.i DecodePayloadMemory(*Packed, PackedSize.i, Codec.i, UnpackedSize.i, *OutSize.Integer = #Null)
    Protected outSize.Integer
    Protected *decoded
    If *OutSize : *OutSize\i = 0 : EndIf
    If *Packed = 0 Or PackedSize <= 0 Or UnpackedSize <= 0 Or IsKnownCodec(Codec) = #False : ProcedureReturn 0 : EndIf

    Select Codec
      Case #Codec_RFX_IMAGE, #Codec_RAU_AUDIO, #Codec_RFXA_ANIMATION, #Codec_FORMA_SPATIAL
        If PackedSize = UnpackedSize And CodecDetectsPayload(*Packed, PackedSize, Codec)
          *decoded = AllocateMemory(UnpackedSize)
          If *decoded = 0 : ProcedureReturn 0 : EndIf
          CopyMemory(*Packed, *decoded, UnpackedSize)
          If *OutSize : *OutSize\i = UnpackedSize : EndIf
          ProcedureReturn *decoded
        EndIf

      Case #Codec_RAW_BYTES
        If PackedSize <> UnpackedSize : ProcedureReturn 0 : EndIf

      Case #Codec_RAW_BRIEFLZ
        *decoded = WORM0_LeXA::BriefLZDecode(*Packed, PackedSize, UnpackedSize, @outSize)
        If *decoded And outSize\i = UnpackedSize
          If *OutSize : *OutSize\i = outSize\i : EndIf
          ProcedureReturn *decoded
        EndIf
        If *decoded : FreeMemory(*decoded) : EndIf

      Case #Codec_LEXA_TEXT, #Codec_LEXA_FONT
        If Codec = #Codec_LEXA_FONT
          *decoded = WORM0_LeXA::DecodeFontMemory(*Packed, PackedSize, @outSize)
        Else
          *decoded = WORM0_LeXA::DecodeTextUTF8Memory(*Packed, PackedSize, 0, @outSize)
        EndIf
        If *decoded And outSize\i = UnpackedSize
          If *OutSize : *OutSize\i = outSize\i : EndIf
          ProcedureReturn *decoded
        EndIf
        If *decoded : FreeMemory(*decoded) : EndIf

      EndSelect

    If Codec <> #Codec_RAW_BYTES : ProcedureReturn 0 : EndIf
    *decoded = AllocateMemory(UnpackedSize)
    If *decoded = 0 : ProcedureReturn 0 : EndIf
    CopyMemory(*Packed, *decoded, UnpackedSize)
    If *OutSize : *OutSize\i = UnpackedSize : EndIf
    ProcedureReturn *decoded
  EndProcedure

  Procedure.i EncodePackMemory(*Input, InputSize.i, ResourceName.s = "", Quality.i = #Quality_Lossless, ChunkSize.i = #DefaultChunkSize, *OutSize.Integer = #Null, ResourceType.i = #Type_Bytes)
    Protected codec.i = CodecForType(resourceType)
    Protected chunkCount.i
    Protected i.i
    Protected chunkBytes.i
    Protected srcOffset.i
    Protected name.s = ResourceName
    Protected nameBytes.i = StringByteLength(name, #PB_UTF8)
    Protected packSize.q
    Protected originalHash.l
    Protected writer.Common_Core::MemoryWriter
    Protected *out
    Dim chunks.PackedChunk(0)

    If *OutSize : *OutSize\i = 0 : EndIf
    If ResourceType < #Type_Bytes Or ResourceType > #Type_Spatial Or FindString(ResourceName, "/") Or FindString(ResourceName, "\") : ProcedureReturn 0 : EndIf
    If *Input = 0 Or InputSize <= 0 Or nameBytes > 65535 Or Quality < #Quality_Crappy Or Quality > #Quality_Lossless
      ProcedureReturn 0
    EndIf
    If ChunkSize < 4096
      ChunkSize = #DefaultChunkSize
    EndIf
    If CodecDetectsPayload(*Input, InputSize, codec)
      ChunkSize = InputSize
    EndIf

    chunkCount = (InputSize + ChunkSize - 1) / ChunkSize
    If chunkCount <= 0
      ProcedureReturn 0
    EndIf
    ReDim chunks(chunkCount - 1)

    For i = 0 To chunkCount - 1
      srcOffset = i * ChunkSize
      chunkBytes = InputSize - srcOffset
      If chunkBytes > ChunkSize
        chunkBytes = ChunkSize
      EndIf
      If StoreChunk(*Input + srcOffset, chunkBytes, @chunks(i), codec) = #False
        Goto fail
      EndIf
    Next
    packSize = #HeaderSize + nameBytes + chunkCount * #ChunkRecordSize
    For i = 0 To chunkCount - 1
      packSize + chunks(i)\packedSize
    Next
    originalHash = FNV1a32(*Input, InputSize)

    If Common_Core::InitMemoryWriter(@writer, packSize) = #False
      Goto fail
    EndIf

    If MW_ASCII(@writer, "WORM") = #False Or MW_Byte(@writer, #Version) = #False Or MW_Byte(@writer, resourceType) = #False Or MW_Byte(@writer, Quality) = #False Or MW_Byte(@writer, 0) = #False
      Goto fail
    EndIf
    If MW_U32(@writer, InputSize) = #False Or MW_U32(@writer, originalHash) = #False Or MW_U32(@writer, ChunkSize) = #False Or MW_U32(@writer, chunkCount) = #False
      Goto fail
    EndIf
    If MW_U16(@writer, nameBytes) = #False Or MW_U16(@writer, 0) = #False Or MW_UTF8(@writer, name) = #False
      Goto fail
    EndIf

    For i = 0 To chunkCount - 1
      If MW_Byte(@writer, chunks(i)\codec) = #False Or MW_U32(@writer, chunks(i)\unpackedSize) = #False Or MW_U32(@writer, chunks(i)\packedSize) = #False Or MW_U32(@writer, chunks(i)\hash32) = #False
        Goto fail
      EndIf
    Next

    For i = 0 To chunkCount - 1
      If Common_Core::MemoryWriteData(@writer, chunks(i)\data, chunks(i)\packedSize) = #False
        Goto fail
      EndIf
    Next

    If writer\size <> packSize
      Goto fail
    EndIf
    *out = Common_Core::FinishMemoryWriter(@writer)
    If *OutSize : *OutSize\i = packSize : EndIf
    For i = 0 To chunkCount - 1
      If chunks(i)\data : FreeMemory(chunks(i)\data) : EndIf
    Next
    ProcedureReturn *out

    fail:
    If writer\data : FreeMemory(writer\data) : EndIf
    For i = 0 To chunkCount - 1
      If chunks(i)\data : FreeMemory(chunks(i)\data) : EndIf
    Next
    ProcedureReturn 0
  EndProcedure

  Procedure.i DecodeFirstResourceMemory(*Pack, PackSize.i, *OutSize.Integer = #Null)
    Protected chunkCount.i
    Protected chunkSize.i
    Protected dataOffset.q
    Protected originalSize.i
    Protected originalHash.l
    Protected nameLen.i
    Protected chunkRecordPos.q
    Protected chunkRecordBytes.q
    Protected recordPos.q
    Protected i.i
    Protected unpacked.i
    Protected packed.i
    Protected offset.q
    Protected hash.l
    Protected chunkCodec.i
    Protected decodedSize.Integer
    Protected *decoded
    Protected writer.Common_Core::MemoryWriter
    Protected *out
    Protected totalUnpacked.q

    If *OutSize : *OutSize\i = 0 : EndIf
    If *Pack = 0 Or PackSize < #HeaderSize
      ProcedureReturn 0
    EndIf
    If PeekS(*Pack, 4, #PB_Ascii) <> "WORM"
      ProcedureReturn 0
    EndIf
    If (PeekA(*Pack + 4) & $FF) <> #Version
      ProcedureReturn 0
    EndIf
    If (PeekA(*Pack + 5) & $FF) > #Type_Spatial Or (PeekA(*Pack + 6) & $FF) > #Quality_Lossless Or (PeekA(*Pack + 7) & $FF) <> 0 Or ReadU16LE(*Pack, 26) <> 0
      ProcedureReturn 0
    EndIf
    originalSize = ReadU32LE(*Pack, 8)
    originalHash = ReadU32LE(*Pack, 12)
    chunkSize = ReadU32LE(*Pack, 16)
    chunkCount = ReadU32LE(*Pack, 20)
    nameLen = ReadU16LE(*Pack, 24)
    If chunkCount <= 0 Or chunkSize <= 0 Or originalSize <= 0 Or chunkCount > PackSize / #ChunkRecordSize
      ProcedureReturn 0
    EndIf
    chunkRecordPos = #HeaderSize + nameLen
    chunkRecordBytes = chunkCount * #ChunkRecordSize
    dataOffset = chunkRecordPos + chunkRecordBytes
    If RangeOK(#HeaderSize, nameLen, PackSize) = #False Or RangeOK(chunkRecordPos, chunkRecordBytes, PackSize) = #False Or dataOffset > PackSize
      ProcedureReturn 0
    EndIf
    If Common_Core::InitMemoryWriter(@writer, originalSize) = #False
      ProcedureReturn 0
    EndIf

    recordPos = chunkRecordPos
    For i = 0 To chunkCount - 1
      chunkCodec = PeekA(*Pack + recordPos) & $FF
      unpacked = ReadU32LE(*Pack, recordPos + 1)
      packed = ReadU32LE(*Pack, recordPos + 5)
      hash = ReadU32LE(*Pack, recordPos + 9)
      recordPos + #ChunkRecordSize
      offset = dataOffset
      dataOffset + packed
      If IsKnownCodec(chunkCodec) = #False Or packed <= 0 Or unpacked <= 0 Or RangeOK(offset, packed, PackSize) = #False
        Goto fail
      EndIf
      If unpacked > chunkSize Or (i < chunkCount - 1 And unpacked <> chunkSize)
        Goto fail
      EndIf
      totalUnpacked + unpacked
      If totalUnpacked > originalSize
        Goto fail
      EndIf
      If packed = unpacked And (chunkCodec = #Codec_RAW_BYTES Or CodecDetectsPayload(*Pack + offset, packed, chunkCodec))
        If FNV1a32(*Pack + offset, packed) <> hash Or Common_Core::MemoryWriteData(@writer, *Pack + offset, packed) = #False
          Goto fail
        EndIf
        Continue
      EndIf
      *decoded = DecodePayloadMemory(*Pack + offset, packed, chunkCodec, unpacked, @decodedSize)
      If *decoded = 0 Or decodedSize\i <> unpacked Or FNV1a32(*decoded, decodedSize\i) <> hash
        If *decoded : FreeMemory(*decoded) : EndIf
        Goto fail
      EndIf
      If Common_Core::MemoryWriteData(@writer, *decoded, decodedSize\i) = #False
        FreeMemory(*decoded)
        Goto fail
      EndIf
      FreeMemory(*decoded)
    Next

    If dataOffset <> PackSize Or totalUnpacked <> originalSize Or writer\size <> originalSize Or FNV1a32(writer\data, writer\size) <> originalHash
      Goto fail
    EndIf
    *out = Common_Core::FinishMemoryWriter(@writer)
    If *OutSize : *OutSize\i = originalSize : EndIf
    ProcedureReturn *out

    fail:
    If writer\data : FreeMemory(writer\data) : EndIf
    ProcedureReturn 0
  EndProcedure

EndModule

CompilerEndIf

CompilerIf #PB_Compiler_IsMainFile
  XIncludeFile "test_lexa_forma_worm0_hardening.pb"
CompilerEndIf