Umm...  I had a topic here already on this subject, with the code I'd originally posted being (Windows-Only).  I went back to modify that time as I was posting code which would turn my Windows-Only comment into a thing of the past, and... umm...  some mod.... *whistles innocently*... who may, or may not have been me...  *whistles a little more*...  completely ended up destroying that whole topic, rather than just renaming it!!

*Whistles Innocently a whole lot!*

But, since these things happen, and nobody will cop up to deleting and obliterating my old topic...  *hum humm deee hummm* ,,, then I guess I'll just start a new one, so I can share the new code which works on all OSes.

_ControlChr Off



a$ = "Hello World"

Print "Original: "; a$



a1$ = To64$(a$)

Print "Encrypted: "; a1$



b$ = From64$(a1$)

Print "Restored: "; b$





$If BASE64 = UNDEFINED Then

    $Let BASE64 = TRUE

    $If WIN Then

        Declare Dynamic Library "Crypt32"

            Function CryptBinaryToStringA& (Compressed$, Byval numElements&, Byval format&, Byval buffer As _Offset, length&)

            Function CryptStringToBinaryA& (s$, Byval length&, Byval flags&, Byval r As _Offset, ret_length&, skip&, flag2&)

        End Declare



        Function To64$ (original$)

            If CryptBinaryToStringA(original$, Len(original$), &H40000001&, 0, l&) Then temp$ = Space$(l&) Else Exit Function

            If CryptBinaryToStringA(original$, Len(original$), &H40000001&, _Offset(temp$), l&) Then To64$ = temp$

        End Function



        Function From64$ (base64$)

            If CryptStringToBinaryA(base64$, Len(base64$), 6&, 0, l&, 0&, 0&) Then temp$ = Space$(l&) Else Exit Function

            If CryptStringToBinaryA(base64$, Len(base64$), 6&, _Offset(temp$), l&, 0&, 0&) Then From64$ = temp$

        End Function

    $Else

            'Note that these two versions were shamelessly stolen from A740g and taken directly from his work.

            'Orignial code and library can be found on the forums here: https://qb64phoenix.com/forum/showthread.php?tid=2184





            ' Converts a normal string or binary data to a base64 string

            Function To64$ (s As String)

            Const BASE64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"



            Dim srcSize As _Unsigned Long: srcSize = Len(s)

            Dim srcSize3rem As _Unsigned Long: srcSize3rem = srcSize Mod 3

            Dim srcSize3mul As _Unsigned Long: srcSize3mul = srcSize - srcSize3rem

            Dim buffer As String: buffer = Space$(((srcSize + 2) \ 3) * 4) ' preallocate complete buffer

            Dim j As _Unsigned Long: j = 1



            Dim i As _Unsigned Long: For i = 1 To srcSize3mul Step 3

            Dim char1 As _Unsigned _Byte: char1 = Asc(s, i)

            Dim char2 As _Unsigned _Byte: char2 = Asc(s, i + 1)

            Dim char3 As _Unsigned _Byte: char3 = Asc(s, i + 2)



            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShR(char1, 2)))

            j = j + 1

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL((char1 And 3), 4) Or _ShR(char2, 4)))

            j = j + 1

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL((char2 And 15), 2) Or _ShR(char3, 6)))

            j = j + 1

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (char3 And 63))

            j = j + 1

            Next i



            ' Add padding

            If srcSize3rem > 0 Then

            char1 = Asc(s, i)



            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShR(char1, 2)))

            j = j + 1



            If srcSize3rem = 1 Then

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL(char1 And 3, 4)))

            j = j + 1

            Asc(buffer, j) = 61 ' "="

            j = j + 1

            Asc(buffer, j) = 61 ' "="

            Else ' srcSize3rem = 2

            char2 = Asc(s, i + 1)



            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL((char1 And 3), 4) Or _ShR(char2, 4)))

            j = j + 1

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL(char2 And 15, 2)))

            j = j + 1

            Asc(buffer, j) = 61 ' "="

            End If

            End If



            To64$ = buffer

            End Function



            ' Converts a base64 string to a normal string or binary data

            Function From64$ (s As String)

            Dim srcSize As _Unsigned Long: srcSize = Len(s)

            Dim buffer As String: buffer = Space$((srcSize \ 4) * 3) ' preallocate complete buffer

            Dim j As _Unsigned Long: j = 1

            Dim As _Unsigned _Byte index, char1, char2, char3, char4



            Dim i As _Unsigned Long: For i = 1 To srcSize Step 4

            index = Asc(s, i): GoSub find_index: char1 = index

            index = Asc(s, i + 1): GoSub find_index: char2 = index

            index = Asc(s, i + 2): GoSub find_index: char3 = index

            index = Asc(s, i + 3): GoSub find_index: char4 = index



            Asc(buffer, j) = _ShL(char1, 2) Or _ShR(char2, 4)

            j = j + 1

            Asc(buffer, j) = _ShL(char2 And 15, 4) Or _ShR(char3, 2)

            j = j + 1

            Asc(buffer, j) = _ShL(char3 And 3, 6) Or char4

            j = j + 1

            Next i



            ' Remove padding

            If Right$(s, 2) = "==" Then

            buffer = Left$(buffer, Len(buffer) - 2)

            ElseIf Right$(s, 1) = "=" Then

            buffer = Left$(buffer, Len(buffer) - 1)

            End If



            From64$ = buffer

            Exit Function



            find_index:

            If index >= 65 And index <= 90 Then

            index = index - 65

            ElseIf index >= 97 And index <= 122 Then

            index = index - 97 + 26

            ElseIf index >= 48 And index <= 57 Then

            index = index - 48 + 52

            ElseIf index = 43 Then

            index = 62

            ElseIf index = 47 Then

            index = 63

            End If

            Return

            End Function

    $End If 

