Module PRS
    Dim srcbuf() As Byte
    Dim dstbuf() As Byte

    Structure PRS_COMPRESSOR
        Dim bitpos As Byte
        Dim ctrlbyteptr As Integer
        Dim srcptr_orig As Integer
        Dim dstptr_orig As Integer
        Dim srcptr As Integer
        Dim dstptr As Integer
    End Structure

    Private Sub put_control_bit_nosave(ByRef PC As PRS_COMPRESSOR, ByVal bit As Byte)
        With PC
            Dim q As Byte = dstbuf(.ctrlbyteptr)
            q = BitSet(q, .bitpos, IntToBool(bit))
            dstbuf(.ctrlbyteptr) = q
            ''dstbuf(.ctrlbyteptr) = dstbuf(.ctrlbyteptr) >> 1
            '.ctrlbyteptr = .ctrlbyteptr >> 1
            '.ctrlbyteptr = .ctrlbyteptr Or ((bit Xor &HFF) << 7)
            ''dstbuf(.ctrlbyteptr) = dstbuf(.ctrlbyteptr) Or (bit << 7)
            .bitpos += 1
        End With
    End Sub
    Private Sub put_control_save(ByRef PC As PRS_COMPRESSOR)
        With PC
            If .bitpos >= 8 Then
                .bitpos = 0
                .ctrlbyteptr = .dstptr
                .dstptr += 1
            End If
        End With
    End Sub
    Private Sub put_control_bit(ByRef PC As PRS_COMPRESSOR, ByVal bit As Byte)
        put_control_bit_nosave(PC, bit)
        put_control_save(PC)
    End Sub
    Private Sub put_static_data(ByRef PC As PRS_COMPRESSOR, ByVal data As Byte)
        With PC
            dstbuf(.dstptr) = data
            .dstptr += 1
        End With
    End Sub
    Private Function get_static_data(ByRef PC As PRS_COMPRESSOR) As Byte
        With PC
            Dim t As Byte = srcbuf(.srcptr)
            .srcptr += 1
            Return t
        End With
    End Function
    Private Sub prs_init(ByRef PC As PRS_COMPRESSOR, ByVal src() As Byte, ByVal dst() As Byte)
        With PC
            .bitpos = 0
            .srcptr = 0
            .dstptr = 0
            .srcptr_orig = 0
            .dstptr_orig = 0
            .ctrlbyteptr = 0
            .dstptr += 1
        End With
        srcbuf = src
        dstbuf = dst
    End Sub
    Private Sub prs_finish(ByRef PC As PRS_COMPRESSOR)
        put_control_bit(PC, 0)
        put_control_bit(PC, 1)
        With PC
            If .bitpos <> 0 Then .ctrlbyteptr = ((.ctrlbyteptr << .bitpos) >> 8)
        End With
        put_static_data(PC, 0)
        put_static_data(PC, 0)
    End Sub
    Private Sub prs_rawbyte(ByRef PC As PRS_COMPRESSOR)
        put_control_bit_nosave(PC, 1)
        put_static_data(PC, get_static_data(PC))
        put_control_save(PC)
    End Sub
    Private Sub prs_shortcopy(ByRef PC As PRS_COMPRESSOR, ByVal offset As Integer, ByVal size As Byte)
        size -= 2
        put_control_bit(PC, 0)
        put_control_bit(PC, 0)
        put_control_bit(PC, (size >> 1) And 1)
        put_control_bit_nosave(PC, size And 1)
        put_static_data(PC, offset And &HFF)
        put_control_save(PC)
    End Sub
    Private Sub prs_longcopy(ByRef PC As PRS_COMPRESSOR, ByVal offset As Integer, ByVal size As Byte)
        Dim byte1 As Byte = (offset << 3) And &HF8
        Dim byte2 As Byte = (offset >> 5) And &HFF
        If size <= 9 Then
            byte1 = byte1 Or ((size - 2) And &H7)
        End If
        put_control_bit(PC, 0)
        put_control_bit_nosave(PC, 1)
        put_static_data(PC, byte1)
        put_static_data(PC, byte2)
        If size > 9 Then put_static_data(PC, size - 1)
        put_control_save(PC)
    End Sub
    Private Sub prs_copy(ByRef PC As PRS_COMPRESSOR, ByVal offset As Integer, ByVal size As Byte)
        If (((offset And &HFFFFE000) <> &HFFFFE000) Or ((offset And &H1FFF) = 0)) Then
            WriteLn("PRS_COPY ERROR!  BAD OFFSET : " & HexOut(offset))
            Stop
        End If
        If ((size > &HFF) Or (size < 3)) Then
            WriteLn("PRS_COPY ERROR!  BAD SIZE : " & HexOut(size))
            Stop
        End If
        If ((offset > -&H100) And (size <= 5)) Then
            prs_shortcopy(PC, offset, size)
        Else
            prs_longcopy(PC, offset, size)
        End If
        PC.srcptr += size
    End Sub

    Public Function compress(ByVal src() As Byte, ByVal dst() As Byte, ByVal size As Integer) As Integer
        Dim PC As PRS_COMPRESSOR
        Dim x, y, xsize, lsoffset, lssize As Integer
        prs_init(PC, src, dst)
        x = 0
        Do While x < size
            lsoffset = 0
            lssize = 0
            xsize = 0
            y = x - 3
            Do While ((y > 0) And (y > (x - &H1FF0)) And (xsize < 255))
                xsize = 3
                If memcmp(bufcpy(srcbuf, y, xsize), bufcpy(srcbuf, x, xsize), xsize) Then
                    Do
                        xsize += 1
                    Loop While (memcmp(bufcpy(srcbuf, y, xsize), bufcpy(srcbuf, x, xsize), xsize) _
                                And (xsize < 256) _
                                And ((xsize + y) < x) _
                                And ((xsize + x) <= size))
                    xsize -= 1
                    If xsize > lssize Then
                        lsoffset = -(x - y)
                        lssize = xsize
                    End If
                End If
                y -= 1
            Loop
            If lssize = 0 Then
                prs_rawbyte(PC)
            Else
                prs_copy(PC, lsoffset, lssize)
                x += (lssize - 1)
            End If
            x += 1
        Loop
        prs_finish(PC)
        Return PC.dstptr - PC.dstptr_orig
    End Function

    Public Function decompress(ByVal src() As Byte, ByVal dst() As Byte) As Integer
        Dim r3, r5 As Integer
        Dim offset, x, t As Integer
        Dim srcptr As Integer = 0
        Dim srcptr_orig As Integer = 0
        Dim dstptr As Integer = 0
        Dim dstptr_orig As Integer = 0
        Dim curbyte As Byte = 0
        Dim flag As Boolean = False
        Dim bitpos As Integer = 9

        srcbuf = src
        dstbuf = dst

        curbyte = srcbuf(srcptr)
        srcptr += 1

        Do
            bitpos -= 1
            If bitpos = 0 Then
                curbyte = srcbuf(srcptr)
                bitpos = 8
                srcptr += 1
            End If
            flag = IntToBool(curbyte And &H1)
            curbyte = curbyte >> 1
            If flag Then
                dstbuf(dstptr) = srcbuf(srcptr)
                srcptr += 1
                dstptr += 1
                Continue Do
            End If
            bitpos -= 1
            If bitpos = 0 Then
                curbyte = srcbuf(srcptr)
                bitpos = 8
                srcptr += 1
            End If
            flag = IntToBool(curbyte And &H1)
            curbyte = curbyte >> 1
            If flag Then
                r3 = srcbuf(srcptr) And &HFF
                offset = ((srcbuf(srcptr + 1) And &HFF) << 8) Or r3
                srcptr += 2
                If offset = 0 Then Return dstptr - dstptr_orig
                r3 = r3 And &H7
                r5 = (offset >> 3) Or &HFFFFE000
                If r3 = 0 Then
                    flag = IntToBool(0)
                    r3 = srcbuf(srcptr) And &HFF
                    srcptr += 1
                    r3 += 1
                Else
                    r3 += 2
                End If
                r5 += dstptr
            Else
                r3 = 0
                For x = 0 To 1
                    bitpos -= 1
                    If bitpos = 0 Then
                        curbyte = srcbuf(srcptr)
                        bitpos = 8
                        srcptr += 1
                    End If
                    flag = IntToBool(curbyte And &H1)
                    curbyte = curbyte >> 1
                    offset = r3 << 1
                    r3 = (offset Or BooltoInt(flag))
                Next
                offset = srcbuf(srcptr) Or &HFFFFFF00
                r3 += 2
                srcptr += 1
                r5 = offset + dstptr
            End If
            If r3 = 0 Then Continue Do
            t = r3
            x = 0
            Do While x < t
                dstbuf(dstptr) = dstbuf(r5)
                r5 += 1
                r3 += 1
                dstptr += 1
                x += 1
            Loop
        Loop
    End Function

    Public Function decompress_size(ByVal src() As Byte)
        Dim r3, r5 As Integer
        Dim offset, x, t As Integer
        Dim srcptr As Integer = 0
        Dim srcptr_orig As Integer = 0
        Dim dstptr As Integer = 0
        Dim dstptr_orig As Integer = 0
        Dim curbyte As Byte = 0
        Dim lstbyte As Byte = 0
        Dim flag As Boolean = False
        Dim bitpos As Integer = 9
        srcbuf = src

        curbyte = srcbuf(srcptr)
        srcptr += 1
        Do
            bitpos -= 1
            If bitpos = 0 Then
                lstbyte = srcbuf(srcptr)
                curbyte = srcbuf(srcptr)
                bitpos = 8
                srcptr += 1
            End If
            flag = IntToBool(curbyte And &H1)
            curbyte = curbyte >> 1
            If flag Then
                srcptr += 1
                dstptr += 1
                Continue Do
            End If
            bitpos -= 1
            If bitpos = 0 Then
                lstbyte = srcbuf(srcptr)
                curbyte = srcbuf(srcptr)
                bitpos = 8
                srcptr += 1
            End If
            flag = IntToBool(curbyte And &H1)
            curbyte = curbyte >> 1
            If flag Then
                r3 = srcbuf(srcptr)
                offset = (srcbuf(srcptr + 1) << 8) Or r3
                srcptr += 2
                If offset = 0 Then Return dstptr
                r3 = r3 And &H7
                r5 = (offset >> 3) Or &HFFFFE000
                If r3 = 0 Then
                    r3 = srcbuf(srcptr)
                    srcptr += 1
                    r3 += 1
                Else
                    r3 += 2
                End If
                r5 += dstptr
            Else
                r3 = 0
                x = 0
                Do While x < 2
                    bitpos -= 1
                    If bitpos = 0 Then
                        lstbyte = srcbuf(srcptr)
                        curbyte = srcbuf(srcptr)
                        bitpos = 8
                        srcptr += 1
                    End If
                    flag = IntToBool(curbyte And &H1)
                    curbyte = curbyte >> 1
                    offset = r3 << 1
                    r3 = offset Or BooltoInt(flag)
                    x += 1
                Loop
                offset = srcbuf(srcptr) Or &HFFFFFF00
                r3 += 2
                srcptr += 1
                r5 = offset + dstptr
            End If
            If r3 = 0 Then Continue Do
            t = r3
            x = 0
            Do While x < t
                r5 += 1
                r3 += 1
                dstptr += 1
                x += 1
            Loop
        Loop
    End Function
    Public Function getdestbuffer(ByVal size As Integer) As Byte()
        Dim q(size) As Byte
        For i As Integer = 0 To size - 1
            q(i) = dstbuf(i)
        Next
        Return q
    End Function
End Module
