PureBasic Forums - English

Posted: **Thu Jun 01, 2006 12:23 am**

Code updated For 5.20+

Further down you find code for a little parser that takes code like this:


;oop example by fsw

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;- start main:

Class YourObject  ;this is a comment
  YourValueOfThat.l  ;this is a comment
  YourAnotherValue.s
  YourThis(par.l)  ;this is a comment
  YourThat()
EndClass

Class MyObject
  ValueOfThat.l
  AnotherValue.s
  myThis(par.l)
  myThat()
EndClass

Global NewObject myThing.MyObject  ;this is a comment
Global NewObject YourThing.YourObject
Global NewObject AnotherThing.MyObject

Global hello.s ; not used, just for testing purpose

AnotherThing\myThis(56)

With myThing
  \myThis(347)
  \myThat()
EndWith

With YourThing
  \YourThis(123)
  \YourThat()
EndWith

myThing\myThat()
YourThing\YourThat()
AnotherThing\myThat()

End


;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; for now no constructor or destructor

Procedure YourObject::yourThis(par.l) ;this is a comment
  *THIS\YourValueOfThat = par
EndProcedure

Procedure YourObject::yourThat()
  *THIS\YourAnotherValue = " That: "
  MessageRequester("YourObject", *THIS\YourAnotherValue + Str(*THIS\YourValueOfThat))
EndProcedure


Procedure MyObject::myThis(par.l)
  *THIS\ValueOfThat = par
EndProcedure

Procedure MyObject::myThat()
  *THIS\AnotherValue = " That: "
  MessageRequester("MyObject", *THIS\AnotherValue + Str(*THIS\ValueOfThat))
EndProcedure

or this:

Code: Select all


;oop example by fsw

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;- start main:

Class YourObject ;this is a comment
  YourValueOfThat.l ;this is a comment
  YourAnotherValue.s
  YourThis(par.l) ;this is a comment
  YourThat()
EndClass ;this is a comment

Class MyObject Extends YourObject ;this is a comment
  ValueOfThat.l
  AnotherValue.s
  myThis(par.l)
  myThat()
EndClass

Global NewObject YourThing.YourObject ;this is a comment
Global NewObject myThing.MyObject
Global NewObject AnotherThing.MyObject

Global hello.s ; not used, just for testing purpose

With myThing
  \myThis(347)
  \myThat()
EndWith

With AnotherThing
  \myThis(123)
  \myThat()
EndWith

With YourThing
  \YourThis(789)
  \YourThat()
EndWith

myThing\YourThis(5)
AnotherThing\YourThis(6)

myThing\YourThat()
AnotherThing\YourThat()
YourThing\YourThat()

End


;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; for now no constructor or destructor

Procedure YourObject::yourThis(par.l)
  *THIS\YourValueOfThat = par
EndProcedure

Procedure YourObject::yourThat()
  *THIS\YourAnotherValue = " That: "
  MessageRequester("YourObject", *THIS\YourAnotherValue + Str(*THIS\YourValueOfThat))
EndProcedure


Procedure MyObject::myThis(par.l)
  *THIS\ValueOfThat = par
EndProcedure

Procedure MyObject::myThat()
  *THIS\AnotherValue = " That: "
  MessageRequester("MyObject", *THIS\AnotherValue + Str(*THIS\ValueOfThat))
EndProcedure

and creates a pb file that can be compiled with the pb compiler.

If somebody has ideas how to improve it please post it.
If you guys/gals want to make a community project out of it: why not.

In any case the generated code helps to understand how the oo portion works.

The Parser:

Code: Select all

; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;                                      ; This is oop code that will be converted correctly:
;      LPC - Little Class Parser       ;
;                                      ; Class YourObject                      ;this is a comment
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;   YourValueOfThat.l                   ;this is a comment
; OOP parser - by FSW                  ;   YourAnotherValue.s
; version 0.3                          ;   YourThis(par.l)                     ;this is a comment
; GPL Licence                          ;   YourThat()
; June 2006                            ; EndClass                              ;this is a comment
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;
; Features:                            ; Class MyObject Extends YourObject     ;this is a comment
;                                      ;   myValueOfThat.l
; Double Colon for Class Methods       ;   myAnotherValue.s
; Data Encapsulation                   ;   myThis(par.l)
; Multiple Inheritance                 ;   myThat()
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; EndClass
; Keywords:                            ;
;                                      ; Global NewObject YourThing.YourObject ;this is a comment
; Class                                ; Global NewObject myThing.MyObject
; EndClass                             ;
; NewObject                            ; With YourThing
; This                                 ;   \YourThis(789)
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;   \YourThat()
; Notes:                               ; EndWith         
;                                      ;
; Extends is used for Inheritance      ; myThing\YourThis(5)
;                                      ; myThing\myThis(347)
; NewObject needs to be set as Global  ; myThing\YourThat()
; because of PureBasic compatibility   ; myThing\MyThat()
; (like NewList or Arrays)             ;
;                                      ; End
; Comments are now allowed on parsed   ; 
; lines                                ; Procedure YourObject::yourThis(par.l)  ;this is a comment
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;   *THIS\YourValueOfThat = par
; Special Notes About This Code:       ; EndProcedure
;                                      ;
; This code is NOT optimized for speed ; Procedure YourObject::yourThat()
;                                      ;   *THIS\YourAnotherValue = " That: "
; This code uses a dim Macro      ;   MessageRequester("YourObject", *THIS\YourAnotherValue + Str(*THIS\YourValueOfThat))
; Dim does look too weird...           ; EndProcedure
; It also goes well with NewList...    ;
;                                      ;
; Macro dim                       ; Procedure MyObject::myThis(par.l)
;   Dim                                ;   *THIS\myValueOfThat = par
; EndMacro                             ; EndProcedure
;                                      ;
; Uncomment this macro if you don't    ; Procedure MyObject::myThat()
; have it in a res file already...     ;   *THIS\myAnotherValue = " That: "
;                                      ;   MessageRequester("MyObject", *THIS\myAnotherValue + Str(*THIS\myValueOfThat))                     
; BTW: it's also used in the generated ; EndProcedure                                                                                   
; code (dim instead of Dim)       ;
;                                      ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;                                      ;
; Another Macro that it used is ArraySize ;
; The result is the amount of the      ;
; elements of the array                ;
;                                      ;
; Macro ArraySize(array)                  ;
;   (PeekL(@array - 8) - 1)             ;
; EndMacro                             ;
;                                      ;
; Uncomment this macro if you don't    ;
; have it in a res file already...     ;
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;

EnableExplicit

#File_In = 0
#File_Out = 1

Global RawLine$, Line$, RestOfLine$
Global ClassName$, InheritedClassName$, NextInheritedClassName$, MethodClassName$
Global MethodLine$, MethodName$, MethodParameter$, MethodComment$
Global ObjectName$, ObjectComment$

Global BracketPos.l, RightOne$, LookFor$

Global i.l, ii.l, si.l, ei.l, di.l, oi.l, ci.l  ; these vars will be used while working with arrays

Global Dim StructureArray.s(0)      ; we need to store the Structure parts of a class
Global Dim InterfaceArray.s(0)      ; we need to store the Interface parts of a class
Global Dim DeclareMethodArray.s(0)  ; we need to store the Declare Method parts of a class
Global Dim DataSectionArray.s(0)    ; we need to store the DataSection Method names of a class
Global Dim ClassArray.s(0)          ; we need to store the Names of the classes
Global Dim AllDataArray.s(0)        ; we need to store all the DataSection Method names in one list for Inheritance
Global Dim ExtendsArray.s(0)        ; we need to store the Inheritance of the classes (who inherits from whom)

