Code : Tout sélectionner
;******************************************
;* Convertisseur de code C vers PureBasic *
;* C->PureBasic converter *
;* Comme nom, je propose : "GoodByeC" *
;* I propose to call it "GoodByeC" *
;* par/by Zapman *
;******************************************
;{ NOTE :
; Dans sa version actuelle, ce traducteur n'a été testé et mis au point que sur les headers.
; Le résultat de son travail est déjà bien meilleur que celui des programmes « Header converter »
; et « Interface Importer » fournis avec PureBasic (c'était pas difficile).
;
; L'objectif est d'arriver à une traduction complètement opérationnelle de n'importe quel code
; écrit en C.
;
;
; Un point délicat venait du fait que PureBasic n'accepte pas les « définitions intermédiaires »
; alors que le C les accepte. Je ne sais pas si le terme de « définition intermédiaire » est bien
; choisi, je veux parler des définitions comme celle-là :
;
; ```C
; #define DMUS_PMSG_PART \
; DWORD dwSize; \
; REFERENCE_TIME rtTime; /* real time (in 100 nanosecond increments) */ \
; MUSIC_TIME mtTime; /* music time */ \
; DWORD dwFlags; /* various bits (see DMUS_PMSGF_FLAGS enumeration) */ \
; DWORD dwPChannel; /* Performance Channel. The Performance can */ \
; /* use this To determine the port/channel. */ \
; DWORD dwVirtualTrackID; /* virtual track ID */ \
; IDirectMusicTool* pTool; /* tool interface pointer */ \
; IDirectMusicGraph* pGraph; /* tool graph interface pointer */ \
; DWORD dwType; /* PMSG type (see DMUS_PMSGT_TYPES defines) */ \
; DWORD dwVoiceID; /* unique voice id which allows synthesizers to */ \
; /* identify a specific event. For DirectX 6.0, */ \
; /* this field should always be 0. */ \
; DWORD dwGroupID; /* Track group id */ \
; IUnknown* punkUser; /* user com pointer, auto released upon PMSG free */
;
; /* every DMUS_PMSG is based off of this structure. The Performance needs
; To access these members consistently in every PMSG that goes through it. */
; typedef struct _DMUS_PMSG
; {
; /* begin DMUS_PMSG_PART */
; DMUS_PMSG_PART
; /* End DMUS_PMSG_PART */
; } DMUS_PMSG;
; ```
;
; Dans cet exemple, la structure « _DMUS_PMSG » va comporter tous les membres déclarés dans
; « DMUS_PMSG_PART ». En fait, au moment de la compilation, le terme « DMUS_PMSG_PART » qui
; figurait dans « _DMUS_PMSG » est purement et simplement remplacé par sa définition.
;
; Pour arriver au même résultat, GoodByeC va remplacer DMUS_PMSG_PART par sa définition au cours
; de la traduction.
;
;
; Un autre point délicat venait du fait que le C accepte des définitions de structures à l'intérieur
; de définitions de structures. Par exemple :
;
; ```C
; typedef struct tagMIXERCONTROLW {
; DWORD cbStruct;
; DWORD dwControlID;
; DWORD dwControlType;
; DWORD fdwControl;
; DWORD cMultipleItems;
; WCHAR szShortName[MIXER_SHORT_NAME_CHARS];
; WCHAR szName[MIXER_LONG_NAME_CHARS];
; union {
; struct {
; LONG lMinimum;
; LONG lMaximum;
; }_STRUCT_NAME(s);
; struct {
; DWORD dwMinimum;
; DWORD dwMaximum;
; }_STRUCT_NAME(s1);
; DWORD dwReserved[6];
; } Bounds;
; union {
; DWORD cSteps;
; DWORD cbCustomData;
; DWORD dwReserved[6];
; } Metrics;
; } MIXERCONTROLW,*PMIXERCONTROLW,*LPMIXERCONTROLW;
; ```
;
; Dans un cas comme celui-là, GoddByeC va déclarer en premier les sous-structures puis la structure
; principale.
;
;
; L'un des autres points délicats venait du fait que PureBasic n'accepte pas les constantes
; calculées à partir de fonctions alors que le C les accepte. Exemple :
;
; ```C
; #define MAKEFOURCC(c0,c1,c2,c3) ((DWORD)(BYTE)(c0)|((DWORD)(BYTE)(c1)<<8)|((DWORD)(BYTE)(c2)<<16)|((DWORD)(BYTE)(c3)<<24))
; #define FOURCC_RIFF MAKEFOURCC('R', 'I', 'F', 'F')
; ```
;
; Il a fallut écrire un petit interpréteur qui calcule le résultat d'une fonction telle que celle-là
; afin de mettre le résultat dans la déclaration de constante.
;
; D'autre part, GoodByeC crée simultanément une fonction sous la forme
;
; ```PureBasic
; Procedure.l MAKEFOURCC(c0.b,c1.b,c2.b,c3.b)
; ProcedureReturn ( c0 |( c1<< 8) |( c2<< 16) |( c3<< 24))
; EndProcedure
; ```
;
; Note de Naheulf : Cette définition semble plutôt être celle d'une macro. En C, les constantes
; doivent être déclarées avec le mot clef « const ».
;
;
; Encore un point particulier : un programme en C démarre « tout nu », c'est à dire sans aucune
; structure ou interface existante, alors que PureBasic est équipé de ses librairies qui
; « pré-déclarent » tout un ensemble de structures et d'interfaces. Pour éviter les messages
; « 'Structure' already declared : xxx » et « 'Interface' already declared : xxx », GoodByeC va :
; - recenser les structures et interfaces pré-existantes (une session du compilateur est
; démarrée, puis GoodByeC interroge le compilateur pour lui demander de lui fournir la
; liste des structures et interfaces existantes. Ces listes sont rangées dans les tableaux
; TExistingStruct et TExistingInterfaces et ces tableaux sont complétés avec les structures
; et les interfaces rencontrées au fur et à mesure de la traduction du code C)
; - supprimer ces structures et interfaces (inutiles puisqu'elles existent déjà) du code traduit.
;
; Les constantes déjà présentes dans les librairies PureBasic et déclarées dans le code à traduire
; avec une autre valeur sont renommées. La liste des constantes renommées est affichée au début du
; code résultant de la traduction.
;
;
;
; Reste à régler :
; - [ ] Certaines structures devront aussi être renommées puisqu'un programme C peut déclarer
; une Structure portant le même nom qu'une structure de PureBasic sans comporter
; obligatoirement les mêmes champs.
; - [ ] Idem pour les interfaces.
; - [ ] Mettre en place un « tableau d'équivalence » qui permettra de dire :
; « Quand tu rencontre tel nom, remplace le par tel autre nom. »
; Ce tableau permettra de gérer :
; - les noms de constantes, déclarée "Nomconstante" en C et "#NomConstante" en PureBasic
; - les noms des GUIDs, déclarés sous la forme « ?NomduGUID » en PureBasic (étant donné
; qu'ils sont déclarés sous forme de Datas)
; - Les constantes, les structures et les interfaces renommées
; - [ ] Gérer les "#include", "#pragma", etc.
;
; Continuer à tester GoodByeC sur d'autres headers, puis sur du code complet pour régler
; les 300 000 cas de figure que je n'ai pas encore rencontré.
;}
IncludeFile "PBCompiler.pbi"
#Test=0 ; Si on met 1, le texte source est pris à partir du presse papier et le programme
; n'essaye pas d'ouvrir un fichier sur le disque. Cela m'a fait gagner beaucoup de temps
; pendant les tests : je garde mon texte source dans une fenêtre en arrière plan et
; je copie des morceaux de code un par un pour tester le résultat de la traduction.
;
; If you choose 1, the original text is took from the clipboard instead of from a file
; that you must open. This is very usefull to make tests. You keep the original in
; a background window and you just copy parts of it to test the conversion.
While GetKeyState_(#VK_LMENU)<0 ; si on appelé ce programme à l'aide d'une touche de fonction,
Delay(10) ; on attend que l'utilisateur relache la touche
Wend ; If the prog have been called with a fonction key
; we'll wait until its released.
;
;- Arrays
;
Dim TWord.s (200)
Dim TSpace.l (200)
Dim TDefN.s (100)
Dim TDefD.s (100)
Dim TArg.s (40)
Dim TTyArg.s (40)
Dim TCTypes.s (50)
Dim TPBTypes.s (50)
Dim TFcn.s (1000)
Dim TFcnDef.s (1000)
Dim TFcnType.s (1000)
Dim TFcnArg.s (1000)
Dim TFcnArgType.s (1000)
Dim TLevStruct.s (30)
Dim TNameStruct.s (30)
Dim TAutoNameStruct.l (30)
Dim TExistingStruct.s (2000) ; Structures déjà présentes
Dim TExistingInterface.s(2000)
Global ttFcn.l, ; Total Functions
ttES.l, ; Total Existing Structures
ttEI.l, ; Total Existing Interfaces
ttTypes.l
;
;
;*************************************************************
;* On demarre une session du compiler pour pouvoir *
;* communiquer avec lui et obtenir la liste des fonctions, *
;* structures et interfaces déjà installées dans les *
;* librairies de PureBasic *
;* We start a new session of the compiler to be able to talk *
;* with it and get the existing interfaces and structures *
;* list *
;*************************************************************
;- Files - ReadFile
#READFILE_LOCALIZE = 1
#READFILE_LOADBASICFUNCTION = 2
#READFILE_STRUCTURESLISTINGREQUEST = 3
#READFILE_STRUCTUREINFOREQUEST = 5
#READFILE_LOADSOURCECODEREAL = 6
#READFILE_PB_MSG_FATAL_ERROR = 7
#READFILE_PB_MSG_SYNTAX_ERROR = 8
#READFILE_PB_MSG_PURECOMMAND = 9
#READFILE_SearchInFiles = 10
#READFILE_LOADAPIFUNCTION = 11
;- Files - CreateFile
#CREATEFILE_ADDTOOLS_SAVETEMPFILE = 20
#CREATEFILE_SAVESOURCECODE = 21
#CREATEFILE_COMPILERUN = 22
#CREATEFILE_CREATEEXECUTABLE = 23
#CREATEFILE_HELP = 24
#CREATEFILE_STRUCTUREINFOREQUEST = 25
Global PB_MSG_ID,CompilerThreadID
#PB_MSG_START_COMPILATION = 10156
#PB_MSG_COMPILER_READY = 10157
#PB_MSG_QUIT = 10158
#PB_MSG_SYNTAX_ERROR = 10160
#PB_MSG_COMPILATION_FINISHED = 10161
#PB_MSG_RUN_PROGRAM = 10162
#PB_MSG_CREATE_EXECUTABLE = 10163
#PB_MSG_IS_PURECOMMAND = 10164
#PB_MSG_FATAL_ERROR = 10165
#PB_MSG_EDITOR_READY = 10166
#PB_MSG_STRUCTURES_LISTING = 10167
#PB_MSG_STRUCTURE_INFO = 10168
#PB_MSG_Assembler_Error = 10169
#PB_MSG_Linker_Error = 10170
#PB_MSG_Interfaces_Listing = 10171
#PB_MSG_Interface_Info = 10172
#PB_MSG_Resource_Error = 10173
#PB_MSG_Restart_Compiler = 10174
#PB_FLG_INLINEASM = 1
#PB_FLG_ENABLENT4 = 1 << 1
#PB_FLG_DEBUGGER = 1 << 2
#PB_FLG_CONSOLE = 1 << 3
#PB_FLG_DLL = 1 << 4
#PB_FLG_ENABLEXP = 1 << 5
#PB_FLG_CPU_MMX = 1 << 6
#PB_FLG_CPU_3DNOW = 1 << 7
#PB_FLG_CPU_SSE = 1 << 8
#PB_FLG_CPU_SSE2 = 1 << 9
#PB_FLG_CPU_DYNAMIC = 1 << 10
#PB_FLG_ENABLEONERROR = 1 << 11
;
; Démarrage d'une nouvelle session du compilateur afin de pouvoir dialoguer avec lui
; Starting of a new session of the compiler to be able to talk with it
;
FullPath.s = GetTemporaryDirectory()+"GoodByeC\"
If FileSize(FullPath) <> -2
CreateDirectory(FullPath)
EndIf
If FileSize(FullPath+"Compilers\") <> -2
CreateDirectory(FullPath+"Compilers\")
EndIf
If FileSize(FullPath+"Compilers") <> -2
MessageRequester("GoodByeC", "Unable to create temporary directory")
End
EndIf
SharedFileName.s = FullPath+"Compilers\Communication.msg"
#MainWindow = 30
OpenWindow(#MainWindow, 0, 0, 190, 20, "GoodByeC", #PB_Window_ScreenCentered | #PB_Window_TitleBar)
CompilerIf #PB_Compiler_Version < 430
If CreateGadgetList(WindowID(#MainWindow))
TextGadget (1, 2, 2, 188, 18, "Loading.")
EndIf
CompilerElse
TextGadget (1, 2, 2, 188, 18, "Loading.")
CompilerEndIf
;TODO Ajouter un timeout de 2000ms
CompilerPath$ = #PB_Compiler_Home +"Compilers\PBCompiler.exe"
Parameters.s = "/STANDBY" + #TAB$
CompilerProcessID = PBCompiler::CompilerStart(CompilerPath$, Parameters, "", #PB_Program_Hide)
If CompilerProcessID <> 0
CompilerThreadID = -1 ;TODO Supprimer cette valeur bidon temporaire pour passer les anciennes conditions
Else
CError = 1
EndIf
;
; Demande la liste des structures existantes
; Get the existing structures
;
SetGadgetText(1, "Loading..")
ttES = PBCompiler::GetStructureList(TExistingStruct()) ; Les tableaux sont passés par référence.
;
; Demande la liste des interfaces existantes
; Get the existing interfaces
;
SetGadgetText(1, "Loading...")
ttEI = PBCompiler::GetInterfaceList(TExistingInterface()) ; Les tableaux sont passés par référence.
If ttES=0
;MessageRequester("Error","Impossible to start a new compiler session !!",#PB_MessageRequester_Ok)
MessageRequester("Erreur","Impossible de lancer une session du compiler !!",#PB_MessageRequester_Ok)
EndIf
Procedure.s TestProg(ToTest.s)
; Envoie un programme au compiler pour voir s'il compile correctement
; Send a program to the compiler to see if it's well compiled
Shared SharedFileName, FullPath, CompilerProcessID
If CompilerProcessID
; Écriture du code source dans un fichier temporaire
TestFile.s = FullPath + "Compilers\PB_EditorOutput.pb"
If CreateFile(1, TestFile)
WriteStringN(1, ToTest)
CloseFile(1)
Else
MessageRequester("GoodBye C", "Impossible de créer le fichier de test !" + Chr(10) + TestFile)
End
EndIf
; Lancement de la compilation du programme
PBCompiler::SetSource(TestFile)
PBCompiler::SetIncludePath(FullPath)
PBCompiler::BeginCompilation("XPSKIN");TODO Voir comment transmettre les infos de compilation
; Analyse du résultat
ReadString(#READFILE_PB_MSG_SYNTAX_ERROR)+Chr(10)+ReadString(#READFILE_PB_MSG_SYNTAX_ERROR) ; 2 lines are possible
Repeat
OutLine$ = PBCompiler::CompilationMessage()
MessageType$ = StringField(OutLine$, 1, #TAB$)
Select MessageType$
Case "WARNING" ; PB 4.30 and newer
Debug OutLine$ + #CRLF$ + PBCompiler::CompilationMessage(#True)
Debug #PB_Compiler_Filename + #PB_Compiler_Procedure + #PB_Compiler_Line
;TODO Use callback to inform warning
Case "ERROR"
MessageSubType$ = StringField(OutLine$, 2, #TAB$)
ErrorDescription$ = OutLine$ + #CRLF$ + PBCompiler::CompilationMessage(#True)
Select MessageSubType$
Case "SYNTAX"
LineError = Val(StringField(OutLine$, 3, #TAB$))
If LineError > -1
Result.s = "Line " + Str(LineError) + ": " + ErrorDescription$ ; 'Line XXX: Error XX'
EndIf
Default
MessageRequester("PureBasic - Compiler Error", ErrorDescription$, #MB_ICONERROR)
PBCompiler::CompilerStop() ;TODO Create "exit" function to do this.
End
EndSelect
Debug ErrorDescription$
Debug #PB_Compiler_Filename + #PB_Compiler_Procedure + #PB_Compiler_Line
;TODO do somthing before return
Case "SUCCESS"
Result.s = "OK"
Debug OutLine$
Default ; To handle future features
Debug "Future output : " + OutLine$
;TODO Use callback again
EndSelect
Until MessageType$ = "SUCCESS" Or MessageType$ = "ERROR"
Else
CError = 1
EndIf
If CError
Result.s = "NotTested"
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s IsAFonction(ToTest.s) ; Pas/plus utilisé !?
; Demande au compiler si "ToTest" est une fonction connue
; Ask to the compiler if "Totest" is a known fonction
Shared SharedFileName,FullPath
If CompilerThreadID
CError = 0
If CreateFile(#CREATEFILE_HELP, SharedFileName)
WriteString(#CREATEFILE_HELP, ToTest)
CloseFile(#CREATEFILE_HELP)
PostThreadMessage_(CompilerThreadID, PB_MSG_ID, #PB_MSG_Is_PureCommand, 0)
Else
CError = 1
EndIf
If CError = 0
CAnswer = 0
Timer = 0
Repeat
If WindowEvent()=PB_MSG_ID And EventwParam() = #PB_MSG_IS_PURECOMMAND
CAnswer = 1
Select EventlParam()
Case 1 ; Build in command (including user one), not an API one.
Result.s = "BuildInFonction" ;TODO FUNCTIONLIST
Case 2
Result = "APIFunction" ;TODO IMPORTLIST
Default
Result = "NotAFunction"
EndSelect
EndIf
Delay(20)
Timer + 20
If Timer >= 2000 ; ms
CError = 1
EndIf
Until CAnswer Or CError
EndIf
Else
CError = 1
EndIf
If CError
Result = "NotTested"
EndIf
ProcedureReturn Result
EndProcedure
Global mode$ , dtw.l, ProgText.s, EndL.l, StartL.l, com.l,dcom.l,defmode.l,NbVirg,SSpace.l,LastChar.s,EndOfLine.s
#CRLF$ = Chr(13)+Chr(10)
#LF$ = Chr(10)
#CJustAfter="^~$%!§:?/\{}()[]=+-*&|><"
DataSection
; Equivalences between C types and PB types
CTypes:
Data.s "." ; <-this must be at the beggining of the list
Data.s ".l","DWORD","LONG","ULONG","BOOL","LPCSTR","LPCWSTR","STRING","." ; <-this must be at the end of the line
Data.s ".w","WORD","UWORD","INT","UINT","SHORT","USHORT","WCHAR","."
Data.s ".b","BYTE","CHAR","UCHAR","."
Data.s ".End" ; <-this must be at the end of the list
EndDataSection
Restore CTypes
tr$="" ; tr$ <=> typeRead$ ?
ttTypes = 0 ; ttTypes : total types count
Repeat
Read.s tr$
If tr$="."
Read.s PBType$ ; ".l"
Else
ttTypes + 1
TPBTypes(ttTypes)=PBType$
TCTypes(ttTypes)=tr$
EndIf
Until PBType$=".End"
; TCTypes = ["DWORD","LONG","ULONG","BOOL","LPCSTR","LPCWSTR","STRING","WORD","UWORD","INT",...]
; TPBTypes = [".l", ".l", ".l", ".l", ".l", ".l", ".l", ".w", ".w", ".w", ...]
Procedure.s ConvertCType(TypeToConvert.s)
Shared TCTypes(), TPBTypes(), TExistingStruct()
Protected LTypeToConvert.s =UCase(TypeToConvert);FIXME Les variables C sont sensibles à la casse
Protected ct = 0
Repeat
ct + 1
Until UCase(TCTypes(ct))=LTypeToConvert Or ct=ttTypes
If UCase(TCTypes(ct))=LTypeToConvert
TypeToConvert=TPBTypes(ct)
Else
ct = 0
Repeat
ct + 1
Until UCase(TExistingStruct(ct))=LTypeToConvert Or ct=ttES
If UCase(TExistingStruct(ct))=LTypeToConvert
TypeToConvert="."+TypeToConvert
EndIf
EndIf
ProcedureReturn TypeToConvert
EndProcedure
Procedure.s ComputeValue(p.l)
Shared TWord(), TFcn(), TFcnType(), TFcnArg(), TFcnArgType(), TFcnDef(), TTyArg(), TArg(), TSpace()
Shared TypeC.s,TCom.s
ToCompute.s = TWord(p)
TypeC = "."
TCom = ""
If Left(ToCompute,2)="0x"
ToCompute="$"+Right(ToCompute,Len(ToCompute)-2)
p=FindString(ToCompute,";",1)
If p
ToCompute=Left(ToCompute,p-1)
tcom=Right(ToCompute,Len(ToCompute)-p+1)
EndIf
If FindString("L",Right(ToCompute,1),1)
TypeC="."+LCase(Right(ToCompute,1))
ToCompute=Left(ToCompute,Len(ToCompute)-1)
EndIf
If ToCompute = "$"
ToCompute = "$0"
EndIf
Else
BadStart.s=#CJustAfter+".;,# 0123456789"+Chr(9)+Chr(34)
If FindString(BadStart,Left(ToCompute,1),1) <>0
leftpart.s=Left(ToCompute,Len(ToCompute)-1)
p=FindString(ToCompute,";",1)
If p
ToCompute=Left(ToCompute,p-1)
tcom=Right(ToCompute,Len(ToCompute)-p+1)
EndIf
If Str(Val(leftpart))= leftpart
If FindString("LBWF",Right(ToCompute,1),1)
TypeC="."+LCase(Right(ToCompute,1))
ToCompute=leftpart
EndIf
EndIf
Else
nt$=ConvertCType(ToCompute)
If nt$<>ToCompute ;it's a type declaration
TypeC = nt$
Else
Found = 0
For ct =1 To ttFcn
If TFcn(ct)=ToCompute
Found = ct
ct = ttFcn
EndIf
Next
If found
TypeC = TFcnType(found)
cont=1
While cont ; Delete blanks
cont=0
For ct=p To dtw
If TWord(ct)="" And TWord(ct+1)
TWord(ct)=TWord(ct+1)
cont=1
EndIf
Next
Wend
pt=p
LArg.s=TFcnArg(found)
LTArg.s=TFcnArgType(found)
tx.s=TFcnDef(found)
pa = 0
While LArg<>""
pp=FindString(LArg,",",1)
If pp=0
pp=Len(LArg)+1
EndIf
arg.s=Left(LArg,pp-1)
LArg=Right(LArg,Len(LArg)-pp)
pp=FindString(LTArg,",",1)
If pp=0
pp=Len(LTArg)+1
EndIf
Targ.s=Left(LTArg,pp-1)
pa + 1
TTyArg(pa)=Targ ; to redistribute the types to FonctionDeclaration()
TArg(pa)=arg ; to redistribute the arguments to FonctionDeclaration()
LTArg=Right(LTArg,Len(LTArg)-pp)
pt + 1
While TWord(pt)="(" Or TWord(pt)=")"
pt+1
Wend
Arcl.s=TWord(pt)
If Left(Arcl,1)=Chr(34)
Arcl=Right(Arcl,Len(Arcl)-1)
If Right(Arcl,1)=Chr(34)
Arcl=Left(Arcl,Len(Arcl)-1)
EndIf
If TArg=".b" And Len(Arcl)=1
Arcl=Str(Asc(Arcl))
EndIf
EndIf
p2=1
cont=1
While cont
cont=0
pp=FindString(tx,arg,p2)
If pp>0
bchar.s=Mid(tx,pp-1,1)
If FindString(#CJustAfter+" ,;#",bchar,1)=0
cont=1
p2=pp+1
EndIf
bchar.s=Mid(tx,pp+Len(arg)+1,1)
If FindString(#CJustAfter+" ,;#",bchar,1)=0
cont=1
p2=pp+1
EndIf
EndIf
Wend
If pp
tx=Left(tx,pp-1)+Arcl+Right(tx,Len(tx)-(pp+Len(arg)-1))
EndIf
Wend
For ct=p+1 To dtw
If TWord(ct)=""
ct=100
Else
If Left(TWord(ct),1)=";"
TWord(ct)=" / "+Right(TWord(ct),Len(TWord(ct))-1)
EndIf
TWord(p)=TWord(p)+TWord(ct)
TWord(ct)=""
TSpace(ct)=0
EndIf
Next
ToCompute=tx
tcom="; "+TWord(p)
Else
If p>2 And TWord(p-1)="*" And (Right(RTrim(TWord(p-2)),1)="=" Or Right(RTrim(TWord(p-2)),1)="(") ; pointer, not multiply !
TWord(p-1)=""
ToCompute ="*"+TWord(p)
Else
ToCompute = "#"+ToCompute
EndIf
p=FindString(ToCompute,";",1)
If p
tcom=Right(ToCompute,Len(ToCompute)-p+1)
ToCompute=Left(ToCompute,p-1)
EndIf
EndIf
EndIf
EndIf
EndIf
ProcedureReturn ToCompute
EndProcedure
Procedure.s FindStructName()
Shared TExistingStruct()
l=0
deb = 1
p=1
ps=StartL
While (l Or deb) And p
deb = 0
p=FindString(ProgText,"}",ps)
p2=FindString(ProgText,"{",ps)
If p2<p And p2>0
l + 1
ps=p2+1
Else
l - 1
ps=p+1
EndIf
Wend
ns.s=""
If p>0
p2 = FindString(ProgText,";",p) ; on cherche le prochain ";" - look for the next ";"
If p2=0
p2=Len(Progtext)+1
EndIf
ns = Mid(Progtext,p+1,p2-p-1)
ns = LTrim(ns)
Before.s = #CJustAfter+",'#"+" ;"+Chr(9)
p = 0
For pt = 1 To Len(Before)
p2=FindString(ns,Mid(Before,pt,1),1)
If (p2<p Or p=0) And p2>0
p=p2
EndIf
Next
If p
ns=Left(ns,p-1)
EndIf
EndIf
cont = 1
While cont
cont = 0
For ct = 1 To ttES
If TExistingStruct(ct)=ns
ns=ns+"n"
cont = 1
EndIf
Next
Wend
ProcedureReturn ns
EndProcedure
Procedure.s ReadNextLine ()
EndL = FindString(ProgText,#CRLF$,StartL) ; on cherche le prochain retour chariot - look for the next line feed
l = Len(#CRLF$)
p = FindString(ProgText,#LF$,StartL) ; on cherche le prochain retour chariot - look for the next line feed
If (p<EndL Or EndL=0) And p<>0
EndL = p
l = Len(#LF$)
EndIf
If EndL=0
EndL=Len(ProgText)+1
EndIf
RLine$ = Mid(ProgText,StartL,EndL-StartL)
mStartL=StartL
StartL=EndL+l
SSpace= Len(RLine$)
RLine$ = LTrim(RLine$)
While Left(RLine$,1)=";"
RLine$ = Right(RLine$,Len(RLine$)-1)
Wend
RLine$ = LTrim(RLine$)
SSpace=SSpace-Len(RLine$)
While(Right(RLine$,1)=" ")
RLine$=Left(RLine$,Len(RLine$)-1)
Wend
; Get the last character of the string
c2.s = RLine$
p=FindString(RLine$,"/*",1) ; If there is a commentary, we'll take the last character before it
p2=FindString(RLine$,"//",1)
AfterCom.s=""
If (p2<p Or p=0) And p2
p=p2
Else
p2=FindString(RLine$,"*/",p)
If p2
AfterCom.s=Trim(Right(RLine$,Len(RLine$)-p2-2))
EndIf
EndIf
EndOfLine=""
p2=FindString(RLine$,"{",2) ; if there is { or } into the line, we send it to the next line
p3=FindString(RLine$,"}",2)
If (p3<p2 Or p2=0) And p3
p2=p3
EndIf
RLine$=RTrim(RLine$)
If (p2<p Or p=0) And p2
EndL=EndL-(Len(RLine$)-p2+1)
StartL=EndL
RLine$=Left(RLine$,p2-1)+AfterCom
Else
If p
Line2$=Left(RLine$,p-1)
EndOfLine=Right(RLine$,Len(RLine$)-Len(Line2$))
RLine$=Line2$+AfterCom
EndIf
EndIf
LastChar=Right(RLine$,1)
If Left(RLine$,1)="{" And RLine$<>"{"
RLine$="{"
EndL=mStartL+SSpace+1
StartL=EndL
LastChar=RLine$
EndOfLine=""
EndIf
ProcedureReturn RLine$
EndProcedure
Procedure FonctionDeclaration()
Shared TSpace(), TWord(), TArg(), TTyArg(), TFcn(), TFcnType(), TFcnArg(), TFcnArgType(), TFcnDef()
TWord(1)=""
p=3
While TWord(p)<>")" And p<dtw ; is it a fonction ?
p + 1
Wend
op=FindString(#CJustAfter+";",Left(TWord(p+1),1),1)
If TWord(p)=")" And (op=0 Or Left(TWord(p+1),1)="(") And p<dtw ; yes, it is.
TWord(3)= ""
returnty.s=""
ttarg = 0
p = 4
While TWord(p)<>")" And p<dtw ; find the arguments
ttarg + 1
TArg(ttarg)=TWord(p)
TWord(p) = ""
p + 1
Wend
If TWord(p)=")"
TWord(p)=""
EndIf
TLCom.s=""
While p<dtw
While (TWord(p)="(" Or TWord(p)=")") And p<dtw
p + 1
Wend
found = 0
pa = 0
While found = 0 And pa<ttarg ; find the types of the arguments
pa + 1
If TWord(p)= TArg(pa)
found = 1
If TWord(p-1)="("
TWord(p-1)=""
TSpace(p-1)=0
EndIf
If TWord(p+1)=")"
TWord(p+1)=""
TSpace(p+1)=0
EndIf
EndIf
Wend
If found
mp = p
p - 1
While (TWord(p)="(" Or TWord(p)=")" Or TWord(p)="") And p>1
p - 1
Wend
tyPB.s=ConvertCType(TWord(p))
If Left(tyPB,1)="."
returnty=tyPB
TTyArg(pa)=tyPB
TWord(p) = ""
If TWord(p-1)="("
TWord(p-1)=""
TSpace(p-1)=0
EndIf
If TWord(p+1)=")"
TWord(p+1)=""
TSpace(p+1)=0
EndIf
EndIf
p - 1
While (TWord(p)="(" Or TWord(p)=")" Or TWord(p)="") And p>1
p - 1
Wend
tyPB.s=ConvertCType(TWord(p))
If Left(tyPB,1)="."
returnty=tyPB
TWord(p) = ""
If TWord(p-1)="("
TWord(p-1)=""
TSpace(p-1)=0
EndIf
If TWord(p+1)=")"
TWord(p+1)=""
TSpace(p+1)=0
EndIf
EndIf
p = mp
Else
If TWord(p)
TWord(p)=ComputeValue(p)
If TypeC.s<>"."
returnty=TypeC
EndIf
TLCom=TLCom+TCom.s
EndIf
EndIf
p + 1
Wend
ptFcn=0
Repeat
ptFcn + 1
Until ptFcn=ttFcn Or TFcn(ptFcn) = TWord(2)
If TFcn(ptFcn) <> TWord(2)
ttFcn + 1
ptFcn = ttFcn
EndIf
TFcn(ptFcn) = TWord(2)
TFcnType(ptFcn)=returnty
TFcnArg(ptFcn) = ""
TFcnArgType(ptFcn ) = ""
TWord(2)="Procedure"+returnty+" "+TWord(2)+"("
For t = 1 To ttarg
If t>1
TFcnArg(ptFcn)=TFcnArg(ptFcn)+","
TFcnArgType(ptFcn)=TFcnArgType(ptFcn)+","
TWord(2) = TWord(2)+","
EndIf
TFcnArg(ptFcn)=TFcnArg(ptFcn)+TArg(t)
TFcnArgType(ptFcn)=TFcnArgType(ptFcn)+TTyArg(t)
TWord(2) = TWord(2)+TArg(t)+TTyArg(t)
Next
p = 3
While TWord(p)=""
p+1
Wend
TFcnDef(ptFcn) =""
While p<dtw+1
TFcnDef(ptFcn) = TFcnDef(ptFcn)+TWord(p)
p+1
Wend
TWord(2)=TWord(2)+")"+#LF$+" ProcedureReturn "
dtw=dtw+1
TWord(dtw)=TLCom+#LF$+"EndProcedure"
TSpace(1) = 0
TSpace(2) = 0
Result = 1
Else
Result = 0
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s CutTheLine()
Shared TSpace(), TWord()
NbVirg =0
verifvirg=0
dcom = 0
RLine$ = ReadNextLine()
TSpace(1)= SSpace.l
TCom.s = EndOfLine.s
While (LastChar.s="," And mode$<>"enum") Or LastChar="("
RLine$ = RLine$ + ReadNextLine()
TCom = TCom + EndOfLine
Wend
l=StartL
While Mid(ProgText,l,1)=" "
l+1
Wend
If Mid(ProgText,l,1)=")"
RLine$ = RLine$ + ReadNextLine()
TCom = TCom + EndOfLine
EndIf
RLine$ = RLine$ + TCom
dtw.l=0
If com
p = FindString(RLine$,"*/",1)
If p
com = 0
RLine$ = ReplaceString(RLine$, "*/", "")
EndIf
RLine$ = ReplaceString(RLine$, "/*", "")
RLine$ = ";"+RLine$
Else
If LastChar="\"
Defmode = 1
EndIf
While RLine$ ; Nous allons découper la ligne et ranger chaque morceau dans le tableau TWord
; We'll cut the line and put each part in the TWord array
; #CJustAfter contient les séparateurs principaux $%!§:?/\{}()[]=+-*&|><
; #CJustAfter is filled with the main separators $%!§:?/\{}()[]=+-*&|><
dtw + 1
If Left(RLine$,1)="'"
p=FindString(RLine$,"'",2)+1 ; The string inside ' and ' must be took as one piece.
If p<2
p=Len(RLine$)+1
EndIf
i=0
Else
If Left(RLine$,2)="/*"
p=FindString(RLine$,"*/",3) ; All what is inside /* and */ must be considered as one block
i=2
If p <1
dcom = 1 ; if the commentary has more than one line, we'll look after dcom
EndIf
Else
If Left(RLine$,2)="//"
p=FindString(RLine$,"//",3)
i=2
Else
i=1
Before0.s = #CJustAfter+"'#" ; we'll cut before ' and # (but not after)
Before1.s = " ;"+Chr(9) ; we'll also cut before space,tab and ; (but not after)
p = 0
For pt = 1 To Len(Before0)
p2=FindString(RLine$,Mid(Before0,pt,1),1)
If (p2<p Or p=0) And p2>1
p=p2
i=0
EndIf
Next
For pt = 1 To Len(Before1)
p2=FindString(RLine$,Mid(Before1,pt,1),1)
If (p2<p Or p=0) And p2>0
p=p2
i=1
EndIf
Next
If FindString(#CJustAfter,Left(RLine$,1),1) ; we'll cut after all the caracteres of #CJustAfter
p=2
i=0
EndIf
p2=FindString(RLine$,",",1) ; comma is a particular case
If (p2<p Or p=0) And p2>0
p=p2
i=1
NbVirg + 1 ; to know how many arguments has a fonction
verifvirg=1
EndIf
EndIf
EndIf
EndIf
If p<1
p=Len(RLine$)+1
EndIf
TWord(dtw)= Mid(RLine$,1,p-1)
l = Len(TWord(dtw))
TWord(dtw)= LTrim(TWord(dtw))
If i=2
TWord(dtw) = ReplaceString(TWord(dtw), "//", ";")
TWord(dtw) = ReplaceString(TWord(dtw), "/*", ";")
Else
TWord(dtw) = ReplaceString(TWord(dtw), "'", Chr(34))
If verifvirg=1
verifvirg=2
Else
verifvirg=0
EndIf
EndIf
If Left(TWord(dtw),2)="0x"
TWord(dtw)="$"+Right(TWord(dtw),Len(TWord(dtw))-2)
If FindString("L",Right(TWord(dtw),1),1)
TWord(dtw)=Left(TWord(dtw),Len(TWord(dtw))-1)
EndIf
If TWord(dtw) = "$"
TWord(dtw) = "$0"
EndIf
Else
ls.s = Left(TWord(dtw),1)
If ls="0" Or Val(ls)>0 ; numeric value
ty.s=Right(TWord(dtw),1)
If Val(ty)=0 And ty<>"0" ; we'll delete the type (f, b, l, etc.) not necessary for Purebasic constants
TWord(dtw) = Left(TWord(dtw), Len(TWord(dtw))-1)
EndIf
Else
If dtw>1
If (TWord(dtw-1)="*" And dtw=2)
TWord(dtw-1)="*"+TWord(dtw)
dtw - 1
EndIf
EndIf
EndIf
EndIf
TSpace(dtw)=TSpace(dtw)+l-Len(TWord(dtw))
RLine$ = Mid(RLine$,(p+i),(Len(RLine$)-p-i+1))
l=Len(RLine$)
RLine$ = LTrim(RLine$)
TSpace(dtw+1)=l-Len(RLine$)+1
While Right(TWord(dtw),1)=" " Or Right(TWord(dtw),1)="," Or Right(TWord(dtw),1)=";"
TWord(dtw) = Left(TWord(dtw),Len(TWord(dtw))-1)
TSpace(dtw+1)=TSpace(dtw+1)+1
Wend
If TWord(dtw)=""
dtw = dtw -1
EndIf
Wend
If verifvirg
NbVirg -1 ; nothing (or the just a commentary) was after the last comma, so we forget it.
EndIf
EndIf
ProcedureReturn RLine$
EndProcedure