'-----------------------------------------------------------------------
'
'
'-----------------------------------------------------------------------
#include "vbcompat.bi"

'-----------------------------------------------------------------------
Const max_dio = 1023

dim pass as integer

dim define_stack(0 to max_dio, 0 to 1) as string
dim obj_stack   (0 to max_dio, 0 to 1) as string

dim block 	as integer
dim kommentar	as integer
dim new_obj	as boolean
dim def_block   as integer
dim def_name    as string

dim f_file_x 	as integer
dim f_file_1 	as integer
dim myexepath	as string

dim as string  a_s, b_s, c_s, d_s 
dim as integer a_i, b_i, c_i, d_i, x_i, y_i, z_i

'-----------------------------------------------------------------------
cls
Print "PreePro 0.0 by PIC18F2550"
Print "Compile Date: " + mid$(__DATE__,4,2) + "." + mid$(__DATE__,1,2) + "." + mid$(__DATE__,7,4) + " Time : " + __TIME__
If Len(Command(1)) = 0 Then
	Print "(keine Start Datei angegeben)"
	end
End If
'-----------------------------------------------------------------------
' Neue elemente suchen
'-----------------------------------------------------------------------
close
pass		= 0
kommentar	= 0
a_s		= ""
def_name	= ""

obj_stack(0,0)		= Command(1)	'main_file
obj_stack(0,1)		= "obj"		'main_file immer eine Spindatei daher Objekt

myexepath	= exepath + "\out\"

'-----------------------------------------------------------------------
do
	pass = pass + 1
	new_obj	= false
	print "Pass : "; pass
	for z_i = 0 to max_dio
		if obj_stack(z_i,0) = "" then
			goto m101
		end if
		If FileExists(obj_stack(z_i,0) ) Then
			print , "open: " & obj_stack(z_i,0), obj_stack(z_i, 1),
		Else
			print z_i, "open: " & obj_stack(z_i,0) & " File not found!"
			goto m900
		end if
		f_file_x		= FreeFile
		open myexepath + obj_stack(z_i,0) for output as f_file_x
		f_file_1		= FreeFile
		open obj_stack(z_i,0) for input as f_file_1
			y_i=0
			block		= 0
			def_block       = 0
			do until eof(f_file_1)
				line input #f_file_1, a_s
				y_i= y_i + 1
				if y_i = 1 then		
					' EF BB BF steht für UTF-8
					if asc(mid$(a_s, 1, 1 )) = 239 and asc(mid$(a_s, 2, 1 )) = 187 and asc(mid$(a_s, 3, 1 )) = 191 then
						print 		 " <UTF8>"
						a_s = mid$(a_s, 4)
						goto m099
					end if

					' FF FE steht für UTF-16, little endian
					if asc(mid$(a_s, 1, 1 )) = 255 and asc(mid$(a_s, 2, 1 )) = 254 then
						print 		 " <UTF-16, little endian>"
						a_s = mid$(a_s, 3)
						goto m099
					end if

					print " <ASCII>"
M099:				end if

'--------------------------------------------------------------------------------
				if len(a_s) = 0 then goto m100	'leerzeile überspringen
	
'--------------------------------------------------------------------------------
				a_i = instr(a_s,"'")
				if a_i = 1 then goto m100	'REM zeile überspringen
				a_s = mid$(a_s, 1, a_i - 1)	'REM abschneiden
	
'--------------------------------------------------------------------------------
				if instr(ucase(a_s),"{{") = 1 then kommentar = kommentar + 1
				if instr(ucase(a_s),"}}") = 1 then 
					if kommentar > 0 then
						kommentar = kommentar - 1
						goto m100
					else
						print "ERROR {{ fehlt."
						Print #f_file_x, "ERROR {{ fehlt."
						goto m900
					end if
				end if
				if kommentar > 0 then goto m100

'--------------------------------------------------------------------------------
				a_s = rtrim(a_s)
	
'--------------------------------------------------------------------------------
				if instr(ucase(a_s),"CON") = 1 then block = 1
				if instr(ucase(a_s),"DAT") = 1 then block = 2
				if instr(ucase(a_s),"OBJ") = 1 then block = 3 : goto m100
				if instr(ucase(a_s),"VAR") = 1 then block = 4
				if instr(ucase(a_s),"PUB") = 1 then block = 5
				if instr(ucase(a_s),"PRI") = 1 then block = 6
	
