Convertisseur C vers PureBasic -> ça commence à marcher
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)
recupere ça la :
http://michel.dobro.free.fr/bidouilles/ ... Cv.400.zip
n'oublie pas de changer le chemin de purebasic au debut
recupere ça la :
http://michel.dobro.free.fr/bidouilles/ ... Cv.400.zip
n'oublie pas de changer le chemin de purebasic au debut
t'as donc pas récupéré le dernier !!Flype a écrit :trop fort
t'aurais pu le mettre en v4 - ok je sors
[EDIT]
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 ! )
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 !
donc la bonne version c'est :
http://michel.dobro.free.fr/bidouilles/ ... Cv.400.zip
[Edit]
harf la réponse est la :
[/EDIT]Dans sa version actuelle, ce traducteur n'a été testé et mis au point que
; sur les headers.
Re: Convertisseur C vers PureBasic -> ça commence à marcher
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 .
PS : Désolé de faire ce "petit" déterrage d'une douzaine d'années
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 .
PS : Désolé de faire ce "petit" déterrage d'une douzaine d'années
MaJ du code pour version de PB plus récente (1/3)
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 » :
É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.
MaJ du code pour version de PB plus récente (2/3)
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.
MaJ du code pour version de PB plus récente (3/3)
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
- Kwai chang caine
- Messages : 6962
- Inscription : sam. 23/sept./2006 18:32
- Localisation : Isere
Re: Convertisseur C vers PureBasic -> ça commence à marcher
Bonjour Naheulf
Wouaaahh quel projet !!!
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 ?
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 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êteEn 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
Wouaaahh quel projet !!!
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 ?
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 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
Encore merci (un peu tard) à ZAPMAN et à toi de ce partage
Re: Convertisseur C vers PureBasic -> ça commence à marcher
Bonjour Kwai chang caine
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 : Et j'ai une erreur de syntaxe, apparemment cette ligne attend une variable en entêteCode : Tout sélectionner
ManqueUneVariable$ = ReadString(#READFILE_PB_MSG_SYNTAX_ERROR) + Chr(10) + ReadString(#READFILE_PB_MSG_SYNTAX_ERROR) ; 2 lines are possible
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 ). 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à...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
- Kwai chang caine
- Messages : 6962
- Inscription : sam. 23/sept./2006 18:32
- Localisation : Isere
Re: Convertisseur C vers PureBasic -> ça commence à marcher
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
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
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
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
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"
Encore merci
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
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
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
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"
Encore merci
Re: Convertisseur C vers PureBasic -> ça commence à marcher
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 :
Très bon ! Pour rappel, ici : https://www.purebasic.fr/french/viewtop ... =21&t=9063, j'écris en tout premier ceci :
J'avais zappé Zapman... Désolé...ç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é.