included.
Code: Select all
'Convenient Code Concatenator / badidea / 2018-09-15
'INPUT FILE
Const As String sourceFile = "code_concatenator.bas"
#Include "file.bi"
Function getFilePath(fullFileName As String) As String
Dim As Integer sepPos = InStrRev(fullFileName, Any "/\")
Return Mid(fullFileName, 1, sepPos)
End Function
Function getFileName(fullFileName As String) As String
Dim As Integer sepPos = InStrRev(fullFileName, Any "/\")
Return Mid(fullFileName, sepPos + 1)
End Function
Function getFileExt(fullFileName As String) As String
Dim As Integer sepPos = InStrRev(fullFileName, Any ".")
Return Mid(fullFileName, sepPos + 1)
End Function
Function changeFileExt(fullFileName As String, newExt As String) As String
Dim As Integer sepPos = InStrRev(fullFileName, Any ".")
Return Mid(fullFileName, 1, sepPos) & newExt
End Function
'===============================================================================
#Define CC_TAB 9 '&h09
#Define CC_LF 10 '&h0A
#Define CC_CR 13 '&h0D
Const As String QDM = Chr(34) 'double quote mark character (")
Const As Integer INC_LEN = Len("#include")
Type extStr_type
Private:
Dim As String text = ""
Dim As String lastText
Public:
Dim As String lineBreak = ""
Dim As Integer length = 0
Dim As Integer position = 0
Declare Sub fileToString(fileName As String)
Declare Sub stringToFile(fileName As String)
Declare Function getNextLine(ByRef row As String) As Integer
Declare Function getLineBreak() As String
Declare Sub show()
Declare Function getText() As String
Declare Sub Append(newText As String)
End Type
Sub extStr_type.fileToString(fileName As String)
Dim As Integer hFile = FreeFile
If Open(fileName For Binary Access Read As hFile) = 0 Then
length = Lof(hFile)
text = Space(length)
Get #hFile,,text
Close #hFile
Else
Print "fileToString: Unable to open '" & fileName & "'"
End If
position = 0
lineBreak = getLineBreak()
End Sub
Sub extStr_type.stringToFile(fileName As String)
Dim As Integer hfile = FreeFile
If Open(fileName For Binary Access Write As hFile) = 0 Then
Put #hFile,, text
Close #hFile
Else
Print "stringToFile: Unable to open '" & fileName & "'"
End If
End Sub
Function extStr_type.getNextLine(ByRef row As String) As Integer
Dim As Integer last, i = position
If i >= length Then Return -1 'end of file
'find first/next LF character
While i < length
If (text[i] = CC_LF) Then
last = i
Exit While
End If
i += 1
Wend
row = Mid(text, position + 1, (last - position) + 1)
position = last + 1 'update position for next call
Return 0
End Function
Function extStr_type.getLineBreak() As String
Dim As Integer lfPos
lfPos = InStr(text, Chr(CC_LF))
If lfPos = 0 Then Return ""
If lfPos = 1 Then
Return Chr(CC_LF)
Else
If Mid(text, lfPos - 1, 1) = Chr(CC_CR) Then
Return Chr(CC_CR) & Chr(CC_LF)
Else
Return Chr(CC_LF)
End If
End If
End Function
Sub extStr_type.show()
Dim As Integer i
length = Len(text)
For i = 0 To length-1
Select Case text[i]
'case CC_TAB
' color 11 : print "..";
Case CC_LF
Color 14 : Print "<LF>" 'no ;
Case CC_CR
Color 10 : Print "<CR>";
Case Else
Color 7 : Print Chr(text[i]);
End Select
Next
Color 7
End Sub
Function extStr_type.getText() As String
Return text
End Function
Sub extStr_type.append(newText As String)
If newText = lineBreak And lastText = lineBreak Then
'skip
Else
lastText = newText
text & = newText
End If
End Sub
'===============================================================================
#Define list_data_type String
#Define LIST_DATA_MAX 100
Type list_type
'dim as integer numItems = 0
Dim As list_data_type value(LIST_DATA_MAX-1)
Dim As Integer occupied(LIST_DATA_MAX-1)
Declare Function Add(value As list_data_type) As Integer
Declare Function del(index As Integer) As Integer
Declare Function find(value As list_data_type) As Integer
Declare Sub clr()
Declare Sub show(showEmpty As Integer)
End Type
Function list_type.add(value As list_data_type) As Integer
Dim As Integer i
For i = 0 To LIST_DATA_MAX-1
If occupied(i) = 0 Then
occupied(i) = 1
This.value(i) = value
'numItems += 1
Return i
End If
Next
Return -1 'failed
End Function
Function list_type.del(index As Integer) As Integer
If index < 0 Then Return -1
If index >= LIST_DATA_MAX Then Return -1
If occupied(index) = 0 Then
Return -1 'was not occupied
Else
occupied(index) = 0
'numItems -= 1
Return 0 'ok
End If
End Function
Function list_type.find(value As list_data_type) As Integer
Dim As Integer i
For i = 0 To LIST_DATA_MAX-1
If occupied(i) = 1 And value = This.value(i) Then
Return i
End If
Next
Return -1 'failed / not found
End Function
Sub list_type.clr()
Dim As Integer i
For i = 0 To LIST_DATA_MAX-1
occupied(i) = 0
Next
'numItems = 0
End Sub
Sub list_type.show(showEmpty As Integer)
Dim As Integer i
For i = 0 To LIST_DATA_MAX-1
If showEmpty = 1 Or occupied(i) = 1 Then
Print i, This.value(i)
End If
Next
End Sub
'===============================================================================
' This is file FBeauty.bas, version 1.04
' Licence: GPLv3
' (C) 2010-2018 Thomas[ dOt }Freiherr{ at }gmx{ DoT ]net
'
' This program is free software; you can redistribute it
' and/or modify it under the terms of the GNU General Public
' License as published by the Free Software Foundation; either
' version 3 of the License, or (at your option) ANY later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
' Lesser General Public License for more details, refer to:
' http://www.gnu.org/licenses/gpl-3.0.html
'#DEFINE DIALECTS ' support for keywords related to FB dialects
#Define THISFIX ' support for THIS./@THIS->
Type FBeauty_type
Private:
Dim As Integer Modus
Dim As UByte Char, Check(255)
Dim As String Wort
Public:
Declare Constructor()
Declare Sub setModus(command_ As String)
Declare Sub setChecks()
Declare Function Cases(ByRef W As String, ByVal I As ZString Ptr) As String
Declare Function Change(ByRef T As String) As String
Declare Sub readTo(ByRef T As String)
Declare Function readEsc() As String
Declare Sub convert(command_ As String, inFileName As String, outFileName As String)
End Type
Constructor FBeauty_type()
setChecks()
End Constructor
Sub FBeauty_type.setModus(command_ As String)
' evaluate command line / Kommandozeile auswerten
Modus = IIf(InStr(command_, "-l"), 1, _ ' lower case keywords
IIf(InStr(command_, "-c"), 2, _ ' capitalized keywords
IIf(InStr(command_, "-i"), 3, 0))) ' individual keywords
' no options = upper case / keine Option = Grossbuchstaben
End Sub
Sub FBeauty_type.setChecks()
' define character types (1 = keyword characters)
Check(Asc("_")) = 1
Check(Asc("-")) = 1
Check(Asc(">")) = 1
Check(Asc(".")) = 1
Check(Asc("$")) = 1
Check(Asc("#")) = 1
Check(Asc("2")) = 1
Check(Asc("3")) = 1
Check(Asc("4")) = 1
Check(Asc("6")) = 1
For i As Integer = Asc("A") To Asc("Z")
Check(i) = 1
Check(i + 32) = 1
Next
Check(Asc( "!")) = 2 ' escaped STRING
Check(Asc("""")) = 3 ' standard STRING
Check(Asc( "'")) = 4 ' comment
Check(Asc( "/")) = 5 ' may be start of multi line comment
Check(0) = 255
End Sub
' convert keyword depending on modus [badidea]
Function FBeauty_type.Cases(ByRef W As String, ByVal I As ZString Ptr) As String
Select Case As Const Modus
Case 0 : Return W 'leave as Ucase [badidea]
Case 1 : Return LCase(W)
Case 2
If W[0] < Asc("A") Then Return Left(W, 2) & LCase(Mid(W, 3)) '__Keyword [badidea]
Return Left(W, 1) & LCase(Mid(W, 2))
End Select
Return (*I)
End Function
Function FBeauty_type.Change(ByRef T As String) As String
Var w = UCase(T)
Select Case As Const w[0]
Case Asc("_")
Select Case w
Case "__DATE__" : Return Cases(w, @"__Date__")
Case "__DATE_ISO__" : Return Cases(w, @"__Date_Iso__")
Case "__FB_64BIT__" : Return Cases(w, @"__Fb_64Bit__")
Case "__FB_ARGC__" : Return Cases(w, @"__Fb_ArgC__")
Case "__FB_ARGV__" : Return Cases(w, @"__Fb_ArgV__")
Case "__FB_BACKEND__" : Return Cases(w, @"__Fb_Backend__")
Case "__FB_BIGENDIAN__" : Return Cases(w, @"__Fb_BigEndian__")
Case "__FB_BUILD_DATE__" : Return Cases(w, @"__Fb_Build_Date__")
Case "__FB_CYGWIN__" : Return Cases(w, @"__Fb_CygWin__")
Case "__FB_DARWIN__" : Return Cases(w, @"__Fb_DarWin__")
Case "__FB_DEBUG__" : Return Cases(w, @"__Fb_Debug__")
Case "__FB_DOS__" : Return Cases(w, @"__Fb_Dos__")
Case "__FB_ERR__" : Return Cases(w, @"__Fb_Err__")
Case "__FB_FPMODE__" : Return Cases(w, @"__Fb_FpMode__")
Case "__FB_FPU__" : Return Cases(w, @"__Fb_Fpu__")
Case "__FB_FREEBSD__" : Return Cases(w, @"__Fb_FreeBsd__")
Case "__FB_LANG__" : Return Cases(w, @"__Fb_Lang__")
Case "__FB_LINUX__" : Return Cases(w, @"__Fb_Linux__")
Case "__FB_MAIN__" : Return Cases(w, @"__Fb_Main__")
Case "__FB_MIN_VERSION__" : Return Cases(w, @"__Fb_Min_Version__")
Case "__FB_MT__" : Return Cases(w, @"__Fb_Mt__")
Case "__FB_NETBSD__" : Return Cases(w, @"__Fb_NetBsd__")
Case "__FB_OPENBSD__" : Return Cases(w, @"__Fb_OpenBsd__")
Case "__FB_OPTION_BYVAL__" : Return Cases(w, @"__Fb_Option_ByVal__")
Case "__FB_OPTION_DYNAMIC__" : Return Cases(w, @"__Fb_Option_Dynamic__")
Case "__FB_OPTION_ESCAPE__" : Return Cases(w, @"__Fb_Option_Escape__")
Case "__FB_OPTION_EXPLICIT__" : Return Cases(w, @"__Fb_Option_Explicit__")
Case "__FB_OPTION_GOSUB__" : Return Cases(w, @"__Fb_Option_Gosub__")
Case "__FB_OPTION_PRIVATE__" : Return Cases(w, @"__Fb_Option_Private__")
Case "__FB_OUT_DLL__" : Return Cases(w, @"__Fb_Out_Dll__")
Case "__FB_OUT_EXE__" : Return Cases(w, @"__Fb_Out_Exe__")
Case "__FB_OUT_LIB__" : Return Cases(w, @"__Fb_Out_Lib__")
Case "__FB_OUT_OBJ__" : Return Cases(w, @"__Fb_Out_Obj__")
Case "__FB_PCOS__" : Return Cases(w, @"__Fb_Pcos__")
Case "__FB_SIGNATURE__" : Return Cases(w, @"__Fb_Signature__")
Case "__FB_SSE__" : Return Cases(w, @"__Fb_Sse__")
Case "__FB_UNIX__" : Return Cases(w, @"__Fb_Unix__")
Case "__FB_VECTORIZE__" : Return Cases(w, @"__Fb_Vectorize__")
Case "__FB_VER_MAJOR__" : Return Cases(w, @"__Fb_Ver_Major__")
Case "__FB_VER_MINOR__" : Return Cases(w, @"__Fb_Ver_Minor__")
Case "__FB_VER_PATCH__" : Return Cases(w, @"__Fb_Ver_Patch__")
Case "__FB_VERSION__" : Return Cases(w, @"__Fb_Version__")
Case "__FB_WIN32__" : Return Cases(w, @"__Fb_Win32__")
Case "__FB_XBOX__" : Return Cases(w, @"__Fb_XBox__")
Case "__FILE__" : Return Cases(w, @"__File__")
Case "__FILE_NQ__" : Return Cases(w, @"__File_NQ__")
Case "__FUNCTION__" : Return Cases(w, @"__Function__")
Case "__FUNCTION_NQ__" : Return Cases(w, @"__Function_NQ__")
Case "__LINE__" : Return Cases(w, @"__Line__")
Case "__PATH__" : Return Cases(w, @"__Path__")
Case "__TIME__" : Return Cases(w, @"__Time__")
End Select
Case Asc("#")
Select Case w
Case "#ASSERT" : Return Cases(w, @"#Assert")
Case "#DEF" : Return Cases(w, @"#Def")
Case "#DEFINE" : Return Cases(w, @"#Define")
Case "#ELSE" : Return Cases(w, @"#Else")
Case "#ELSEIF" : Return Cases(w, @"#ElseIf")
Case "#ENDIF" : Return Cases(w, @"#EndIf")
Case "#ENDMACRO" : Return Cases(w, @"#EndMacro")
Case "#ERROR" : Return Cases(w, @"#Error")
Case "#IF" : Return Cases(w, @"#If")
Case "#IFDEF" : Return Cases(w, @"#IfDef")
Case "#IFNDEF" : Return Cases(w, @"#IfNDef")
Case "#INCLUDE" : Return Cases(w, @"#Include")
Case "#INCLIB" : Return Cases(w, @"#IncLib")
Case "#LANG" : Return Cases(w, @"#Lang")
Case "#LIBPATH" : Return Cases(w, @"#LibPath")
Case "#LINE" : Return Cases(w, @"#Line")
Case "#MACRO" : Return Cases(w, @"#Macro")
Case "#PRAGMA" : Return Cases(w, @"#Pragma")
Case "#PRINT" : Return Cases(w, @"#Print")
Case "#UNDEF" : Return Cases(w, @"#UnDef")
End Select
#IfDef DIALECTS
Case Asc("$")
Select Case w
Case "$INCLUDE" : Return Cases(w, @"$Include")
Case "$DYNAMIC" : Return Cases(w, @"$Dynamic")
Case "$LANG" : Return Cases(w, @"$Lang")
Case "$STATIC" : Return Cases(w, @"$Static")
End Select
#EndIf
Case Asc("A")
Select Case w
Case "ABS" : Return Cases(w, @"Abs")
Case "ABSTRACT" : Return Cases(w, @"Abstract")
Case "ACCESS" : Return Cases(w, @"Access")
Case "ACOS" : Return Cases(w, @"ACos")
Case "ADD" : Return Cases(w, @"Add")
Case "ALIAS" : Return Cases(w, @"Alias")
Case "ALLOCATE" : Return Cases(w, @"Allocate")
Case "ALPHA" : Return Cases(w, @"Alpha")
Case "AND" : Return Cases(w, @"And")
Case "ANDALSO" : Return Cases(w, @"AndAlso")
Case "ANY" : Return Cases(w, @"Any")
Case "APPEND" : Return Cases(w, @"Append")
Case "AS" : Return Cases(w, @"As")
Case "ASC" : Return Cases(w, @"Asc")
Case "ASIN" : Return Cases(w, @"ASin")
Case "ASM" : Return Cases(w, @"Asm")
Case "ASSERT" : Return Cases(w, @"Assert")
Case "ASSERTWARN" : Return Cases(w, @"AssertWarn")
Case "ATAN2" : Return Cases(w, @"ATan2")
Case "ATN" : Return Cases(w, @"Atn")
End Select
Case Asc("B")
Select Case w
Case "BEEP" : Return Cases(w, @"Beep")
Case "BIN" : Return Cases(w, @"Bin")
Case "BINARY" : Return Cases(w, @"Binary")
Case "BIT" : Return Cases(w, @"Bit")
Case "BITRESET" : Return Cases(w, @"BitReSet")
Case "BITSET" : Return Cases(w, @"BitSet")
Case "BLOAD" : Return Cases(w, @"BLoad")
Case "BSAVE" : Return Cases(w, @"BSave")
Case "BYTE" : Return Cases(w, @"Byte")
Case "BYREF" : Return Cases(w, @"ByRef")
Case "BYVAL" : Return Cases(w, @"ByVal")
Case "BASE" : Return Cases(w, @"Base")
End Select
Case Asc("C")
Select Case w
Case "CALL" : Return Cases(w, @"Call")
Case "CALLOCATE" : Return Cases(w, @"CAllocate")
Case "CALLS" : Return Cases(w, @"Calls")
Case "CASE" : Return Cases(w, @"Case")
Case "CAST" : Return Cases(w, @"Cast")
Case "CBYTE" : Return Cases(w, @"CByte")
Case "CDBL" : Return Cases(w, @"CDbl")
Case "CDECL" : Return Cases(w, @"CDecl")
Case "CHAIN" : Return Cases(w, @"Chain")
Case "CHDIR" : Return Cases(w, @"ChDir")
Case "CHR" : Return Cases(w, @"Chr")
Case "CINT" : Return Cases(w, @"CInt")
Case "CIRCLE" : Return Cases(w, @"Circle")
Case "CLASS" : Return Cases(w, @"Class")
Case "CLEAR" : Return Cases(w, @"Clear")
Case "CLNG" : Return Cases(w, @"CLng")
Case "CLNGINT" : Return Cases(w, @"CLngInt")
Case "CLOSE" : Return Cases(w, @"Close")
Case "CLS" : Return Cases(w, @"Cls")
Case "COLOR" : Return Cases(w, @"Color")
Case "COM" : Return Cases(w, @"Com")
Case "COMMAND" : Return Cases(w, @"Command")
Case "COMMON" : Return Cases(w, @"Common")
Case "CONDBROADCAST" : Return Cases(w, @"CondBroadCast")
Case "CONDCREATE" : Return Cases(w, @"CondCreate")
Case "CONDDESTROY" : Return Cases(w, @"CondDestroy")
Case "CONDSIGNAL" : Return Cases(w, @"CondSignal")
Case "CONDWAIT" : Return Cases(w, @"CondWait")
Case "CONS" : Return Cases(w, @"Cons")
Case "CONST" : Return Cases(w, @"Const")
Case "CONSTRUCTOR" : Return Cases(w, @"Constructor")
Case "CONTINUE" : Return Cases(w, @"Continue")
Case "COS" : Return Cases(w, @"Cos")
Case "CPTR" : Return Cases(w, @"CPtr")
Case "CSHORT" : Return Cases(w, @"CShort")
Case "CSIGN" : Return Cases(w, @"CSign")
Case "CSNG" : Return Cases(w, @"CSng")
Case "CSRLIN" : Return Cases(w, @"CsrLin")
Case "CUBYTE" : Return Cases(w, @"CUByte")
Case "CUINT" : Return Cases(w, @"CUInt")
Case "CULNG" : Return Cases(w, @"CULng")
Case "CULNGINT" : Return Cases(w, @"CULngInt")
Case "CUNSG" : Return Cases(w, @"CUnSg")
Case "CURDIR" : Return Cases(w, @"CurDir")
Case "CUSHORT" : Return Cases(w, @"CUShort")
Case "CUSTOM" : Return Cases(w, @"Custom")
Case "CVD" : Return Cases(w, @"CvD")
Case "CVI" : Return Cases(w, @"CvI")
Case "CVL" : Return Cases(w, @"CvL")
Case "CVLONGINT" : Return Cases(w, @"CvLongInt")
Case "CVS" : Return Cases(w, @"CvS")
Case "CVSHORT" : Return Cases(w, @"CvShort")
End Select
Case Asc("D")
Select Case w
Case "DATA" : Return Cases(w, @"Data")
Case "DATE" : Return Cases(w, @"Date")
Case "DATEADD" : Return Cases(w, @"DateAdd")
Case "DATEDIFF" : Return Cases(w, @"DateDiff")
Case "DATEPART" : Return Cases(w, @"DatePart")
Case "DATESERIAL" : Return Cases(w, @"DateSerial")
Case "DATEVALUE" : Return Cases(w, @"DateValue")
Case "DAY" : Return Cases(w, @"Day")
Case "DEALLOCATE" : Return Cases(w, @"DeAllocate")
Case "DECLARE" : Return Cases(w, @"Declare")
Case "DEFBYTE" : Return Cases(w, @"DefByte")
Case "DEFDBL" : Return Cases(w, @"DefDbl")
Case "DEFINE" : Return Cases(w, @"Define")
Case "DEFINED" : Return Cases(w, @"Defined")
Case "DEFINT" : Return Cases(w, @"DefInt")
Case "DEFLNG" : Return Cases(w, @"DefLng")
Case "DEFLONGINT" : Return Cases(w, @"DefLongInt")
Case "DEFSHORT" : Return Cases(w, @"DefShort")
Case "DEFSNG" : Return Cases(w, @"DefSng")
Case "DEFSTR" : Return Cases(w, @"DefStr")
Case "DEFUBYTE" : Return Cases(w, @"DefUByte")
Case "DEFUINT" : Return Cases(w, @"DefUInt")
Case "DEFULONGINT" : Return Cases(w, @"DefULongInt")
Case "DEFUSHORT" : Return Cases(w, @"DefUShort")
Case "DELETE" : Return Cases(w, @"Delete")
Case "DESTRUCTOR" : Return Cases(w, @"Destructor")
Case "DIM" : Return Cases(w, @"Dim")
Case "DIR" : Return Cases(w, @"Dir")
Case "DO" : Return Cases(w, @"Do")
Case "DOUBLE" : Return Cases(w, @"Double")
Case "DRAW" : Return Cases(w, @"Draw")
Case "DYLIBFREE" : Return Cases(w, @"DyLibFree")
Case "DYLIBLOAD" : Return Cases(w, @"DyLibLoad")
Case "DYLIBSYMBOL" : Return Cases(w, @"DyLibSymbol")
#IfDef DIALECTS
Case "DYNAMIC" : Return Cases(w, @"Dynamic")
#EndIf
End Select
Case Asc("E")
Select Case w
Case "ELSE" : Return Cases(w, @"Else")
Case "ELSEIF" : Return Cases(w, @"ElseIf")
Case "ENCODING" : Return Cases(w, @"Encoding")
Case "END" : Return Cases(w, @"End")
Case "ENDIF" : Return Cases(w, @"EndIf")
Case "ENDMACRO" : Return Cases(w, @"EndMacro")
Case "ENUM" : Return Cases(w, @"Enum")
Case "ENVIRON" : Return Cases(w, @"Environ")
Case "EOF" : Return Cases(w, @"Eof")
Case "EQV" : Return Cases(w, @"Eqv")
Case "ERASE" : Return Cases(w, @"Erase")
Case "ERFN" : Return Cases(w, @"ErFn")
Case "ERL" : Return Cases(w, @"ErL")
Case "ERMN" : Return Cases(w, @"ErMn")
Case "ERR" : Return Cases(w, @"Err")
Case "ERROR" : Return Cases(w, @"Error")
Case "ESCAPE" : Return Cases(w, @"Escape")
Case "EXEC" : Return Cases(w, @"Exec")
Case "EXEPATH" : Return Cases(w, @"ExePath")
Case "EXPLICIT" : Return Cases(w, @"Explicit")
Case "EXIT" : Return Cases(w, @"Exit")
Case "EXP" : Return Cases(w, @"Exp")
Case "EXPORT" : Return Cases(w, @"Export")
Case "EXTENDS" : Return Cases(w, @"Extends")
Case "EXTERN" : Return Cases(w, @"Extern")
#IfDef DIALECTS
Case "ESCAPE" : Return Cases(w, @"Escape")
Case "EXPLICIT" : Return Cases(w, @"Explicit")
#EndIf
End Select
Case Asc("F")
Select Case w
Case "FIELD" : Return Cases(w, @"Field")
Case "FILEATTR" : Return Cases(w, @"FileAttr")
Case "FILECOPY" : Return Cases(w, @"FileCopy")
Case "FILEDATETIME" : Return Cases(w, @"FileDateTime")
Case "FILEEXISTS" : Return Cases(w, @"FileExists")
Case "FILELEN" : Return Cases(w, @"FileLen")
Case "FIX" : Return Cases(w, @"Fix")
Case "FLIP" : Return Cases(w, @"Flip")
Case "FOR" : Return Cases(w, @"For")
Case "FORMAT" : Return Cases(w, @"Format")
Case "FRAC" : Return Cases(w, @"Frac")
Case "FRE" : Return Cases(w, @"Fre")
Case "FREEFILE" : Return Cases(w, @"FreeFile")
Case "FUNCTION" : Return Cases(w, @"Function")
End Select
Case Asc("G")
Select Case w
Case "GET" : Return Cases(w, @"Get")
Case "GETJOYSTICK" : Return Cases(w, @"GetJoyStick")
Case "GETKEY" : Return Cases(w, @"GetKey")
Case "GETMOUSE" : Return Cases(w, @"GetMouse")
Case "GOSUB" : Return Cases(w, @"GoSub")
Case "GOTO" : Return Cases(w, @"GoTo")
End Select
Case Asc("H")
Select Case w
Case "HEX" : Return Cases(w, @"Hex")
Case "HIBYTE" : Return Cases(w, @"HiByte")
Case "HIWORD" : Return Cases(w, @"HiWord")
Case "HOUR" : Return Cases(w, @"Hour")
End Select
Case Asc("I")
Select Case w
Case "IF" : Return Cases(w, @"If")
Case "IIF" : Return Cases(w, @"IIf")
Case "IMAGECONVERTROW" : Return Cases(w, @"ImageConvertRow")
Case "IMAGECREATE" : Return Cases(w, @"ImageCreate")
Case "IMAGEDESTROY" : Return Cases(w, @"ImageDestroy")
Case "IMAGEINFO" : Return Cases(w, @"ImageInfo")
Case "IMP" : Return Cases(w, @"Imp")
Case "IMPLEMENTS" : Return Cases(w, @"Implements")
Case "IMPORT" : Return Cases(w, @"Import")
Case "INCLIB" : Return Cases(w, @"IncLib")
Case "INCLUDE" : Return Cases(w, @"Include")
Case "INKEY" : Return Cases(w, @"InKey")
Case "INP" : Return Cases(w, @"Inp")
Case "INPUT" : Return Cases(w, @"Input")
Case "INSTR" : Return Cases(w, @"InStr")
Case "INSTRREV" : Return Cases(w, @"InStrRev")
Case "INT" : Return Cases(w, @"Int")
Case "INTEGER" : Return Cases(w, @"Integer")
Case "IS" : Return Cases(w, @"Is")
Case "ISDATE" : Return Cases(w, @"IsDate")
Case "ISREDIRECTED" : Return Cases(w, @"IsRedirected")
End Select
Case Asc("K")
Select Case w
Case "KILL" : Return Cases(w, @"Kill")
End Select
Case Asc("L")
Select Case w
Case "LBOUND" : Return Cases(w, @"LBound")
Case "LCASE" : Return Cases(w, @"LCase")
Case "LEFT" : Return Cases(w, @"Left")
Case "LEN" : Return Cases(w, @"Len")
Case "LET" : Return Cases(w, @"Let")
Case "LIB" : Return Cases(w, @"Lib")
Case "LIBPATH" : Return Cases(w, @"LibPath")
Case "LINE" : Return Cases(w, @"Line")
Case "LOBYTE" : Return Cases(w, @"LoByte")
Case "LOC" : Return Cases(w, @"Loc")
Case "LOCAL" : Return Cases(w, @"Local")
Case "LOCATE" : Return Cases(w, @"Locate")
Case "LOCK" : Return Cases(w, @"Lock")
Case "LOF" : Return Cases(w, @"Lof")
Case "LOG" : Return Cases(w, @"Log")
Case "LONG" : Return Cases(w, @"Long")
Case "LONGINT" : Return Cases(w, @"LongInt")
Case "LOOP" : Return Cases(w, @"Loop")
Case "LOWORD" : Return Cases(w, @"LoWord")
Case "LPOS" : Return Cases(w, @"LPos")
Case "LPRINT" : Return Cases(w, @"LPrint")
Case "LPT" : Return Cases(w, @"Lpt")
Case "LSET" : Return Cases(w, @"LSet")
Case "LTRIM" : Return Cases(w, @"LTrim")
End Select
Case Asc("M")
Select Case w
Case "MID" : Return Cases(w, @"Mid")
Case "MINUTE" : Return Cases(w, @"Minute")
Case "MKD" : Return Cases(w, @"MkD")
Case "MKDIR" : Return Cases(w, @"MkDir")
Case "MKI" : Return Cases(w, @"MkI")
Case "MKL" : Return Cases(w, @"MkL")
Case "MKLONGINT" : Return Cases(w, @"MkLongInt")
Case "MKS" : Return Cases(w, @"MkS")
Case "MKSHORT" : Return Cases(w, @"MkShort")
Case "MOD" : Return Cases(w, @"Mod")
Case "MONTH" : Return Cases(w, @"Month")
Case "MONTHNAME" : Return Cases(w, @"MonthName")
Case "MULTIKEY" : Return Cases(w, @"MultiKey")
Case "MUTEXCREATE" : Return Cases(w, @"MutexCreate")
Case "MUTEXDESTROY" : Return Cases(w, @"MutexDestroy")
Case "MUTEXLOCK" : Return Cases(w, @"MutexLock")
Case "MUTEXUNLOCK" : Return Cases(w, @"MutexUnLock")
End Select
Case Asc("N")
Select Case w
Case "NAKED" : Return Cases(w, @"Naked")
Case "NAME" : Return Cases(w, @"Name")
Case "NAMESPACE" : Return Cases(w, @"NameSpace")
Case "NEW" : Return Cases(w, @"New")
Case "NEXT" : Return Cases(w, @"Next")
Case "NOT" : Return Cases(w, @"Not")
Case "NOW" : Return Cases(w, @"Now")
#IfDef DIALECTS
Case "NOGOSUB" : Return Cases(w, @"NoGoSub")
Case "NOKEYWORD" : Return Cases(w, @"NoKeyWord")
#EndIf
End Select
Case Asc("O")
Select Case w
Case "OBJECT" : Return Cases(w, @"Object")
Case "OCT" : Return Cases(w, @"Oct")
Case "OFFSETOF" : Return Cases(w, @"OffsetOf")
Case "ON" : Return Cases(w, @"On")
Case "ONCE" : Return Cases(w, @"Once")
Case "OPEN" : Return Cases(w, @"Open")
Case "OPERATOR" : Return Cases(w, @"Operator")
Case "OPTION" : Return Cases(w, @"Option")
Case "OR" : Return Cases(w, @"Or")
Case "ORELSE" : Return Cases(w, @"OrElse")
Case "OUT" : Return Cases(w, @"Out")
Case "OUTPUT" : Return Cases(w, @"Output")
Case "OVERLOAD" : Return Cases(w, @"Overload")
Case "OVERRIDE" : Return Cases(w, @"Override")
#IfDef DIALECTS
Case "OPTION" : Return Cases(w, @"Option")
#EndIf
End Select
Case Asc("P")
Select Case w
Case "PAINT" : Return Cases(w, @"Paint")
Case "PALETTE" : Return Cases(w, @"Palette")
Case "PASCAL" : Return Cases(w, @"Pascal")
Case "PCOPY" : Return Cases(w, @"PCopy")
Case "PEEK" : Return Cases(w, @"Peek")
Case "PIPE" : Return Cases(w, @"Pipe")
Case "PMAP" : Return Cases(w, @"PMap")
Case "POINT" : Return Cases(w, @"Point")
Case "POINTER" : Return Cases(w, @"Pointer")
Case "POKE" : Return Cases(w, @"Poke")
Case "POS" : Return Cases(w, @"Pos")
Case "POP" : Return Cases(w, @"Pop")
Case "PRESERVE" : Return Cases(w, @"Preserve")
Case "PRESET" : Return Cases(w, @"PreSet")
Case "PRINT" : Return Cases(w, @"Print")
Case "PRIVATE" : Return Cases(w, @"Private")
Case "PROCPTR" : Return Cases(w, @"ProcPtr")
Case "PROPERTY" : Return Cases(w, @"Property")
Case "PROTECTED" : Return Cases(w, @"Protected")
Case "PSET" : Return Cases(w, @"PSet")
Case "PTR" : Return Cases(w, @"Ptr")
Case "PUBLIC" : Return Cases(w, @"Public")
Case "PUT" : Return Cases(w, @"Put")
Case "PUSH" : Return Cases(w, @"Push")
End Select
Case Asc("R")
Select Case w
Case "RANDOM" : Return Cases(w, @"Random")
Case "RANDOMIZE" : Return Cases(w, @"Randomize")
Case "READ" : Return Cases(w, @"Read")
Case "REALLOCATE" : Return Cases(w, @"ReAllocate")
Case "REDIM" : Return Cases(w, @"ReDim")
Case "REM" : Return Cases(w, @"Rem")
Case "RESET" : Return Cases(w, @"ReSet")
Case "RESTORE" : Return Cases(w, @"ReStore")
Case "RESUME" : Return Cases(w, @"ReSume")
Case "RETURN" : Return Cases(w, @"Return")
Case "RGB" : Return Cases(w, @"RGB")
Case "RGBA" : Return Cases(w, @"RGBA")
Case "RIGHT" : Return Cases(w, @"Right")
Case "RMDIR" : Return Cases(w, @"RmDir")
Case "RND" : Return Cases(w, @"Rnd")
Case "RSET" : Return Cases(w, @"RSet")
Case "RTRIM" : Return Cases(w, @"RTrim")
Case "RUN" : Return Cases(w, @"Run")
End Select
Case Asc("S")
Select Case w
Case "SADD" : Return Cases(w, @"SAdd")
Case "SCOPE" : Return Cases(w, @"Scope")
Case "SCREEN" : Return Cases(w, @"Screen")
Case "SCREENCONTROL" : Return Cases(w, @"ScreenControl")
Case "SCREENCOPY" : Return Cases(w, @"ScreenCopy")
Case "SCREENEVENT" : Return Cases(w, @"ScreenEvent")
Case "SCREENGLPROC" : Return Cases(w, @"ScreenGlProc")
Case "SCREENINFO" : Return Cases(w, @"ScreenInfo")
Case "SCREENLIST" : Return Cases(w, @"ScreenList")
Case "SCREENLOCK" : Return Cases(w, @"ScreenLock")
Case "SCREENPTR" : Return Cases(w, @"ScreenPtr")
Case "SCREENRES" : Return Cases(w, @"ScreenRes")
Case "SCREENSET" : Return Cases(w, @"ScreenSet")
Case "SCREENSYNC" : Return Cases(w, @"ScreenSync")
Case "SCREENUNLOCK" : Return Cases(w, @"ScreenUnLock")
Case "SCRN" : Return Cases(w, @"Scrn")
Case "SECOND" : Return Cases(w, @"Second")
Case "SEEK" : Return Cases(w, @"Seek")
Case "SELECT" : Return Cases(w, @"Select")
Case "SETDATE" : Return Cases(w, @"SetDate")
Case "SETENVIRON" : Return Cases(w, @"SetEnviron")
Case "SETMOUSE" : Return Cases(w, @"SetMouse")
Case "SETTIME" : Return Cases(w, @"SetTime")
Case "SGN" : Return Cases(w, @"Sgn")
Case "SHARED" : Return Cases(w, @"Shared")
Case "SHELL" : Return Cases(w, @"Shell")
Case "SHL" : Return Cases(w, @"ShL")
Case "SHORT" : Return Cases(w, @"Short")
Case "SHR" : Return Cases(w, @"ShR")
Case "SIN" : Return Cases(w, @"Sin")
Case "SINGLE" : Return Cases(w, @"Single")
Case "SIZEOF" : Return Cases(w, @"SizeOf")
Case "SLEEP" : Return Cases(w, @"Sleep")
Case "SPACE" : Return Cases(w, @"Space")
Case "SPC" : Return Cases(w, @"Spc")
Case "SQR" : Return Cases(w, @"Sqr")
Case "STATIC" : Return Cases(w, @"Static")
Case "STDCALL" : Return Cases(w, @"StdCall")
Case "STEP" : Return Cases(w, @"Step")
Case "STICK" : Return Cases(w, @"Stick")
Case "STOP" : Return Cases(w, @"Stop")
Case "STR" : Return Cases(w, @"Str")
Case "STRIG" : Return Cases(w, @"Strig")
Case "STRING" : Return Cases(w, @"String")
Case "STRPTR" : Return Cases(w, @"StrPtr")
Case "SUB" : Return Cases(w, @"Sub")
Case "SWAP" : Return Cases(w, @"Swap")
Case "SYSTEM" : Return Cases(w, @"System")
End Select
Case Asc("T")
Select Case w
Case "TAB" : Return Cases(w, @"Tab")
Case "TAN" : Return Cases(w, @"Tan")
Case "THEN" : Return Cases(w, @"Then")
Case "THIS" : Return Cases(w, @"This")
Case "THREADCALL" : Return Cases(w, @"Threadcall")
Case "THREADCREATE" : Return Cases(w, @"ThreadCreate")
Case "THREADDETACH" : Return Cases(w, @"ThreadDetach")
Case "THREADWAIT" : Return Cases(w, @"ThreadWait")
Case "TIME" : Return Cases(w, @"Time")
Case "TIMER" : Return Cases(w, @"Timer")
Case "TIMESERIAL" : Return Cases(w, @"TimeSerial")
Case "TIMEVALUE" : Return Cases(w, @"TimeValue")
Case "TO" : Return Cases(w, @"To")
Case "TRANS" : Return Cases(w, @"Trans")
Case "TRIM" : Return Cases(w, @"Trim")
Case "TYPE" : Return Cases(w, @"Type")
Case "TYPEOF" : Return Cases(w, @"TypeOf")
End Select
#IfDef THISFIX
If Left(w, 4) = "THIS" Then
Select Case As Const Asc(w, 5)
Case Asc("."), Asc("-") : Mid(T, 1, 4) = Cases(Left(w, 4), @"This")
End Select
End If
#EndIf
Case Asc("U")
Select Case w
Case "UBOUND" : Return Cases(w, @"UBound")
Case "UBYTE" : Return Cases(w, @"UByte")
Case "UCASE" : Return Cases(w, @"UCase")
Case "UINTEGER" : Return Cases(w, @"UInteger")
Case "ULONG" : Return Cases(w, @"ULong")
Case "ULONGINT" : Return Cases(w, @"ULongInt")
Case "UNDEF" : Return Cases(w, @"UnDef")
Case "UNION" : Return Cases(w, @"Union")
Case "UNLOCK" : Return Cases(w, @"UnLock")
Case "UNSIGNED" : Return Cases(w, @"UnSigned")
Case "UNTIL" : Return Cases(w, @"Until")
Case "USHORT" : Return Cases(w, @"UShort")
Case "USING" : Return Cases(w, @"Using")
End Select
Case Asc("V")
Select Case w
Case "VA_ARG" : Return Cases(w, @"VA_Arg")
Case "VA_FIRST" : Return Cases(w, @"VA_First")
Case "VA_NEXT" : Return Cases(w, @"VA_Next")
Case "VAL" : Return Cases(w, @"Val")
Case "VAL64" : Return Cases(w, @"Val64")
Case "VALINT" : Return Cases(w, @"ValInt")
Case "VALLNG" : Return Cases(w, @"ValLng")
Case "VALUINT" : Return Cases(w, @"ValUInt")
Case "VALULNG" : Return Cases(w, @"ValULng")
Case "VAR" : Return Cases(w, @"Var")
Case "VARPTR" : Return Cases(w, @"VarPtr")
Case "VIEW" : Return Cases(w, @"View")
Case "VIRTUAL" : Return Cases(w, @"Virtual")
End Select
Case Asc("W")
Select Case w
Case "WAIT" : Return Cases(w, @"Wait")
Case "WBIN" : Return Cases(w, @"WBin")
Case "WCHR" : Return Cases(w, @"WChr")
Case "WEEKDAY" : Return Cases(w, @"WeekDay")
Case "WEEKDAYNAME" : Return Cases(w, @"WeekDayName")
Case "WEND" : Return Cases(w, @"Wend")
Case "WHEX" : Return Cases(w, @"WHex")
Case "WHILE" : Return Cases(w, @"While")
Case "WIDTH" : Return Cases(w, @"Width")
Case "WINDOW" : Return Cases(w, @"Window")
Case "WINDOWTITLE" : Return Cases(w, @"WindowTitle")
Case "WINPUT" : Return Cases(w, @"WInput")
Case "WITH" : Return Cases(w, @"With")
Case "WOCT" : Return Cases(w, @"WOct")
Case "WRITE" : Return Cases(w, @"Write")
Case "WSPACE" : Return Cases(w, @"WSpace")
Case "WSTR" : Return Cases(w, @"WStr")
Case "WSTRING" : Return Cases(w, @"WString")
End Select
Case Asc("X")
Select Case w
Case "XOR" : Return Cases(w, @"Xor")
End Select
Case Asc("Y")
Select Case w
Case "YEAR" : Return Cases(w, @"Year")
End Select
Case Asc("Z")
Select Case w
Case "ZSTRING" : Return Cases(w, @"ZString")
End Select
End Select : Return T
End Function
' skip a comment or standard STRING
Sub FBeauty_type.readTo(ByRef T As String)
Var i = 0, lt = Len(T)
While Not Eof(1)
Get #1, , Char
Print #2, Chr(Char);
If Char <> T[i] Then i = 0 Else i += 1 : If i = lt Then Exit Sub
Wend
End Sub
' check for an escaped STRING, skip it
Function FBeauty_type.readEsc() As String
If Eof(1) Then Return ""
Get #1, , Char
If Char <> Asc("""") Then
If Check(Char) = 1 Then Return Chr(Char)
Print #2, Chr(Char); : Return ""
End If : Print #2, Chr(Char);
Var i = 0
While Not Eof(1)
Get #1, , Char
Print #2, Chr(Char);
Select Case As Const Char
Case Asc("\") : i += 1
Case Asc("""") : If Bit(i, 0) Then i = 0 Else Exit While
Case Else : i = 0
End Select
Wend : Return ""
End Function
' convert text / file, use "" for CONS [badidea]
Sub FBeauty_type.convert(command_ As String, inFileName As String, outFileName As String)
If inFileName = "" Then Open Cons For Input As #1 _
Else Open inFileName For Input As #1
If outFileName = "" Then Open Cons For Output As #2 _
Else Open outFileName For Output As #2
setModus(command_)
'print Modus
While Not Eof(1)
Get #1, , Char
Select Case As Const Check(Char)
Case 1 : Wort &= Chr(Char) ' a word character
Case 255 : Exit While ' end of input
Case Else ' evaluate non-word letter. But first, process
If Len(Wort) Then Print #2, Change(Wort); : Wort = "" ' pending word
Print #2, Chr(Char); ' output the character
Select Case As Const Check(Char) ' check it
Case 2 : Wort &= readEsc() ' check escaped STRING
Case 3 : readTo("""") ' skip standard STRING
Case 4 : readTo(!"\n") ' skip single line comment
Case 5 ' may be multi line comment
If Not Eof(1) Then Get #1, , Char Else Exit While ' get next character
Select Case As Const Check(Char) ' check it
Case 1 : Wort &= Chr(Char) ' a keyword letter
Case 2 : Print #2, Chr(Char); : Wort &= readEsc() ' check escaped STRING
Case 3 : Print #2, Chr(Char); : readTo("""") ' skip standard STRING
Case 4 : Print #2, Chr(Char); : readTo("'/") ' skip single line comment
Case Else : Print #2, Chr(Char); ' other letters, simply output
End Select
End Select
End Select
Wend
If Len(Wort) Then Print #2, Change(Wort); ' process pending word
Close #2
Close #1
End Sub
'---------------------------------- main ---------------------------------------
'Var FBeauty = FBeauty_type
'FBeauty.convert(command, "", "") 'con -> con
'FBeauty.convert("-i", "test.bas", "out.bas") 'file -> file
'===============================================================================
'-------------------------------------------------------------------------------
'look for <include> statement in line
Function checkInclude(row As String) As String
Dim As String trm, incFile = ""
Dim As Integer dqpos1, dqpos2
'trim white space characters
trm = Trim(row, Any " " + Chr(CC_TAB))
'check if trimmed line starts with #include
If Mid(trm, 1, INC_LEN) = "#include" Then
'get first double quotion mark position
dqpos1 = InStr(trm, QDM)
'get second double quotion mark relative position
dqpos2 = InStr(Mid(trm, dqpos1 + 1), QDM)
'file should be between then double quotion mark
incFile = Mid(trm, dqpos1 + 1, dqpos2 - 1)
'trim any white space again
incFile = Trim(incFile, Any " " + Chr(CC_TAB))
End If
Return incFile
End Function
Function commentLine(ByVal comment As String) As String
Dim As String commentText
Dim As Integer commentPos, commentLen
commentText = "'"
If comment = "" Then
commentText &= String(79, "=")
Else
comment = " " & comment & " "
commentLen = Len(comment)
commentPos = (80 - commentLen) / 2
commentText &= String(commentPos, "=")
commentText &= comment
commentText &= String(80 - Len(commentText), "=")
End If
Return commentText
End Function
Sub convertFile(srcFile As String, ByRef concatCode As extStr_type, ByRef fileList As list_type)
Static As Integer firstFile = 1
Static As String firstFileName
Dim As extStr_type code
Dim As String incFile, row, path
Static As String lb
If fileList.find(srcFile) = -1 Then
fileList.add(srcFile)
path = getFilePath(srcFile)
Print "Load: <" & srcFile & ">"
'load source file
code.fileToString(srcFile)
'set line break on first file
If firstFile = 1 Then
concatCode.lineBreak = code.getLineBreak()
lb = concatCode.lineBreak
firstFileName = srcFile
firstFile = 0
End If
'concatCode.append(lb)
'concatCode.append(commentLine(srcFile & " (begin)") & lb)
'concatCode.append(lb)
'Loop lines in file contents
While code.getNextLine(row) <> -1
incFile = checkInclude(row)
'if include file in code and file existing at path
If incFile <> "" Then
If FileExists(path & incFile) Then
convertFile(path & incFile, concatCode, fileList)
Else
Print "Skip: <" & incFile & ">"
concatCode.append(row)
End If
Else
concatCode.append(row)
End If
Wend
'concatCode.append(lb)
'concatCode.append(commentLine(srcFile & " (end)") & lb)
'concatCode.append(lb)
If srcFile <> firstFileName Then
concatCode.append(lb)
concatCode.append(commentLine("") & lb)
concatCode.append(lb)
End If
End If
End Sub
'-------------------------------------------------------------------------------
'OUTPUT FILE
Dim As String concatFile = changeFileExt(getFilePath(sourceFile) & "concat_" & getFileName(sourceFile), "tmp")
Dim As extStr_type concatCode
Dim As list_type fileList
convertFile(sourceFile, concatCode, fileList) 'recursive function
'fileList.show(0)
concatCode.show()
concatCode.stringToFile(concatFile)
Var FBeauty = FBeauty_type
FBeauty.convert("-i", concatFile, changeFileExt(concatFile, "bas"))
Print Kill(concatFile) 'delete .tmp file