$End If 

Good morning everyone, 

I would like to try using the C language support to integrate certain functions that do not exist or are difficult to access in QB64.

Apart from the wiki, I have not found a proper guide that can help me understand how to do it, and the examples I have found have not been very helpful.

Can you help me with this?

Even Python, which is currently very popular, would be fantastic if it were implemented in QB64… but I realize I'm asking for too much.
Besides, I don't like Python but I have to acknowledge that it has an incredible amount of libraries.

Thank you!

TOP4 is a unique data compression algorithm by me (James) originally done in QuickBasic 7.1 PDS
.
I started it around 2011, and came back to it and finished it in 2018.

As it's simplest form, it is the top 4 symbols changed to 7 bits (4/256 = .015625) from an assumed 256 symbol alphabet.

The last 8 symbols are given an extra bit, and are changed from 8 to 9 bits (8/256 = .03125) to ensure that you still have a complete binary table that represents 256 symbols, albeit it is a variable-bit table now ranging from 7 to 9 bits, with 95.3% of it (244/256 = .953125) still remaining 8 bits.

The compression comes naturally from associating the most frequent counts of the top 4 symbols to 7 bits, whereas the expansion is very slight or seldom, since the last 8 symbols that occur the least get 9 bits but have a frequency that is too small to expand quickly (since the majority of the data is equal, and the majority of the most frequent data compresses by 1 bit per symbol when seen).

So if you assume an 8 bit table from 0 to 255 like this:

00000000
00000001
00000010
00000011
00000100
00000101
00000110
00000111...
etc
ending with
11111111

you would modify it to where the top 4 are now 7 bits

0000000 0
0000001 1
0000010 2
0000011 3
00001000 4
00001001 5
00001010 6
00001011 7
00001100 8
00001101 9
00001110 10
00001111 11 etc
...............
(the binary patterns for 4 to 247 remain equal at 8 bits)
...............
11111000 244
11111001 245
11111010 246
11111011 247
..............
(the binary patterns for 248 to 255 are expanded to 9 bits until the end to hold the table)

111111000 248
111111001 249
111111010 250
111111011 251
111111100 252
111111101 253
111111110 254
111111111 255

and then use an array that holds the frequencies for each of the symbols, arranged from least to greatest, and paired with the table.

When decompressing, the bits are read back as they were written (fifo) and the process terminated when it reaches the end of the file.

No tree required, no other probability weights needed other than the raw symbol statistics.

A CRC check is needed still at the end because at times (not often but on some smaller files) the last byte will be misread if it is a 9 or 7 bit code instead of 8, and a shift is needed to fix that there.

There are other modifications to give gains over huffman, but you should find that doing this with data that is not highly redundant but is compressible by huffman yields better results with top4 instead.

Whenever the data is more even and redundant, or there are less than 128 symbols in a file...for either case huffman will still excel. For all other situations, top4 will do better. You can assess the data type and tailor this to your needs.