'--------------------------------------------------------------------------------
				if def_block > 0 then
					if instr(ucase(a_s),"#ENDDEF") = 1 then
						a_s = ucase(trim(mid$(a_s, 8)))
						if def_name = a_s then
							def_block = 0
							def_name = ""
							goto m100
						end if				        
					end if
				end if

'--------------------------------------------------------------------------------
				if def_block = 0 then 
					if instr(ucase(a_s),"#IFDEF") = 1 then
						a_s = ucase(trim(mid$(a_s, 7)))
						for x_i = 0 to max_dio
							if define_stack(x_i, 0) = a_s then
								define_stack(x_i, 1) = "X"	' benutzt
								def_block = 2			' ausgeben
								def_name = a_s
								goto m100
							end if
						next x_i
						def_block = 1					' nicht ausgeben
						def_name = a_s
						goto m100				        ' Überspringen da nicht deffiniert
					end if
				end if

'--------------------------------------------------------------------------------
				if def_block = 0 then
					if instr(ucase(a_s),"#IFNDEF") = 1 then
						a_s = ucase(trim(mid$(a_s, 8)))
						for x_i = 0 to max_dio
							if define_stack(x_i, 0) = a_s then
								def_block = 1			' nicht ausgeben
								def_name = a_s
								goto m100
							end if
						next x_i
						def_block = 2					' ausgeben
						def_name = a_s
						goto m100
					end if
				end if

'--------------------------------------------------------------------------------
				if def_block = 1 then goto m100				        ' Überspringen nicht ausgeben

'--------------------------------------------------------------------------------
				if instr(ucase(a_s),"#DEFINE") = 1 then
					a_s = ucase(trim(mid$(a_s, 8)))
					for x_i = 0 to max_dio
						if define_stack(x_i, 0) = a_S then goto m100
						if define_stack(x_i, 0) = "" then
							define_stack(x_i, 0) = a_s
							x_i = max_dio + 1
							new_obj	= true
							goto m100
						end if
					next x_i
				end if
	
'--------------------------------------------------------------------------------
				if instr(ucase(a_s),"#INCLUDE") = 1 then
					a_s = trim(mid$(a_s, 9))
					for x_i = 0 to max_dio
						if obj_stack(x_i,0) = a_S then goto m100
						if obj_stack(x_i,0) = "" then
							obj_stack(x_i,0) = a_S
							obj_stack(x_i,1) = "inc"
							x_i = max_dio + 1
							new_obj	= true
							goto m100
						end if
					next x_i
				end if
	
'--------------------------------------------------------------------------------
				if block = 3 then	'Objekte einlesen
					a_s = trim(a_s)
					a_s = mid$(a_s,instr(a_s, ":") + 1)
					a_s = trim(a_s)
					for x_i = 0 to max_dio
						if obj_stack(x_i,0) = a_S then goto m100
						if obj_stack(x_i,0) = "" then
							obj_stack(x_i,0) = a_S
							obj_stack(x_i,1) = "obj"
							x_i = max_dio + 1
							new_obj	= true
						end if
					next x_i
				end if
	
'--------------------------------------------------------------------------------
				print #f_file_x, a_s
	
'--------------------------------------------------------------------------------
m100:
			loop
		close f_file_1
		close f_file_x
		if kommentar <> 0 then
			print "Fehler in {{}}} Strucktur!"
			end
		end if
		if def_block =1 then
			print "Fehler in #if Strucktur! " ; def_name
			end
		end if
		sleep 100				' 1/10 Secunde warten
	
'-----------------------------------------------------------------------
	next
m101:
loop Until (new_obj = false)	' Verlassen wenn keine neuen Elemente gefunden.
print "Ready"

'-----------------------------------------------------------------------
M900:
print "--- Defines -------------------------------------------"
For a_i = 0 to max_dio
	if define_stack(a_i,0) <> "" then print define_stack(a_i,0), define_stack(a_i,1)
next a_i

print "--- Includes / OBJ ------------------------------------"
For a_i = 0 to max_dio
	if obj_stack(a_i,0) <> "" then print obj_stack(a_i,0), " ";obj_stack(a_i,1)
next a_i

print "press key to exit."
input ">", a_s
end 0