1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-07-03 11:11:20 +00:00

Change to QB64 to make the config file standard QB64 code and esier to expand in the future.

This commit is contained in:
SMcNeill 2015-07-08 08:40:57 -04:00
parent 73b18284eb
commit 6462df028a
3 changed files with 147 additions and 38 deletions

View file

@ -1,2 +1,40 @@
'Used for debugging the compiler's code (not the code it compiles) [for temporary/advanced usage]
CONST Debug = 0
DIM SHARED IDECommentColor AS _UNSIGNED LONG, IDEMetaCommandColor AS _UNSIGNED LONG
DIM SHARED IDEQuoteColor AS _UNSIGNED LONG, IDETextColor AS _UNSIGNED LONG
ConfigFile$ = "internal/config.txt"
ConfigBak$ = "internal/config.bak"
IF _FILEEXISTS(ConfigFile$) = 0 THEN
'There's no config file in the folder. Let's make one for future use.
WriteConfigSetting "'[CONFIG VERSION]", "ConfigVersion", "1"
WriteConfigSetting "'[IDE COLOR SETTINGS]", "CommentColor", "_RGB32(85,255,255)"
WriteConfigSetting "'[IDE COLOR SETTINGS]", "MetaCommandColor", "_RGB32(85,255,85)"
WriteConfigSetting "'[IDE COLOR SETTINGS]", "QuoteColor", "_RGB32(255,255,85)"
WriteConfigSetting "'[IDE COLOR SETTINGS]", "TextColor", "_RGB32(255,255,255)"
'go ahead and set default values automatically
ConfigFileVersion = 1
IDECommentColor = _RGB32(85, 255, 255)
IDEMetaCommandColor = _RGB32(85, 255, 85)
IDEQuoteColor = _RGB32(255, 255, 85)
IDETextColor = _RGB32(255, 255, 255)
ELSE
result = ReadConfigSetting("ConfigVersion", value$) 'Not really used for anything at this point, but might be important in the future.
ConfigFileVersion = VAL(value$) 'We'll get a config file version of 0 if there isn't any in the file
result = ReadConfigSetting("CommentColor", value$)
IF result THEN IDECommentColor = VRGBS(value$, _RGB32(85, 255, 255)) ELSE IDECommentColor = _RGB32(85, 255, 255)
result = ReadConfigSetting("MetaCommandColor", value$)
IF result THEN IDEMetaCommandColor = VRGBS(value$, _RGB32(85, 255, 85)) ELSE IDEMetaCommandColor = _RGB32(85, 255, 85)
result = ReadConfigSetting("QuoteColor", value$)
IF result THEN IDEQuoteColor = VRGBS(value$, _RGB32(255, 255, 85)) ELSE IDEQuoteColor = _RGB32(255, 255, 85)
result = ReadConfigSetting("TextColor", value$)
IF result THEN IDETextColor = VRGBS(value$, _RGB32(255, 255, 2555)) ELSE IDETextColor = _RGB32(255, 255, 255)
END IF

View file

@ -6162,44 +6162,10 @@ idet$ = LEFT$(idet$, ideli - 1) + MKL$(textlen) + text$ + MKL$(textlen) + RIGHT$
END SUB
SUB ideshowtext
static IdeShowTextInit as integer
STATIC CommentColor as _unsigned long, QuoteColor as _unsigned Long
STATIC MetaCommandColor as _unsigned long, TextColor as _unsigned long
if IdeShowTextInit <> -1 then
IdeShowTextInit = -1
If _fileexists("internal\IDEcolor.txt") then
f = freefile
open "internal\IDEcolor.txt" for Input as #f
input #1, r, g, b : line input #1, junk$
CommentColor = _RGB32(r, g,b)
input #1, r, g, b : line input #1, junk$
MetaCommandColor = _RGB32(r, g, b)
input #1, r, g, b : line input #1, junk$
QuoteColor = _RGB32(r, g, b)
input #1, r, g, b : line input #1, junk$
TextColor = _RGB32(r, g, b)
close #f
else
f = freefile
open "internal\IDEcolor.txt" for Output as #f
print #f, "85, 255, 255, 'Comment RGB Color"
print #f, "85, 255, 85, 'MetaCommand RGB Color"
print #f, "255, 255, 85, 'Quote RGB Color"
print #f, "255, 255, 255, 'Text RGB Color"
close #f
CommentColor = _RGB32(85, 255,255)
MetaCommandColor = _RGB32(85, 255, 85)
QuoteColor = _RGB32(255, 255, 85)
TextColor = _RGB32(255, 255,255)
end if
end if
_palettecolor 11, CommentColor, 0
_palettecolor 10, MetaCommandColor, 0
_palettecolor 14, QuoteColor, 0
_palettecolor 13, TextColor, 0
_palettecolor 11, IDECommentColor, 0
_palettecolor 10, IDEMetaCommandColor, 0
_palettecolor 14, IDEQuoteColor, 0
_palettecolor 13, IDETextColor, 0
cc = -1

