ronblue

Untitled

Apr 6th, 2021
114
326 days
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' syntax_highlighter.bas
  2.  
  3. Enum
  4.    _else = 0
  5.    _command '1
  6.    _command2 '2
  7.    _string '3
  8.    _operator '4
  9.    _cypher '5
  10.    _character '6
  11.    _comment_start
  12.    _comment_end
  13.    _comment
  14.    _comment2
  15.    _root
  16. End Enum
  17.  
  18.  
  19. Const color_command=&h729fcf
  20. Const color_command2=&h1e90ff
  21. Const color_string=&hdd4040
  22. Const color_operator=&hfcaf3e
  23. Const color_comment=&h888a85
  24. Const color_else=&he5e5e5
  25.  
  26. Dim Shared As ULong col_d(_else To _root)
  27. col_d(_else)          = color_else
  28. col_d(_command)       = color_command
  29. col_d(_command2)      = color_command2
  30. col_d(_string)        = color_string
  31. col_d(_operator)      = color_operator
  32. col_d(_cypher)        = color_else
  33. col_d(_character)     = color_else
  34. col_d(_comment_start) = color_comment
  35. col_d(_comment_end)   = color_comment
  36. col_d(_comment)       = color_comment
  37. col_d(_comment2)      = color_comment
  38.  
  39.  
  40. Const colortext_command=9
  41. Const colortext_command2=1
  42. Const colortext_string=4
  43. Const colortext_operator=6
  44. Const colortext_comment=8
  45. Const colortext_else=15
  46.  
  47. Dim Shared As ULong col_t(_else To _root)
  48. col_t(_else)          = colortext_else
  49. col_t(_command)       = colortext_command
  50. col_t(_command2)      = colortext_command2
  51. col_t(_string)        = colortext_string
  52. col_t(_operator)      = colortext_operator
  53. col_t(_cypher)        = colortext_else
  54. col_t(_character)     = colortext_else
  55. col_t(_comment_start) = colortext_comment
  56. col_t(_comment_end)   = colortext_comment
  57. col_t(_comment)       = colortext_comment
  58. col_t(_comment2)      = colortext_comment
  59.  
  60. Const Assembler=0
  61. Const Bash=1
  62. Const Batch=2
  63. Const C=3
  64. Const CPP=4
  65. Const CSharp=5
  66. Const FreeBasic=6
  67. Const Lua=7
  68. Const Python=8
  69. Const FreePascal=9
  70.  
  71.  
  72. Type tNode
  73.    As tNode Ptr subNodes(32 To 127) 'the ASCII value of the character is used as index to the subnode array
  74.    As ULong keywordType
  75. End Type
  76.  
  77. Type PLanguage
  78.    As tNode Ptr commtree '= Callocate(SizeOf(tNode)) 'create root node
  79.    As Boolean case_sensitive    'C is case sensitive, FreeBasic is not
  80.    As Boolean commentFlag = FALSE
  81.          
  82.    Declare Property string_(st As UByte)
  83.    Declare Property string_() As UByte
  84.    Declare Property comment_sign(cs As String) 'writes the sign to the keyword list
  85.    Declare Property comment_sign() As String
  86.    Declare Property comment_sign2(cs As String)
  87.    Declare Property comment_sign2() As String
  88.    Declare Property comment_sign_start(cs As String)
  89.    Declare Property comment_sign_start() As String
  90.    Declare Property comment_sign_end(cs As String)
  91.    Declare Property comment_sign_end() As String
  92.    
  93.    Declare Sub SetCommands(kw As String, kwType As Integer)
  94.    Declare Constructor
  95.    Declare Destructor
  96.    Declare Sub deallocateTree(node As tNode Ptr)
  97.    
  98.    Private :
  99.    As String _comment_sign_
  100.    As String _comment_sign2_
  101.    As String _comment_sign_start_
  102.    As String _comment_sign_end_
  103.    As UByte _string_
  104.    
  105. End Type
  106.  
  107.  
  108. Constructor PLanguage
  109.    With This
  110.       .commtree = Callocate(SizeOf(tNode)) 'create root node
  111.       .commtree->keywordType = _root
  112.    
  113.       'initialize 1st characters of keyword list
  114.       For x As Integer = LBound(.commtree->subNodes) To UBound(.commtree->subNodes)
  115.          .commtree->subNodes(x) = Callocate(SizeOf(tNode))
  116.          Select Case x
  117.             Case Asc("a") To Asc("z"), Asc("A") To Asc("Z"), Asc("_")
  118.                .commtree->subNodes(x)->keywordType = _character
  119.             Case Asc("0") To Asc("9")
  120.                .commtree->subNodes(x)->keywordType = _cypher
  121.             Case Else
  122.                .commtree->subNodes(x)->keywordType = _operator
  123.          End Select
  124.       Next
  125.    End With  
  126. End Constructor
  127.  
  128. Destructor PLanguage
  129.    'free the memory used by the keyword list
  130.   deallocateTree(this.commtree)
  131.   DeAllocate this.commtree
  132. End Destructor
  133.  
  134. Sub PLanguage.deallocateTree(node As tNode Ptr)
  135.    For x As Integer = LBound(node->subNodes) To UBound(node->subNodes)
  136.      If node->subNodes(x) <> 0 Then
  137.         deallocateTree(node->subNodes(x))
  138.         DeAllocate node->subNodes(x)
  139.      EndIf
  140.    Next
  141. End Sub
  142.  
  143. Property pLanguage.string_(st As UByte)
  144.    Dim As tNode Ptr node
  145.    
  146.    With This
  147.       ._string_ = st
  148.      
  149.       If .commtree->subnodes(st) = 0 Then
  150.          .commtree->subnodes(st) = Callocate(SizeOf(tNode))
  151.       EndIf
  152.       .commtree->subnodes(st)->keywordType = _string
  153.    End With
  154. End Property
  155.  
  156. Property PLanguage.string_() As UByte
  157.    Return this._string_
  158. End Property
  159.  
  160. Property pLanguage.comment_sign(cs  As String)
  161.    Dim As tNode Ptr node
  162.    
  163.    With This
  164.       ._comment_sign_ = cs
  165.       .SetCommands(Chr(1) & cs, _comment)
  166.    End With
  167.    
  168. End Property
  169.  
  170. Property PLanguage.comment_sign() As String
  171.    Return this._comment_sign_
  172. End Property
  173.  
  174. Property pLanguage.comment_sign2(cs  As String)
  175.    Dim As tNode Ptr node
  176.    
  177.    With This
  178.       ._comment_sign2_ = cs
  179.       .SetCommands(Chr(1) & cs, _comment2)
  180.    End With
  181.    
  182. End Property
  183.  
  184. Property PLanguage.comment_sign2() As String
  185.    Return this._comment_sign2_
  186. End Property
  187.  
  188. Property pLanguage.comment_sign_start(cs  As String)
  189.    Dim As tNode Ptr node
  190.    
  191.    With This
  192.       ._comment_sign_start_ = cs
  193.       .SetCommands(Chr(1) & cs, _comment_start)
  194.    End With
  195.    
  196. End Property
  197.  
  198. Property PLanguage.comment_sign_start() As String
  199.    Return this._comment_sign_start_
  200. End Property
  201.  
  202. Property pLanguage.comment_sign_end(cs  As String)
  203.    Dim As tNode Ptr node
  204.    
  205.    With This
  206.       ._comment_sign_end_ = cs
  207.       .SetCommands(Chr(1) & cs, _comment_end)
  208.    End With
  209.    
  210. End Property
  211.  
  212. Property PLanguage.comment_sign_end() As String
  213.    Return this._comment_sign_end_
  214. End Property
  215.  
  216.  
  217. Sub pLanguage.SetCommands(kw As String, kwType As Integer)
  218.    Dim As Integer x
  219.    Dim As tNode Ptr node = this.commtree
  220.    Dim As UByte separator = kw[0]
  221.  
  222.    If this.case_sensitive = FALSE Then
  223.       kw = UCase(kw)
  224.    EndIf
  225.  
  226.    For x = 1 To Len(kw) - 1
  227.       If kw[x] = separator Then
  228.          node->keywordType = kwType 'write type to current node
  229.          node = this.commtree 'prepare for next keyword
  230.       Else
  231.          If node->subNodes(kw[x]) = 0 Then 'no subnode for this character yet
  232.             node->subNodes(kw[x]) = Callocate(SizeOf(tNode)) 'create new subnode
  233.          EndIf
  234.          node = node->subNodes(kw[x]) 'get next node
  235.       EndIf
  236.    Next
  237.  
  238. End Sub
  239.  
  240.  
  241. Dim Shared As PLanguage PLanguages(9)
  242. Dim As String keywords
  243.  
  244. With PLanguages(Assembler)
  245.    .string_=34
  246.    .case_sensitive=FALSE
  247.    .comment_sign=";"
  248.      
  249.    keywords = ",hlt,lad,spi,add,sub,mul,div,jmp,jez,jgz,jlz,swap,jsr,ret,pushac,popac,"_
  250.               "addst,subst,mulst,divst,lsa,lds,push,pop,cli,ldi,ink,lia,dek,ldx,adc,sbb,"_
  251.               "ja,jb,jna,jnb,je,jne,cmp,int,call,jz,jnz,shl,shr,mov,sar,sal,rol,ror,lea,"_
  252.               "nop,inc,dec,and,xor,or"
  253.    .SetCommands(keywords, _command)
  254.  
  255.    keywords = ",%define,%xdefine,%undef,%assign,%ifdef,%ifndef,%ifmacro,%if,%error,%else,"_
  256.               "%endif,%endmacro,%macro,%define,%elifdef,%define,%include"
  257.    .SetCommands(keywords, _command2)
  258.  
  259. End With
  260.  
  261. With PLanguages(Bash)
  262.    .string_=34
  263.    .case_sensitive=TRUE
  264.    .comment_sign="#"
  265.      
  266.    keywords = ",break,case,continue,done,do,elif,else,esac,eval,exit,export,fi,for,function,"_
  267.               "goto,if,integer,in,return,set,shift,then,until,while"
  268.    .SetCommands(keywords, _command)
  269.  
  270. End With
  271.  
  272. With PLanguages(Batch)
  273.    .string_=34
  274.    .case_sensitive=FALSE
  275.    .comment_sign="REM"
  276.    .comment_sign2="::"
  277.          
  278.    keywords = ",set,if,else,exist,errorlevel,for,in,do,break,call,copy,chcp,cd,chdir,choice,"_
  279.               "cls,country,ctty,date,del,erase,dir,echo,exit,goto,loadfix,loadhigh,mkdir,md,"_
  280.               "move,path,pause,prompt,rename,ren,rmdir,rd,shift,time,type,verify,ver,vol,com,"_
  281.               "con,lpt,nul,defined,not,errorlevel,cmdextversion"
  282.    .SetCommands(keywords, _command)
  283.    
  284. End With
  285.  
  286. With PLanguages(C)
  287.    .string_=34
  288.    .case_sensitive=TRUE
  289.    .comment_sign="//"
  290.    .comment_sign2="/*"
  291.    .comment_sign_start="/*"
  292.   .comment_sign_end="*/"
  293.            
  294.    keywords = ",asm,auto,break,case,char,const,continue,default,double,do,else,enum,extern,"_
  295.               "float,for,goto,if,inline,int,long,register,restrict,return,short,signed,"_
  296.               "sizeof,static,struct,switch,typedef,union,unsigned,void,volatile,while,"_
  297.               "Alignas,Alignof,Atomic,Bool,Complex,Generic,Imaginary,Noreturn,Static,assert,"_
  298.               "Thread,local,FALSE,NULL,TRUE"
  299.    .SetCommands(keywords, _command)
  300.  
  301.    keywords = ",#include,#define,#undef,#ifndef,#ifdef,#if,#error,#pragma,#elif,#else,#endif"
  302.    .SetCommands(keywords, _command2)
  303.  
  304. End With
  305.  
  306. With PLanguages(CPP)
  307.    .string_=34
  308.    .case_sensitive=TRUE
  309.    .comment_sign="//"
  310.    .comment_sign_start="/*"
  311.   .comment_sign_end="*/"
  312.      
  313.    keywords = ",alignas,alignof,and,eq,asm,auto,bitand,bitor,bool,break,case,catch,char32,"_
  314.               "char16,char,class,compl,const,cast,constexpr,continue,decltype,default,"_
  315.               "delete,double,do,dynamic,cast,else,enum,explicit,export,extern,false,final,"_
  316.               "float,for,friend,goto,if,inline,int,long,mutable,namespace,new,noexcept,not,"_
  317.               "eq,nullptr,operator,or,eq,override,private,protected,public,register,"_
  318.               "reinterpret,cast,return,short,signed,sizeof,static,assert,cast,struct,"_
  319.               "switch,template,this,thread,local,throw,true,try,typedef,typeid,typename,"_
  320.               "union,unsigned,using,virtual,void,volatile,wchar,while,xor,eq"
  321.    .SetCommands(keywords, _command)
  322.  
  323.    keywords = ",#include,#define,#undef,#ifndef,#ifdef,#if,#error,#pragma,#elif,#else,#endif"
  324.    .SetCommands(keywords, _command2)
  325.  
  326. End With
  327.  
  328. With PLanguages(CSharp)
  329.    .string_=34
  330.    .case_sensitive=TRUE
  331.    .comment_sign="//"
  332.    .comment_sign_start="/*"
  333.   .comment_sign_end="*/"
  334.      
  335.    keywords = ",abstract,as,base,bool,break,byte,case,catch,char,checked,class,const,"_
  336.               "continue,decimal,default,delegate,double,do,else,enum,event,explicit,extern,"_
  337.               "false,finally,fixed,float,foreach,for,goto,if,implicit,internal,interface,int,"_
  338.               "in,is,lock,long,namespace,new,null,object,operator,out,override,params,private,"_
  339.               "protected,public,readonly,ref,return,sbyte,sealed,short,sizeof,stackalloc,"_
  340.               "static,string,struct,switch,this,throw,true,try,typeof,uint,ulong,unchecked,"_
  341.               "unsafe,ushort,using,virtual,void,volatile,while"
  342.    .SetCommands(keywords, _command)
  343.  
  344.    keywords = ",#include,#define,#undef,#ifndef,#ifdef,#if,#error,#pragma,#elif,#else,#endif,"_
  345.               "#warning,#line,#region,#endregion"
  346.    .SetCommands(keywords, _command2)
  347.  
  348. End With
  349.  
  350. With PLanguages(FreeBasic)
  351.    .string_=34 'quotation mark
  352.    .case_sensitive=FALSE
  353.    .comment_sign="'"
  354.    .comment_sign_start="/'"
  355.   .comment_sign_end="'/"
  356.    
  357.    keywords = ",abs,access,acos,alias,allocate,alpha,andalso,and,any,append,asc,asm,asin,"_
  358.               "assertwarn,assert,as,atan2,atn,base,beep,binary,bin,bitset,bitreset,bit,bload,"_
  359.               "bsave,byref,byte,byval,callocate,call,case,cast,cbyte,cdbl,cdecl,chain,chdir,"_
  360.               "chr,cint,circle,class,clear,clngint,clng,close,cls,color,command,common,"_
  361.               "condbroadcast,condcreate,conddestroy,condsignal,condwait,constructor,const,"_
  362.               "cons,continue,cos,cptr,cshort,csign,csng,csrlin,cubyte,cuint,culngint,culng,"_
  363.               "cunsg,curdir,cushort,custom,cvd,cvi,cvl,cvlongint,cvshort,cvs,data,datevalue,"_
  364.               "dateadd,datediff,datepart,dateserial,date,day,deallocate,declare,defbyte,"_
  365.               "defdbl,defint,deflngint,deflng,defshort,defsng,defstr,defubyte,defuint,"_
  366.               "defulngint,defushort,delete,destructor,dim,dir,double,do,draw,dylibfree,"_
  367.               "dylibload,dylibsymbol,dynamic,elseif,else,encoding,endif,end,enum,environ,"_
  368.               "eof,eqv,erase,erfn,erl,ermn,error,err,escape,exec,exepath,exit,explicit,exp,"_
  369.               "export,extends,extern,false,fboolean,field,fileattr,filecopy,filedatetime,"_
  370.               "fileexists,filelen,fix,flip,format,for,frac,freefile,fre,function,getmouse,"_
  371.               "getjoystick,getkey,get,gosub,goto,hex,hibyte,hiword,hour,if,iif,"_
  372.               "imageconvertrow,imagecreate,imagedestroy,import,implements,inkey,input,input,"_
  373.               "inp,instrrev,instr,integer,int,interface,is,isdate,kill,lbound,lcase,left,len,"_
  374.               "let,lib,line,lobyte,loc,local,locate,lock,lof,log,longint,long,loop,loword,"_
  375.               "lpos,lprint,lpt,lset,ltrim,mid,minute,mkd,mkdir,mki,mklongint,mkl,mkshort,mks,"_
  376.               "mod,month,monthname,multikey,mutexcreate,mutexdestroy,mutexlock,mutexunlock,"_
  377.               "namespace,name,new,next,nokeyword,not,now,object,oct,offsetof,once,on,open,"_
  378.               "operator,option,orelse,or,output,out,overload,paint,palette,pascal,pcopy,peek,"_
  379.               "pipe,pmap,pointer,point,poke,pos,preserve,preset,print,private,procptr,"_
  380.               "property,protected,pset,ptr,public,put,randomize,random,read,reallocate,"_
  381.               "redim,rem,reset,restore,resume,return,rgba,rgb,right,rmdir,rnd,rset,rtrim,"_
  382.               "run,sadd,scope,screenunlock,screencontrol,screencopy,screenevent,screenglproc,"_
  383.               "screeninfo,screenlist,screenlock,screenptr,screenres,screenset,screensync,"_
  384.               "screen,scrn,second,seek,select,setdate,setenviron,setmouse,settime,sgn,shared,"_
  385.               "shell,shl,short,shr,single,sin,sizeof,sleep,space,spc,sqr,static,stdcall,step,"_
  386.               "stop,string,strptr,str,sub,swap,system,tab,tan,then,this,threadcreate,"_
  387.               "threadwait,timer,time,timeserial,timevalue,to,trans,trim,true,type,ubound,"_
  388.               "ubyte,ucase,uinteger,ulongint,ulong,union,unlock,unsigned,until,ushort,using,"_
  389.               "va,arg,va,first,valulng,valuint,vallng,valint,val,va,next,varptr,var,view,"_
  390.               "virtual,wait,wbin,wchr,weekdayname,weekday,wend,whex,while,width,windowtitle,"_
  391.               "window,winput,with,woct,write,wspace,wstring,wstr,xor,year,zstring,abstract,"_
  392.               "boolean,imp,naked,override,add,threaddetach,cbool,deflongint,defulongint,"_
  393.               "imageinfo,nogosub ,stick,strig,threadcall,val64"
  394.    .SetCommands(keywords, _command)
  395.  
  396.    keywords = ",#assert,#defined,#define,#elseif,#else,#endif,#endmacro,#error,#ifndef,#ifdef,"_
  397.               "#if,#inclib,#include,#lang,#libpath,#line,#macro,#once,#pragma,#print,#typeof,"_
  398.               "#undef"
  399.    .SetCommands(keywords, _command2)
  400.      
  401. End With
  402.  
  403. With PLanguages(Lua)
  404.    .string_=34
  405.    .case_sensitive=TRUE
  406.    .comment_sign="--"
  407.    .comment_sign_start="--[["
  408.   .comment_sign_end="]]--"
  409.      
  410.    keywords = ",and,break,do,else,elseif,end,false,for,function,if,in,local,nil,not,or,repeat,"_
  411.               "return,then,true,until,while"
  412.    .SetCommands(keywords, _command)
  413.  
  414.    keywords = ",ALERT,assert,call,collectgarbage,coroutine,debug,dofile,dostring,ERRORMESSAGE,"_
  415.               "error,foreachi,foreach,globals,gcinfo,getfenv,getmetatable,getn,G,INPUT,io,"_
  416.               "ipairs,loadstring,loadfile,loadlib,load,math,module,newtype,next,os,OUTPUT,"_
  417.               "pairs,pcall,print,PROMPT,rawequal,rawget,rawset,require,select,setfenv,"_
  418.               "setmetatable,sort,STDERR,STDIN,STDOUT,string,table,tinsert,tonumber,tostring,"_
  419.               "tremove,type,unpack,VERSION,xpcall"
  420.    .SetCommands(keywords, _command2)
  421.  
  422. End With
  423.  
  424. With PLanguages(Python)
  425.    .string_=34
  426.    .case_sensitive=TRUE
  427.    .comment_sign="#"
  428.      
  429.    keywords = ",False,None,True,and,assert,as,break,class,continue,def,del,elif,else,except,"_
  430.               "exec,finally,for,from,global,if,import,in,is,lambda,nonlocal,not,or,pass,print,"_
  431.               "raise,return,try,while,with,yield"
  432.    .SetCommands(keywords, _command)
  433.  
  434.    keywords = ",build,class,debug,doc,import,loader,name,package,spec,abs,all,any,apply,ascii,"_
  435.               "basestring,bin,bool,buffer,bytearray,bytes,callable,chr,classmethod,cmp,coerce,"_
  436.               "compile,complex,copyright,credits,delattr,dict,dir,divmod,enumerate,eval,"_
  437.               "execfile,exit,file,filter,float,format,frozenset,getattr,globals,hasattr,hash,"_
  438.               "help,hex,id,input,intern,int,isinstance,issubclass,iter,len,license,list,"_
  439.               "locals,long,map,max,memoryview,min,next,object,oct,open,ord,pow,property,quit,"_
  440.               "range,raw,input,reduce,reload,repr,reversed,round,setattr,set,slice,sorted,"_
  441.               "staticmethod,str,sum,super,tuple,type,unichr,unicode,vars,xrange,zip"
  442.    .SetCommands(keywords, _command2)
  443.  
  444. End With
  445.  
  446. With PLanguages(FreePascal)
  447.    .string_=34
  448.    .case_sensitive=FALSE
  449.    .comment_sign="{"
  450.      
  451.    keywords = ",absolute,abstract,add,and,array,assembler,asm,as,automated,begin,boolean,"_
  452.               "break,byte,case,cdecl,char,class,constructor,const,contains,default,deprecated,"_
  453.               "destructor,dispid,dispinterface,div,downto,do,dynamic,else,end,except,exports,"_
  454.               "export,external,far,file,finally,finalization,final,forwar,for,function,goto,"_
  455.               "if,implementation,implements,interface,index,inherited,initialization,inline,"_
  456.               "integer,in,is,label,library,message,mod,name,near,nil,nodefault,not,object,of,"_
  457.               "on,or,out,overload,override,package,packed,pascal,platform,private,procedure,"_
  458.               "program,property,protected,public,published,raise,readonly,read,real,record,"_
  459.               "register,reintroduce,remove,repeat,requires,resourcestring,safecall,sealed,"_
  460.               "set,shl,shr,static,stdcall,stored,strict,string,then,threadvar,to,try,type,"_
  461.               "unit,unsafe,until,uses,varargs,var,virtual,while,with,word,writeonly,write,xor"
  462.    .SetCommands(keywords, _command)
  463.  
  464. End With
  465.  
  466. Sub PrintCode(text As String, language As UByte = 0)
  467.    Dim As tNode Ptr node
  468.    Dim As ULong kwType, j, k, e, ce
  469.    Dim As String tx
  470.      
  471.    With PLanguages(language)
  472.       text += " "
  473.      
  474.       'create working copy of <text>
  475.       If .case_sensitive Then
  476.          tx = text & " "
  477.       Else
  478.          tx = UCase(text & " ")
  479.       EndIf
  480.  
  481.       For i As Integer = 0 To Len(text) - 2
  482.          node = .commtree 'root node --> begin of expression
  483.          
  484.          For j = i To Len(text) - 1 'check for keyword
  485.             If node->subNodes(tx[j]) = 0 Then 'end of listed expression
  486.                kwType = node->keywordType
  487.                Select Case kwType
  488.                   Case _command, _command2
  489.                      For e = j To Len(text) - 1
  490.                         Select Case .commtree->subNodes(tx[e])->keywordType 'type of following character
  491.                            Case _character, _cypher 'no keyword --> find end of expression
  492.                               kwType = _else
  493.                            Case Else 'end of expression
  494.                               e -= 1
  495.                               Exit For, For
  496.                         End Select
  497.                      Next
  498.                   Case _string
  499.                      For e = j To Len(text) - 1 'find end of string
  500.                         If .commtree->subNodes(tx[e])->keywordType = _string Then
  501.                               Exit For, For
  502.                         EndIf
  503.                      Next
  504.                   Case _character, _cypher, _else
  505.                      For e = j To Len(text) - 1 'find end of expression
  506.                         Select Case .commtree->subNodes(tx[e])->keywordType
  507.                            Case _character, _cypher
  508.                               'continue
  509.                            Case Else 'end of expression
  510.                               e -= 1
  511.                               Exit For, For
  512.                         End Select
  513.                      Next
  514.                   Case _comment, _comment2
  515.                      e = Len(text) - 2
  516.                      Exit For
  517.                   Case _comment_start
  518.                      .commentFlag = TRUE
  519.                      e = j - 1
  520.                      Exit For
  521.                   Case _comment_end
  522.                      .commentFlag = FALSE
  523.                      e = j - 1
  524.                      Exit For
  525.                   Case Else 'any other expression
  526.                      e = j - 1
  527.                      Exit For
  528.                End Select
  529.             EndIf
  530.             node = node->subNodes(tx[j])
  531.          Next
  532.                  
  533.          If .commentFlag Then
  534.             ce = InStrRev(tx, .comment_sign_end)
  535.             If ce Then
  536.                e = ce - 2
  537.                kwType = _comment_start
  538.             Else
  539.                kwType = _comment
  540.             EndIf
  541.          EndIf
  542.                  
  543.          Color col_t(kwType)
  544.          Print Mid(text, i + 1, e - i + 1);
  545.          
  546.          i = e
  547.                  
  548.       Next
  549.    End With
  550.    Print
  551. End Sub
  552.  
  553.  
  554. Sub DrawCode(x As Integer, y As Integer, text As String, language As UByte=0)
  555.    Dim As tNode Ptr node
  556.    Dim As ULong kwType, j, k, e, ce
  557.    Dim As String tx
  558.      
  559.    With PLanguages(language)
  560.       text += " "
  561.      
  562.       'create working copy of <text>
  563.       If .case_sensitive Then
  564.          tx = text & " "
  565.       Else
  566.          tx = UCase(text & " ")
  567.       EndIf
  568.  
  569.       For i As Integer = 0 To Len(text) - 2
  570.          node = .commtree 'root node --> begin of expression
  571.          
  572.          For j = i To Len(text) - 1 'check for keyword
  573.             If node->subNodes(tx[j]) = 0 Then 'end of listed expression
  574.                kwType = node->keywordType
  575.                Select Case kwType
  576.                   Case _command, _command2
  577.                      For e = j To Len(text) - 1
  578.                         Select Case .commtree->subNodes(tx[e])->keywordType 'type of following character
  579.                            Case _character, _cypher 'no keyword --> find end of expression
  580.                               kwType = _else
  581.                            Case Else 'end of expression
  582.                               e -= 1
  583.                               Exit For, For
  584.                         End Select
  585.                      Next
  586.                   Case _string
  587.                      For e = j To Len(text) - 1 'find end of string
  588.                         If .commtree->subNodes(tx[e])->keywordType = _string Then
  589.                               Exit For, For
  590.                         EndIf
  591.                      Next
  592.                   Case _character, _cypher, _else
  593.                      For e = j To Len(text) - 1 'find end of expression
  594.                         Select Case .commtree->subNodes(tx[e])->keywordType
  595.                            Case _character, _cypher
  596.                               'continue
  597.                            Case Else 'end of expression
  598.                               e -= 1
  599.                               Exit For, For
  600.                         End Select
  601.                      Next
  602.                   Case _comment, _comment2
  603.                      e = Len(text) - 2
  604.                      Exit For
  605.                   Case _comment_start
  606.                      .commentFlag = TRUE
  607.                      e = j - 1
  608.                      Exit For
  609.                   Case _comment_end
  610.                      .commentFlag = FALSE
  611.                      e = j - 1
  612.                      Exit For
  613.                   Case Else 'any other expression
  614.                      e = j - 1
  615.                      Exit For
  616.                End Select
  617.             EndIf
  618.             node = node->subNodes(tx[j])
  619.          Next
  620.                  
  621.          If .commentFlag Then
  622.             ce = InStrRev(tx, .comment_sign_end)
  623.             If ce Then
  624.                e = ce - 2
  625.                kwType = _comment_start
  626.             Else
  627.                kwType = _comment
  628.             EndIf
  629.          EndIf
  630.                  
  631.          Draw String (x + 8*i, y), Mid(text, i + 1, e - i + 1), col_d(kwType)
  632.          i = e
  633.                  
  634.       Next
  635.    End With
  636.  
  637. End Sub
  638.  
  639. ' load and display .bas
  640.  
  641. dim as string row(700)
  642. dim i as integer
  643.  
  644. dim as integer filehandle
  645. filehandle = freefile
  646. open "fb_mandelbrot_set_ron77.bas" for input as #filehandle
  647.    
  648. DO UNTIL EOF(filehandle)            
  649.   line input #filehandle, row(i)              
  650.   i+=1                  
  651. LOOP                              
  652.    
  653. for i = 0 to 657
  654.   PrintCode(row(i),FreeBasic)
  655. next i
  656.  
  657. Sleep
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×