Routines to write syntax highlighted code

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
IchMagBier
Posts: 52
Joined: Jan 13, 2018 8:47
Location: Germany
Contact:

Re: Routines to write syntax highlighted code

Post by IchMagBier »

I changed the keyword-order for all languages, since I found some bugs with the others aswell (See first post). It should work now.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Routines to write syntax highlighted code

Post by jj2007 »

sancho3 wrote:I have uploaded the complete (I think) list of keywords here.
They are in the format you are using:

Code: Select all

.Command(0) = "ABS":.Command(1) = "ABSTRACT":.Command(2) = "ACCESS"
Translated to linear format with CrLf between records, see here:

Code: Select all

000=ABS
001=ABSTRACT
002=ACCESS
003=ACOS
...
239=WSTR
240=WSTRING
241=XOR
242=ZSTRING
This format offers better performance, because a simple Instr(Keywords, "="+pattern+CrLf) is sufficient (and no ambiguity for ABS vs ABSTRACT etc). The pointer obtained (e.g. to ACCESS) minus 4 chars gives immediate access to the index, 002 in this case. There are options to speed this up, like coding the index as a hex string, but for a tiny list of keywords like this one there should be no speed problem at all.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Routines to write syntax highlighted code

Post by dodicat »

Here is a list from the wiki page
I have 491 distinct entities.

Code: Select all

