mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-16 17:54:16 +00:00
6e01fc8dce
Added new _STRCMP and _STRICMP commands for quick string comparisons. Cleaned up QB64 to finish removing the QUI (quick user insert) code and folders. Altered UCASE and LCASE routines to be faster in some situations for us.
405 lines
14 KiB
QBasic
405 lines
14 KiB
QBasic
FUNCTION gl2qb_type_convert$ (a$, symbol$, typ, ctyp$)
|
|
symbol$ = ""
|
|
|
|
'unsigned int
|
|
IF a$ = "GLenum" THEN b$ = "_UNSIGNED LONG": symbol$ = "~&": typ = ULONGTYPE - ISPOINTER: ctyp$ = "uint32"
|
|
IF a$ = "GLbitfield" THEN b$ = "_UNSIGNED LONG": symbol$ = "~&": typ = ULONGTYPE - ISPOINTER: ctyp$ = "uint32"
|
|
IF a$ = "GLuint" THEN b$ = "_UNSIGNED LONG": symbol$ = "~&": typ = ULONGTYPE - ISPOINTER: ctyp$ = "uint32"
|
|
|
|
'int
|
|
IF a$ = "GLint" THEN b$ = "LONG": symbol$ = "&": typ = LONGTYPE - ISPOINTER: ctyp$ = "int32"
|
|
IF a$ = "GLsizei" THEN b$ = "LONG": symbol$ = "&": typ = LONGTYPE - ISPOINTER: ctyp$ = "int32"
|
|
|
|
'unsigned char
|
|
IF a$ = "GLboolean" THEN b$ = "_UNSIGNED _BYTE": symbol$ = "~%%": typ = UBYTETYPE - ISPOINTER: ctyp$ = "uint8"
|
|
IF a$ = "GLubyte" THEN b$ = "_UNSIGNED _BYTE": symbol$ = "~%%": typ = UBYTETYPE - ISPOINTER: ctyp$ = "uint8"
|
|
|
|
'char
|
|
IF a$ = "GLbyte" THEN b$ = "_BYTE": symbol$ = "%%": typ = BYTETYPE - ISPOINTER: ctyp$ = "int8"
|
|
|
|
'unsigned short
|
|
IF a$ = "GLushort" THEN b$ = "_UNSIGNED INTEGER": symbol$ = "~%": typ = UINTEGERTYPE - ISPOINTER: ctyp$ = "uint16"
|
|
|
|
'short
|
|
IF a$ = "GLshort" THEN b$ = "INTEGER": symbol$ = "%": typ = INTEGERTYPE - ISPOINTER: ctyp$ = "int16"
|
|
|
|
'float
|
|
IF a$ = "GLfloat" THEN b$ = "SINGLE": symbol$ = "!": typ = SINGLETYPE - ISPOINTER: ctyp$ = "float"
|
|
IF a$ = "GLclampf" THEN b$ = "SINGLE": symbol$ = "!": typ = SINGLETYPE - ISPOINTER: ctyp$ = "float"
|
|
|
|
'double
|
|
IF a$ = "GLdouble" THEN b$ = "DOUBLE": symbol$ = "#": typ = DOUBLETYPE - ISPOINTER: ctyp$ = "double"
|
|
IF a$ = "GLclampd" THEN b$ = "DOUBLE": symbol$ = "#": typ = DOUBLETYPE - ISPOINTER: ctyp$ = "double"
|
|
|
|
'void
|
|
IF a$ = "GLvoid" THEN b$ = "_OFFSET": symbol$ = "&&": typ = OFFSETTYPE - ISPOINTER: ctyp$ = "ptrszint"
|
|
|
|
'typedef unsigned int GLenum;
|
|
'typedef unsigned char GLboolean;
|
|
'typedef unsigned int GLbitfield;
|
|
'typedef signed char GLbyte;
|
|
'typedef short GLshort;
|
|
'typedef int GLint;
|
|
'typedef int GLsizei;
|
|
'typedef unsigned char GLubyte;
|
|
'typedef unsigned short GLushort;
|
|
'typedef unsigned int GLuint;
|
|
'typedef float GLfloat;
|
|
'typedef float GLclampf;
|
|
'typedef double GLdouble;
|
|
'typedef double GLclampd;
|
|
'typedef void GLvoid;
|
|
|
|
IF b$ = "" THEN PRINT "Unknown type:" + a$: END
|
|
gl2qb_type_convert$ = b$
|
|
END FUNCTION
|
|
|
|
FUNCTION readchunk$ (a$, last_character$)
|
|
a$ = LTRIM$(RTRIM$(a$))
|
|
FOR x = 1 TO LEN(a$)
|
|
c = ASC(a$, x)
|
|
IF c = 32 OR c = 44 OR c = 40 OR c = 41 THEN last_character$ = CHR$(c): readchunk$ = LEFT$(a$, x - 1): a$ = LTRIM$(RIGHT$(a$, LEN(a$) - x)): EXIT FUNCTION
|
|
NEXT
|
|
readchunk$ = a$: last_character$ = "": a$ = ""
|
|
END FUNCTION
|
|
|
|
|
|
SUB gl_scan_header
|
|
|
|
IF GL_KIT THEN hk = FREEFILE: OPEN "internal\c\parts\core\gl_header_for_parsing\temp\gl_kit.bas" FOR OUTPUT AS #hk
|
|
IF GL_KIT THEN PRINT #hk, "DECLARE LIBRARY"
|
|
|
|
d = 0: a2$ = ""
|
|
h = FREEFILE
|
|
OPEN "internal\c\parts\core\gl_header_for_parsing\gl.h" FOR INPUT AS #h
|
|
DO UNTIL EOF(h)
|
|
LINE INPUT #h, a$
|
|
IF LEN(a$) THEN
|
|
a$ = LTRIM$(RTRIM$(a$))
|
|
IF LEFT$(a$, 8) = "#define " THEN
|
|
a2$ = ""
|
|
a$ = a$ + " "
|
|
FOR x = 1 TO LEN(a$)
|
|
c = ASC(a$, x)
|
|
IF c = 32 THEN
|
|
FOR x2 = 1 TO LEN(a2$)
|
|
c2 = ASC(a2$, x2)
|
|
IF c2 >= 65 AND c2 <= 90 THEN GOTO define_ok
|
|
IF c2 >= 48 AND c2 <= 57 AND x2 <> 1 THEN GOTO define_ok
|
|
IF c2 = 95 THEN GOTO define_ok
|
|
GOTO define_not_ok
|
|
define_ok:
|
|
NEXT
|
|
value$ = LTRIM$(RTRIM$(RIGHT$(a$, LEN(a$) - x)))
|
|
IF LEN(value$) = 0 THEN GOTO define_not_ok
|
|
|
|
IF LEFT$(value$, 2) = "0x" THEN
|
|
value&& = VAL("&H" + RIGHT$(value$, LEN(value$) - 2) + "&&")
|
|
'PRINT a2$, value&&
|
|
d = d + 1: GL_DEFINES(d) = a2$: GL_DEFINES_VALUE(d) = value&&
|
|
ELSEIF ASC(value$) >= 48 AND ASC(value$) <= 57 THEN
|
|
value&& = VAL(value$)
|
|
'PRINT a2$, value&&
|
|
d = d + 1: GL_DEFINES(d) = a2$: GL_DEFINES_VALUE(d) = value&&
|
|
ELSE
|
|
'PRINT a2$, value$, "?"
|
|
FOR i = 1 TO d
|
|
IF GL_DEFINES(i) = value$ THEN
|
|
d = d + 1: GL_DEFINES(d) = a2$: GL_DEFINES_VALUE(d) = GL_DEFINES_VALUE(i)
|
|
'PRINT a2$, GL_DEFINES_VALUE(i)
|
|
EXIT FOR
|
|
END IF
|
|
NEXT
|
|
END IF
|
|
GOTO got_define
|
|
define_not_ok:
|
|
a2$ = ""
|
|
ELSE
|
|
a2$ = a2$ + CHR$(c)
|
|
END IF
|
|
NEXT
|
|
got_define:
|
|
END IF '#define
|
|
|
|
|
|
IF RIGHT$(a$, 1) = ";" THEN
|
|
a2$ = readchunk(a$, l$): IF a2$ <> "WINGDIAPI" GOTO discard
|
|
ret_type$ = readchunk(a$, l$)
|
|
IF ret_type$ = "const" THEN ret_type$ = readchunk(a$, l$)
|
|
|
|
is_func = 0: IF ret_type$ <> "void" THEN is_func = 1
|
|
|
|
a2$ = readchunk(a$, l$)
|
|
IF a2$ = "*APIENTRY" THEN ret_type$ = ret_type$ + "*": a2$ = "APIENTRY"
|
|
IF a2$ <> "APIENTRY" THEN GOTO discard
|
|
|
|
GL_COMMANDS_LAST = GL_COMMANDS_LAST + 1
|
|
c = GL_COMMANDS_LAST
|
|
|
|
hc$ = ""
|
|
hd$ = ""
|
|
need_helper_function = 0
|
|
|
|
IF is_func THEN
|
|
GL_COMMANDS(c).subfunc = 1
|
|
IF GL_KIT THEN PRINT #hk, "FUNCTION ";
|
|
ELSE
|
|
GL_COMMANDS(c).subfunc = 2
|
|
IF GL_KIT THEN PRINT #hk, "SUB ";
|
|
END IF
|
|
|
|
proc_name$ = readchunk(a$, l$)
|
|
|
|
GL_COMMANDS(c).cn = "_" + proc_name$: IF GL_KIT THEN PRINT #hk, proc_name$;
|
|
GL_COMMANDS(c).callname = proc_name$
|
|
|
|
GL_COMMANDS(c).ret = 0
|
|
IF is_func THEN
|
|
pointer = 0: IF RIGHT$(ret_type$, 1) = "*" THEN pointer = 1
|
|
IF pointer THEN
|
|
t$ = "_OFFSET": s$ = "&&"
|
|
GL_COMMANDS(c).ret = OFFSETTYPE - ISPOINTER
|
|
hd$ = hd$ + "ptrszint "
|
|
need_helper_function = 1
|
|
ELSE
|
|
t$ = gl2qb_type_convert(ret_type$, s$, typ, ctyp$)
|
|
GL_COMMANDS(c).ret = typ
|
|
hd$ = hd$ + ctyp$ + " "
|
|
END IF
|
|
IF GL_KIT THEN PRINT #hk, s$;
|
|
hc$ = hc$ + "return (" + ctyp$ + ")(" + ret_type$ + ")"
|
|
ELSE
|
|
hd$ = hd$ + "void "
|
|
END IF
|
|
|
|
IF GL_KIT THEN PRINT #hk, "(";
|
|
|
|
hc$ = hc$ + proc_name$ + "("
|
|
hd$ = hd$ + "call_" + proc_name$ + "("
|
|
|
|
|
|
GL_COMMANDS(c).args = 0
|
|
GL_COMMANDS(c).arg = ""
|
|
|
|
DO
|
|
|
|
var_type$ = readchunk(a$, l$)
|
|
IF var_type$ = "" AND l$ = "(" THEN var_type$ = readchunk(a$, l$) 'space between fun name and "("?
|
|
IF var_type$ = "const" THEN var_type$ = readchunk(a$, l$)
|
|
IF var_type$ = "void" OR var_type$ = "" THEN GOTO no_arguments
|
|
IF l$ <> "," AND l$ <> ")" THEN
|
|
var_name$ = readchunk(a$, l$)
|
|
IF LEFT$(var_name$, 1) = "*" THEN var_type$ = var_type$ + "*": var_name$ = RIGHT$(var_name$, LEN(var_name$) - 1)
|
|
IF LEFT$(var_name$, 1) = "*" THEN var_type$ = var_type$ + "*": var_name$ = RIGHT$(var_name$, LEN(var_name$) - 1)
|
|
'Note: could be a poiner to a pointer
|
|
ELSE
|
|
var_name$ = "no_name"
|
|
END IF
|
|
|
|
var_type_backup$ = var_type$
|
|
|
|
pointer = 0
|
|
|
|
IF RIGHT$(var_type$, 1) = "*" THEN
|
|
var_type$ = LEFT$(var_type$, LEN(var_type$) - 1)
|
|
pointer = 1
|
|
END IF
|
|
IF RIGHT$(var_type$, 1) = "*" THEN
|
|
var_type$ = LEFT$(var_type$, LEN(var_type$) - 1)
|
|
pointer = 2
|
|
END IF
|
|
|
|
IF pointer = 2 THEN
|
|
qb_type$ = "_OFFSET" 'it's the offset of an offset
|
|
ELSE
|
|
qb_type$ = gl2qb_type_convert$(var_type$, s$, typ, ctyp$)
|
|
END IF
|
|
|
|
'IF pointer THEN need_helper_function = 1
|
|
need_helper_function = 1
|
|
|
|
IF GL_KIT THEN
|
|
IF pointer = 0 THEN PRINT #hk, "BYVAL ";
|
|
PRINT #hk, var_name$ + " AS " + qb_type$;
|
|
IF l$ <> ")" THEN PRINT #hk, ",";
|
|
END IF
|
|
|
|
IF pointer = 0 THEN
|
|
arg$ = MKL$(typ)
|
|
END IF
|
|
IF pointer = 1 THEN 'all pointers convert to BYVAL _OFFSET
|
|
arg$ = MKL$(OFFSETTYPE - ISPOINTER)
|
|
ctyp$ = "ptrszint"
|
|
END IF
|
|
IF pointer = 2 THEN 'all pointers-to-pointers convert to xxx"BYREF"xxx BYVAL _OFFSET
|
|
arg$ = MKL$(OFFSETTYPE - ISPOINTER)
|
|
ctyp$ = "ptrszint"
|
|
'***this is important or you lose the ability to specify any offset, only the offset of a variable of type
|
|
' _OFFSET
|
|
' arg$ = MKL$(OFFSETTYPE)
|
|
' ctyp$ = "ptrszint*"
|
|
END IF
|
|
|
|
GL_COMMANDS(c).args = GL_COMMANDS(c).args + 1
|
|
|
|
MID$(GL_COMMANDS(c).arg, (GL_COMMANDS(c).args - 1) * 4 + 1, 4) = arg$
|
|
'z$ = GL_COMMANDS(c).arg
|
|
'MID$(z$, (GL_COMMANDS(c).args - 1) * 4 + 1, 4) = arg$
|
|
'GL_COMMANDS(c).arg = z$
|
|
|
|
letter$ = CHR$(96 + GL_COMMANDS(c).args)
|
|
|
|
hc$ = hc$ + "(" + var_type_backup$ + ")" + letter$
|
|
hd$ = hd$ + ctyp$ + " " + letter$
|
|
|
|
|
|
|
|
IF l$ <> ")" THEN hc$ = hc$ + ",": hd$ = hd$ + ","
|
|
|
|
LOOP UNTIL l$ = ")"
|
|
no_arguments:
|
|
|
|
|
|
hd$ = hd$ + "){"
|
|
hc$ = hc$ + ");"
|
|
IF GL_KIT THEN PRINT #hk, ")"
|
|
h$ = hd$ + CRLF + "if (!sub_gl_called) error(270);" + CRLF + hc$ + CRLF + "}" + CRLF
|
|
|
|
IF need_helper_function THEN 'do we need the helper function for this command?
|
|
GL_HELPER_CODE = GL_HELPER_CODE + h$
|
|
GL_COMMANDS(c).callname = "call_" + proc_name$
|
|
END IF
|
|
|
|
|
|
IF proc_name$ = "glGetString" THEN
|
|
GL_COMMANDS(c).ret = STRINGTYPE
|
|
GL_COMMANDS(c).callname = "( char* )" + RTRIM$(GL_COMMANDS(c).callname)
|
|
END IF
|
|
|
|
|
|
|
|
|
|
END IF
|
|
|
|
END IF
|
|
|
|
|
|
|
|
|
|
|
|
discard:
|
|
LOOP
|
|
CLOSE #h
|
|
|
|
IF GL_KIT THEN PRINT #hk, "END DECLARE"
|
|
|
|
GL_DEFINES_LAST = d
|
|
REDIM _PRESERVE GL_DEFINES(d) AS STRING
|
|
'PRINT "Defines:"; GL_DEFINES_LAST
|
|
|
|
REDIM _PRESERVE GL_COMMANDS(GL_COMMANDS_LAST) AS GL_idstruct
|
|
'PRINT "Commands:"; GL_COMMANDS_LAST
|
|
|
|
IF GL_KIT THEN
|
|
FOR i = 1 TO GL_DEFINES_LAST
|
|
PRINT #hk, "CONST " + GL_DEFINES(i) + "="; GL_DEFINES_VALUE(i)
|
|
NEXT
|
|
END IF
|
|
|
|
'FOR i = 1 TO GL_COMMANDS_LAST
|
|
' PRINT ".cn="; GL_COMMANDS(i).cn
|
|
' PRINT ".callname="; GL_COMMANDS(i).callname
|
|
' PRINT ".subfunc="; GL_COMMANDS(i).subfunc
|
|
' PRINT ".args="; GL_COMMANDS(i).args
|
|
' _CONTROLCHR OFF
|
|
' PRINT ".arg=[" + RTRIM$(GL_COMMANDS(i).arg) + "]"
|
|
' _CONTROLCHR ON
|
|
' PRINT ".ret="; GL_COMMANDS(i).ret
|
|
'NEXT
|
|
|
|
IF GL_KIT THEN CLOSE #hk
|
|
|
|
|
|
fh = FREEFILE
|
|
OPEN "internal\c\parts\core\gl_header_for_parsing\temp\gl_helper_code.h" FOR OUTPUT AS #fh
|
|
PRINT #fh, GL_HELPER_CODE
|
|
CLOSE #fh
|
|
|
|
|
|
END SUB
|
|
|
|
SUB gl_include_content
|
|
|
|
'add constants
|
|
FOR d = 1 TO GL_DEFINES_LAST
|
|
IF ASC(GL_DEFINES(d)) <> 95 THEN
|
|
GL_DEFINES(d) = "_" + GL_DEFINES(d)
|
|
END IF
|
|
constlast = constlast + 1
|
|
IF constlast > constmax THEN
|
|
constmax = constmax * 2
|
|
REDIM _PRESERVE constname(constmax) AS STRING
|
|
REDIM _PRESERVE constcname(constmax) AS STRING
|
|
REDIM _PRESERVE constnamesymbol(constmax) AS STRING 'optional name symbol
|
|
REDIM _PRESERVE consttype(constmax) AS LONG 'variable type number
|
|
REDIM _PRESERVE constinteger(constmax) AS _INTEGER64
|
|
REDIM _PRESERVE constuinteger(constmax) AS _UNSIGNED _INTEGER64
|
|
REDIM _PRESERVE constfloat(constmax) AS _FLOAT
|
|
REDIM _PRESERVE conststring(constmax) AS STRING
|
|
REDIM _PRESERVE constsubfunc(constmax) AS LONG
|
|
REDIM _PRESERVE constdefined(constmax) AS LONG
|
|
END IF
|
|
i = constlast
|
|
constname(i) = GL_DEFINES(d)
|
|
constcname(i) = GL_DEFINES(d)
|
|
constnamesymbol(i) = "&&"
|
|
consttype(i) = INTEGER64TYPE - ISPOINTER
|
|
constinteger(i) = GL_DEFINES_VALUE(d)
|
|
constsubfunc(i) = 0 'global
|
|
constdefined(i) = 1
|
|
'add to hash table
|
|
HashAdd constcname(i), HASHFLAG_CONSTANT, i
|
|
NEXT
|
|
|
|
|
|
'add subs/functions
|
|
FOR c = 1 TO GL_COMMANDS_LAST
|
|
DIM g AS GL_idstruct
|
|
' TYPE GL_idstruct
|
|
' cn AS STRING * 64 'case sensitive version of n
|
|
' subfunc AS INTEGER 'if function=1, sub=2
|
|
' callname AS STRING * 64
|
|
' args AS INTEGER
|
|
' arg AS STRING * 80 'similar to t
|
|
' ret AS LONG 'the value it returns if it is a function (again like t)
|
|
' END TYPE
|
|
g = GL_COMMANDS(c)
|
|
|
|
reginternalsubfunc = 1
|
|
clearid
|
|
id.ccall = 1 '*** important for handling string returns correctly ***
|
|
id.n = RTRIM$(g.cn)
|
|
s = g.subfunc
|
|
id.subfunc = s
|
|
id.callname = RTRIM$(g.callname)
|
|
id.args = g.args
|
|
id.arg = g.arg
|
|
id.ret = g.ret
|
|
regid
|
|
reginternalsubfunc = 0
|
|
NEXT
|
|
|
|
'add inline function definitions
|
|
|
|
'SUB gluPerspective (BYVAL fovy#, BYVAL aspect#, BYVAL zNear#, BYVAL zFar#)
|
|
reginternalsubfunc = 1
|
|
clearid
|
|
id.n = "_gluPerspective"
|
|
id.subfunc = 2 'sub
|
|
id.callname = "gluPerspective"
|
|
id.args = 4
|
|
id.arg = MKL$(DOUBLETYPE - ISPOINTER) + MKL$(DOUBLETYPE - ISPOINTER) + MKL$(DOUBLETYPE - ISPOINTER) + MKL$(DOUBLETYPE - ISPOINTER)
|
|
regid
|
|
reginternalsubfunc = 0
|
|
|
|
END SUB
|