One of 4 different modifications I have for this is to use a byte modifier that tries to predict the next byte based on the last, another is a 1.5 byte sliding binary window. Both of these make it possible to compress a few file types that normally expand a little.

It's a basic build to demo it only, and it is simple enough that it can be done with only very few lines of code.

Here is the compressor and decompressor for this. It is released as public domain.

James

TOP4 Compress:

'TOP4 COMPRESS BASIC/Quickbasic/QB64 implementation by James Wasil 2018 

'TOP4 is a compression method I came up with that can replace Huffman for some post-LZ and other final pass compression methods. It can be used that way or standalone.

'It's easy to use, easy to implement, easy to convert to other programming languages, straightforward, and treeless. 

'This version will work with the 32 or 64 bit version of the QB64 compiler for Windows, Mac OS X, and Linux 

'freely available at http://www.qb64.net or http://www.qb64.org 

'It can work with classic Quickbasic or Qbasic from DOSBOX. 



'Top4 can be made to work with Visual Basic 6.0 or higher by adding a form and placing this code in the main. The locate/write visual updates may be replaced with 

'Caption changes to a .Text of a TextBox if you like. The rest should work as-is. 



'This is released as public domain to use, improve upon, or do as you like with it for data compression. 

'If you find this helpful or useful, please give credit or leave my name in the code. That's all I ask.  

'Feel free to send feedback to: james.wasil@gmail.com 

'Enjoy! 



' 

'Array definitions: 

'P1$() =  ASCII symbols from 0 to 255 

'P2()  =  Numeric array that holds count of symbols 

'P3$() =  Binary string array from 0 to 255 that holds variable-sized bit patterns 

'BUFFER$ = Temporary file buffer of up to 32767 bytes 

'Z2$ =    Working string buffer of data read from BUFFER$ out of the file 

'OUTP$ =  Output string for binary patterns. These get sent to the disk after there are enough to convert to an 8 bit byte. 



DIM P1$(256), P2(256), P3$(256): P = P - 1 

FOR T = 0 TO 3: P = P + 1: TEMP$ = CHR$(T): CALL Ascii.To.Bynary(TEMP$, OUT1$): P3$(P) = RIGHT$(OUT1$, 7): OUT1$ = "": NEXT T: 'ADD FIRST 4 PATTERNS THAT ARE 7 BITS TO P3$(P), WHERE P IS ALWAYS +1. 

FOR T = 8 TO 249: P = P + 1: TEMP$ = CHR$(T): CALL Ascii.To.Bynary(TEMP$, OUT1$): P3$(P) = OUT1$: OUT1$ = "": NEXT T: 'ADD NEXT 248 PATTERNS THAT ARE 8 BITS TO P3$(P), WHERE P IS ALWAYS +1. 

FOR T = 250 TO 254: P = P + 1: TEMP$ = CHR$(T): CALL Ascii.To.Bynary(TEMP$, OUT1$): P3$(P) = OUT1$ + "0": P = P + 1: P3$(P) = OUT1$ + "1": OUT1$ = "": NEXT T: 'ADD LAST 8 PATTERNS THAT ARE 9 BITS TO P3$(P), WHERE P IS ALWAYS +1. 

'SLIGHTLY MODIFIED FROM ORIGINAL TOP4 PATTERN TO MAKE SPACE FOR AN EOF SYMBOL. 

'TEMP$=CHR$(255): P=P+1: CALL Ascii.To.Bynary(TEMP$, OUT1$): P3$(P) = OUT1$ + "0": P = P + 1: P3$(P) = OUT1$ + "1": OUT1$ = "": 'ADD STOP/EOF SYMBOL AND WILDCARD$ 



FOR T = 0 TO 255: P1$(T) = CHR$(T): NEXT T: 'CREATE STANDARD ASCII TABLE 



LINE INPUT "File to read:", FILE1$    :'FILE TO READ FROM 

LINE INPUT "File to write to:", FILE2$ :'FILE TO OUTPUT TO 

OPEN FILE1$ FOR BINARY AS #1 

OPEN FILE2$ FOR OUTPUT AS #2: CLOSE #2: OPEN FILE2$ FOR BINARY AS #2 



DO 

IF LEN(Z2$)<=1 THEN 

DO 

IF LOF(1)-LOC(1)=>32767 THEN BUFFER$=STRING$(32767,"0") ELSE BUFFER$=STRING$(LOF(1)-LOC(1),"0") 