dim as string s(490)= _
{"__DATE__","__DATE_ISO__","__FB_64BIT__","__FB_ARGC__","__FB_ARGV__", _
"__FB_ARM__","__FB_ASM__","__FB_BACKEND__","__FB_BIGENDIAN__","__FB_BUILD_DATE__", _
"__FB_CYGWIN__","__FB_DARWIN__","__FB_DEBUG__","__FB_DOS__","__FB_ERR__", _
"__FB_FPMODE__","__FB_FPU__","__FB_FREEBSD__","__FB_GCC__","__FB_LANG__", _
"__FB_LINUX__","__FB_MAIN__","__FB_MIN_VERSION__","__FB_MT__","__FB_NETBSD__", _
"__FB_OPENBSD__","__FB_OPTION_BYVAL__","__FB_OPTION_DYNAMIC__","__FB_OPTION_ESCAPE__","__FB_OPTION_EXPLICIT__", _
"__FB_OPTION_GOSUB__","__FB_OPTION_PRIVATE__","__FB_OUT_DLL__","__FB_OUT_EXE__","__FB_OUT_LIB__", _
"__FB_OUT_OBJ__","__FB_PCOS__","__FB_SIGNATURE__","__FB_SSE__","__FB_UNIX__", _
"__FB_VECTORIZE__","__FB_VER_MAJOR__","__FB_VER_MINOR__","__FB_VER_PATCH__","__FB_VERSION__", _
"__FB_WIN32__","__FB_XBOX__","__FILE__","__FILE_NQ__","__FUNCTION__", _
"__FUNCTION_NQ__","__LINE__","__PATH__","__TIME__","#", _
"#ASSERT","#DEFINE","#ELSE","#ELSEIF","#ENDIF", _
"#ENDMACRO","#ERROR","#IF","#IFDEF","#IFNDEF", _
"#INCLIB","#INCLUDE","#LANG","#LIBPATH","#LINE", _
"#MACRO","#PRAGMA","#PRINT","#UNDEF","$DYNAMIC", _
"$INCLUDE","$LANG","$STATIC","ABS","ABSTRACT", _
"ACCESS","ACOS","ADD ","ALIAS","ALLOCATE", _
"ALPHA ","AND","ANDALSO","ANY","APPEND", _
"AS","ASC","ASIN","ASM","ASSERT", _
"ASSERTWARN","ATAN2","ATN","BASE","BEEP", _
"BIN","BINARY","BIT","BITRESET","BITSET", _
"BLOAD","BOOLEAN","BSAVE","BYREF","BYTE", _
"BYVAL","CALL","CALLOCATE","CASE","CAST", _
"CBOOL","CBYTE","CDBL","CDECL","CHAIN", _
"CHDIR","CHR","CINT","CIRCLE","CLASS", _
"CLEAR","CLNG","CLNGINT","CLOSE","CLS", _
"COLOR","COMMAND","COMMON","CONDBROADCAST","CONDCREATE", _
"CONDDESTROY","CONDSIGNAL","CONDWAIT","CONST","CONSTRUCTOR", _
"CONTINUE","COS","CPTR","CSHORT","CSIGN", _
"CSNG","CSRLIN","CUBYTE","CUINT","CULNG", _
"CULNGINT","CUNSG","CURDIR","CUSHORT","CUSTOM", _
"CVD","CVI","CVL","CVLONGINT","CVS", _
"CVSHORT","DATA","DATE","DATEADD","DATEDIFF", _
"DATEPART","DATESERIAL","DATEVALUE","DAY","DEALLOCATE", _
"DECLARE","DEFBYTE","DEFDBL","DEFINED","DEFINT", _
"DEFLNG","DEFLONGINT","DEFSHORT","DEFSNG","DEFSTR", _
"DEFUBYTE","DEFUINT","DEFULONGINT","DEFUSHORT","DELETE", _
"DESTRUCTOR","DIM","DIR","DO","DOUBLE", _
"DRAW","DRAW STRING","DYLIBFREE","DYLIBLOAD","DYLIBSYMBOL", _
"ELSE","ELSEIF","ENCODING","END","ENUM", _
"ENVIRON","EOF","EQV","ERASE","ERFN", _
"ERL","ERMN","ERR","ERROR","EVENT", _
"EXEC","EXEPATH","EXIT","EXP","EXPORT", _
"EXTENDS","EXTERN","FALSE","FIELD","FILEATTR", _
"FILECOPY","FILEDATETIME","FILEEXISTS","FILELEN","FIX", _
"FLIP","FOR","FORMAT","FRAC","FRE", _
"FREEFILE","FUNCTION","GET","GETJOYSTICK","GETKEY", _
"GETMOUSE","GOSUB","GOTO","HEX","HIBYTE", _
"HIWORD","HOUR","IF","IIF","IMAGECONVERTROW", _
"IMAGECREATE","IMAGEDESTROY","IMAGEINFO","IMP","IMPLEMENTS", _
"IMPORT","INKEY","INP","INPUT","INPUT$", _
"INSTR","INSTRREV","INT","INTEGER","IS", _
"ISDATE","ISREDIRECTED","KILL","LBOUND","LCASE", _
"LEFT","LEN","LET","LIB","LINE", _
"LOBYTE","LOC","LOCAL","LOCATE","LOCK", _
"LOF","LOG","LONG","LONGINT","LOOP", _
"LOWORD","LPOS","LPRINT","LSET","LTRIM", _
"MID","MINUTE","MKD","MKDIR","MKI", _
"MKL","MKLONGINT","MKS","MKSHORT","MOD", _
"MONTH","MONTHNAME","MULTIKEY","MUTEXCREATE","MUTEXDESTROY", _
"MUTEXLOCK","MUTEXUNLOCK","NAKED","NAME","NAMESPACE", _
"NEW","NEXT","NOT","NOW","OBJECT", _
"OCT","OFFSETOF","ON ERROR","ONCE","OPEN", _
"OPEN COM","OPEN CONS","OPEN ERR","OPEN LPT","OPEN PIPE", _
"OPEN SCRN","OPERATOR","OPTION()","OPTION BASE","OPTION BYVAL", _
"OPTION DYNAMIC","OPTION ESCAPE","OPTION EXPLICIT","OPTION GOSUB","OPTION NOGOSUB", _
"OPTION NOKEYWORD","OPTION PRIVATE","OPTION STATIC","OR","ORELSE", _
"OUT","OUTPUT","OVERLOAD","OVERRIDE","PAINT", _
"PALETTE","PASCAL","PCOPY","PEEK","PMAP", _
"POINT","POINTCOORD","POINTER","POKE","POS", _
"PRESERVE","PRESET","PRINT","?","PRIVATE", _
"PROCPTR","PROPERTY","PROTECTED","PSET","PTR", _
"PUBLIC","PUBLIC","PUT","RANDOM","RANDOMIZE", _
"READ","REALLOCATE","REDIM","REM","RESET", _
"RESTORE","RESUME","RESUME NEXT","RETURN","RGB", _
"RGBA","RIGHT","RMDIR","RND","RSET", _
"RTRIM","RUN","SADD","SCOPE","SCREEN", _
"SCREENCOPY","SCREENCONTROL","SCREENEVENT","SCREENGLPROC","SCREENINFO", _
"SCREENLIST","SCREENLOCK","SCREENPTR","SCREENRES","SCREENSET", _
"SCREENSYNC","SCREENUNLOCK","SECOND","SEEK","SELECT CASE", _
"SETDATE","SETENVIRON","SETMOUSE","SETTIME","SGN", _
"SHARED","SHELL","SHL","SHORT","SHR", _
"SIN","SINGLE","SIZEOF","SLEEP","SPACE", _
"SPC","SQR","STATIC","STDCALL","STEP", _
"STICK","STOP","STR","STRIG","STRING", _
"STRPTR","SWAP","SYSTEM","TAB","TAN", _
"THEN","THIS","THREADCALL","THREADCREATE","THREADDETACH", _
"THREADWAIT","TIME","TIMER","TIMESERIAL","TIMEVALUE", _
"TO","TRANS","TRIM","TRUE","TYPE", _
"TYPEOF","UBOUND","UBYTE","UCASE","UINTEGER", _
"ULONG","ULONGINT","UNION","UNLOCK","UNSIGNED", _
"UNTIL","USHORT","USING","VA_ARG","VA_FIRST", _
"VA_NEXT","VAL","VALLNG","VALINT","VALUINT", _
"VALULNG","VAR","VARPTR","VIEW","VIRTUAL", _
"WAIT","WBIN","WCHR","WEEKDAY","WEEKDAYNAME", _
"WEND","WHILE","WHEX","WIDTH","WINDOW", _
"WINDOWTITLE","WINPUT","WITH","WOCT","WRITE", _
"WSPACE","WSTR","WSTRING","XOR","YEAR", _
"ZSTRING"}
for n as long=0 to 490
    print right("000" +str(n),3)+" = ";s(n)
next
sleep  
FreeBASIC probably has more keywords than C sharp, C plus plus and Objective Caml put together.
IchMagBier
Posts: 52
Joined: Jan 13, 2018 8:47
Location: Germany
Contact:

Re: Routines to write syntax highlighted code

Post by IchMagBier »

C, C++ and C# have 223 keywords together. FreeBasic has 408 (without preprocessor-stuff). Most of it comes from the FB-library though, which is the reason why fbc-generated executables are really big (At least that's what I believe).
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Routines to write syntax highlighted code