View file

@ -24014,6 +24014,111 @@ LOOP
StrReplace$ = a$
END FUNCTION
SUB WriteConfigSetting (heading$, item$, value$)
SHARED ConfigFile$, ConfigBak$
DIM CRLF AS STRING
IF INSTR(os$, "WIN") THEN CRLF = CHR$(13) + CHR$(10) ELSE CRLF = CHR$(10)
InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile
OutFile = FREEFILE: OPEN ConfigBak$ FOR OUTPUT AS #OutFile
placed = 0
IF LOF(InFile) THEN
DO UNTIL EOF(InFile)
LINE INPUT #InFile, junk$
'we really don't care about heading$ here; it's only used to make things easier for the user to locate in the config file
junk$ = LTRIM$(RTRIM$(junk$))
IF _STRICMP(LEFT$(junk$, LEN(item$)), item$) = 0 THEN
PRINT #OutFile, item$; " = "; value$
placed = -1
ELSE
PRINT #OutFile, junk$
END IF
LOOP
END IF
CLOSE #InFile, #OutFile
IF NOT placed THEN 'we didn't find the proper setting already in the file somewhere.
'Either the file was corrupted, or the user deleted this particulat setting sometime in the past.
'Now we look to see if the heading exists in the file or not.
'If it does, then we place the new setting under that heading.
'If not then we write that heading to the end of the file to make it easier for the user to locate in the future
'and then we write it below there.
OPEN ConfigBak$ FOR BINARY AS #InFile
l = LOF(InFile)
out$ = item$ + " = " + value$ + CRLF
temp$ = SPACE$(l)
GET #InFile, 1, temp$
l1 = INSTR(temp$, heading$)
IF l1 THEN
l1 = l1 + LEN(heading$) + LEN(CRLF)
PUT #InFile, l1 + 1, out$
r$ = MID$(temp$, l1 + 1)
PUT #InFile, l1 + LEN(out$) + 1, r$
placed = -1
END IF
IF NOT placed THEN
PUT #InFile, l + 1, CRLF
PUT #InFile, , heading$
PUT #InFile, , CRLF
PUT #InFile, , out$
END IF
CLOSE InFile
END IF
KILL ConfigFile$
NAME ConfigBak$ AS ConfigFile$
END SUB
FUNCTION ReadConfigSetting (item$, value$)
SHARED ConfigFile$
value$ = "" 'We start by blanking the value$ as a default return state
InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile
IF LOF(InFile) THEN
found = 0
DO UNTIL EOF(InFile)
LINE INPUT #InFile, temp$
temp$ = LTRIM$(RTRIM$(temp$))
IF LEFT$(UCASE$(temp$), LEN(item$)) = UCASE$(item$) THEN found = -1: EXIT DO
LOOP
CLOSE InFile
IF found THEN 'we found what we're looking for
l = INSTR(temp$, "=") 'return the value after the = sign
IF l THEN
value$ = MID$(temp$, l + 1)
l = INSTR(value$, CHR$(13)) 'we only want what's before a CR
IF l THEN value$ = LEFT$(value$, l)
l = INSTR(value$, CHR$(10)) 'or a LineFeed
'These are basic text files; they shouldn't have stray CHR$(10) or CHR$(13) characters in them!
IF l THEN value$ = LEFT$(value$, l)
value$ = LTRIM$(RTRIM$(value$))
ReadConfigSetting = -1
EXIT FUNCTION
END IF
END IF
END IF
ReadConfigSetting = 0 'failed to find the setting
END FUNCTION
FUNCTION VRGBS (text$, DefaultColor AS _UNSIGNED LONG)
'Value of RGB String = VRGBS without a ton of typing
'A function to get the RGB value back from a string such as _RGB32(255,255,255)
'text$ is the string that we send to check for a value
'DefaultColor is the value we send back if the string isn't in the proper format
VRGBS = DefaultColor 'A return the default value if we can't parse the string properly
IF UCASE$(LEFT$(text$, 4)) = "_RGB" THEN
rpos = INSTR(text$, "(")
gpos = INSTR(rpos, text$, ",")
bpos = INSTR(gpos + 1, text$, ",")
IF rpos <> 0 AND bpos <> 0 AND gpos <> 0 THEN
red = VAL(MID$(text$, rpos + 1))
green = VAL(MID$(text$, gpos + 1))
blue = VAL(MID$(text$, bpos + 1))
VRGBS = _RGB32(red, green, blue)
END IF
END IF
END FUNCTION
'$INCLUDE:'subs_functions\extensions\opengl\opengl_methods.bas'