IF LOF(1)-LOC(1)=>0 THEN GET #1,,BUFFER$:Z2$=Z2$+BUFFER$ 

LOOP UNTIL LOF(1)-LOC(1)=<0 OR LEN(Z2$)>=1 

ELSE 

END IF 



Z$ = LEFT$(Z2$,1):Z2$=RIGHT$(Z2$,LEN(Z2$)-1) 

IF LEN(Z$)=>1 THEN P2(ASC(Z$)) = P2(ASC(Z$)) + 1 

LOCATE 1, 1: WRITE LOF(1) - LOC(1) 

LOOP UNTIL Z$="" 



DO 

FOUND = 0 

FOR T = 0 TO 254 

IF P2(T) < P2(T + 1) THEN TEMP1 = P2(T): TEMP2$ = P1$(T): P2(T) = P2(T + 1): P2(T + 1) = TEMP1: P1$(T) = P1$(T + 1): P1$(T + 1) = TEMP2$: FOUND = 1 

NEXT T 

LOOP UNTIL FOUND = 0 

  

'MAKE STATIC BYTE HEADER HERE. NOW THAT IT IS ARRANGED STATISTICALLY, IT CORRESPONDS FROM GREATEST TO LEAST OCCURENCES WITH THE P3$() ARRAY BIT PATTERNS. 

for T=0 to 255:HEADER$=HEADER$+P1$(T):NEXT T:

PUT #2,,HEADER$:' This adds an easy to restore 256 byte header. It is possible to reduce this to 12 bytes and build around it to restore. 



'ADD THE FILESIZE NEXT. The file size is added to the second part of the header after the 256 byte table. For easy implementation, file size digits are stored as raw 

'8 bit bytes. The file size can be any size this way, but if you want to save space this can be a static 4 byte file header to support up to 4gb, even though the overhead isn't 

'that large with this dynamic size header, it may make a difference of a few bytes for smaller files: 



FILESIZE$=LTRIM$(STR$(LOF(1)))+"E":'E FOR END 

PUT #2,,FILESIZE$ 



'Set the file pointer to the first position. Z$ is the same as BUFFER$ here, but needs to be initialized with any symbol of at least 1 byte. It can be up to 32767 bytes or more, but gets slower if too large 

'of a string is used. 



SEEK #1, 1: Z$ = "P" 



CLS



'Get up to 32767 bytes, use Z3$ as a BUFFER$, add the new bytes to Z2$ 



DO 

IF LOF(1)-LOC(1)=>32767 AND LEN(Z2$)<2 THEN Z3$ = STRING$(32767,"0") 

IF LOF(1)-LOC(1)<32767 AND LEN(Z2$)<2 THEN Z3$="0" 

IF LEN(Z2$)<2 AND LOF(1)-LOC(1)=>1 THEN 

DO 

GET #1, , Z3$:Z2$=Z2$+Z3$ 

LOOP UNTIL LEN(Z2$)=>1 OR LOF(1)-LOC(1)<1 

END IF 

  

LOCATE 1, 1: WRITE LOC(1):WRITE LOF(2):'Write the position we're at from FILE1$ and the size of the new FILE2$ and update it. Compression goes slightly faster without this visual update. 





'A few modifications: 



'Modification 1: If ASCII symbol 0+0 is seen, then compress each to 4.5 bits and group the occurence together as 1 9 bit pattern. 

IF LEFT$(Z2$,2)=CHR$(0)+CHR$(0) THEN 

OUTP$=OUTP$+"111111110" 

Z2$=RIGHT$(Z2$,LEN(Z2$)-2):'Remove the 2 bytes from the input file stream after we've output the binary result 



'Modification 2: If we see the last symbol output appear as the next 2 symbols, we are able to group those 2 symbols together as 4.5 bits and output as 1 9 bit pattern: 

ELSEIF Z2$=LAST$+LAST$ THEN 

OUTP$=OUTP$+"111111111" 

Z2$=RIGHT$(Z2$,LEN(Z2$)-2):'Remove the 2 bytes from the input file stream after we've output the binary result 



'Proceed with normal ASCII to binary lookup table here: 

ELSE 

Z$=LEFT$(Z2$,1):Z2$=RIGHT$(Z2$,LEN(Z2$)-1) 

