Convertisseur C vers PureBasic -> ça commence à marcher

Sujets variés concernant le développement en PureBasic
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

dobro,

ce lien est cassé, tu l'as encore ?

http://michel.dobro.free.fr/bidouilles/GoodByeC.zip

çà m'interesse...

sinon il y a ANTLR qui a pour vocation la génération de convertisseur de langage. à voir mais faut il faut etre courageux http://www.antlr.org/download.html
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

je l'ai mis en Pure Basic V4.00 (et viré la procedure qui augmente le buffer de Strings, plus besoin avec la V4.00) :D

recupere ça la :

http://michel.dobro.free.fr/bidouilles/ ... Cv.400.zip

:D

n'oublie pas de changer le chemin de purebasic au debut :D
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

trop fort 8)

t'aurais pu le mettre en v4 - ok je sors :D

[EDIT]

ca plante à donf - l'interface avec le compilateur v4 doit etre completement différente depuis...
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

Flype a écrit :trop fort 8)

t'aurais pu le mettre en v4 - ok je sors :D

[EDIT]
t'as donc pas récupéré le dernier !!
je l'avais mis en V4.00 et chez moi ça se lance !

il ne traduit pas de code, mais il ouvre un onglet et pose le code traité
(je cherche encore ce qu'il traite d'ailleurs ! :D)

ps : je n'ai pas de listing en C, peut être ne traite t'il que les *.C ??? :?

entre temps j'avais éditer mon message ci dessus ! :D

donc la bonne version c'est :
http://michel.dobro.free.fr/bidouilles/ ... Cv.400.zip

[Edit]
harf la réponse est la :
Dans sa version actuelle, ce traducteur n'a été testé et mis au point que
; sur les headers.
[/EDIT]
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

oui oui c'est bien les .h qu'il traite - c'est ce que je veux.

merci encore dobro.

zapman a raison quand il dit que c'est un gros tas de caca
mais ca va m'aider à voir 2/3 trucs.


sinon, à la premiere ligne t'as qu'à mettre FullPath.s = #PB_Compiler_Home
Avatar de l’utilisateur
Naheulf
Messages : 191
Inscription : dim. 10/mars/2013 22:22
Localisation : France

Re: Convertisseur C vers PureBasic -> ça commence à marcher

Message par Naheulf »

Bonjour,

Est-ce que quelqu’un aurait dans un coin de son ordinateur la version 4 du script proposé par ZapMan ?

Je voudrais essayer de le mettre à jour:
- Support de la "nouvelle" interface en ligne de commande du compilateur
- Support du 64 bits

Pour commence je pense que ce sera pas mal :mrgreen: .

PS : Désolé de faire ce "petit" déterrage d'une douzaine d'années
Avatar de l’utilisateur
Naheulf
Messages : 191
Inscription : dim. 10/mars/2013 22:22
Localisation : France

MaJ du code pour version de PB plus récente (1/3)

Message par Naheulf »

J'ai mis à jour le code de Zapman du 22/04/04 - 2h42 (heure de Nouméa). Je n'ai pas pu me baser sur une version plus récente car les liens sont tous morts. Le code mis à jour tourne avec PureBasic 5.62 (x64) sous Windows. Je n'ai pas testé avec les autres versions de PB mais je pense que cela devrait pour toutes les versions >= 4.10 (introduction de la nouvelle interface du compilateur).
ÉDIT : En fait ça fonctionne à partir de la version 5.20 car j'ai utilisé les modules.

J'ai mis le code qui interagit avec le compilateur dans un fichier/module dédié.
Fichier « PBCompiler.pbi » :

Code : Tout sélectionner