Post by MrSwiss »

IchMagBier wrote:... the reason why fbc-generated executables are really big (At least that's what I believe).
You must be joking!
Have a look at executables sizes, created by other compilers.
(you can't get much smaller than FBC's .exe)
Except perhaps with pure Assembly (however, not regarded as a HLL).
IchMagBier
Posts: 52
Joined: Jan 13, 2018 8:47
Location: Germany
Contact:

Re: Routines to write syntax highlighted code

Post by IchMagBier »

Well ...
localhost@localhost:~/Projekte/C+Basic/tests$ cat test.bas
Print "Hello World"
localhost@localhost:~/Projekte/C+Basic/tests$ cat c-test.c
#include <stdio.h>

int main() {
puts("Hello World");
}
localhost@localhost:~/Projekte/C+Basic/tests$ ls -l
insgesamt 44
8632 Jan 16 19:16 c-test
57 Jan 16 19:16 c-test.c
22912 Jan 16 19:16 test
20 Jan 16 19:16 test.bas
The fbc-compiled binary is nearly 3 times bigger than the gcc-compiled one (first column is the size in bytes). Both of them are x86_64 Linux executables.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Routines to write syntax highlighted code

Post by MrSwiss »

Well, I'd call that, a unfair comparison ...
As soon as the source code gets larger, which leads in C almost instantly, to
more included libraries, the difference shrinks remarkably.

The philosphies are different:
C minimalistic (almost everything, in external libraries)
FreeBASIC all-in-one (no external libraries for basic programs, but larger internal lib)
Munair
Posts: 1286
Joined: Oct 19, 2017 15:00
Location: Netherlands
Contact:

Re: Routines to write syntax highlighted code

Post by Munair »

IchMagBier wrote:@sancho
It's important that 'ABS' comes after 'ABSTRACT' in the list, because the routine would first find 'ABS' in the code and then completely ignores 'ABSTRACT'. Like this: ABSTRACT SUB
You could try to find the keywords as whole words, i.e separated by spaces, arithmetic characters, etc. That way it doesn't matter how the keywords are ordered.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Routines to write syntax highlighted code

Post by jj2007 »

Munair wrote:You could try to find the keywords as whole words, i.e separated by spaces, arithmetic characters, etc. That way it doesn't matter how the keywords are ordered.
Slightly slower than the method posted above:
jj2007 wrote:This format offers better performance, because a simple Instr(Keywords, "="+pattern+CrLf) is sufficient (and no ambiguity for ABS vs ABSTRACT etc).
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by grindstone »

Please correct me if I'm wrong, but the program can't handle comment blocks yet, can it?

@IchMagBier: In your latest example code (1st post) the C section doesn't work correct.
IchMagBier
Posts: 52
Joined: Jan 13, 2018 8:47
Location: Germany
Contact:

Re: Routines to write syntax highlighted code

Post by IchMagBier »

It can handle comment blocks. What do you mean "the C section doesn't work correct"? I don't see any problems there.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by grindstone »

I mean that here from line 3 on the C code is displayed in comment color.

And yes, I see you have added comment_sign_start and comment_sign_end.

What about the operator characters ((){}[]=+-*/<>;)? Are they the same in all languages? Otherwise it might be necessary to append an additional member operators (as STRING, containing the characters) to the PLanguages type.
IchMagBier
Posts: 52
Joined: Jan 13, 2018 8:47
Location: Germany
Contact:

Re: Routines to write syntax highlighted code

Post by IchMagBier »

Lines 3-5 are commented out in the C-Code, that's why they appear gray.

Operators are the same for all languages. I don't want to change that, but I fixed a bug with them and added some more "operators": . , %
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by grindstone »

It would be better readable (and much easier to implement) if you'd replace

Code: Select all

ElseIf (text[i]=40 Or text[i]=41 Or text[i]=123 Or text[i]=125 Or text[i]=91 Or text[i]=93 Or ...
with

Code: Select all

ElseIf InStr("(){}[]=+-*/<>;,%:.@", Chr(text[i])) And strings=0 Then
Some members of your oparator list may collide with other signs, eg. the ";" with the line end mark of C or the "." with the decimal point.

And there's another flaw: Replace the "Once" in

Code: Select all

PrintCode(" #Include Once "+Chr(34)+"test.bi"+Chr(34),FreeBasic):Print
with "Onceagain" and you will see that the "Once" is blue, while the "again" is white although the whole word should be white.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Routines to write syntax highlighted code

Post by grindstone »

Just for fun, I recoded the program using a chained list instead of arrays. A little tricky, but it's working 3 times (graphics screen) to 7 times (console window) faster:

Code: Select all

Enum
	_else = 0
	_command '1
	_command2 '2
	_string '3
	_operator '4
	_cypher '5
	_character '6
	_comment_start
	_comment_end
	_comment
	_comment2
	_root
End Enum


Const color_command=&h729fcf
Const color_command2=&h1e90ff
Const color_string=&hdd4040
Const color_operator=&hfcaf3e
Const color_comment=&h888a85
Const color_else=&he5e5e5

Dim Shared As ULong col_d(_else To _root)
col_d(_else)          = color_else
col_d(_command)       = color_command
col_d(_command2)      = color_command2
col_d(_string)        = color_string
col_d(_operator)      = color_operator
col_d(_cypher)        = color_else
col_d(_character)     = color_else
col_d(_comment_start) = color_comment
col_d(_comment_end)   = color_comment
col_d(_comment)       = color_comment
col_d(_comment2)      = color_comment


Const colortext_command=9
Const colortext_command2=1
Const colortext_string=4
Const colortext_operator=6
Const colortext_comment=8
Const colortext_else=15

Dim Shared As ULong col_t(_else To _root)
col_t(_else)          = colortext_else
col_t(_command)       = colortext_command
col_t(_command2)      = colortext_command2
col_t(_string)        = colortext_string
col_t(_operator)      = colortext_operator
col_t(_cypher)        = colortext_else
col_t(_character)     = colortext_else
col_t(_comment_start) = colortext_comment
col_t(_comment_end)   = colortext_comment
col_t(_comment)       = colortext_comment
col_t(_comment2)      = colortext_comment

Const Assembler=0
Const Bash=1
Const Batch=2
Const C=3
Const CPP=4
Const CSharp=5
Const FreeBasic=6
Const Lua=7
Const Python=8
Const FreePascal=9


Type tNode
	As tNode Ptr subNodes(32 To 127) 'the ASCII value of the character is used as index to the subnode array
	As ULong keywordType
End Type

Type PLanguage
	As tNode Ptr commtree '= Callocate(SizeOf(tNode)) 'create root node
	As Boolean case_sensitive    'C is case sensitive, FreeBasic is not
	As Boolean commentFlag = FALSE
			
	Declare Property string_(st As UByte)
	Declare Property string_() As UByte
	Declare Property comment_sign(cs As String) 'writes the sign to the keyword list 
	Declare Property comment_sign() As String
	Declare Property comment_sign2(cs As String) 
	Declare Property comment_sign2() As String
	Declare Property comment_sign_start(cs As String) 
	Declare Property comment_sign_start() As String
	Declare Property comment_sign_end(cs As String) 
	Declare Property comment_sign_end() As String
	
	Declare Sub SetCommands(kw As String, kwType As Integer)
	Declare Constructor
	Declare Destructor
	Declare Sub deallocateTree(node As tNode Ptr)
	
	Private :
	As String _comment_sign_
	As String _comment_sign2_
	As String _comment_sign_start_
	As String _comment_sign_end_ 
	As UByte _string_
	
End Type


Constructor PLanguage
	With This
		.commtree = Callocate(SizeOf(tNode)) 'create root node
		.commtree->keywordType = _root
	
		'initialize 1st characters of keyword list
		For x As Integer = LBound(.commtree->subNodes) To UBound(.commtree->subNodes)
			.commtree->subNodes(x) = Callocate(SizeOf(tNode))
			Select Case x
				Case Asc("a") To Asc("z"), Asc("A") To Asc("Z"), Asc("_")
					.commtree->subNodes(x)->keywordType = _character
				Case Asc("0") To Asc("9")
					.commtree->subNodes(x)->keywordType = _cypher
				Case Else
					.commtree->subNodes(x)->keywordType = _operator
			End Select
		Next
	End With	
End Constructor

Destructor PLanguage
	'free the memory used by the keyword list  
  deallocateTree(this.commtree)
  DeAllocate this.commtree
End Destructor

Sub PLanguage.deallocateTree(node As tNode Ptr)
	For x As Integer = LBound(node->subNodes) To UBound(node->subNodes)
  	If node->subNodes(x) <> 0 Then
  		deallocateTree(node->subNodes(x))
  		DeAllocate node->subNodes(x)
  	EndIf
	Next
End Sub

Property pLanguage.string_(st As UByte)
	Dim As tNode Ptr node
	
	With This
		._string_ = st
		
		If .commtree->subnodes(st) = 0 Then
			.commtree->subnodes(st) = Callocate(SizeOf(tNode))
		EndIf
		.commtree->subnodes(st)->keywordType = _string
	End With
End Property

Property PLanguage.string_() As UByte 
	Return this._string_
End Property

Property pLanguage.comment_sign(cs  As String)
	Dim As tNode Ptr node
	
	With This
		._comment_sign_ = cs
		.SetCommands(Chr(1) & cs, _comment)
	End With
	
End Property

Property PLanguage.comment_sign() As String
	Return this._comment_sign_
End Property

Property pLanguage.comment_sign2(cs  As String)
	Dim As tNode Ptr node
	
	With This
		._comment_sign2_ = cs
		.SetCommands(Chr(1) & cs, _comment2)
	End With
	
End Property

Property PLanguage.comment_sign2() As String
	Return this._comment_sign2_
End Property

Property pLanguage.comment_sign_start(cs  As String)
	Dim As tNode Ptr node
	
	With This
		._comment_sign_start_ = cs
		.SetCommands(Chr(1) & cs, _comment_start)
	End With
	
End Property

Property PLanguage.comment_sign_start() As String
	Return this._comment_sign_start_
End Property

Property pLanguage.comment_sign_end(cs  As String)
	Dim As tNode Ptr node
	
	With This
		._comment_sign_end_ = cs
		.SetCommands(Chr(1) & cs, _comment_end)
	End With
	
End Property

Property PLanguage.comment_sign_end() As String
	Return this._comment_sign_end_
End Property


Sub pLanguage.SetCommands(kw As String, kwType As Integer)
	Dim As Integer x
	Dim As tNode Ptr node = this.commtree
	Dim As UByte separator = kw[0]

	If this.case_sensitive = FALSE Then
		kw = UCase(kw)
	EndIf

	For x = 1 To Len(kw) - 1
		If kw[x] = separator Then
			node->keywordType = kwType 'write type to current node
			node = this.commtree 'prepare for next keyword
		Else
			If node->subNodes(kw[x]) = 0 Then 'no subnode for this character yet
				node->subNodes(kw[x]) = Callocate(SizeOf(tNode)) 'create new subnode
			EndIf
			node = node->subNodes(kw[x]) 'get next node
		EndIf
	Next

End Sub


Dim Shared As PLanguage PLanguages(9)
Dim As String keywords

With PLanguages(Assembler)
	.string_=34
	.case_sensitive=FALSE
	.comment_sign=";"
		
	keywords = ",hlt,lad,spi,add,sub,mul,div,jmp,jez,jgz,jlz,swap,jsr,ret,pushac,popac,"_
	           "addst,subst,mulst,divst,lsa,lds,push,pop,cli,ldi,ink,lia,dek,ldx,adc,sbb,"_
	           "ja,jb,jna,jnb,je,jne,cmp,int,call,jz,jnz,shl,shr,mov,sar,sal,rol,ror,lea,"_
	           "nop,inc,dec,and,xor,or"
	.SetCommands(keywords, _command)

	keywords = ",%define,%xdefine,%undef,%assign,%ifdef,%ifndef,%ifmacro,%if,%error,%else,"_
	           "%endif,%endmacro,%macro,%define,%elifdef,%define,%include"
	.SetCommands(keywords, _command2)

End With

With PLanguages(Bash)
	.string_=34
	.case_sensitive=TRUE
	.comment_sign="#"
		
	keywords = ",break,case,continue,done,do,elif,else,esac,eval,exit,export,fi,for,function,"_
	           "goto,if,integer,in,return,set,shift,then,until,while"
	.SetCommands(keywords, _command)

End With

With PLanguages(Batch)
	.string_=34
	.case_sensitive=FALSE
	.comment_sign="REM"
	.comment_sign2="::"
			
	keywords = ",set,if,else,exist,errorlevel,for,in,do,break,call,copy,chcp,cd,chdir,choice,"_
	           "cls,country,ctty,date,del,erase,dir,echo,exit,goto,loadfix,loadhigh,mkdir,md,"_
	           "move,path,pause,prompt,rename,ren,rmdir,rd,shift,time,type,verify,ver,vol,com,"_
	           "con,lpt,nul,defined,not,errorlevel,cmdextversion"
	.SetCommands(keywords, _command)
	
End With

With PLanguages(C)
	.string_=34
	.case_sensitive=TRUE
	.comment_sign="//"
	.comment_sign2="/*"
	.comment_sign_start="/*"
  .comment_sign_end="*/"
        	
	keywords = ",asm,auto,break,case,char,const,continue,default,double,do,else,enum,extern,"_
	           "float,for,goto,if,inline,int,long,register,restrict,return,short,signed,"_
	           "sizeof,static,struct,switch,typedef,union,unsigned,void,volatile,while,"_
	           "Alignas,Alignof,Atomic,Bool,Complex,Generic,Imaginary,Noreturn,Static,assert,"_
	           "Thread,local,FALSE,NULL,TRUE"
	.SetCommands(keywords, _command)

	keywords = ",#include,#define,#undef,#ifndef,#ifdef,#if,#error,#pragma,#elif,#else,#endif"
	.SetCommands(keywords, _command2)

End With

With PLanguages(CPP)
	.string_=34
	.case_sensitive=TRUE
	.comment_sign="//"
	.comment_sign_start="/*"
  .comment_sign_end="*/"
  	
	keywords = ",alignas,alignof,and,eq,asm,auto,bitand,bitor,bool,break,case,catch,char32,"_
	           "char16,char,class,compl,const,cast,constexpr,continue,decltype,default,"_
	           "delete,double,do,dynamic,cast,else,enum,explicit,export,extern,false,final,"_
	           "float,for,friend,goto,if,inline,int,long,mutable,namespace,new,noexcept,not,"_
	           "eq,nullptr,operator,or,eq,override,private,protected,public,register,"_
	           "reinterpret,cast,return,short,signed,sizeof,static,assert,cast,struct,"_
	           "switch,template,this,thread,local,throw,true,try,typedef,typeid,typename,"_
	           "union,unsigned,using,virtual,void,volatile,wchar,while,xor,eq"
	.SetCommands(keywords, _command)

	keywords = ",#include,#define,#undef,#ifndef,#ifdef,#if,#error,#pragma,#elif,#else,#endif"
	.SetCommands(keywords, _command2)

End With

With PLanguages(CSharp)
	.string_=34
	.case_sensitive=TRUE
	.comment_sign="//"
	.comment_sign_start="/*"
  .comment_sign_end="*/"
		
	keywords = ",abstract,as,base,bool,break,byte,case,catch,char,checked,class,const,"_
	           "continue,decimal,default,delegate,double,do,else,enum,event,explicit,extern,"_
	           "false,finally,fixed,float,foreach,for,goto,if,implicit,internal,interface,int,"_
	           "in,is,lock,long,namespace,new,null,object,operator,out,override,params,private,"_
	           "protected,public,readonly,ref,return,sbyte,sealed,short,sizeof,stackalloc,"_
	           "static,string,struct,switch,this,throw,true,try,typeof,uint,ulong,unchecked,"_
	           "unsafe,ushort,using,virtual,void,volatile,while"
	.SetCommands(keywords, _command)

	keywords = ",#include,#define,#undef,#ifndef,#ifdef,#if,#error,#pragma,#elif,#else,#endif,"_
	           "#warning,#line,#region,#endregion"
	.SetCommands(keywords, _command2)

End With

With PLanguages(FreeBasic)
	.string_=34 'quotation mark
	.case_sensitive=FALSE
	.comment_sign="'"
	.comment_sign_start="/'"
  .comment_sign_end="'/" 
	
	keywords = ",abs,access,acos,alias,allocate,alpha,andalso,and,any,append,asc,asm,asin,"_
	           "assertwarn,assert,as,atan2,atn,base,beep,binary,bin,bitset,bitreset,bit,bload,"_
	           "bsave,byref,byte,byval,callocate,call,case,cast,cbyte,cdbl,cdecl,chain,chdir,"_
	           "chr,cint,circle,class,clear,clngint,clng,close,cls,color,command,common,"_
	           "condbroadcast,condcreate,conddestroy,condsignal,condwait,constructor,const,"_
	           "cons,continue,cos,cptr,cshort,csign,csng,csrlin,cubyte,cuint,culngint,culng,"_
	           "cunsg,curdir,cushort,custom,cvd,cvi,cvl,cvlongint,cvshort,cvs,data,datevalue,"_
	           "dateadd,datediff,datepart,dateserial,date,day,deallocate,declare,defbyte,"_
	           "defdbl,defint,deflngint,deflng,defshort,defsng,defstr,defubyte,defuint,"_
	           "defulngint,defushort,delete,destructor,dim,dir,double,do,draw,dylibfree,"_
	           "dylibload,dylibsymbol,dynamic,elseif,else,encoding,endif,end,enum,environ,"_
	           "eof,eqv,erase,erfn,erl,ermn,error,err,escape,exec,exepath,exit,explicit,exp,"_
	           "export,extends,extern,false,fboolean,field,fileattr,filecopy,filedatetime,"_
	           "fileexists,filelen,fix,flip,format,for,frac,freefile,fre,function,getmouse,"_
	           "getjoystick,getkey,get,gosub,goto,hex,hibyte,hiword,hour,if,iif,"_
	           "imageconvertrow,imagecreate,imagedestroy,import,implements,inkey,input,input,"_
	           "inp,instrrev,instr,integer,int,interface,is,isdate,kill,lbound,lcase,left,len,"_
	           "let,lib,line,lobyte,loc,local,locate,lock,lof,log,longint,long,loop,loword,"_
	           "lpos,lprint,lpt,lset,ltrim,mid,minute,mkd,mkdir,mki,mklongint,mkl,mkshort,mks,"_
	           "mod,month,monthname,multikey,mutexcreate,mutexdestroy,mutexlock,mutexunlock,"_
	           "namespace,name,new,next,nokeyword,not,now,object,oct,offsetof,once,on,open,"_
	           "operator,option,orelse,or,output,out,overload,paint,palette,pascal,pcopy,peek,"_
	           "pipe,pmap,pointer,point,poke,pos,preserve,preset,print,private,procptr,"_
	           "property,protected,pset,ptr,public,put,randomize,random,read,reallocate,"_
	           "redim,rem,reset,restore,resume,return,rgba,rgb,right,rmdir,rnd,rset,rtrim,"_
	           "run,sadd,scope,screenunlock,screencontrol,screencopy,screenevent,screenglproc,"_
	           "screeninfo,screenlist,screenlock,screenptr,screenres,screenset,screensync,"_
	           "screen,scrn,second,seek,select,setdate,setenviron,setmouse,settime,sgn,shared,"_
	           "shell,shl,short,shr,single,sin,sizeof,sleep,space,spc,sqr,static,stdcall,step,"_
	           "stop,string,strptr,str,sub,swap,system,tab,tan,then,this,threadcreate,"_
	           "threadwait,timer,time,timeserial,timevalue,to,trans,trim,true,type,ubound,"_
	           "ubyte,ucase,uinteger,ulongint,ulong,union,unlock,unsigned,until,ushort,using,"_
	           "va,arg,va,first,valulng,valuint,vallng,valint,val,va,next,varptr,var,view,"_
	           "virtual,wait,wbin,wchr,weekdayname,weekday,wend,whex,while,width,windowtitle,"_
	           "window,winput,with,woct,write,wspace,wstring,wstr,xor,year,zstring,abstract,"_
	           "boolean,imp,naked,override,add,threaddetach,cbool,deflongint,defulongint,"_
	           "imageinfo,nogosub ,stick,strig,threadcall,val64"
	.SetCommands(keywords, _command)

	keywords = ",#assert,#defined,#define,#elseif,#else,#endif,#endmacro,#error,#ifndef,#ifdef,"_
	           "#if,#inclib,#include,#lang,#libpath,#line,#macro,#once,#pragma,#print,#typeof,"_
	           "#undef"
	.SetCommands(keywords, _command2)
		
End With

With PLanguages(Lua)
	.string_=34
	.case_sensitive=TRUE
	.comment_sign="--"
	.comment_sign_start="--[["
  .comment_sign_end="]]--"
      
	keywords = ",and,break,do,else,elseif,end,false,for,function,if,in,local,nil,not,or,repeat,"_
	           "return,then,true,until,while"
	.SetCommands(keywords, _command)

	keywords = ",ALERT,assert,call,collectgarbage,coroutine,debug,dofile,dostring,ERRORMESSAGE,"_
	           "error,foreachi,foreach,globals,gcinfo,getfenv,getmetatable,getn,G,INPUT,io,"_
	           "ipairs,loadstring,loadfile,loadlib,load,math,module,newtype,next,os,OUTPUT,"_
	           "pairs,pcall,print,PROMPT,rawequal,rawget,rawset,require,select,setfenv,"_
	           "setmetatable,sort,STDERR,STDIN,STDOUT,string,table,tinsert,tonumber,tostring,"_
	           "tremove,type,unpack,VERSION,xpcall"
	.SetCommands(keywords, _command2)

End With

With PLanguages(Python)
	.string_=34
	.case_sensitive=TRUE
	.comment_sign="#"
		
	keywords = ",False,None,True,and,assert,as,break,class,continue,def,del,elif,else,except,"_
	           "exec,finally,for,from,global,if,import,in,is,lambda,nonlocal,not,or,pass,print,"_
	           "raise,return,try,while,with,yield"
	.SetCommands(keywords, _command)

	keywords = ",build,class,debug,doc,import,loader,name,package,spec,abs,all,any,apply,ascii,"_
	           "basestring,bin,bool,buffer,bytearray,bytes,callable,chr,classmethod,cmp,coerce,"_
	           "compile,complex,copyright,credits,delattr,dict,dir,divmod,enumerate,eval,"_
	           "execfile,exit,file,filter,float,format,frozenset,getattr,globals,hasattr,hash,"_
	           "help,hex,id,input,intern,int,isinstance,issubclass,iter,len,license,list,"_
	           "locals,long,map,max,memoryview,min,next,object,oct,open,ord,pow,property,quit,"_
	           "range,raw,input,reduce,reload,repr,reversed,round,setattr,set,slice,sorted,"_
	           "staticmethod,str,sum,super,tuple,type,unichr,unicode,vars,xrange,zip"
	.SetCommands(keywords, _command2)

End With

With PLanguages(FreePascal)
	.string_=34
	.case_sensitive=FALSE
	.comment_sign="{"
		
	keywords = ",absolute,abstract,add,and,array,assembler,asm,as,automated,begin,boolean,"_
	           "break,byte,case,cdecl,char,class,constructor,const,contains,default,deprecated,"_
	           "destructor,dispid,dispinterface,div,downto,do,dynamic,else,end,except,exports,"_
	           "export,external,far,file,finally,finalization,final,forwar,for,function,goto,"_
	           "if,implementation,implements,interface,index,inherited,initialization,inline,"_
	           "integer,in,is,label,library,message,mod,name,near,nil,nodefault,not,object,of,"_
	           "on,or,out,overload,override,package,packed,pascal,platform,private,procedure,"_
	           "program,property,protected,public,published,raise,readonly,read,real,record,"_
	           "register,reintroduce,remove,repeat,requires,resourcestring,safecall,sealed,"_
	           "set,shl,shr,static,stdcall,stored,strict,string,then,threadvar,to,try,type,"_
	           "unit,unsafe,until,uses,varargs,var,virtual,while,with,word,writeonly,write,xor"
	.SetCommands(keywords, _command)

End With

Sub PrintCode(text As String, language As UByte = 0)
	Dim As tNode Ptr node
	Dim As ULong kwType, j, k, e, ce
	Dim As String tx
		
	With PLanguages(language)
		text += " "
		
		'create working copy of <text>
		If .case_sensitive Then 
			tx = text & " "
		Else
			tx = UCase(text & " ")
		EndIf

		For i As Integer = 0 To Len(text) - 2
			node = .commtree 'root node --> begin of expression
			
			For j = i To Len(text) - 1 'check for keyword
				If node->subNodes(tx[j]) = 0 Then 'end of listed expression
					kwType = node->keywordType
					Select Case kwType
						Case _command, _command2
							For e = j To Len(text) - 1
								Select Case .commtree->subNodes(tx[e])->keywordType 'type of following character
									Case _character, _cypher 'no keyword --> find end of expression
										kwType = _else
									Case Else 'end of expression
										e -= 1
										Exit For, For
								End Select
							Next
						Case _string
							For e = j To Len(text) - 1 'find end of string
								If .commtree->subNodes(tx[e])->keywordType = _string Then
										Exit For, For
								EndIf
							Next
						Case _character, _cypher, _else
							For e = j To Len(text) - 1 'find end of expression
								Select Case .commtree->subNodes(tx[e])->keywordType
									Case _character, _cypher
										'continue
									Case Else 'end of expression
										e -= 1
										Exit For, For
								End Select
							Next
						Case _comment, _comment2
							e = Len(text) - 2
							Exit For
						Case _comment_start
							.commentFlag = TRUE
							e = j - 1
							Exit For
						Case _comment_end
							.commentFlag = FALSE
							e = j - 1
							Exit For
						Case Else 'any other expression
							e = j - 1
							Exit For
					End Select
				EndIf
				node = node->subNodes(tx[j])
			Next
						
			If .commentFlag Then
				ce = InStrRev(tx, .comment_sign_end)
				If ce Then 
					e = ce - 2
					kwType = _comment_start
				Else
					kwType = _comment
				EndIf
			EndIf
						
			Color col_t(kwType)
			Print Mid(text, i + 1, e - i + 1);
			
			i = e 
						
		Next
	End With
End Sub


Sub DrawCode(x As Integer, y As Integer, text As String, language As UByte=0)
	Dim As tNode Ptr node
	Dim As ULong kwType, j, k, e, ce
	Dim As String tx
		
	With PLanguages(language)
		text += " "
		
		'create working copy of <text>
		If .case_sensitive Then 
			tx = text & " "
		Else
			tx = UCase(text & " ")
		EndIf

		For i As Integer = 0 To Len(text) - 2
			node = .commtree 'root node --> begin of expression
			
			For j = i To Len(text) - 1 'check for keyword
				If node->subNodes(tx[j]) = 0 Then 'end of listed expression
					kwType = node->keywordType
					Select Case kwType
						Case _command, _command2
							For e = j To Len(text) - 1
								Select Case .commtree->subNodes(tx[e])->keywordType 'type of following character
									Case _character, _cypher 'no keyword --> find end of expression
										kwType = _else
									Case Else 'end of expression
										e -= 1
										Exit For, For
								End Select
							Next
						Case _string
							For e = j To Len(text) - 1 'find end of string
								If .commtree->subNodes(tx[e])->keywordType = _string Then
										Exit For, For
								EndIf
							Next
						Case _character, _cypher, _else
							For e = j To Len(text) - 1 'find end of expression
								Select Case .commtree->subNodes(tx[e])->keywordType
									Case _character, _cypher
										'continue
									Case Else 'end of expression
										e -= 1
										Exit For, For
								End Select
							Next
						Case _comment, _comment2
							e = Len(text) - 2
							Exit For
						Case _comment_start
							.commentFlag = TRUE
							e = j - 1
							Exit For
						Case _comment_end
							.commentFlag = FALSE
							e = j - 1
							Exit For
						Case Else 'any other expression
							e = j - 1
							Exit For
					End Select
				EndIf
				node = node->subNodes(tx[j])
			Next
						
			If .commentFlag Then
				ce = InStrRev(tx, .comment_sign_end)
				If ce Then 
					e = ce - 2
					kwType = _comment_start
				Else
					kwType = _comment
				EndIf
			EndIf
						
			Draw String (x + 8*i, y), Mid(text, i + 1, e - i + 1), col_d(kwType)
			i = e 
						
		Next
	End With
	
End Sub


Print "FreeBasic:"
PrintCode(" #Include Once "+Chr(34)+"test.bi"+Chr(34),FreeBasic):Print
PrintCode(" Dim As UInteger testvar=42 'Comment",FreeBasic):Print
PrintCode(" Function testfunc (parameter As UByte) As Integer",FreeBasic):Print
PrintCode("    Print "+Chr(34)+"Hello World"+Chr(34),FreeBasic):Print
PrintCode("    Return 43",FreeBasic):Print
PrintCode(" End Function",FreeBasic):Print
Print

Color 7:Print "C:"
PrintCode(" #include <test.h>",C):Print
PrintCode(" unsigned int testvar=42; //Comment",C):Print
PrintCode(" /*int testfunc (unsigned char parameter) {",C):Print
PrintCode("    puts("+Chr(34)+"Hallo Welt"+Chr(34)+");",C):Print
PrintCode("    return 43;*/",C):Print
PrintCode(" }",C):Print
Print
Color 7:Print "Assembler:"
PrintCode(" %include "+Chr(34)+"test.asm"+Chr(34),Assembler):Print
PrintCode(" mov rax,42 ;Comment",Assembler):Print
PrintCode(" testfunc:",Assembler):Print
PrintCode("    call printf",Assembler):Print
PrintCode("    push 43",Assembler):Print
PrintCode(" ret",Assembler):Print
Sleep

ScreenRes 640,480,16
Width 640/8,480/16
Line (0,0)-(640,480),&h2d3335,BF

Draw String (5,5),"FreeBasic:"
DrawCode(10,25,"#Include Once "+Chr(34)+"test.bi"+Chr(34),FreeBasic)
DrawCode(10,40,"Dim As UInteger testvar=42 'Comment",FreeBasic)
DrawCode(10,70,"Function testfunc (parameter As UByte) As Integer",FreeBasic)
DrawCode(10,85,"   Print "+Chr(34)+"Hello World"+Chr(34),FreeBasic)
DrawCode(10,100,"   Return 43",FreeBasic)
DrawCode(10,115,"End Function",FreeBasic)

Line (5,140)-(635,140),&hffffff

Draw String (5,150),"C:"
DrawCode(10,170,"#include <test.h>",C)
DrawCode(10,185,"unsigned int testvar=42; //Comment",C)
DrawCode(10,215,"/*int testfunc (unsigned char parameter) {",C)
DrawCode(10,230,"   puts("+Chr(34)+"Hallo Welt"+Chr(34)+");",C)
DrawCode(10,245,"   return 43;*/",C)
DrawCode(10,260,"}",C)

Line (5,285)-(635,285),&hffffff

Draw String (5,295),"Assembler:"
DrawCode(10,315,"%include "+Chr(34)+"test.asm"+Chr(34),Assembler)
DrawCode(10,330,"mov rax,42 ;Comment",Assembler)
DrawCode(10,360,"testfunc:",Assembler)
DrawCode(10,375,"   call printf",Assembler)
DrawCode(10,390,"   push 43",Assembler)
DrawCode(10,405,"ret",Assembler)
Sleep

Post Reply