PureBasic

Forums PureBasic
Nous sommes le Jeu 22/Aoû/2019 5:48

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 43 messages ]  Aller à la page Précédente  1, 2, 3
Auteur Message
 Sujet du message:
MessagePosté: Mer 04/Avr/2007 10:56 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Jan/2004 0:26
Messages: 2433
Localisation: Nantes
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message:
MessagePosté: Mer 04/Avr/2007 13:22 
Hors ligne

Inscription: Lun 26/Avr/2004 0:40
Messages: 14535
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message:
MessagePosté: Mer 04/Avr/2007 13:40 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Jan/2004 0:26
Messages: 2433
Localisation: Nantes
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...


Haut
 Profil  
Répondre en citant le message  
 Sujet du message:
MessagePosté: Mer 04/Avr/2007 14:49 
Hors ligne

Inscription: Lun 26/Avr/2004 0:40
Messages: 14535
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 :
Citation:
Dans sa version actuelle, ce traducteur n'a été testé et mis au point que
; sur les headers.

[/EDIT]


Haut
 Profil  
Répondre en citant le message  
 Sujet du message:
MessagePosté: Mer 04/Avr/2007 15:12 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Jan/2004 0:26
Messages: 2433
Localisation: Nantes
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Convertisseur C vers PureBasic -> ça commence à marcher
MessagePosté: Dim 06/Jan/2019 21:10 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 10/Mar/2013 22:22
Messages: 25
Localisation: France
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: MaJ du code pour version de PB plus récente (1/3)
MessagePosté: Sam 12/Jan/2019 23:29 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 10/Mar/2013 22:22
Messages: 25
Localisation: France
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:
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 édition par Naheulf le Dim 13/Jan/2019 14:06, édité 3 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: MaJ du code pour version de PB plus récente (2/3)
MessagePosté: Sam 12/Jan/2019 23:37 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 10/Mar/2013 22:22
Messages: 25
Localisation: France
Fichier « GoodByeC.pb » (partie 1/2) :
Code:
;******************************************
;* 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 édition par Naheulf le Sam 12/Jan/2019 23:40, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: MaJ du code pour version de PB plus récente (3/3)
MessagePosté: Sam 12/Jan/2019 23:38 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 10/Mar/2013 22:22
Messages: 25
Localisation: France
Fichier « GoodByeC.pb » (partie 2/2) :
Code:
;**********************************************
;*     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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Convertisseur C vers PureBasic -> ça commence à marcher
MessagePosté: Mar 15/Jan/2019 18:42 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6644
Localisation: Isere
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:
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Convertisseur C vers PureBasic -> ça commence à marcher
MessagePosté: Mer 16/Jan/2019 0:37 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 10/Mar/2013 22:22
Messages: 25
Localisation: France
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:
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à...


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Convertisseur C vers PureBasic -> ça commence à marcher
MessagePosté: Mer 16/Jan/2019 9:34 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6644
Localisation: Isere
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Convertisseur C vers PureBasic -> ça commence à marcher
MessagePosté: Ven 18/Jan/2019 8:47 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3483
Houl... La prospection des sous-sols !

Très bon ! Pour rappel, ici : https://www.purebasic.fr/french/viewtopic.php?f=21&t=9063, j'écris en tout premier ceci :
Citation:
ç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é...


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 43 messages ]  Aller à la page Précédente  1, 2, 3

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye