mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-07-06 07:00:23 +00:00
45ffc8c9e6
- As suggested by @mkilgore , moved the embed list array reset out of the $EMBED block - Imposed a 20% least ratio for compression - Moved the handle comparison into `func__embedded()` to avoid some unnecessary function calls
228 lines
6.7 KiB
QBasic
228 lines
6.7 KiB
QBasic
|
|
'
|
|
' Duplicates the contents of one file into another
|
|
'
|
|
' Returns: 0 on success, 1 on error
|
|
FUNCTION CopyFile& (sourceFile$, destFile$)
|
|
DIM sourceFileNo, destFileNo
|
|
DIM fileLength AS _INTEGER64
|
|
|
|
E = 0
|
|
sourceFileNo = FREEFILE
|
|
OPEN sourceFile$ FOR BINARY AS #sourceFileNo
|
|
IF E = 1 THEN GOTO errorCleanup
|
|
|
|
fileLength = LOF(sourceFileNo)
|
|
|
|
destFileNo = FREEFILE
|
|
OPEN destFile$ FOR OUTPUT AS #destFileNo: CLOSE #destFileNo 'create and blank any existing file with the dest name.
|
|
OPEN destFile$ FOR BINARY AS #destFileNo
|
|
IF E = 1 THEN GOTO errorCleanup
|
|
|
|
' Read the file in one go
|
|
buffer$ = SPACE$(fileLength)
|
|
|
|
GET #sourceFileNo, , buffer$
|
|
PUT #destFileNo, , buffer$
|
|
|
|
errorCleanup:
|
|
IF sourceFileNo <> 0 THEN CLOSE #sourceFileNo
|
|
IF destFileNo <> 0 THEN CLOSE #destFileNo
|
|
|
|
CopyFile& = E
|
|
END FUNCTION
|
|
|
|
'
|
|
' Convert a file into an C-Array incl. read function and append it
|
|
' to the file 'internal\temp\embedded.cpp'
|
|
'
|
|
' Inputs: sourcefile spec, unique handle (case sensitive)
|
|
' Return: 0 = normal embed, 1 = packed embed (DEPENDENCY_ZLIB required)
|
|
FUNCTION ConvertFileToCArray% (file$, handle$)
|
|
'--- read file contents ---
|
|
sff% = FREEFILE
|
|
OPEN "B", #sff%, file$
|
|
filedata$ = SPACE$(LOF(sff%))
|
|
GET #sff%, , filedata$
|
|
CLOSE #sff%
|
|
'--- try to compress ---
|
|
compdata$ = _DEFLATE$(filedata$)
|
|
IF LEN(compdata$) < (LEN(filedata$) * 0.8) THEN
|
|
tmpfile$ = tmpdir$ + "embed.bin"
|
|
OPEN "O", #sff%, tmpfile$: CLOSE #sff%
|
|
OPEN "B", #sff%, tmpfile$: PUT #sff%, , compdata$: CLOSE #sff%
|
|
packed% = 1
|
|
OPEN "B", #sff%, tmpfile$
|
|
ELSE
|
|
packed% = 0
|
|
OPEN "B", #sff%, file$
|
|
END IF
|
|
'--- init variables ---
|
|
fl& = LOF(sff%)
|
|
cntL& = INT(fl& / 32)
|
|
cntV& = INT(cntL& / 8180)
|
|
cntB& = (fl& - (cntL& * 32))
|
|
'--- create C-Array ---
|
|
dff% = FREEFILE
|
|
OPEN "A", #dff%, tmpdir$ + "embedded.cpp"
|
|
'--- process LONGs ---
|
|
tmpI$ = SPACE$(32)
|
|
FOR vc& = 0 TO cntV&
|
|
IF vc& = cntV& THEN numL& = (cntL& MOD 8180): ELSE numL& = 8180
|
|
PRINT #dff%, "static const uint32_t "; handle$; "L"; LTRIM$(STR$(vc&)); "[] = {"
|
|
PRINT #dff%, " "; LTRIM$(STR$(numL& * 8)); ","
|
|
FOR z& = 1 TO numL&
|
|
GET #sff%, , tmpI$: offI% = 1
|
|
tmpO$ = " " + STRING$(88, ","): offO% = 5
|
|
DO
|
|
tmpL& = CVL(MID$(tmpI$, offI%, 4)): offI% = offI% + 4
|
|
MID$(tmpO$, offO%, 10) = "0x" + RIGHT$("00000000" + HEX$(tmpL&), 8)
|
|
offO% = offO% + 11
|
|
LOOP UNTIL offO% > 92
|
|
IF z& < numL& THEN PRINT #dff%, tmpO$: ELSE PRINT #dff%, LEFT$(tmpO$, 91)
|
|
NEXT z&
|
|
PRINT #dff%, "};"
|
|
PRINT #dff%, ""
|
|
NEXT vc&
|
|
'--- process remaining BYTEs ---
|
|
IF cntB& > 0 THEN
|
|
PRINT #dff%, "static const uint8_t "; handle$; "B[] = {"
|
|
PRINT #dff%, " "; LTRIM$(STR$(cntB&)); ","
|
|
PRINT #dff%, " ";
|
|
FOR x% = 1 TO cntB&
|
|
GET #sff%, , tmpB%%
|
|
PRINT #dff%, "0x" + RIGHT$("00" + HEX$(tmpB%%), 2);
|
|
IF x% <> 16 THEN
|
|
IF x% <> cntB& THEN PRINT #dff%, ",";
|
|
ELSE
|
|
IF x% <> cntB& THEN
|
|
PRINT #dff%, ","
|
|
PRINT #dff%, " ";
|
|
END IF
|
|
END IF
|
|
NEXT x%
|
|
PRINT #dff%, ""
|
|
PRINT #dff%, "};"
|
|
PRINT #dff%, ""
|
|
END IF
|
|
'--- make a read function ---
|
|
PRINT #dff%, "qbs *GetArrayData_"; handle$; "(void)"
|
|
PRINT #dff%, "{"
|
|
PRINT #dff%, " qbs *data = qbs_new("; LTRIM$(STR$(fl&)); ", 1);"
|
|
PRINT #dff%, " char *buff = (char*) data -> chr;"
|
|
PRINT #dff%, ""
|
|
FOR vc& = 0 TO cntV&
|
|
PRINT #dff%, " memcpy(buff, &"; handle$; "L"; LTRIM$(STR$(vc&)); "[1], "; handle$; "L"; LTRIM$(STR$(vc&)); "[0] << 2);"
|
|
IF vc& < cntV& OR cntB& > 0 THEN
|
|
PRINT #dff%, " buff += ("; handle$; "L"; LTRIM$(STR$(vc&)); "[0] << 2);"
|
|
END IF
|
|
NEXT vc&
|
|
IF cntB& > 0 THEN
|
|
PRINT #dff%, " memcpy(buff, &"; handle$; "B[1], "; handle$; "B[0]);"
|
|
END IF
|
|
PRINT #dff%, ""
|
|
IF packed% THEN
|
|
PRINT #dff%, " return func__inflate(data, "; LTRIM$(STR$(LEN(filedata$))); ", 1);"
|
|
ELSE
|
|
PRINT #dff%, " return data;"
|
|
END IF
|
|
PRINT #dff%, "}"
|
|
PRINT #dff%, ""
|
|
'--- ending ---
|
|
CLOSE #dff%
|
|
CLOSE #sff%
|
|
ConvertFileToCArray% = packed%
|
|
END FUNCTION
|
|
|
|
'
|
|
' Splits the filename from its path, and returns the path
|
|
'
|
|
' Returns: The path, or empty if no path
|
|
FUNCTION getfilepath$ (f$)
|
|
FOR i = LEN(f$) TO 1 STEP -1
|
|
a$ = MID$(f$, i, 1)
|
|
IF a$ = "/" OR a$ = "\" THEN
|
|
getfilepath$ = LEFT$(f$, i)
|
|
EXIT FUNCTION
|
|
END IF
|
|
NEXT
|
|
getfilepath$ = ""
|
|
END FUNCTION
|
|
|
|
'
|
|
' Checks if a filename has an extension on the end
|
|
'
|
|
' Returns: True if provided filename has an extension
|
|
FUNCTION FileHasExtension (f$)
|
|
FOR i = LEN(f$) TO 1 STEP -1
|
|
a = ASC(f$, i)
|
|
IF a = 47 OR a = 92 THEN EXIT FOR
|
|
IF a = 46 THEN FileHasExtension = -1: EXIT FUNCTION
|
|
NEXT
|
|
END FUNCTION
|
|
|
|
'
|
|
' Strips the extension off of a filename
|
|
'
|
|
' Returns: Provided filename without extension on the end
|
|
FUNCTION RemoveFileExtension$ (f$)
|
|
FOR i = LEN(f$) TO 1 STEP -1
|
|
a = ASC(f$, i)
|
|
IF a = 47 OR a = 92 THEN EXIT FOR
|
|
IF a = 46 THEN RemoveFileExtension$ = LEFT$(f$, i - 1): EXIT FUNCTION
|
|
NEXT
|
|
RemoveFileExtension$ = f$
|
|
END FUNCTION
|
|
|
|
'
|
|
' Returns the extension on the end of a file name
|
|
'
|
|
' Returns "" if there is no extension
|
|
'
|
|
FUNCTION GetFileExtension$ (f$)
|
|
FOR i = LEN(f$) TO 1 STEP -1
|
|
a = ASC(f$, i)
|
|
IF a = 47 OR a = 92 THEN EXIT FOR
|
|
IF a = 46 THEN GetFileExtension$ = MID$(f$, i + 1): EXIT FUNCTION
|
|
NEXT
|
|
GetFileExtension$ = ""
|
|
END FUNCTION
|
|
|
|
'
|
|
' Fixes the provided filename and path to use the correct path separator
|
|
'
|
|
SUB PATH_SLASH_CORRECT (a$)
|
|
IF os$ = "WIN" THEN
|
|
FOR x = 1 TO LEN(a$)
|
|
IF ASC(a$, x) = 47 THEN ASC(a$, x) = 92
|
|
NEXT
|
|
ELSE
|
|
FOR x = 1 TO LEN(a$)
|
|
IF ASC(a$, x) = 92 THEN ASC(a$, x) = 47
|
|
NEXT
|
|
END IF
|
|
END SUB
|
|
|
|
' Return a pathname where all "\" are correctly escaped
|
|
FUNCTION GetEscapedPath$ (path_name AS STRING)
|
|
DIM buf AS STRING, z AS _UNSIGNED LONG, a AS _UNSIGNED _BYTE
|
|
|
|
FOR z = 1 TO LEN(path_name)
|
|
a = ASC(path_name, z)
|
|
buf = buf + CHR$(a)
|
|
IF a = 92 THEN buf = buf + "\"
|
|
NEXT
|
|
|
|
GetEscapedPath = buf
|
|
END FUNCTION
|
|
|
|
' Adds a trailing \ or / to a directory name if needed
|
|
FUNCTION FixDirectoryName$ (dir_name AS STRING)
|
|
IF LEN(dir_name) > 0 AND RIGHT$(dir_name, 1) <> pathsep$ THEN
|
|
FixDirectoryName = dir_name + pathsep$
|
|
ELSE
|
|
FixDirectoryName = dir_name
|
|
END IF
|
|
END FUNCTION
|
|
|