FOR PP = 0 TO 255: IF P1$(PP) = Z$ THEN OUTP$ = OUTP$ + P3$(PP):LAST$=Z$:Z$="":EXIT FOR: 'ADD THE BINARY REFERENCE PATTERN BY ASCII VALUE, BASED ON THE STATISTICAL ARRANGEMENT OF THE SYMBOLS HERE. 

NEXT PP 

END IF 



'If we're not at the end of the file yet 

IF LOF(1)-LOC(1)=<0 THEN 



'See if we are able to output a byte to the disk from OUTP$. If it's at least 8 bits, convert to a byte and send it out: 

IF LEN(OUTP$) >= 8 THEN TEMP$ = LEFT$(OUTP$, 8): OUTP$ = RIGHT$(OUTP$, LEN(OUTP$) - 8): CALL Bynary.To.Ascii(TEMP$, OUTP2$): PUT #2, , OUTP2$: OUTP2$ = "" 

EXIT DO 

ELSE 

END IF 



'IF WE HAVE 8 BITS, THEN OUTPUT A BYTE FROM THE LEFT. SAME AS ABOVE, BUT OUTSIDE OF THE MAIN LOOP: 

IF LEN(OUTP$) >= 8 THEN 

DO 

TEMP$ = LEFT$(OUTP$, 8): OUTP$ = RIGHT$(OUTP$, LEN(OUTP$) - 8): CALL Bynary.To.Ascii(TEMP$, OUTP2$): PUT #2, , OUTP2$: OUTP2$ = "" 

LOOP UNTIL LEN(OUTP$)<8 

END IF 

LOOP UNTIL LOF(1)-LOC(1)=<0 AND Z2$="" AND LEN(OUTP$)<8 



'OUTSIDE OF THE LOOP AND READY TO FINISH: 

'IF THERE ARE STILL BITS PRESENT WITH OUTP$, THEN PAD IT TO 8 BITS WITH EXTRA ZEROS THEN OUTPUT THE LAST BYTE. 

IF LEN(OUTP$) <> 0 THEN OUTP$ = OUTP$ + STRING$(8 - LEN(OUTP$), "0"): OUTP$ = RIGHT$(OUTP$, LEN(OUTP$) - 8): CALL Bynary.To.Ascii(TEMP$, OUTP2$): PUT #2, , OUTP2$: OUTP2$ = "" 

WRITE "Original File:", LOF(1) 

WRITE "Compressed Output:", LOF(2) 

WRITE "Difference:", LOF(1) - LOF(2) 

CLOSE #1 

CLOSE #2 

END 







'Functions / Subs area. 

SUB Ascii.To.Bynary (X$, OUTZX$) 

FOR K = 1 TO LEN(X$) 

KXZZ# = ASC(MID$(X$, K, 1)) 

IF KXZZ# - 128 >= 0 THEN KXZZ# = KXZZ# - 128: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 64 >= 0 THEN KXZZ# = KXZZ# - 64: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 32 >= 0 THEN KXZZ# = KXZZ# - 32: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 16 >= 0 THEN KXZZ# = KXZZ# - 16: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 8 >= 0 THEN KXZZ# = KXZZ# - 8: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 4 >= 0 THEN KXZZ# = KXZZ# - 4: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 2 >= 0 THEN KXZZ# = KXZZ# - 2: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 1 >= 0 THEN KXZZ# = KXZZ# - 1: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

NEXT K 

END SUB 



SUB Bynary.To.Ascii (X$, KXX$) 

KXX$ = "" 

FOR X = 1 TO LEN(X$) STEP 8 

IF MID$(X$, X, 1) = "1" THEN XXZ = XXZ + 128 

IF MID$(X$, X + 1, 1) = "1" THEN XXZ = XXZ + 64 

IF MID$(X$, X + 2, 1) = "1" THEN XXZ = XXZ + 32 

IF MID$(X$, X + 3, 1) = "1" THEN XXZ = XXZ + 16 

IF MID$(X$, X + 4, 1) = "1" THEN XXZ = XXZ + 8 

IF MID$(X$, X + 5, 1) = "1" THEN XXZ = XXZ + 4 

IF MID$(X$, X + 6, 1) = "1" THEN XXZ = XXZ + 2 

IF MID$(X$, X + 7, 1) = "1" THEN XXZ = XXZ + 1 

KXX$ = KXX$ + CHR$(XXZ): XXZ = 0 

NEXT X 

END SUB

'TOP4 DECOMPRESS BASIC/Quickbasic/QB64 implementation by James Wasil 2018 