;Result = OpenFile(#File_In, ".\try_normal.pbo")
;Result = OpenFile(#File_In, ".\try_extends.pbo")
;Result = OpenFile(#File_In, ".\try_double_extends.pbo")
;Result = OpenFile(#File_In, ".\try_triple_extends.pbo")
;Result = OpenFile(#File_In, ".\try_quad_extends.pbo")

OpenFile(#File_In, ProgramParameter(0))

CreateFile(#File_Out, ".\output.pb")

; Special note...
WriteStringN(#File_Out, "; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
WriteStringN(#File_Out, "; Special Notes About This Code:")
WriteStringN(#File_Out, "; ")
WriteStringN(#File_Out, "; This code uses a dim Macro")
WriteStringN(#File_Out, "; Dim does look too weird...")
WriteStringN(#File_Out, "; It also goes well with NewList...")
WriteStringN(#File_Out, ";")
WriteStringN(#File_Out, "; Macro dim")
WriteStringN(#File_Out, ";   Dim")
WriteStringN(#File_Out, "; EndMacro")
WriteStringN(#File_Out, ";")
WriteStringN(#File_Out, "; Uncomment this macro if you don't")
WriteStringN(#File_Out, "; have it in a res file already...")
WriteStringN(#File_Out, "; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
; End Special note...


Repeat
  ; read the line from the file
  RawLine$ = ReadString(#File_In)
  ; trim and upper case it
  Line$ = UCase(Trim(RawLine$))
  
  ; set some settings to default values
  InheritedClassName$ = ""
  ii = 0
  ReDim InterfaceArray.s(ii)
  si = 0
  ReDim StructureArray.s(si)
  
  
  ; Debug Line$
  ;this line needs to be parsed
  
  ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
  ; looking out for CLASS
  If Left(Line$, 5) = "CLASS"
    ; Debug "Class Begin Found"
    ; get class name
    If FindString(Line$, "EXTENDS", 0)
      InheritedClassName$ = StringField(Line$, 4, " ")
    EndIf
    
    ; class name is the second word
    ClassName$ = LTrim(StringField(Line$, 2, " "))
    
    ; Debug "ClassName: " + ClassName$
    
    Repeat
      ; ReadNextLine and do some stuff with it
      Line$ = Trim(ReadString(#File_In))
      BracketPos.l = FindString(Line$, "(", 0)
      ; if there is a bracket then this is a Method -> goes into interface
      If BracketPos
        ;start of methods...
        ; Debug ii
        ; Debug "Method found: " + Line$
        
        If ii = 0
          ; first line of the interface
          If Len(InheritedClassName$) > 0
            ; with inheritance
            InterfaceArray.s(ii) = "Interface " + ClassName$ + "_Methods " + "EXTENDS " + InheritedClassName$ + "_Methods"
            
            ;store all inheritances
            ExtendsArray.s(ei) = ClassName$ + " " + InheritedClassName$
            ; Debug "Extended= " + ExtendsArray.s(ei)
            ei+1
            ReDim ExtendsArray.s(ei)
          Else
            ; NO inheritance
            InterfaceArray.s(ii) = "Interface " + ClassName$ + "_Methods"
          EndIf
          
          ; start of DataSection
          DataSectionArray.s(ii) = "DataSection : " + ClassName$ + "_VTable:"
          
          ii+1
          
          ; prepare the interface line array for writing the next lin
          ReDim InterfaceArray.s(ii)
          
          ; prepare the declare line array for writing the next lin
          ReDim DeclareMethodArray.s(ii)
          
          ; prepare the DataSection array for writing the next line
          ReDim DataSectionArray.s(ii)
        EndIf
        
        ; write the interface line to the array
        InterfaceArray.s(ii) = "  " + Line$
        
        ; prepare the parameters for the declare line
        RestOfLine$ = Trim(Right(Line$, Len(Line$) - BracketPos))
        
        ; write the declare line to the array
        If Len(RestOfLine$) > 1
          ; there are some parameters
          DeclareMethodArray.s(ii) = "Declare " + ClassName$ + "_" + Left(Line$, BracketPos) + "*THIS." + ClassName$ + ", " + RestOfLine$
        Else
          ; there are NO parameters
          
          DeclareMethodArray.s(ii) = "Declare " + ClassName$ + "_" + Left(Line$, BracketPos) + "*THIS." + ClassName$ + RestOfLine$
        EndIf
        ; End of writing Interface line
        
        ; start of DataSection
        DataSectionArray.s(ii) = "  Data.l @" + ClassName$ + "_" + Left(Line$, BracketPos) + ")"
        
        ;store all methods into an array, needed for inheritance
        AllDataArray.s(di) = "  Data.l @" + ClassName$ + "_" + Left(Line$, BracketPos) + ")"
        
        
        ;  Call; Debugger
        ; redim the needed arrays
        ii+1
        ReDim InterfaceArray.s(ii)
        ReDim DeclareMethodArray.s(ii)
        ReDim DataSectionArray.s(ii)
        
        di+1
        ReDim AllDataArray.s(di)
        
        
        
        ;end of methods...
        
      Else ; no bracket, this is a property -> goes into structure
        ; start of properties...
        If FindString(Line$, ".", 0)
          ; Debug si
          ; Debug "Property found: " + Line$
          ;property found
          
          If si = 0
            ; first line of the structure
            
            ; check for inheritance
            If Len(InheritedClassName$) > 0
              StructureArray.s(si) = "Structure " + ClassName$ + " Extends " + InheritedClassName$ ; + " : VTable.l"
            Else
              StructureArray.s(si) = "Structure " + ClassName$ + " : VTable.l"
            EndIf
            
            ; prepare for the next line
            si+1
            ReDim StructureArray.s(si)
          EndIf
          
          ; write the line of structure
          StructureArray.s(si) = "  " + Line$
          
          ; prepare for the next line
          si+1
          ReDim StructureArray.s(si)
          
        EndIf
        ; end of properties...
        
      EndIf
      ; and of line inside the class - goto next line inside the class
      
    Until UCase(Left(Line$,8)) = "ENDCLASS"
    ; this class is done...
    
    ;finish up the arrays
    StructureArray.s(si) = "EndStructure"
    InterfaceArray.s(ii) = "EndInterface"
    
    DataSectionArray.s(ii) = "EndDataSection : Global dim " + ClassName$ + "_Self." + ClassName$ + "(" + Str(oi) + ")"
    
    
    ; START writing a class
    WriteStringN(#File_Out, "; Start of class")
    
    ; write the structure
    For i = 0 To ArraySize(StructureArray.s())
      WriteStringN(#File_Out, StructureArray.s(i))
    Next
    
    WriteStringN(#File_Out, "")
    
    ; write the interface
    For i = 0 To ArraySize(InterfaceArray.s())
      WriteStringN(#File_Out, InterfaceArray.s(i))
    Next
    
    WriteStringN(#File_Out, "")
    
    ; write the declares
    For i = 0 To ArraySize(DeclareMethodArray.s())
      WriteStringN(#File_Out, DeclareMethodArray.s(i))
    Next
    
    WriteStringN(#File_Out, "")
    
    ; write first DataSection line
    WriteStringN(#File_Out, DataSectionArray.s(0))
    
    
    ; ----------------------------------------
    ; ----------------------------------------
    ; look for inheritance and write the lines
    ; ----------------------------------------
    
    
    ; start single inheritance - WORKS!   ; but not used anymore...
    ; ---------------------------------
    ;If Len(InheritedClassName$) > 0
    ;   ; single inheritance
    ;  For i = 0 To ArraySize(AllDataArray.s())
    ;    If FindString(AllDataArray.s(i), InheritedClassName$, 0)
    ;      WriteStringN(#File_Out, AllDataArray.s(i))
    ;    EndIf
    ;  Next
    ;EndIf
    ; end single inheritance
    ; ----------------------
    
    ; start multiple inheritance - WORKS!
    ; -----------------------------------
    If Len(InheritedClassName$) > 0
      ; now go down all the way and start from the first inherited class...
      NextInheritedClassName$ = InheritedClassName$
      
      Repeat
        LookFor$ = ""
        
        For i = 0 To ArraySize(ExtendsArray.s())
          ;  ; Debug "ExtendsArray=  " + ExtendsArray.s(i)
          
          ; this only works properly with StringField
          If StringField(ExtendsArray.s(i), 1, " ") = NextInheritedClassName$
            ;this class has inherited methods
            
            ; Debug "ExtendsArray=  " + ExtendsArray.s(i)
            ; this only works properly with StringField
            LookFor$ = StringField(ExtendsArray.s(i), 2, " ")
            ; Debug "LookFor 1=  " + LookFor$
            
            NextInheritedClassName$ = LookFor$
          EndIf
          
        Next
        
      Until Len(LookFor$) = 0
      ; now the NextInheritedClassName$ should have the first class of inheritance
      ; Debug "EXIT Repeat loop 1"
      ; Debug ""
      
      Repeat
        ; write the Inherited Class Name
        For i = 0 To ArraySize(AllDataArray.s())
          If FindString(AllDataArray.s(i), "@" + NextInheritedClassName$ + "_", 0)
            WriteStringN(#File_Out, AllDataArray.s(i))
          EndIf
        Next
        
        InheritedClassName$ = NextInheritedClassName$
        NextInheritedClassName$ = ""
        ; Call; Debugger
        ; look out for the next class in line...
        For i = 0 To ArraySize(ExtendsArray.s())
          ; Debug "InheritedClassName=  " + InheritedClassName$
          ; Debug "ExtendsArray=  " + ExtendsArray.s(i)
          
          ; this only works properly with StringField
          If StringField(ExtendsArray.s(i), 2, " ") = InheritedClassName$
            ; found the Inherited Class Name, get the Next Inherited Class Name
            ; Debug "WHAT=  " + Trim(RemoveString(ExtendsArray.s(i), InheritedClassName$))
            NextInheritedClassName$ = Trim(RemoveString(ExtendsArray.s(i), InheritedClassName$))
            
            ; look if Next Inherited ClassName = ClassName
            If NextInheritedClassName$ = ClassName$
              ; stop here, don't write the methods of ClassName$
              ; they will be written later...
              NextInheritedClassName$ = ""
            EndIf
            
          EndIf
        Next
        
      Until Len(NextInheritedClassName$) = 0       
      
    EndIf
    ; end multiple inheritance
    ; ------------------------
    
    
    ;write the methods of ClassName$, always!!!
    For i = 1 To ArraySize(DataSectionArray.s())
      WriteStringN(#File_Out, DataSectionArray.s(i))
    Next
    
    WriteStringN(#File_Out, "; End of class")
    ; END writing a class
    
    WriteStringN(#File_Out, "")
    WriteStringN(#File_Out, "")
    
    ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
    ; looking out for NEWOBJECT
  ElseIf Left(Line$, 6) = "GLOBAL" Or Left(Line$, 9) = "NEWOBJECT"
    RightOne$ = ""
    If Left(Line$, 6) = "GLOBAL"
      ; Debug "GLOBAL FOUND"
      RightOne$ = Trim(StringField(Line$, 2, " "))
      If RightOne$ = "NEWOBJECT"
        Line$ = Trim(Right(Line$, Len(Line$) - 7))
      EndIf
    EndIf
    
    If RightOne$ = "NEWOBJECT" Or Left(Line$, 9) = "NEWOBJECT"
      ; time to write the new object...
      ; get the object name without any comments
      ObjectName$ = Trim(StringField(Right(Line$, Len(Line$) - 9), 1, ";"))
      
      ; get the class name without any comments
      ClassName$ = Trim(StringField(Right(Line$, Len(Line$) - FindString(Line$, ".", 10)), 1, ";"))
      ; write class name into array - needed for inheritance
      ClassArray.s(ci) = ClassName$
      
      ; get the comment
      ObjectComment$ = ""
      ObjectComment$ = Trim(StringField(Line$, 2, ";"))
      
      ; START writing an object
      WriteStringN(#File_Out, "")
      
      ; check how many times this class is already used...
      ; and increase the number of the class array according to the amount of objects that use the class
      ; this way we don't waste memory
      oi = -1
      For i = 0 To ArraySize(ClassArray.s())
        ; only the exact class name is valid
        If ClassArray.s(i) = ClassName$
          oi+1
        EndIf
      Next
      
      ; start writing the object
      WriteStringN(#File_Out, "; Define Object")
      ; write the object
      If RightOne$ = "NEWOBJECT"
        ; global is used
        WriteStringN(#File_Out, "ReDim " + ClassName$ + "_Self." + ClassName$ + "(" + Str(oi) + ") : " + ClassName$ + "_Self(" + Str(oi) + ")\VTable = ?" + ClassName$ + "_VTable" + " : Global " + ObjectName$ + "_Methods = " + ClassName$ + "_Self(" + Str(oi) + ")" + " ;" + ObjectComment$)
      Else
        ;object is not defined as global
        WriteStringN(#File_Out, "ReDim " + ClassName$ + "_Self." + ClassName$ + "(" + Str(oi) + ") : " + ClassName$ + "_Self(" + Str(oi) + ")\VTable = ?" + ClassName$ + "_VTable" + " : " + ObjectName$ + "_Methods = " + ClassName$ + "_Self(" + Str(oi) + ")" + " ;" + ObjectComment$)
      EndIf
      
      ; prepare the array for the next round
      ci+1
      ReDim ClassArray.s(ci)
    Else
      ; global variable or list, nothing to do...
      WriteStringN(#File_Out, RawLine$)
    EndIf
    
    ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
    ; looking out for METHODS (Procedure)
  ElseIf Left(Line$, 9) = "PROCEDURE"
    
    ; look out for methods...
    If FindString(Line$, "::", 10)
      ; it's a method...
      ; Debug "Method for class found"
      
      ; remove "preocedure" for further process..
      Line$ = Trim(RemoveString(Line$, "PROCEDURE"))
      ; Debug Line$
      ; Debug "analize line"
      
      ; get the class of the method
      MethodClassName$ = Left(Line$, FindString(Line$, "::", 1) - 1)
      
      ; get the rest of the line
      MethodLine$ = Right(Line$, Len(Line$) - FindString(Line$, "::", 1) - 1)
      
      ; extract the method name
      MethodName$ = StringField(MethodLine$, 1, "(")
      
      ; get the method parameters
      MethodParameter$ = Trim(StringField( StringField(MethodLine$, 2, "("), 1, ";"))
      
      ; delete old comments
      MethodComment$ = ""
      ; get new comment
      MethodComment$ = Trim(StringField( StringField(MethodLine$, 2, "("), 2, ";"))
      
      ; now write the procedure line
      If Len(MethodParameter$) > 1
        ; there are parameter
        WriteStringN(#File_Out, "Procedure " + MethodClassName$ + "_" + MethodName$ + "(*THIS." + MethodClassName$ + ", " + MethodParameter$ + " ;" + MethodComment$)
      Else
        ; no parameter
        WriteStringN(#File_Out, "Procedure " + MethodClassName$ + "_" + MethodName$ + "(*THIS." + MethodClassName$ + MethodParameter$ + " ;" + MethodComment$)
      EndIf
      
      ; Debug MethodName$
    Else
      ; this is not a method, but a simple procedure - write it straight into the new file
      WriteStringN(#File_Out, RawLine$)
    EndIf
    
    ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
  Else
    
    ; no CLASS, NEWOBJECT or METHOD found, just copy this line to the new file...
    WriteStringN(#File_Out, RawLine$)
    
    ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
  EndIf
  ; goto next line of input file
  
Until  Eof(#File_In) 
; end of input file


; now close the files
CloseFile(#File_In)
CloseFile(#File_Out)

End

; this is the end my friend...

Hope there are enough comments to show what's going on.
Please keep the code simple.

Feedback welcome.

EDIT: Code above updated (examples and parser).
Uses Double Colon for the Method now.
THIS is a keyword.
THIS as the first method (procedure) parameter is not needed anymore.
(see examples)

EDIT: Code above updated (parser).
Fixed bug with comments on the NewObject line.
Comments on the parsed line should not criple the actual code.

EDIT: Code above updated (examples and parser).
NewObject now needs to be defined as Global, because of PureBasic compatibility (like Lists or Arrays).
Also a new Keyword is introduced: NewArray (as macro)
I have it since the first V4 beta. IMHO NewArray fits better with NewList, NewObject etc.

EDIT: Code above updated (parser).
Fixed bug when a Class name contained the name of another Class.
Also forgot to mention that the UBound Macro is needed too.
(it's in the parser code)

Got Multiple Inheritance to work

Posted: **Thu Jun 01, 2006 12:47 am**

Hey that looks pretty cool.

I'll have a bash with it tomorrow as tiredness is forcing me to bed right now.

Any chance of setting this up as a tool for the IDE, kind of like a preprocessor which then automatically calls the compiler etc?

Thanks for sharing.

Posted: **Thu Jun 01, 2006 1:04 am**

Hi fsw!

First of all, thanks for this. I have noticed lounging on the forum, that OOP is something quite a few people would like to try/start using. (One of my own reasons is that I'm so fussy when it comes to most things, if my code looks messy, it's not a good thing. OOP naturally seems to organise both the code flow and the logic to be neater. Then again, whenever OOP presents itself, it seems to wallow in a nasty side-effect called "BLOAT", which I cannot stand. There must be a nice middle ground between using OOP and controlling the bloat - and PB seems to be the best place to start).

I mean no offence whatsoever, and please understand my complete ignorance, but is this:
http://www.purebasic.fr/english/viewtop ... ht=#144127
in any way connected with what you have posted (it's a preprocessor plugin for OOP)?

If not, consider me bashed around the head with a wet (frozen) fish.

As with most everything to do with PB, we are lucky to have numerous choices and tools available (and wonderfully helpful people with which to consult) for whatever we are trying to achieve. The other side of the coin, is that for a beginner, the choices can be confusing, as they are for myself trying to test the "OOP waters" for the first time.

Posted: **Thu Jun 01, 2006 2:19 am**

It's a command line tool, not a plug-in.
Yet....

Now that the code is out (as a starting point) it can become whatever we want it to be.

Posted: **Thu Jun 01, 2006 12:51 pm**

Thanks fsw !

Gonna maybe try this weekend to play a bit aroudn with it and see what comes to mind... ( but i def need a better way to organize my code... .. at least partwise )

Cheers,
Thalius

Posted: **Thu Jun 01, 2006 6:18 pm**

Deleted...

This text is now in the first post...

Posted: **Mon Jun 05, 2006 12:27 pm**

Hi fsw,

Just a quick thanks for this, it has been worthwhile exploring your approach.

So thanks!

Edit: BTW, do you use an INC macro? I turned asm on to make the code work (INC ii and etc).

Posted: **Mon Jun 05, 2006 4:48 pm**

Dare wrote:I turned asm on to make the code work (INC ii and etc).

me too.

Sorry forgot to mention...

Posted: **Wed Aug 09, 2006 7:15 am**

Hi fsw,

All I can say is: THANK YOU!

Incredible how you've integrated so many OOP concepts so elegantly.

Posted: **Wed Aug 09, 2006 3:46 pm**

Amundo wrote:Hi fsw,

All I can say is: THANK YOU!

Incredible how you've integrated so many OOP concepts so elegantly.

Thanks.

Actually what is displayed here are the early beginnings with no real lexer.
Just to figure out the principles how it could be done.

Here:
http://www.purebasic.fr/english/viewtopic.php?t=23062
you can see the readme file of the newest version 0.7 (3rd rewrite).
It uses a real lexer (by remi-meier) with a parser (by me) and all is written in the currently used oop syntax (not the same as above).

Now the only new keywords are: Class, EndClass, New and This,
and follows more the known syntax of Java and C++ (more or less...)
Include files can be used without loosing inheritance (multiple inheritance).

BTW: It translates itself which is pretty neat imho.

Thanks again for showing your appreciation.

Posted: **Thu Aug 10, 2006 11:59 am**

Is there a download which we can look at for the classes, as well as the readme?

Posted: **Tue Aug 15, 2006 7:25 pm**

Sorry not at the moment.

Because it's written in itself it doesn't make much sense to release the code; nobody could compile it (you would need the program). But... ...heck I don't even know if I will release the program at all.

It seems to me that only 4 people are really interested in this (me, you and 2 others that pm'ed me), far more people are bit**ing about oop in PB.

Also afaik the normal IDE doesn't allow to add keywords to be highlighted. Coding in such an environment is not really nice.

This said, at this point in time, it doesn't make much sense ... :roll:

Posted: **Wed Aug 16, 2006 12:16 am**

Posted: **Wed Aug 16, 2006 12:50 am**

New poll: whoever is interested in fsw's class parser please reply to thread.

I am interested.

And if you are not interested, please don't post anything here, this is not a debate about OOP in PB.

Posted: **Wed Aug 16, 2006 12:56 am**

definitely interested