+- PowerBASIC Users Meeting Point (http://pump.richheimer.de)
+-- Forum: User to User Discussions (http://pump.richheimer.de/forumdisplay.php?fid=3)
+--- Forum: Source Code Library (http://pump.richheimer.de/forumdisplay.php?fid=8)
+--- Thread: PB 3.5 8-to-7 Bit Text Compression (/showthread.php?tid=50)
PB 3.5 8-to-7 Bit Text Compression - Andy Dee - 04-03-2025
Hello everyone,
I developed a method to compress short texts by reducing 8-bit characters to 7-bit. While the compression ratio is low for large files, it efficiently reduces small strings.
Key Steps:
- Normalization: The input text is restricted to 7-bit ASCII (32–127).
- Offset Adjustment: Each character is decremented by 32 to fit within 0–95.
- Compression:
For every 8 bytes, extract bits 0–6 (discarding bit 7).Pack these 7-bit segments into 7 bytes, using all 8 bits per byte.
- Remaining Bytes: If the text length isn’t a multiple of 8, the last 1–7 bytes are copied uncompressed.
- Decompression:
Reverse the process: Expand 7-bit segments to 8 bits, then increment by 32.
Here is the code, including some testing:
Code:
$Compile exe
$Dim All
$Lib All Off
$Error All Off
$String 2
$Com 0
$Float Procedure
$Optimize Size'Speed
$Cpu 80386
$Sound 1
$Stack 1536
'----------------------------------------------------------------------------
' Packe limitierten Text von 8 auf 7 Bit.
' Nutze dafür Zeiger zum Erhöhen der Geschwindigkeit
Declare _
FUNCTION PackTxt87 (sQuelle AS STRING) AS STRING
FUNCTION PackTxt87 (sQuelle AS STRING) AS STRING
' lokale Variablen
DIM iQlen AS LOCAL INTEGER ' Länge von sQuelle
DIM Q_ptr AS LOCAL BYTE PTR ' Zeichen-Pointer auf sQuelle
Dim sZiel As Local String ' Komprimiertes sZiel
DIM iZlen AS LOCAL INTEGER ' Länge von sZiel
DIM Z_ptr AS LOCAL BYTE PTR ' Zeichen-Pointer auf sZiel
DIM iZPos AS LOCAL INTEGER ' Position in sZiel
DIM iQPos AS LOCAL INTEGER ' Position in sQuelle
DIM iQLoop AS LOCAL INTEGER ' Anzahl KompressionsSchleifen
DIM iKompS AS LOCAL INTEGER ' Anzahl komprimierbarer Zeichen
Dim iRest As Local Integer ' Anzahl unkomprimierbarer Zeichen
Dim bWert As Local Byte ' ASCII-32-Wert eines Zeichens.
Dim iBitQ As Local Integer ' Aktuelle Bitbosition in sQuelle
Dim iBitZ As Local Integer ' Aktuelle Bitbosition in sZiel
Dim sTemp As Local String
'
iQlen = LEN(sQuelle) ' Hole Länge der Quelle
'--------------------------------------------------------------------------
' Fehler 1 abfangen
If iQlen < 8 Then _ ' String zu kurz?
Function = sQuelle: _ ' Gib Original zurück
Exit Function ' und raus
iQLoop = Fix(iQlen/8) ' Hole Anzahl KompressionsSchleifen
iRest = iQlen Mod 8 ' Hole Anzahl unkomprimierbarer Zeichen
iKompS = iQLoop * 8 ' Hole Anzahl komprimierbarer Zeichen
iZlen = iQLoop * 7 + iRest ' Hole Länge komprimierten Strings
'
DECR iQlen ' Null-basiert für Pointer
Q_ptr = STRPTR32( sQuelle ) ' Setze Pointer auf sQuelle
'--------------------------------------------------------------------------
' Fehler 2 abfangen
For iQPos = 0 To iQlen ' Überprüfe auf ungültige Zeichen
IF @Q_ptr[iQPos] < 32 _
Or @Q_ptr[iQPos] > 159 _
THEN
sZiel = sZiel _ ' sammle diese
+ Chr$(@Q_ptr[iQPos])
End If
Next iQPos
If Len(sZiel) Then _
Function = "Falsche Quelle: "+sZiel : _
Exit Function ' und gib sie zurück
sZiel = Repeat$(iZlen,Chr$(0)) ' Platz für Kompression in sZiel
Z_ptr = STRPTR32( sZiel ) ' Setze Pointer auf sZiel
iZPos = 0 ' Position im Pointer = 0
iBitQ = 0 ' Bitbosition in sQuelle auf 0
iBitZ = 0 ' Bitbosition in sZiel auf 0
DECR iKompS ' Null-basiert für Pointer
'--------------------------------------------------------------------------
' Kompression:
For iQPos = 0 To iKompS ' Für komprimierbare Zeichen in sQuelle:
' 1. Schritt:
bWert = @Q_ptr[iQPos] - 32 ' ASCII-Wert um 32 vermindern, dass
' ASCII zwischen 0-159 ist
For iBitQ = 0 To 6 ' Lies aus sQuelle Bit 0-6
If Bit(bWert,iBitQ) = 1 Then ' Schreibe Ziel-Bits 0-7
Bit Set @Z_ptr[iZPos], iBitZ '
Else '
Bit ReSet @Z_ptr[iZPos], iBitZ '
End If
If iBitZ < 7 Then ' Solange in Ziel zwischen Bit 0 und 7
Incr iBitZ ' Nächstes Bit
Else ' sonst
iBitZ = 0 ' Bit 0 in
Incr iZPos ' nächstem Zeichen
End If
Next iBitQ
Next iQPos
iZPos = iZlen-iRest ' Setze Zeiger auf erstes unpackbares
' Zeichen
For iQPos = iQlen-iRest+1 To iQlen ' Für unpackbare Zeichen in sQuelle
@Z_ptr[iZPos] = @Q_ptr[iQPos] ' Schreibe unpackbare Zeichen
Incr iZPos
Next iQPos
Function = sZiel
END FUNCTION
'----------------------------------------------------------------------------
' EntPacke limitierten Text von 8 auf 7 Bit.
' Nutze dafür Zeiger zum Erhöhen der Geschwindigkeit
Declare _
FUNCTION DePackTxt87 (sQuelle AS STRING) AS STRING
FUNCTION DePackTxt87 (sQuelle AS STRING) AS STRING
' lokale Variablen
DIM iQlen AS LOCAL INTEGER ' Länge von sQuelle
DIM Q_ptr AS LOCAL BYTE PTR ' Zeichen-Pointer auf sQuelle
Dim sZiel As Local String ' Komprimiertes sZiel
DIM iZlen AS LOCAL INTEGER ' Länge von sZiel
DIM Z_ptr AS LOCAL BYTE PTR ' Zeichen-Pointer auf sZiel
DIM iZPos AS LOCAL INTEGER ' Position in sZiel
DIM iQPos AS LOCAL INTEGER ' Position in sQuelle
DIM iQLoop AS LOCAL INTEGER ' Anzahl KompressionsSchleifen
DIM iKompS AS LOCAL INTEGER ' Anzahl komprimierbarer Zeichen
Dim iRest As Local Integer ' Anzahl unkomprimierbarer Zeichen
Dim bWert As Local Byte ' ASCII-32-Wert eines Zeichens.
Dim iBitQ As Local Integer ' Aktuelle Bitbosition in sQuelle
Dim iBitZ As Local Integer ' Aktuelle Bitbosition in sZiel
Dim sTemp As Local String
Dim bPack As Local Byte ' Gepackte Bytes an sQuelleEnde
iQlen = LEN(sQuelle) ' Hole Länge der Quelle
'--------------------------------------------------------------------------
' Fehler 1 abfangen
If iQlen < 7 Then _ ' String zu kurz?
Function = sQuelle: _ ' Gib Original zurück
Exit Function ' und raus
Q_ptr = STRPTR32( sQuelle ) ' Setze Pointer auf sQuelle
iQLoop = Fix(iQlen/7) ' Hole Anzahl EntPacksSchleifen
iRest = iQlen Mod 7 ' Anzahl ungepackte Zeichen?
'--------------------------------------------------------------------------
' Fehler 2 abfangen
If iRest = 0 Then ' Scheint alles gepackt zu sein, dann
bPack = 0 ' GePacktes = 0
For iQPos = iQlen - 7 To iQlen-1 ' Überprfe letzte 7 Zeichen auf
IF @Q_ptr[iQPos] < 32 _ ' komprimierte Zeichen
Or @Q_ptr[iQPos] > 127 _ ' Wenn welche da, dann
THEN Incr bPack ' Erhöhe Gepacktes (bPack)
Next iQPos
End If
If bPack = 0? _ ' Wenn keine gepackten Zeichen (bPack)
And iRest = 0 _ ' und keine ungepackten Zeichen (iRest)
Then ' dann
iRest = 7 ' ungepackte Zeichen (iRest) = 7
iKompS = iQlen - iRest ' Setze Anzahl entpackbarer Zeichen
Else ' sonst
iKompS = iQLoop * 7 ' Setze Anzahl entpackbarer Zeichen
End If
If IsFalse(bPack) _ ' Sind die iRest-lichen Zeichen
And iRest = 7 _ ' ungepackt, dann reduziere
Then Decr iQLoop ' die Anzahl der Entpackaufrufe
iZlen = iQLoop * 8 + iRest ' Hole Länge komprimierten Strings
'
DECR iQlen ' Null-basiert für Pointer
sZiel = Repeat$(iZlen,Chr$(0)) ' Platz für Kompression in sZiel
Z_ptr = STRPTR32( sZiel ) ' Setze Pointer auf sZiel
iZPos = 0 ' Position im Pointer = 0
iBitQ = 0 ' Bitbosition in sQuelle auf 0
iBitZ = 0 ' Bitbosition in sZiel auf 0
'--------------------------------------------------------------------------
' DeKompression: Rechne Zeichen in sQuelle auf ASCII 32-159 um
For iQPos = 0 To iKompS ' Fr entkomprimierbare Zeichen in sQuelle:
' 1. Schritt:
For iBitQ = 0 To 7 ' Lies aus sQuelle Bit 0-7
If Bit(@Q_ptr[iQPos],iBitQ) = 1 Then ' Schreibe Ziel-Bits 0-7
Bit Set @Z_ptr[iZPos], iBitZ '
Else '
Bit ReSet @Z_ptr[iZPos], iBitZ '
End If
If iBitZ < 6 Then ' Solange in Ziel zwischen Bit 0 und 6
Incr iBitZ ' Nächstes Bit
Else ' sonst
iBitZ = 0 ' Bit 0
Incr @Z_ptr[iZPos], 32 ' Erstelle das richtige ZielZeichen
Incr iZPos ' und nächstes ZielZeichen
End If
Next iBitQ
Next iQPos
iZPos = iZlen-iRest ' Setze Zeiger auf erstes unpackbares
' Zeichen
For iQPos = iQlen-iRest+1 To iQlen ' Für ungepackte Zeichen in sQuelle
@Z_ptr[iZPos] = @Q_ptr[iQPos] ' Schreibe ungepackte Zeichen
Incr iZPos
Next iQPos
Function = sZiel
END FUNCTION
' Test-Code'
DIM originalText AS STRING, _
compressedText AS STRING, _
decompressedText AS STRING, _
iIndex As Integer, _
iLOrg As Integer, _
iLPck As Integer, _
iLEpk As Integer
For iIndex = 07 To 19
'?
originalText = Left$("PowerBASIC 3.5 is a wonderful tool for writing fast and usefull programs.",iIndex)
iLOrg = Len(originalText)
compressedText = PackTxt87(originalText)
iLPck = Len(compressedText)
If Instr(compressedText, "Falsche Quelle: ") = 1 Then ?compressedText:end
decompressedText = DePackTxt87(compressedText)
iLEpk = Len(decompressedText)
'PRINT "Original: ";
PRINT "Original: ";
Print originalText;
$If 0
Print " ist =";iLOrg;" Byte lang"
PRINT "Komprimiert: ";
Print compressedText;
Print " ist =";iLPck;" Byte lang"
PRINT "Dekomprimiert: ";
Print decompressedText;
Print " ist =";iLEpk;" Byte lang"
$EndIf
? " --> Test verlief: [erfolg";
If originalText = decompressedText Then
Print "reich] :-) :";iLOrg;iLPck;iLEpk
Else
Print "los] ;-(";iLOrg;iLPck;iLEpk
?"Original und wieder Entpacktes unterscheiden sich an folgenden Stellen:"
For iIndex = 1 To iLOrg
If ASCII(originalText,iIndex) <> ASCII(decompressedText,iIndex) Then
?"Position";iIndex;" - Zeichen Original: ";Chr$(ASCII(originalText,iIndex)); _
" - Zeichen Entpackt: ";Chr$(ASCII(decompressedText,iIndex))
End If
Next iIndex
End If
Next iIndex
Sleep
originalText = "PowerBASIC 3.5 is a wonderful tool for writing fast, small and usefull programs under DOS."
iLOrg = Len(originalText)
compressedText = PackTxt87(originalText)
iLPck = Len(compressedText)
If Instr(compressedText, "Falsche Quelle: ") = 1 Then ?compressedText:end
decompressedText = DePackTxt87(compressedText)
iLEpk = Len(decompressedText)
PRINT "Original:"
Print originalText;
? " --> Test verlief: [erfolg";
If originalText = decompressedText Then
Print "reich] :-) :";iLOrg;iLPck;iLEpk
Else
Print "los] ;-(";iLOrg;iLPck;iLEpk
?"Original und wieder Entpacktes unterscheiden sich an folgenden Stellen:"
For iIndex = 1 To iLOrg
If ASCII(originalText,iIndex) <> ASCII(decompressedText,iIndex) Then
?"Position";iIndex;" - Zeichen Original: ";Chr$(ASCII(originalText,iIndex)); _
" - Zeichen Entpackt: ";Chr$(ASCII(decompressedText,iIndex))
End If
Next iIndex
End If
PRINT "Komprimiert:"
Print compressedText
Print "ist =";iLPck;" Byte lang"
PRINT "Dekomprimiert:"
Print decompressedText
Print "ist =";iLEpk;" Byte lang"
originalText = "PowerBASIC 3.5 ist ein wundervolles Werkzeug fr schnelle, kleine bis groáe und vor allen ¯ntzliche® Programme unter DOS."
?originalText
iLOrg = Len(originalText)
compressedText = PackTxt87(originalText)
iLPck = Len(compressedText)
If Instr(compressedText, "Falsche Quelle: ") = 1 Then ?compressedText:end
decompressedText = DePackTxt87(compressedText)
iLEpk = Len(decompressedText)
PRINT "Original:"
Print originalText;
? " --> Test verlief: [erfolg";
If originalText = decompressedText Then
Print "reich] :-) :";iLOrg;iLPck;iLEpk
Else
Print "los] ;-(";iLOrg;iLPck;iLEpk
?"Original und wieder Entpacktes unterscheiden sich an folgenden Stellen:"
For iIndex = 1 To iLOrg
If ASCII(originalText,iIndex) <> ASCII(decompressedText,iIndex) Then
?"Position";iIndex;" - Zeichen Original: ";Chr$(ASCII(originalText,iIndex)); _
" - Zeichen Entpackt: ";Chr$(ASCII(decompressedText,iIndex))
End If
Next iIndex
End If
PRINT "Komprimiert:"
Print compressedText
Print "ist =";iLPck;" Byte lang"
PRINT "Dekomprimiert:"
Print decompressedText
Print "ist =";iLEpk;" Byte lang"This is the DOS-output:
Code:
Original: PowerBA --> Test verlief: [erfolgreich] :-) : 7 7 7
Original: PowerBAS --> Test verlief: [erfolgreich] :-) : 8 7 8
Original: PowerBASI --> Test verlief: [erfolgreich] :-) : 9 8 9
Original: PowerBASIC --> Test verlief: [erfolgreich] :-) : 10 9 10
Original: PowerBASIC --> Test verlief: [erfolgreich] :-) : 11 10 11
Original: PowerBASIC 3 --> Test verlief: [erfolgreich] :-) : 12 11 12
Original: PowerBASIC 3. --> Test verlief: [erfolgreich] :-) : 13 12 13
Original: PowerBASIC 3.5 --> Test verlief: [erfolgreich] :-) : 14 13 14
Original: PowerBASIC 3.5 --> Test verlief: [erfolgreich] :-) : 15 14 15
Original: PowerBASIC 3.5 i --> Test verlief: [erfolgreich] :-) : 16 14 16
Original: PowerBASIC 3.5 is --> Test verlief: [erfolgreich] :-) : 17 15 17
Original: PowerBASIC 3.5 is --> Test verlief: [erfolgreich] :-) : 18 16 18
Original: PowerBASIC 3.5 is a --> Test verlief: [erfolgreich] :-) : 19 17 19
Original:PowerBASIC 3.5 is a wonderful tool for writing fast, small and usefull
programs under DOS. --> Test verlief: [erfolgreich] :-) : 90 79 90
Komprimiert:
░τ╡(§àf⌐◄`Γ¿ ÆS@►p}:ëE⌐▒╩♦PƒO&└°ö☻«╥$5Θ<☻î┴)ò☺ÿ6âL& Φ$☻¬╙ó▒╩d☻á╥τQ→lN☺U'▒(♣É^S.
ist = 79 Byte lang
Dekomprimiert:
PowerBASIC 3.5 is a wonderful tool for writing fast, small and usefull programs
under DOS.
ist = 90 Byte lang
PowerBASIC 3.5 ist ein wundervolles Werkzeug für schnelle, kleine bis große und
vor allen »nützliche« Programme unter DOS.
Falsche Quelle: ᯮ Perhaps the code will also be of use to others...