'TOP4 is a compression method I came up with that can replace Huffman for some post-LZ and other final pass compression methods. It can be used that way or standalone. 

'It's easy to use, easy to implement, easy to convert to other programming languages, straightforward, and treeless. 

'This version will work with the 32 or 64 bit version of the QB64 compiler for Windows, Mac OS X, and Linux 

'freely available at http://www.qb64.net or http://www.qb64.org 

'It can work with classic Quickbasic or Qbasic from DOSBOX. 



'Top4 can be made to work with Visual Basic 6.0 or higher by adding a form and placing this code in the main. The locate/write visual updates may be replaced with 

'Caption changes to a .Text of a TextBox if you like. The rest should work as-is. 



'This is released as public domain to use, improve upon, or do as you like with it for data compression. 

'If you find this helpful or useful, please give credit or leave my name in the code. That's all I ask.  

'Feel free to send feedback to: james.wasil@gmail.com 

'Enjoy! 



DIM P1$(256), P2(256), P3$(256): P = P - 1 

FOR T = 0 TO 3: P = P + 1: TEMP$ = CHR$(T): CALL Ascii.To.Bynary(TEMP$, OUT1$): P3$(P) = RIGHT$(OUT1$, 7): OUT1$ = "": NEXT T: 'ADD FIRST 4 PATTERNS THAT ARE 7 BITS TO P3$(P), WHERE P IS ALWAYS +1. 

FOR T = 8 TO 249: P = P + 1: TEMP$ = CHR$(T): CALL Ascii.To.Bynary(TEMP$, OUT1$): P3$(P) = OUT1$: OUT1$ = "": NEXT T: 'ADD NEXT 248 PATTERNS THAT ARE 8 BITS TO P3$(P), WHERE P IS ALWAYS +1. 

FOR T = 250 TO 254: P = P + 1: TEMP$ = CHR$(T): CALL Ascii.To.Bynary(TEMP$, OUT1$): P3$(P) = OUT1$ + "0": P = P + 1: P3$(P) = OUT1$ + "1": OUT1$ = "": NEXT T: 'ADD LAST 8 PATTERNS THAT ARE 9 BITS TO P3$(P), WHERE P IS ALWAYS +1. 



FOR T = 0 TO 255: P1$(T) = CHR$(T): NEXT T: 'CREATE STANDARD ASCII TABLE 



LINE INPUT "File to read:", FILE1$ 

LINE INPUT "File to write to:", FILE2$ 

OPEN FILE1$ FOR BINARY AS #1 

OPEN FILE2$ FOR OUTPUT AS #2: CLOSE #2: OPEN FILE2$ FOR BINARY AS #2 

Z$ = STRING$(256, "0"): GET #1, , Z$: HEADER$ = Z$: Z$ = "P" 

FOR T = 1 TO 256: P1$(T - 1) = MID$(HEADER$, T, 1): NEXT T: 'Load HEADER$ to P1$() array. 

'GET FILESIZE NEXT 

Z$="G" 

DO 

GET #1,,Z$:IF Z$="E" THEN EXIT DO ELSE FILESIZE$=FILESIZE$+Z$ 

LOOP 

SIZEFILE#=VAL(FILESIZE$) 



DO 



'ENSURE WE HAVE ENOUGH BYTES 

DO 

Z$=STRING$(1024,"0"):IF LOF(1)-LOC(1)<32767 THEN Z$="0" 

IF LEN(OUTP$)<16 AND LOF(1)-LOC(1)>0 THEN GET #1,,Z$ 

'LOCATE 1, 1: WRITE LOC(1) 

IF LEN(OUTP$) < 16 THEN CALL Ascii.To.Bynary(Z$, OUTP1$): OUTP$ = OUTP$ + OUTP1$: OUTP1$ = "" 

LOOP UNTIL LEN(OUTP$)=>16 OR LOF(1)-LOC(1)=<0 



LOCATE 1,1:WRITE LOF(1)-LOC(1) 

IF LEFT$(OUTP$,9)="111111110" THEN OUTP$ = RIGHT$(OUTP$, LEN(OUTP$) - 9): OUTP2$ = CHR$(0)+CHR$(0): PUT #2, , OUTP2$ 

IF LEFT$(OUTP$,9)="111111111" THEN OUTP$ = RIGHT$(OUTP$, LEN(OUTP$) - 9): OUTP2$ = LAST$+LAST$: PUT #2, , OUTP2$ 

FOR PP = 0 TO 255: IF LEFT$(OUTP$, LEN(P3$(PP))) = P3$(PP) THEN OUTP$ = RIGHT$(OUTP$, LEN(OUTP$) - LEN(P3$(PP))): OUTP2$ = P1$(PP): LAST$=OUTP2$UT #2, , OUTP2$: EXIT FOR: 'ADD THE BINARY REFERENCE PATTERN BY ASCII VALUE, BASED ON THE STATISTICAL ARRANGEMENT OF THE SYMBOLS HERE. 

NEXT PP 

'WRITE OUTP$ 

LOOP UNTIL LOF(2)=>SIZEFILE# AND LOF(1)-LOC(1)=<0 

WRITE "Compressed File:", LOF(1) 

WRITE "Original File:", LOF(2) 

WRITE "Difference:", LOF(1) - LOF(2) 

CLOSE #1 

CLOSE #2 

END 



SUB Ascii.To.Bynary (X$, OUTZX$) 

FOR K = 1 TO LEN(X$) 

KXZZ# = ASC(MID$(X$, K, 1)) 

IF KXZZ# - 128 >= 0 THEN KXZZ# = KXZZ# - 128: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 64 >= 0 THEN KXZZ# = KXZZ# - 64: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 32 >= 0 THEN KXZZ# = KXZZ# - 32: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 16 >= 0 THEN KXZZ# = KXZZ# - 16: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 8 >= 0 THEN KXZZ# = KXZZ# - 8: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 4 >= 0 THEN KXZZ# = KXZZ# - 4: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 2 >= 0 THEN KXZZ# = KXZZ# - 2: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

IF KXZZ# - 1 >= 0 THEN KXZZ# = KXZZ# - 1: OUTZX$ = OUTZX$ + "1" ELSE OUTZX$ = OUTZX$ + "0" 

NEXT K 

END SUB 



SUB Bynary.To.Ascii (X$, KXX$) 

KXX$ = "" 

FOR X = 1 TO LEN(X$) STEP 8 

IF MID$(X$, X, 1) = "1" THEN XXZ = XXZ + 128 

IF MID$(X$, X + 1, 1) = "1" THEN XXZ = XXZ + 64 

IF MID$(X$, X + 2, 1) = "1" THEN XXZ = XXZ + 32 

IF MID$(X$, X + 3, 1) = "1" THEN XXZ = XXZ + 16 

IF MID$(X$, X + 4, 1) = "1" THEN XXZ = XXZ + 8 

IF MID$(X$, X + 5, 1) = "1" THEN XXZ = XXZ + 4 

IF MID$(X$, X + 6, 1) = "1" THEN XXZ = XXZ + 2 

IF MID$(X$, X + 7, 1) = "1" THEN XXZ = XXZ + 1 

KXX$ = KXX$ + CHR$(XXZ): XXZ = 0 

NEXT X 

END SUB

Handed my kid a simple dice roller program to see how worked on his computer.  It worked fine... until he decided to enter the maximum integer value for the # of dice rolls. The program accepted it but... then NOTHING. It didn't crash the system but it was going to take a LONG time to get an answer as it looped through all those dice rolls.

It was an easy fix to throttle the maximum valid input values but it was a good reminder to me to have someone else check a program before sending it on to other people.

Say hello to Bin2Data.



Bin2Data is a command-line tool that allows for the conversion of binary files to Base64 encoded DATA / CONST statements. The companion library allows for the decoding of Base64 encoded data back into its binary form. The data is optionally compressed using Google's Zopfli compression library if it sees any goodness. This means that files that are already compressed, may not go through one more compression and decompression step. The compressed data is compatible with QB64-PE's _DEFLATE$.

The original idea for this tool and library comes from two awesome tools: DAV's BASFILE and RhoSigma's MakeDATA.

So, what different about Bin2Data? Two things:

1. It uses Google's Zopfli deflate based compressor. Zopfli is one of the best deflate compressor in the world.
   
2. It can generate the data to CONSTs. Which means there is no performance hit that happens when loading files from DATA statements and string concatenation. String concatenation happens at compile time.
   

Attached Files

  libbase64.zip (Size: 86.7 KB / Downloads: 73)
  Bin2Data.zip (Size: 459.89 KB / Downloads: 33)

