Convertisseur C vers PureBasic -> ça commence à marcher

ZapMan · Message par **ZapMan** » lun. 12/avr./2004 15:34

Bon, avec ce week-end de 3 jours j'ai eu le temps de m'attaquer à un convertisseur C vers PureBasic. Le plus gros est fait.
Ca marche déjà pas mal et j'arrive à convertir tous les headers (constantes, structures et interfaces) avec de bien meilleurs résultats que les utilitaires "Header converter" et "Interface Importer" fournis avec PureBasic. Mon programme convertit par exemple les GUIDs, ce qui est bien pratique quand on veut travailler avec DirectX

J'aurais juste besoin d'un petit coup de main :
Je voudrais éviter le message 'Structure' or 'Interface' already declared :
Mon idée est de ne pas inclure dans le résultat de la traduction les interfaces ou les structures déjà déclarées dans les libs de PureBasic.

Mais comment obtenir une liste à jour de ces interfaces et structures ?

ZapMan · Message par **ZapMan** » lun. 12/avr./2004 15:50

Patrick88 a écrit :bin, en fait sur le forum anglais y'a déjà pas mal de trucs et astuces pour convertir du c en pb...

J'ai fait une recherche rapide et j'ai pas trouvé grand chose. Si l'un d'entre vous a repéré quelque chose de précis, ça m'interesse.

Chris · Message par **Chris** » lun. 12/avr./2004 15:59

Peut-etre une idée idiote, mais pour les structures, tu as déjà le visualiseur de structures dans les outils de l'éditeur.
Cet outil doit certainement se baser sur un des fichiers contenus dans l'installation, sinon, il ne te reste plus qu'à récupérer chaque structure une à une. (Tout au moins, le nom)

Par contre, pour les interfaces, je ne sais pas. (D'ailleurs, je ne sais meme pas ce qu'est une interface, et encore moins à quoi ça peut servir

)

Chris

PS : Pour les structures, il y a PB_Structures.txt dans le dossier Compilers.

ZapMan · Message par **ZapMan** » mar. 13/avr./2004 13:44

J'ai trouvé.
J'ai examiné le code source de l'éditeur et de structure viewer et en récupérant des lignes ici et là, j'ai pondu ça :

Code : Tout sélectionner

;- 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

;- 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

#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_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  