DeclareModule PBCompiler
	;Structures
	Enumeration Status
		#STATUS_STOP
		#STATUS_STARTING
		#STATUS_READY
		#STATUS_COMPILING
		#STATUS_WAITING
	EndEnumeration
	
	Enumeration CompilerMessage
		#MSG_POGRESS  
			#MSG_POGRESS_INCLUDE
			#MSG_POGRESS_LINES
			#MSG_POGRESS_ASSEMBLING
			#MSG_POGRESS_LINKING
			#MSG_POGRESS_FUTURE
		#MSG_WARNING  ;PB 4.30+
		#MSG_REDIRECT ;PB 4.40+
		#MSG_SUCCESS
		#MSG_ERROR
	EndEnumeration
	
	;- Declare module procedures
	Declare.i CompilerStart(CompilerPath$ = "", Parameters$ = "", WorkingDirectory$ = "", RunProgramFlags = 0)
	Declare.i CompilerStop()
	Declare   Send(message$)
	
	;- Declare compiler commands
	Declare SetSource(SourceFile$)
	Declare SetSourceAlias(Alias$)
	Declare SetIncludePath(Path$)
	CompilerIf #PB_Compiler_OS = #PB_OS_Windows
		Declare AddResource(File$)
	CompilerEndIf
	CompilerIf #PB_Compiler_OS = #PB_OS_Windows Or #PB_Compiler_OS = #PB_OS_MacOS
		Declare SetIcon(File$)
	CompilerEndIf
	Declare SetTarget(TargetFile$)
	Declare AddConstant(Name$, Value$)
	Declare SetLinker(LinkerCommandFile$)
	Declare Compile(FlagsList$ = "")
	Declare GetFunctionList(Array FunctionList.s(1)); Functions known by the compiler. (PB functions + Userlibrary functions)
	Declare GetStructureList(Array StructureList.s(1))
	Declare GetInterfaceList(Array InterfaceList.s(1))
	CompilerIf #PB_Compiler_Version >= 510
		Declare GetConstantList(Array ConstantList.s(1))
	CompilerEndIf
	;Declare GetImportList(); All imported functions known by the compiler.
	;Declare GetStructure(Name$)
	;Declare GetInterface(Name$)
	;Declare GetHelpDirectory(FunctionName$)
	
	;- Declare compilation commands
	Declare BeginCompilation(FlagsList$ = "") ; For now same params as Compile 
	Declare AvailableCompilationMessage()
	Declare.s CompilationMessage(readMessageBlock = #False)
EndDeclareModule

Module PBCompiler
	CompilerIf #PB_Compiler_Version < 410
		CompilerError #PB_Compiler_Module + "Require PureBasic 4.10 or earlier"
	CompilerEndIf

	; Vars to save compiler settings. 
	; Global Subsystem$, Unicode
	; Global OptSource$, OptTarget$, OptIcon$, OptResource$, OptIncludePath$, OptConstant$, OptLinker$
	
	; Default settings
	Global PB_CompilerPath$
	
	; Vars to save 
	Global CompilerID = 0
	CompilerVersion.i
	CompilerOS.i
	CompilerProcessor.i
	
	
	
	;- Module procedures
	Procedure CompilerStart(CompilerPath$ = "", Parameters$ = "", WorkingDirectory$ = "", RunProgramFlags = 0)
		Protected PB_Home$
		
		If CompilerPath$ = ""
			CompilerPath$ = GetEnvironmentVariable("PB_TOOL_Compiler")
			If CompilerPath$ = ""
				PB_Home$ = GetEnvironmentVariable("PUREBASIC_HOME")
				If PB_Home$ = ""
					PB_Home$ = #PB_Compiler_Home
				EndIf
				CompilerPath$ = PB_Home$ + "Compilers/pbcompiler"
			EndIf
		EndIf
		
		; Start new compiler session
		CompilerID = RunProgram(CompilerPath$, Parameters$ + " --standby", WorkingDirectory$,
		                        RunProgramFlags | #PB_Program_Open | #PB_Program_Read | #PB_Program_Write)
		
		If Not CompilerID
			ProcedureReturn #False
		EndIf
		
		; Read line "STARTING<T><VersionNr><T><VersionString>"
		Output$ = ReadProgramString(CompilerID)
		Status$ = StringField(Output$, 1, #TAB$)
		
		VersionNr$ = StringField(Output$, 2, #TAB$)
		VersionString$ = StringField(Output$, 3, #TAB$)
		
		; "READY" or "ERROR<T>..."
		Output$ = ReadProgramString(CompilerID)
		Status$ = StringField(Output$, 1, #TAB$)
		
		If Status$ <> "READY"
			CompilerStop()
			ProcedureReturn #False
		EndIf
		
		ProcedureReturn CompilerID

	EndProcedure
	
	Procedure CompilerStop()
		Send("END")
		If Not WaitProgram(CompilerID, 1000)
			KillProgram(CompilerID)
		EndIf
		Status$ = "CLOSED"
		CloseProgram(CompilerID)
	EndProcedure
	
	Procedure Send(message$)
		WriteProgramStringN(CompilerID, message$)
	EndProcedure
	
	
	;-Compiler commands
	Procedure SetSource(SourceFile$)
		Send("SOURCE"+#TAB$+SourceFile$)
	EndProcedure
	
	Procedure SetSourceAlias(Alias$)
		Send("SOURCEALIAS"+#TAB$+Alias$)
	EndProcedure
	
	Procedure SetIncludePath(Path$)
		Send("INCLUDEPATH"+#TAB$+Path$)
	EndProcedure
	
	Procedure AddResource(File$)
		Send("RESOURCE"+#TAB$+File$)
	EndProcedure
	
	Procedure SetIcon(File$)
		Send("ICON"+#TAB$+File$)
	EndProcedure
	
	Procedure SetTarget(TargetFile$)
		Send("TARGET"+#TAB$+TargetFile$)
	EndProcedure
	
	Procedure AddConstant(Name$, Value$)
		Send("CONSTANT"+#TAB$+Name$+"="+Value$)
	EndProcedure
	
	Procedure SetLinker(LinkerCommandFile$)
		Send("LINKER"+#TAB$+LinkerCommandFile$)
	EndProcedure
	
	Procedure Compile(FlagsList$ = "")
		; Start compilation
		BeginCompilation(FlagsList$)
		
		; Autodeal with compilation messages
		Protected Output$, OutLine$, MessageType$, MessageSubType$
		Repeat 
			OutLine$ = ReadProgramString(CompilerID)
			MessageType$ = StringField(OutLine$, 1, #TAB$)
			Select MessageType$
				Case "PROGRESS"; only with "PROGRESS" flag
					Debug OutLine$
					;TODO Use callback to inform progress
					
				Case "WARNING" ; PB 4.30 and newer, only with "WARNINGS" flag
					Debug OutLine$ + #CRLF$ + CompilationMessage(#True)
					;TODO Use callback to inform warning
					
				Case "REDIRECT" ; PB 4.40 and newer, only with "REDIRECT" flag
					Send(StringField(OutLine$, 3, #TAB$))
					Debug OutLine$
					;TODO Use callback to perform correct redirection
					
				Case "ERROR"
					Debug OutLine$ + #CRLF$ + CompilationMessage(#True)
					Debug #PB_Compiler_Filename + #PB_Compiler_Procedure + #PB_Compiler_Line
					;TODO do somthing before return
					
				Case "SUCCESS"
					; Nothing to do 
					Debug OutLine$
					
				Default ; To handle future features
					Debug "Future output : " + OutLine$
					;TODO Use callback again
					
			EndSelect
		Until MessageType$ = "SUCCESS" Or MessageType$ = "ERROR"
	EndProcedure
	
	Procedure GetFunctionList(Array FunctionList.s(1))
		Send("FUNCTIONLIST")
		OutLine$ = ReadProgramString(CompilerID)
		Repeat
			Output$ + OutLine$
			OutLine$ = ReadProgramString(CompilerID)
		Until OutLine$ = "OUTPUT"+#TAB$+"COMPLETE"
		;TODO Terminer la fonction
	EndProcedure
	
	Procedure GetStructureList(Array StructureList.s(1))
		Protected size, compilerCount, localCount = 0, index = 0
		Send("STRUCTURELIST")
		size = ArraySize(StructureList())
		OutLine$ = ReadProgramString(CompilerID)
		compilerCount = Val(OutLine$)
		If size < compilerCount
			ReDim StructureList.s(compilerCount)
		EndIf
		OutLine$ = ReadProgramString(CompilerID)
		Repeat
			StructureList(index) = OutLine$
			index + 1
			OutLine$ = ReadProgramString(CompilerID)
		Until OutLine$ = "OUTPUT"+#TAB$+"COMPLETE"
		ProcedureReturn index
	EndProcedure
	
	Procedure GetInterfaceList(Array InterfaceList.s(1))
		Protected size, compilerCount, localCount = 0, index = 0
		Send("INTERFACELIST")
		size = ArraySize(InterfaceList())
		OutLine$ = ReadProgramString(CompilerID)
		compilerCount = Val(OutLine$)
		If size < compilerCount
			ReDim InterfaceList.s(compilerCount)
		EndIf
		OutLine$ = ReadProgramString(CompilerID)
		Repeat
			InterfaceList(index) = OutLine$
			index + 1
			OutLine$ = ReadProgramString(CompilerID)
		Until OutLine$ = "OUTPUT"+#TAB$+"COMPLETE"
		ProcedureReturn index
	EndProcedure
	
	Procedure GetConstantList(Array ConstantList.s(1))
		;TODO Coder la fonction
	EndProcedure 
	
	;- Compilation commands
	Procedure BeginCompilation(FlagsList$ = "")
		Send("COMPILE"+#TAB$+FlagsList$)
	EndProcedure
	
	Procedure AvailableCompilationMessage()
		ProcedureReturn AvailableProgramOutput(CompilerID)
	EndProcedure
	
	Procedure.s CompilationMessage(readMessageBlock = #False)
		#END_MESSAGE_BLOCK$ = "OUTPUT"+#TAB$+"COMPLETE"
		Protected Line$, Message$
		
		If readMessageBlock
			Message$ = ReadProgramString(CompilerID)
			Line$ = ReadProgramString(CompilerID)
			While Line$ <> #END_MESSAGE_BLOCK$
				Message$ + Line$
				Line$ = ReadProgramString(CompilerID)
			Wend 
		Else
			Message$ = ReadProgramString(CompilerID)
		EndIf
		ProcedureReturn Message$
	EndProcedure
	
EndModule
Dernière modification par Naheulf le dim. 13/janv./2019 14:06, modifié 3 fois.
Avatar de l’utilisateur
Naheulf
Messages : 191
Inscription : dim. 10/mars/2013 22:22
Localisation : France

MaJ du code pour version de PB plus récente (2/3)

Message par Naheulf »

Fichier « GoodByeC.pb » (partie 1/2) :

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
Dernière modification par Naheulf le sam. 12/janv./2019 23:40, modifié 1 fois.
Avatar de l’utilisateur
Naheulf
Messages : 191
Inscription : dim. 10/mars/2013 22:22
Localisation : France

MaJ du code pour version de PB plus récente (3/3)

Message par Naheulf »

Fichier « GoodByeC.pb » (partie 2/2) :

Code : Tout sélectionner

;**********************************************
;*     Récupération des données à convertir   *
;*     We take the text to convert            *
;**********************************************

ProgText.s=""
If #Test
  ProgText=GetClipboardText()
Else
  ;File.s = OpenFileRequester("Open a C code file", "", "(*.*)|*.*", 0)
  File.s = OpenFileRequester("Ouvrir un programme en language C", "", "(*.*)|*.*", 0)
  If File
    If OpenFile(0,File)
      l=0
      While l < Lof(0)
        tl.s = ReadString(0)+#CRLF$
        ProgText=ProgText+tl
        l = l + Len(tl)
      Wend
    EndIf
  EndIf
EndIf
;
If ProgText<>""
  ProgText=ProgText+#CRLF$+#CRLF$

  ;*****************************
  ;- Conversion                *
  ;*****************************
  DoAsFredSaid = 1
  Prog.s=""
  ttdef = 0
  ttFcn = 1
  TFcn(1) = "MAKELONG"
  TFcnDef(1) = "(c0|(c1<<16))"
  TFcnType(1)= ".l"
  TFcnArg(1) = "c0,c1"
  TFcnArgType(1) = ".b,.b"
  ;
  ; On commence par rechercher toutes les déclarations de fonction et on les enregistre
  ; Begin by register all the fonction declarations
  SetGadgetText(1, "Analysing fonctions")
  cont = 1
  AnLine = 0
  While cont
    cont = 0
    com = 0
    LevelStruct = 0
    StartL = 1
    EndL = 0
    While EndL < Len(ProgText)
      ForgetIt = 0
      ForgetLF = 0
      CutTheLine()
      If com=0
        If LCase(TWord(1))="#define" And dtw > 2
          If UCase(TWord(2))<>"WINMMAPI" And UCase(TWord(2))<>"INTERFACE" And TWord(3)<>"\"
            mttFcn = ttFcn
            FonctionDeclaration()
            If mttFcn <> ttFcn
              cont=1
              AnLine +1
              SetGadgetText(1, "Analysing fonctions : "+Str(AnLine))
            EndIf
          EndIf
        EndIf
      EndIf
      If dcom
        com = 1
      EndIf
      If DefMode = 1
        DefMode = 2
      Else
        If DefMode = 2
          DefMode = 0
          mode$="none"
        EndIf
      EndIf
    Wend
  Wend
  ;
  ; Maintenant on analyse le reste
  ; Then do the rest of the job
  SetGadgetText(1, "Analysing all the code")
  com = 0
  LevelStruct = 0
  StartL = 1
  EndL = 0
  mode$="none"
  AnLine = 0
  While EndL < Len(ProgText)
    AnLine + 1
    SetGadgetText(1, "Analysing code line #"+Str(AnLine))
    ForgetIt = 0
    ForgetLF = 0
    TLine.s = CutTheLine()
    If com=0 And dtw>0
      ti.s = LCase(TWord(1))
      Select ti
        Case "#define"
          If dtw > 2 And UCase(TWord(2))<>"WINMMAPI" And UCase(TWord(2))<>"INTERFACE"
            If dtw = 3 And TWord(2) And TWord(3)="\"          ; a complex definition is going on
              ttdef + 1                                        ; we'll memorize it to be able
              TDefN(ttdef)=TWord(2)                            ; to use it when necessary
              ForgetIt = 1
              mode$="struct"

            Else
              If FonctionDeclaration()=0
                TWord(2)="#"+TWord(2)+" = "
                TSpace(3)=TSpace(3)-3
                TSpace(2)=TSpace(2)-1
                TLCom.s=""
                For p = 3 To dtw
                  If ConvertCType(TWord(p))<>TWord(p) ;it's a type declaration. Dont care
                    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
                  Else
                    If TWord(p)
                      TWord(p)=ComputeValue(p)
                      TLCom=TLCom+TCom
                    EndIf
                  EndIf
                Next
                TWord(dtw)=TWord(dtw)+TLCom
              EndIf
            EndIf
          Else
            ForgetIt = 1
          EndIf
      Case "struct"
        ;DoAsFredSaid = 1
        If DoAsFredSaid
          If Left(TWord(2),3)="tag"
            TWord(2)=Right(TWord(2),Len(TWord(2))-3)
          EndIf
          If Left(TWord(2),1)="_"
            TWord(2)=Right(TWord(2),Len(TWord(2))-1)
          EndIf
          If Right(TWord(2),4)="_tag"
            TWord(2)=Left(TWord(2),Len(TWord(2))-4)
          EndIf
        EndIf
        If TWord(2)= TNameStruct(LevelStruct)
          ; ça n'est pas le début d'une nouvelle structure mais une déclaration de
          ; structure chainée.
          ; It's not the begining of a new structure. It's a chained structure declaration
          TWord(2)=""
          TWord(1)=TWord(3)
          TWord(3)=""
          If TWord(1)="*"; the * had been taken out from the name when we "cut the line" (begining of the analysis)
            TWord(1)=TWord(1)+TWord(4) ;we re-glue the * And the name
            TWord(4)=""
          EndIf
          TWord(1)=TWord(1)+"."+TNameStruct(LevelStruct)
          e = LevelStruct*2
          If TSpace(1)<e
            TSpace(1)= e
          EndIf
        Else
          mt.s=""
          Goto STRUCT ; Goto is not forbiden if it's cleverly used.
          ; Je suis un vrai rebelle (tiens, la preuve : j'ai une guitare électrique)
          ; et je suis parfois capable de faire des trucs complètement ouf (mais vraiment ouf de chez ouf)
          ; comme utiliser Goto, par exemple. WHHHHAAAAAAAAARHRHRHRH !!! Faites gaffe !!!! I'm a rocker !!
        EndIf
      Case "union"
        LevelStruct = LevelStruct + 1
        TLevStruct(LevelStruct)="union"
        TWord(1)="StructureUnion"
        If TWord(2)<>"{" And Left(TWord(2),1)<>";"
          TWord(1)=TWord(1)+" ;"
        EndIf
        If TWord(2)="{"
          TWord(2) = ""
        EndIf
        mode$="struct"
        e = (LevelStruct-1)*2
        If TSpace(1)<e
          TSpace(1)= e
        EndIf
      Case "typedef"
        ti.s = LCase(TWord(2))
        Select ti
          Case "struct"
            mt.s=TWord(2)
            If dtw=2
              TWord(2)=""
            Else
              TWord(2)=TWord(3)
            EndIf
            TWord(3)=""
STRUCT:
            mode$="struct"
            If LevelStruct = 0
              StartMainStruct = Len(Prog) ; will be used to re-order the structures
            EndIf
            LevelStruct = LevelStruct + 1
            TLevStruct(LevelStruct)="struct"
            TWord(1)="Structure"
            If Left(mt,1)=";" Or TWord(2)="" Or dtw=1
              TWord(2)=FindStructName()
              TAutoNameStruct(LevelStruct)=1
            Else
              TAutoNameStruct(LevelStruct)=0
            EndIf
            ;DoAsFredSaid = 1
            If DoAsFredSaid
              If Left(TWord(2),3)="tag"
                TWord(2)=Right(TWord(2),Len(TWord(2))-3)
              EndIf
              If Left(TWord(2),1)="_"
                TWord(2)=Right(TWord(2),Len(TWord(2))-1)
              EndIf
              If Right(TWord(2),4)="_tag"
                TWord(2)=Left(TWord(2),Len(TWord(2))-4)
              EndIf
            EndIf
            TNameStruct(LevelStruct) = TWord(2)
            TSpace(2)=1
            l = 2
            ct = 3
            While ct<dtw
              ct+1
              If Left(TWord(ct),1)=";" ; we keep the commentary
                l = 3
                TWord(3)=TWord(ct)
                ct=dtw
              EndIf
            Wend
            dtw = l
            e = (LevelStruct-1)*2
            If TSpace(1)<e
              TSpace(1)= e
            EndIf
        Case "enum"
            TWord(1) = "Enumeration ;"
            TWord(2) = ""
            If Left(TWord(3),4)="enum"
              TWord(3)= Right(TWord(3),Len(TWord(3))-4)
            EndIf
            mode$="enum"
        Default
          ForgetIt = 1
        EndSelect
      Case "enum"
          TWord(1) = "Enumeration"
          dtw = 1
          mode$="enum"
      Case "}"
        Select mode$
          Case "struct"
            Select TLevStruct(LevelStruct)
              Case "struct"
                YetExisting = 0
                For ct = 1 To ttES
                  UCName.s=UCase(TNameStruct(LevelStruct))
                  If UCase(TExistingStruct(ct))=UCName
                    YetExisting = 1
                    ct = ttES
                  EndIf
                Next

                If YetExisting
                  pp=Len(prog)
                  StrToFind$="Structure "+TNameStruct(LevelStruct)
                  lStrToFind=Len(StrToFind$)
                  While Mid(Prog,pp,lStrToFind)<>StrToFind$ And pp>0
                    pp - 1
                  Wend
                  Prog = Left(Prog,pp-1)
                Else
                  ttES + 1
                  TExistingStruct(ttES)=TNameStruct(LevelStruct)
                EndIf
                TWord(1)= "EndStructure"
                cd.s=""
                ;DoAsFredSaid = 1
                For ct=2 To dtw
                  If Left(TWord(ct),1)<>";" And Left(TWord(ct),1)<>"("
                    If TWord(ct)<>"*" ; the * had been taken out from the name when we "cut the line" (begining of the analysis)
                      If DoAsFredSaid And UCase(TWord(ct))= UCase(TNameStruct(LevelStruct))
                        TWord(ct)=""
                      EndIf
                      If TWord(ct)
                        tx.s = TNameStruct(LevelStruct)
                        l = Len(TWord(ct))
                        If Left(tx,l)=TWord(ct) And TAutoNameStruct(LevelStruct)
                          TWord(ct) = tx
                        EndIf
                        e = (LevelStruct-1)*2
                        If TSpace(ct)<e
                          TSpace(ct)= e
                        EndIf
                        cd + #LF$ + Space(TSpace(ct))+TWord(ct)+"."+TNameStruct(LevelStruct)
                        TSpace(ct)=0
                      EndIf
                    Else
                      If DoAsFredSaid
                        TWord(ct+1)= "" ; forget all variables beggining by "*"
                        TWord(ct)=""
                      Else
                        TWord(ct+1)= "*"+TWord(ct+1) ; we re-glue the * and the name
                        TWord(ct)=""
                      EndIf
                    EndIf
                  Else
                    TWord(1)= "EndStructure ;"+TWord(ct)
                    ct = dtw
                  EndIf             
                Next
                If YetExisting
                  TWord(1)= "; "+TNameStruct(LevelStruct)+" already declared in the PureBasic libs"+cd
                Else
                  TWord(1)=TWord(1)+cd
                EndIf
                dtw = 1
              Case "union"
                If dtw>1
                  TWord(1)= "EndStructureUnion ;"
                Else
                  TWord(1)= "EndStructureUnion"
                EndIf
            EndSelect
            LevelStruct = LevelStruct - 1
            If LevelStruct = 0
              mode$="none"
              ;
              ; ******* OK, now we'll re-order the structures *******
              ;
              cont = 1
              ToKeepInPlace.s=""
              ToPutUpside.s=""
              ToPutUpsideOne.s=""
              StartL2 = Len(Prog)-1
              WhatToDo.s = "KeepIt"
              While StartL2 > StartMainStruct
                EndL2 = StartL2
                While StartL2>1 And Mid(Prog,StartL2 ,1)<>#LF$
                  StartL2-1
                Wend
                If Mid(Prog,StartL2 ,1)<>#LF$
                  StartL2=0
                EndIf
                Line2.s = Mid(Prog,StartL2+1,EndL2-StartL2-1)
                l = Len(Line2)
                Line2.s = LTrim(Line2)
                l = l-Len(Line2)
                Prog = Left(Prog,StartL2-1)
                If Left(Line2,12)="EndStructure" And Left(Line2,17)<>"EndStructureUnion"
                  WhatToDo = "PutItUp"
                EndIf
                If WhatToDo = "PutItUp"
                  If Left(Line2,6)<>"Struct" And Left(Line2,6)<>"EndStr"
                    Line2="  "+Line2
                  EndIf
                  ToPutUpsideOne=Line2+#LF$+ToPutUpsideOne
                Else
                  ToKeepInPlace=Space(l)+Line2+#LF$+ToKeepInPlace
                EndIf
                If Left(Line2,10)="Structure " And ToPutUpsideOne<>""
                  WhatToDo = "KeepIt"
                  ToPutUpside=ToPutUpside+#LF$+ToPutUpsideOne ; As said Jesus : the first will be the last and the last will be the first
                  ToPutUpsideOne=""
                EndIf
              Wend
              Prog=Prog+ToPutUpside+#LF$+ToKeepInPlace ; **** well done ! ****
            EndIf
            e = LevelStruct*2
            If TSpace(1)<e
              TSpace(1)= e
            EndIf
          Case "enum"
            TWord(1)= "EndEnumeration ;"
            mode$="none"
          Case "if"
            TWord(1)= "EndIf ;"
            mode$="none"
          Case "interface"
            TWord(1)= "EndInterface ;"
            For ct = 1 To ttEI
              YetExisting = 0
              InterfaceName.s=UCase(InterfaceName)
              If UCase(TExistingInterface(ct))=InterfaceName.s
                YetExisting = 1
                ct = ttEI
              EndIf
            Next
            If YetExisting
              pp=Len(prog)
              While Mid(Prog,pp,10)<>"Interface " And pp>0
                pp - 1
              Wend
              Prog = Left(Prog,pp-1)
              TWord(1)=";"+InterfaceName+" already declared in the PureBasic libs."
              dtw=1

            Else
              ttES + 1
              TExistingInterface(ttES)=InterfaceName
            EndIf
            mode$="none"
          Case "interfacel"
            TWord(1)= "EndInterface ;"
            mode$="none"
          Default
            TWord(1)= "End ;"
            mode$="none"
        EndSelect
      ;
      Case "{"
        If dtw >1         
          TWord(1) = TWord(2)
          TWord(2) = ""
          TSpace(1)=TSpace(1)+TSpace(2)+1
          TSpace(2)=0
        Else
          TWord(1) =""
        EndIf
      ;
      Case "define_guid"
        TWord(1) = "DataSection"
        p=2
        While TWord(p)<>"(" And p<dtw
          p + 1
        Wend
        TWord(p)=""
        p + 1
        TWord(p)=#LF$+"  "+TWord(p)+":"+#LF$
        TWord(p+1)="    Data.l "+TWord(p+1)+#LF$
        TWord(p+2)="    Data.w "+TWord(p+2)+","+TWord(p+3)+#LF$
        TWord(p+3)=""
        TWord(p+4)="    Data.b "+TWord(p+4)
        For ct = p+5 To dtw
          If Left(TWord(ct),1)=";"
            TWord(p+4)=TWord(p+4)+" "+TWord(ct)
          Else
            If TWord(ct)<>")"
              TWord(p+4)=TWord(p+4)+","+TWord(ct)
            EndIf
          EndIf
          TWord(ct)=""
        Next
        TWord(p+4)=TWord(p+4)+#LF$
        TWord(p+5)="EndDataSection"
        dtw = p+5
        For ct = 1 To dtw
          TSpace(ct)=0
        Next
        mode$="none"
      ;
      Case "declare_interface_"
        TWord(1)="Interface"
        p=2
        While TWord(p)<>"("
          p + 1
        Wend
        TWord(p)=""
        p + 1
        TSpace(p)=1
        For ct = p+1 To dtw
          TWord(ct)=""
        Next
        dtw = p
        TSpace(1)=0
        mode$="interface"
        If TWord(2)=""
          TWord(2)=TWord(3)
          TWord(3)=""
        EndIf
        InterfaceName.s=TWord(2)
      ;
      Case "interface"
        ForgetIt = 1
        mode$="none"
      Case "#include"
        ForgetIt = 1
      Case "#ifndef"
        ForgetIt = 1
      Case "#ifdef"
        Repeat
        Until Left(LTrim(ReadNextLine()),6)="#endif" Or EndL >= Len(ProgText)
        ForgetIt = 1
      Case "#endif"
        ForgetIt = 1
      Case "extern"
        ForgetIt = 1
      Case "#undef"
        ForgetIt = 1
      Case "#pragma"
        ForgetIt = 1
      Case "declare_handle"
        ForgetIt = 1
      Default
        If TWord(2)="WINAPI"
          ForgetIt = 1
        Else
          If mode$ ="interface" Or mode$ = "interfacel"
            If mode$ = "interface"
              If LCase(TWord(1)) = "stdmethod"
                mode$="interfacel"
                na = Asc("a")-1
                TWord(1)=""
                TWord(2) = TWord(3)
                TWord(3) = "("
                p=4
              EndIf
              If LCase(TWord(1)) = "stdmethod_"
                mode$="interfacel"
                na = Asc("a")-1
                TWord(1)=""
                TWord(2)= TWord(4)
                TWord(3) = "("
                TWord(4) = ""
                p=5
              EndIf
            Else
              p = 1
            EndIf
            If mode$="interfacel"
              For ct = p To dtw
                If LCase(TWord(ct))="pure"
                  TWord(ct)=")"
                  mode$="interface"
                Else
                  TWord(ct)=""
                  TSpace(ct)=0
                EndIf
              Next

              If TWord(p)<>")"
                na + 1
                TWord(p)=Chr(na)+".l"
                If p=1
                  TWord(1)=","+TWord(p)
                EndIf
                For ct = 1 To NbVirg
                  na + 1
                  TWord(p)=TWord(p)+","+Chr(na)+".l"
                Next
              EndIf
            EndIf
            If mode$="interfacel"
              ForgetLF = 1
            EndIf
          EndIf
          Select mode$
            Case "enum"
              If TWord(1) And Left(TWord(1),1)<>";"
                TWord(1) = "#"+TWord(1)
                TSpace(1)=TSpace(1)-1
              EndIf
              p = 0
              While TWord(p)<>"=" And p<dtw
                p + 1
              Wend
              If TWord(p)="="
                pt = p
                TLcom=""
                For p = pt To dtw
                  If TWord(p)
                    TWord(p)=ComputeValue(p)
                    TLCom=TLCom+TCom
                  EndIf
                Next
                TWord(dtw)=TWord(dtw)+TLCom
              EndIf
            Case "struct"
              tyPB.s=ConvertCType(TWord(1))
              TWord(1)=""
              pt = 0
              If Left(tyPB,1)<>"." And Left(tyPB,1)<>";"
                If dtw=1 Or Left(TWord(2),1)=";"
                  p=0
                  ct = 0
                  While ct<ttdef
                    ct+1
                    If UCase(TdefN(ct))=tyPB
                      p=ct
                      ct=ttdef
                    EndIf
                  Wend
                  If p
                    TWord(2)=TDefD(p) ; Replace the name by its definition
                    If dtw<2
                      dtw=2
                    EndIf
                    tyPB = ""
                    TSpace(1)=0
                    TSpace(2)=0
                  EndIf
                Else
                  tyPB = ".l"
                EndIf
                pt = 1
              EndIf
              p = 2
              While TWord(p)="*"
                TWord(p)=""
                p + 1
              Wend
              m.s=TWord(p)
              TWord(p)=""
              TWord(2)=m
              If tyPB And TWord(2) And TWord(2)<>"\" And Left(tyPB,1)<>";"
                md.s = ""
                If TWord(3)="["
                  If TWord(4)
                    md=ComputeValue(4)
                  EndIf
                EndIf
                TWord(2)=TWord(2) + tyPB
                If md
                  TWord(4)=md
                EndIf
              EndIf
              If Left(tyPB,1)<>"."
                ct = 2
                l = 0
                While ct<dtw
                  ct+1
                  If Left(TWord(ct),1)=";" ; we look for the commentary
                    l = ct
                  EndIf
                Wend
                If l=0
                  dtw + 1
                  TWord(dtw)=""
                  l=dtw
                EndIf
                If TWord(l)
                  TWord(l) = "; "+tyPB+" : "+Right(TWord(l),Len(TWord(l))-1)
                Else
                  TWord(l) = "; "+tyPB
                EndIf
              EndIf
              TWord(1)=""
              TSpace(2)=TSpace(1)
              e = LevelStruct*2
              If TSpace(2)<e
                TSpace(2)= e
              EndIf
              TSpace(1)=0
          EndSelect
        EndIf   
      EndSelect
      ct=0
      TLine.s = ""
      While ct<dtw And ForgetIt=0
        ct+1
        If TWord(ct)
          p=ct-1
          While p>1 And TWord(p)=""
            p -1
          Wend
          If TSpace(ct)<1 Or TWord(ct)="[" Or TWord(p)="[" Or TWord(ct)="]" Or TWord(ct)="(" Or TWord(p)="(" Or TWord(ct)=Chr(34) Or TWord(p)=Chr(34) Or TWord(ct)=")" Or TWord(p)="(" Or TWord(ct)="<" Or TWord(ct)=">"
            TSpace(ct)=0
          EndIf
          TLine=TLine+Space(TSpace(ct))+TWord(ct)
        EndIf
      Wend
    EndIf
    If TLine And ForgetIt = 0
      TLine = ReplaceString(TLine, "; ;", ";")
      TLine = ReplaceString(TLine, "\", "")
      TLine = ReplaceString(TLine, "*/", "")
      Debug TLine
      If DefMode
        TDefD(ttdef) = TDefD(ttdef)+TLine
        If ForgetLF = 0
          TDefD(ttdef) = TDefD(ttdef)+#LF$
        EndIf
      Else
        Prog = Prog+TLine +" "
        If ForgetLF = 0
          Prog = Prog+#LF$
        EndIf
      EndIf
    EndIf

    If dcom
      com = 1
    EndIf
    If DefMode = 1
      DefMode = 2
    Else
      If DefMode = 2
        DefMode = 0
        mode$="none"
      EndIf
    EndIf
  Wend
  ; On renomme toutes les constantes portant le même nom qu'une constante PureBasic
  ; et ayant une valeur différente (pour éviter le message "Constant already declared with a different value")
  ; Rename all the constants having the same name than a PureBasic Constant and having
  ; a different value (to avoid the "Constant already declared with a different value" message).

  StartL=1
  EndL = 1
  Prog2.s=""
  While EndL>0
    EndL  = FindString(Prog,#LF$,StartL) ; on cherche le prochain retour chariot - look for the next line feed
    If EndL
      TLine = LTrim(Mid(Prog,StartL,EndL-StartL))
      If Left(Tline,1)="#"
        Prog2=Prog2+TLine+#LF$ ; on ne garde que les déclarations de constantes - We keep only constant declarations
      EndIf
      StartL=EndL+Len(#LF$)
    EndIf
  Wend
  AnLine = 0
  RenameCText$=""
  cont = 1
  While cont
    cont=0
    RTest$=TestProg(Prog2)
    If RTest$<>"OK"
      nLine=Val(StringField(Mid(RTest$,6,14), 1, ": "))
      ct=0
      StartL=1
      EndL = 1
      While ct<nLine And EndL>0
        ct + 1
        EndL  = FindString(Prog2,#LF$,StartL) ; on cherche le prochain retour chariot - look for the next line feed
        mStartL=StartL
        StartL=EndL+Len(#LF$)
      Wend
      If ct=nLine
        Const$ = StringField(LTrim(Mid(Prog2,mStartL,EndL-mStartL)),1," ")
        If FindString(RTest$,"Constant already declared with a different value",1)
          Prog=ReplaceString(Prog, Const$, Const$+"n")
          RenameCText$=RenameCText$+"; "+Const$+" has been renamed To "+Const$+"n"+#LF$
          Prog2=ReplaceString(Prog2, Const$, Const$+"n")
          AnLine + 1
          SetGadgetText(1, "Renaming some constants : "+Str(AnLine))
        Else
          Prog2=ReplaceString(#LF$+Prog2, #LF$+Const$, #LF$+";"+Const$) ; pour annuler l'erreur - To kick off the error
          Prog2=ReplaceString(Prog2, Const$, "0")
        EndIf
        cont = 1
      EndIf
    EndIf
  Wend
  If RenameCText$
  	Prog="; Some constants was already declared into the PureBasic Libs with"+#LF$+
  	     "; a different value : "+#LF$+RenameCText$+#LF$+Prog
  EndIf
  SetGadgetText(1, "Ending...")
  ;
  ;*********************************************************
  ;* Recherche de la Fenêtre de PureBasic                  *
  ;* Le code original vient de Brossden et il est bien !   *
  ;* From a cool Brossden code
  ;*********************************************************
  CloseWindow(30)
  Hwnd = FindWindow_( 0, 0 )
  While Hwnd <> 0
    Txt.s = Space(256)
    GetWindowText_(Hwnd, Txt, 256)
    Hwnd = GetWindow_(Hwnd, #GW_HWNDNEXT)
    If FindString(UCase(Txt),"PUREBASIC - ",1) = 1 And FindString(UCase(Txt),"DEBUG",1) =0
      HandlePB=Hwnd
      Hwnd=0
    EndIf
  Wend

  ;******************************************
  ;* Activation de la Fenêtre de PureBasic  *
  ;* Activation of the PureBasic Window     *
  ;******************************************

  SetFocus_(HandlePB)

  ;*****************************************************
  ;* On sauvegarde le contenu du presse-papier         *
  ;* save the clipboard datas                          *
  ;*****************************************************

  Sauv.s = GetClipboardText()
 
  ;*****************************************************
  ;* On va coller le résultat de notre conversion dans *
  ;* un nouveau document que l'on crée dans PureBasic  *
  ;* We paste the result of the conversion into a new  *
  ;* document of PureBasic                             *
  ;*****************************************************
 
  tx.s = ";***************************************************************"+#CRLF$
  tx.s + ";* Programme converti du language C vers PureBasic à l'aide de *"+#CRLF$
  tx.s + ";*  This Program had been converted from C to PureBasic with   *"+#CRLF$
  tx.s + ";*                           GoodByeC®                         *"+#CRLF$
  tx.s + ";*                Zapman - familledeborde@lagoon.nc            *"+#CRLF$
  tx.s + ";***************************************************************"+#CRLF$
  Prog = tx+Prog
 
  SetClipboardText(Prog)
  keybd_event_(#VK_CONTROL,0,0,0):keybd_event_(#VK_N,0,0,0) ; Nouveau (Ctrl N)
  Delay(200)
  keybd_event_(#VK_CONTROL,0,0,0):keybd_event_(#VK_V,0,0,0) ; Coller  (Ctrl V)
  Delay(200)
  keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0)
  Delay(500)

  ;*********************************************************
  ;*       Restauration du contenu du presse-papier        *
  ;*               Restore the clipboard                   *
  ;*********************************************************

  SetClipboardText(Sauv)
EndIf ;ProgText<>""

PBCompiler::CompilerStop() ; Stop PB Compiler process

End ; Il faut que j'aille me coucher
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Convertisseur C vers PureBasic -> ça commence à marcher

Message par Kwai chang caine »

Bonjour Naheulf 8)
Wouaaahh quel projet !!! 8O
Je me disais.... mais comment ne savais-je pas qu'il avait existé, étant donné que je suis passionné de tout ce qui est conversion de langage ? 8O
Puis tout de suite après, mais pourquoi n'avais-je pas écrit au moins un encouragement ?
Et en jetant un œil à gauche je me suis aperçu qu'en 2004, je n'étais pas né :|
Perso, j'avais eu l'idée vite abandonnée :oops: de faire l'inverse, pour apprendre le C

Le blême c'est que j'y connais rien en C, et donc j'ai rien à convertir
J'ai donc tenté avec un 2048 du ROSETTA code

Et j'ai une erreur de syntaxe, apparemment cette ligne attend une variable en entête :?:

Code : Tout sélectionner

ManqueUneVariable$ = ReadString(#READFILE_PB_MSG_SYNTAX_ERROR) + Chr(10) + ReadString(#READFILE_PB_MSG_SYNTAX_ERROR)  ; 2 lines are possible
En tout cas j’espère que ce gros projet et le travail que tu as aussi fait ne tombera pas à nouveau dans l'oubli, et que tous les "quinquins" de PB qui s'y connaissent en C s'intéresseront à terminer ce dernier
Encore merci (un peu tard) à ZAPMAN et à toi de ce partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
Naheulf
Messages : 191
Inscription : dim. 10/mars/2013 22:22
Localisation : France

Re: Convertisseur C vers PureBasic -> ça commence à marcher

Message par Naheulf »

Bonjour Kwai chang caine
Kwai chang caine a écrit : Et j'ai une erreur de syntaxe, apparemment cette ligne attend une variable en entête :?:

Code : Tout sélectionner

ManqueUneVariable$ = ReadString(#READFILE_PB_MSG_SYNTAX_ERROR) + Chr(10) + ReadString(#READFILE_PB_MSG_SYNTAX_ERROR)  ; 2 lines are possible
C'est un reliquat de la version précédente, tu peut supprimer cette ligne. (J'ai du cafouiller lorsque j'ai viré les anciennes portions de codes à minuit passé)
Kwai chang caine a écrit : En tout cas j’espère que ce gros projet et le travail que tu as aussi fait ne tombera pas à nouveau dans l'oubli, et que tous les "quinquins" de PB qui s'y connaissent en C s'intéresseront à terminer ce dernier
Encore merci (un peu tard) à ZAPMAN et à toi de ce partage 8)
Comme déjà dit dans les messages précédents : ce code était un gros tas de caca. C'est maintenant un gros tas de caca à jour (avec les odeurs et tout et tout :twisted: ). Plus sérieusement, je préfère recoder un truc neuf sans chercher à garder la compatibilité avec les précédentes versions de PB. Comme ça j'ai des variables systématiquement déclarées et possédant des noms explicites, des commentaires plus détaillés, moins de variables globales dans tous les sens (pour l'instant) et pas de "if" de 795 lines... Donc au contraire j'espère que l'on pourra rapidement "oublier" ce gros tas de fleurs là...
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Convertisseur C vers PureBasic -> ça commence à marcher

Message par Kwai chang caine »

J'ai failli lancer le code avec a$, mais après je me suis dit gros nigaud, si tu mets "rien que des porte quoi" en variable ça risque pas de marcher...apparemment si :lol:
C'est la première fois ou je tombe sur un code qu'on peut customiser à son gout sans perturber le fonctionnement. ..cool c'est puissant :mrgreen:
Bon en temps que générateur quotidien de ce style de codage, c'est peut être un gros tas de caca, mais il a le mérite d'exister et même de pouvoir être utile et pour ça, si il fonctionne, c'est cool 8)
Maintenant si tu as la capacité, le temps et le courage de tout refaire à zéro, c'est encore mieux, en tout cas merci d'avoir refait revivre un cacamobile (caca qui marche) car grâce à toi on a déjà quelque chose en 5.60 8)
En attendant je te souhaite beaucoup de courage, pour avoir vu tellement de projets ne pas se finir, y compris les miens, que contrairement à ce que l'on pense lorsque l'on se lance dans une nouvelle aventure, l'instruction la plus compliquée de PB à ecrire au bon moment est "End" :wink:
Encore merci
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Convertisseur C vers PureBasic -> ça commence à marcher

Message par Ollivier »

Houl... La prospection des sous-sols !

Très bon ! Pour rappel, ici : https://www.purebasic.fr/french/viewtop ... =21&t=9063, j'écris en tout premier ceci :
ça me turlupinait un temps de ne rien trouver à ce sujet. (Si j'ai loopé un tel sujet, son auteur m'en voit désolé.
J'avais zappé Zapman... Désolé...
Répondre