In my quest to find the BEST font to use with the QB64PE IDE, I have finally found it!

"What it", you ask?

Well......  Not the best font, but probably the WORST!

   

I...  I can't imagine that it'd get much worse than that one!   Monospaced Script font for the LOSE!!

I noticed this today. I reckon the wiki isn't supposed to do that?

I finished the game. I have included many elements that I have not used before. For example, shading. This has slowed down games a lot so far, so I used to create separate textures for different distances. Here, however, the translucent shadow is drawn over the texture.

Lots of physics, interactions between objects, subtle movements. (not piecemeal, but transitional)

The best innovation is the automatic FPS setting. In the past, I usually set the image refresh rate to 20-25-30 so that it would run well even on weaker computers. It is noticeable and can be confusing. Here, however, I used it to adapt the image update to the speed of the machine. On a faster machine, it can go up to 60-100 FPS, which makes the animation very soft and fluid.

I cover this so that even those who don't play 3D games can understand it. Let's say I want to move a point from one side of the screen to the other. There is strictly 1 minute available for this. What should be its velocity vector? It depends on how wide the window is, and it also depends on how many times I want to interrupt the operation. The more times we interrupt, the more we see beautiful animation. If we break it a few times, it will be lumpy.
The automatic fps adjuster continuously monitors whether interruptions have been completed at the current FPS during a specified measurement time. If not, it means the machine is slow, so at that fps the whole game will stutter and become unenjoyable, so set it lower. On the other hand, if our computer is fast, we will perceive a wonderful display. All of this unnoticed, because in the game the speeds are constantly set to this. So it makes the most of the computer's performance (it tries not to leave any 'rest time'), and in return very nice animation takes place.

I would like a challenge. I divided the CHALLENGE into 12 tracks! Completing one is more difficult and exciting. I would like you to try it, and if everyone succeeds in posting the puzzle picture!

The game contains 2 pieces of BAS! One is in dm_start and the other is in the need/game_exe folder!
download:

https://qb64phoenix.com/forum/showthread.php?tid=686
corrections:
in principle, it also runs on Linux, it uses the appropriate per-signal

advices:
if possible, no windows or browsers should be running, so you can enjoy the game at the highest fps
the bigger the water, the slower you walk in it. if you jump, run away, you go faster
if the water is already overflowing, you can get air by jumping

I came upon this in Help. I like what it does, but don't get how it works. How do the CHR$(&H0)s and CHR$(&HEF)s create the string pattern to be filled? I understand the &H definition in Help is hex base 16 format, but that's as far as I go... Thanks!

DIM Row$(1 TO 8)
SCREEN 12

'make red-brick wall
Row$(1) = CHR$(&H0) + CHR$(&H0) + CHR$(&HFE) + CHR$(&HFE)
Row$(2) = Row$(1)
Row$(3) = Row$(1)
Row$(4) = CHR$(&H0) + CHR$(&H0) + CHR$(&H0) + CHR$(&H0)
Row$(5) = CHR$(&H0) + CHR$(&H0) + CHR$(&HEF) + CHR$(&HEF)
Row$(6) = Row$(5)
Row$(7) = Row$(5)
Row$(8) = Row$(4)
Tile$ = Row$(1) + Row$(2) + Row$(3) + Row$(4) + Row$(5) + Row$(6) + Row$(7) + Row$(8)

LINE (59, 124)-(581, 336), 14, B 'yellow box border to paint inside
PAINT (320, 240), Tile$, 14 'paints brick tiles within yellow border

This is an animated GIF player library written purely in QB64-PE.

I was kind of annoyed and frustrated with the issues in the animated GIF library implementation we have listed in the wiki. Unfortunately, InForm's GIF support is derived from the same code, and it suffers from the same limitations and issues. Basically, it does not support frame local color tables and does not correctly support all of GIF's frame disposal methods. So, I set out to write an animated GIF library that can work standalone and also with InForm-PE.

The latest version of the library will always be a part of InForm-PE. You can find the code inside InForm-PE/InForm/extensions.

I am also attaching a standalone zip file here. This zip file contains just the GIFPlay library, demo and its dependencies.

Library documentation is here: https://github.com/a740g/InForm-PE/blob/...GIFPlay.md

You'll find some other useful (?) stuff in the InForm/extensions directory. 

Cheers!

Attached Files

  GIFPlay.zip (Size: 1.81 MB / Downloads: 108)