FullPath.s="C:\Program Files\PureBasic\"
SharedFileName.s = FullPath+"Compilers\Communication.msg"
OpenWindow(30, 0, 0, 20, 20,  #PB_Window_ScreenCentered | #PB_Window_TitleBar , "GoodByeC")
PB_MSG_ID = RegisterWindowMessage_("PB_MSG_ID")
Parameters.s = Str(GetCurrentThreadId_())+" /STANDBY"
CompilerProcessID = RunProgram(FullPath+"Compilers\PBCompiler.exe", Parameters, "", 2)
Repeat
  EventID = WaitWindowEvent()
  Select EventID
  
    ;- Event PB_Message
    Case PB_MSG_ID
    
      Select EventwParam()
        Case #PB_MSG_Fatal_Error
        
          If ReadFile(#READFILE_PB_MSG_FATAL_ERROR, SharedFileName)
            ErrorDescription$ = ReadString()
            CloseFile(#READFILE_PB_MSG_FATAL_ERROR)
          EndIf

          MessageRequester("PureBasic - Compiler Error", ErrorDescription$, #MB_ICONERROR)
          End
          
    
        Case #PB_MSG_Compiler_Ready
          CompilerThreadID = EventlParam()
          PostThreadMessage_(CompilerThreadID, PB_MSG_ID, #PB_MSG_EDITOR_READY, 0)
          ;LoadBasicFunctions()
          
          
        Case #PB_MSG_Syntax_Error
          LineError = EventlParam()-1
       
          If ReadFile(#READFILE_PB_MSG_SYNTAX_ERROR, SharedFileName)
            ErrorDescription$ = ReadString()+Chr(10)+ReadString()  ; 2 lines are possible
            CloseFile(#READFILE_PB_MSG_SYNTAX_ERROR)

            If LineError > -1
              ErrorDescription$ = "Line " + Str(LineError+1) + ": " + ErrorDescription$ ; 'Line XXX: Error XX'
            EndIf
            
            MessageRequester("PureBasic", ErrorDescription$, #MB_ICONERROR)
          EndIf            
          
        Case #PB_MSG_COMPILATION_FINISHED

        Case #PB_MSG_IS_PURECOMMAND:
          
      EndSelect
  EndSelect
Until CompilerThreadID    
         

   PostThreadMessage_(CompilerThreadID, PB_MSG_ID, #PB_MSG_Structures_Listing, 0)

  ; Just wait for the compiler response
  ;
  Repeat 
    EventID = WaitWindowEvent()
  
    If EventID = PB_MSG_ID And EventwParam() = #PB_MSG_Structures_Listing
      If ReadFile(#READFILE_STRUCTURESLISTINGREQUEST, FullPath + "Compilers\PBStructures.txt")
      
        Repeat
          Line$ = ReadString()
          If Line$
            Debug line$
          EndIf
        Until Line$ = ""
        CloseFile(#READFILE_STRUCTURESLISTINGREQUEST)
      EndIf
      
      Quit = 1
    EndIf
  Until Quit = 1
TerminateProcess_(CompilerProcessID,0)  ; Terminate the PB Compiler process

Ce programme lance une nouvelle instance du compiler et communique avec lui comme le fait l'éditeur. L'exemple ci-dessus demande au compiler d'envoyer la liste des structures existantes.

On peut aussi lui demander le détail des structures et la liste des fonctions.

Je vais aussi utiliser ça pour savoir si une constante existe déjà.

Je suis sur qu'il existe des messages-commandes qui ne sont pas utilisées par l'éditeur (la liste des interfaces, par exemple ?). Ca serait vraiment cool si Fred était d'accord pour nous donner la liste complète des messages-commandes, hein Fred ?

Sinon mon convertisseur avance tranquillement. Je suis en train de compléter ses capacités en le testant sur des headers les uns aprés les autres. Je suis tombé sur des problèmes hardus comme par exemple le fait que le C accepte des définitions de constantes calculées à l'aide de fonctions alors que PB n'accepte pas ça. Mais bon, je trouve des solutions et ça avance.

PS : Merci Chris, ta réponse m'a d'une certaine façon mis sur la voie. Les interface sont (un peu rapidement) expliquées dans l'aide de PureBasic. Comme les API utilisent pas mal ce mode de programmation, il est impératif d'inclure leurs conversions dans mon programme.

Message par **Fred** » mar. 13/avr./2004 14:50

A mon avis, tu dois avoir un code source ancien de l'editeur, parce que les interfaces sont presentes dans le code source complet. Vas faire un tour la: cvs.purebasic.com (repertoire Help si tu connais pas CVS).

ZapMan · Message par **ZapMan** » mar. 13/avr./2004 22:48

Merci Fred.
Est-ce que TOUTES les commandes figurent dans cette nouvelle version ou est-ce que tu nous en cache qui ne seraient pas utilisées par l'éditeur ?

cederavic · Message par **cederavic** » mer. 14/avr./2004 8:13

ZapMan, il y a une liste des mots clefs quelque part dedans? J'en ai besoin pour PBNSU merci

Message par **Fred** » mer. 14/avr./2004 8:54

Non, l'éditeur les utilise toutes, rien de caché

ZapMan · Message par **ZapMan** » mer. 14/avr./2004 9:27

Pour Cederavic :
La dernière version du fichier "Common.pb" qui fait partie du dossier de travail de l'éditeur (à l'adresse donnée par Fred ci-dessus) donne :
#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

On trouve aussi :
#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

et

#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

PS pour Fred : ma femme aussi prétend qu'elle n'a rien à cacher. Mais...bon...enfin... En tout cas merci pour ta réponse.

cederavic · Message par **cederavic** » mer. 14/avr./2004 9:33

merci zapman mais c'etait les mot clef qu'il me fallait : If Else ElseIf EndIf Repeat Until Procedure etc... je les ai trouver, merci qd meme

ZapMan · Message par **ZapMan** » jeu. 15/avr./2004 0:21

De rien.

Voici les nouvelles du front :

J'ai trouvé un nom qui me plait bien pour mon projet : "GoodByeC"
Ca vous plait ?

Hier soir j'ai réglé le problème des déclarations de structure qui incluent des déclarations de structures (le C permet de faire ça, pas PB) ainsi que les structures déclarées sans nom. J'ai remercié le ciel que Fred ai prévu l'instruction "StructureUnion", sans quoi ça aurait été beaucoup plus compliqué. Merci, merci, merci, Fred.

J'ai optimisé mon programme pour le rendre plus souple et lui permettre de gérer une plus grande variété de façons d'écrire les codes. Je suis arrivé à quelquechose qui me semble bien "propre" aussi bien dans le résultat (le code traduit) que dans la forme (mon propre programme).

Je vais bientôt vous proposer une première version pour receuillir vos critiques. Je voudrais d'abord régler le problème des constantes calculées (le C permet d'affecter le résultat d'une petite fonction à une constante, ce que PB n'autorise pas).

J'ai le sentiment d'avoir terminé le plus gros, mais je me trompe peut-être, on verra ça quand je l'aurais testé sur des gros code-sources.

Message par **Fred** » jeu. 15/avr./2004 10:14

Je suis impatient de voir le resultat

ZapMan · Message par **ZapMan** » jeu. 15/avr./2004 22:30

C'est beaucoup d'honneur.
Ca me motive. Merci.

ZapMan · Message par **ZapMan** » sam. 17/avr./2004 17:01

PREMIERE PARTIE DU CODE
(le code complet dépasse la limite de taille des messages de ce forum)
VOIR SUITE PLUS LOIN.

Code actualisé au 22/04/04 - 2h42 (heure de Nouméa)

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 les
          ; résultat du "Header converter" et "Interface Importer" de 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à :
          
          ;#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 :
          ;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'une 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 : 
          ;
          ; #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
          ;
          ; Procedure.l MAKEFOURCC(c0.b,c1.b,c2.b,c3.b)
          ;   ProcedureReturn ( c0 |( c1<< 8) |( c2<< 16) |( c3<< 24)) 
          ; EndProcedure
          ;
      ; 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 cession 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 existants déjà 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é.
                      
;
Global Voir.s ; pour voir certaines valeurs dans le debugger
;
#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
;         Ca m'a fait gagner beaucoup de temps pour 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.
         ; 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
  Delay(10)                      ; de fonction, on attend que l'utilisateur relache
Wend                            ; la touche
                                 ; 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)
Dim TExistingInterface.s(2000)
Global ttFcn.l,ttES.l,ttEI.l,ttTypes.l
;
;                                 
;*************************************************************
;*     On demarre une cession 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 cession 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

; ****** Codes extraits de "Structure Viewer" et de "PureBasicIde" ******
; (Ces deux fichiers font partie des sources de l'éditeur de PureBasic et
; sont distribués en GNU.
; *** Codes Extracted from "Structure Viewer" and from "PureBasicIde" ***
; (these two files are sources of the PureBasic Editor and are distributed
; with a GNU License.
Procedure SendCompilerRequest(RequestID)
  ;PostThreadMessage_(CompilerThreadID, PB_MSG_ID, RequestID, 0)
  PostThreadMessage_(CompilerThreadID, PB_MSG_ID, RequestID, 0)
  ; Just wait for the compiler response with timeout.
  ; If compiler crashes, the timeout quits the procedure
  ; and the user can save his sources and nothing gets lost.
  ;
  Quit  = 0
  Timer = 0
  Repeat 
    EventID = WindowEvent()
    If EventID = PB_MSG_ID And EventwParam() = RequestID
      ProcedureReturn 1
    Else
      Delay(20)
      Timer + 20
      If Timer >= 2000 ; ms
        Quit = 1
      EndIf
    EndIf
  Until Quit
EndProcedure
;
; Démarrage d'une nouvelle cession du compiler afin de pouvoir dialoguer avec lui
; Starting of a new cession of the compiler to be able to talk with it
;
FullPath.s="C:\Program Files\PureBasic\"
SharedFileName.s = FullPath+"Compilers\Communication.msg"
OpenWindow(30, 0, 0, 190, 20,  #PB_Window_ScreenCentered | #PB_Window_TitleBar , "GoodByeC")
If CreateGadgetList(WindowID())
  TextGadget  (1, 2, 2, 188, 18, "Loading.")
EndIf 
PB_MSG_ID = RegisterWindowMessage_("PB_MSG_ID")
Parameters.s = Str(GetCurrentThreadId_())+" /STANDBY"
CompilerProcessID = RunProgram(FullPath+"Compilers\PBCompiler.exe", Parameters, "", 2)
;
CError = 0
Repeat
  EventID = WindowEvent()
  If EventID = PB_MSG_ID And EventwParam() = #PB_MSG_Compiler_Ready
    CompilerThreadID = EventlParam()
    PostThreadMessage_(CompilerThreadID, PB_MSG_ID, #PB_MSG_EDITOR_READY, 0)
  EndIf
  Delay(20)
  Timer + 20
  If Timer >= 2000 ; ms
    CError = 1
  EndIf
Until CompilerThreadID Or CError
;
; Demande la liste des structures existantes
; Get the existing structures
;
SetGadgetText(1, "Loading..")
ttES=0
ttEI=0
If SendCompilerRequest(#PB_MSG_Structures_Listing)
  If ReadFile(#READFILE_STRUCTURESLISTINGREQUEST, FullPath + "Compilers\PBStructures.txt")
    Repeat
      Line$ = ReadString()
      If Line$
        ttES + 1
        TExistingStruct.s(ttES) = Line$
      EndIf
    Until Line$ = ""
    CloseFile(#READFILE_STRUCTURESLISTINGREQUEST)
  EndIf
  Quit = 1
EndIf
;
; Demande la liste des interfaces existantes
; Get the existing interfaces
;
SetGadgetText(1, "Loading...")
If SendCompilerRequest(#PB_MSG_Interfaces_Listing)
  If ReadFile(#READFILE_STRUCTURESLISTINGREQUEST, FullPath + "Compilers\PBInterfaces.txt")
    Repeat
      Line$ = ReadString()
      If Line$
        ttEI + 1
        TExistingInterface.s(ttEI) = Line$
      EndIf
    Until Line$ = ""
    CloseFile(#READFILE_STRUCTURESLISTINGREQUEST)
  EndIf
  Quit = 1
EndIf
;
If ttES=0
  ;MessageRequester("Error","Impossible to start a new compiler cession !!",#PB_MessageRequester_Ok)
  MessageRequester("Erreur","Impossible de lancer une cession du compiler !!",#PB_MessageRequester_Ok)
EndIf 
;
;
Procedure.s TestProg(ToTest.s)
; Envoie un programme au compiler pour voir s'il s'exécute correctement
; Send a program to the compiler to see if it's well executed
  Shared SharedFileName,FullPath
  If CompilerThreadID
    TestFile.s = FullPath + "Compilers\PB_EditorOutput.pb"
    CreateFile(1, TestFile)
    WriteStringN(ToTest)
    CloseFile(1)
    If CreateFile(1, SharedFileName)
      WriteStringN(TestFile)
      WriteStringN(FullPath)
      WriteStringN("") 
      CloseFile(1)
    EndIf
    PostThreadMessage_(CompilerThreadID, PB_MSG_ID, #PB_MSG_START_COMPILATION, #PB_FLG_ENABLEXP)
    CAnswer = 0
    Timer = 0
    CError = 0
    Repeat
      If WindowEvent()=PB_MSG_ID
        Select EventwParam()
          Case #PB_MSG_Fatal_Error
            If ReadFile(#READFILE_PB_MSG_FATAL_ERROR, SharedFileName)
              ErrorDescription$ = ReadString()
              CloseFile(#READFILE_PB_MSG_FATAL_ERROR)
            EndIf
            MessageRequester("PureBasic - Compiler Error", ErrorDescription$, #MB_ICONERROR)
            End          
            
          Case #PB_MSG_Syntax_Error
            CAnswer=1
            LineError = EventlParam()-1
            If ReadFile(#READFILE_PB_MSG_SYNTAX_ERROR, SharedFileName)
              ErrorDescription$ = ReadString()+Chr(10)+ReadString()  ; 2 lines are possible
              CloseFile(#READFILE_PB_MSG_SYNTAX_ERROR)
              If LineError > -1
                Result.s = "Line " + Str(LineError+1) + ": " + ErrorDescription$ ; 'Line XXX: Error XX'
              EndIf
            EndIf

          Case #PB_MSG_COMPILATION_FINISHED
            CAnswer=1
            Result.s = "OK"
         EndSelect
      EndIf
      Delay(20)
      Timer + 20
      If Timer >= 2000 ; ms
        CError = 1
      EndIf
    Until CAnswer Or CError
  Else
    CError = 1
  EndIf
  If CError
    Result.s = "NotTested"
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure.s IsAFonction(ToTest.s)
; 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(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"
            Case 2
              Result = "APIFunction"
            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
;
;************************************************************
;* Le truc de Fred pour augmenter la taille du buffer texte *
;*   et éviter les plantage quand on manipule des grandes   *
;*    chaines de caractères.                                *
;* Fred tip to increase the text buffer size and avoid a    *
;*   bug when using very long strings                       *
;************************************************************
;
#MaxSize=2000000
;
Procedure SetStringManipulationBufferSize(Bytes)
  PBStringBase.l = 0
  PBMemoryBase.l = 0
  !MOV eax, dword [PB_StringBase]
  !MOV [esp+4],eax
  !MOV eax, dword [PB_MemoryBase]
  !MOV [esp+8],eax
  HeapReAlloc_(PBMemoryBase, #GMEM_ZEROINIT, PBStringBase, Bytes)
  !MOV dword [_PB_StringBase],eax
EndProcedure
;
; Set the buffer size for all strings to #MaxSize.
SetStringManipulationBufferSize(#MaxSize)
;
Global mode$ , dtw.l, ProgText.s, EndL.l, StartL.l, com.l,dcom.l,defmode.l,NbVirg,SSpace.l,LastChar.s,EndOfLine.s
;
#RC1 = Chr(13)+Chr(10)
#RC2 = 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$=""
ttTypes = 0
Repeat
  Read tr$
  If tr$="."
    Read PBType$
  Else
    ttTypes + 1
    TPBTypes(ttTypes)=PBType$
    TCTypes(ttTypes)=tr$
  EndIf
Until PBType$=".End"
;
Procedure.s ConvertCType(TypeToConvert.s)
  LTypeToConvert.s =UCase(TypeToConvert)
  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)
  ToCompute.s = TWord(p)
  Shared TypeC.s,TCom.s
  TypeC ="."
  TCom  = ""
  If Left(ToCompute,2)="0x"
    ToCompute="$"+Right(ToCompute,Len(ToCompute)-2)
    p=FindString(ToCompute,";",1)>0
    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)>0
      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)>0
          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()
  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,#RC1,StartL) ; on cherche le prochain retour chariot - look for the next line feed
  l = Len(#RC1)
  p = FindString(ProgText,#RC2,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(#RC2)
  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()
  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)+")"+#RC2+"  ProcedureReturn "
    dtw=dtw+1
    TWord(dtw)=TLCom+#RC2+"EndProcedure"
    TSpace(1) = 0
    TSpace(2) = 0
    Result = 1
  Else
    Result = 0
  EndIf
  ProcedureReturn Result 
EndProcedure 
                  
Procedure.s CutTheLine()
  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

ZapMan · Message par **ZapMan** » dim. 18/avr./2004 10:03