POO : Module de Class générique et Template

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

POO : Module de Class générique et Template

Message par graph100 »

Suite à ce topic de microdevweb, j'ai fais un Module qui permet de créer des Classes et de les hériter.

Voici donc le module de base, il contient la classe générique 'Class', qui est mère de toutes les autres :

Code : Tout sélectionner

;{ MODULE Class

CompilerIf Defined(Class, #PB_Module) = #False


DeclareModule Class
	
	Structure ClassInfo
		*vTable
		ClassName.s
		*ClassParent.ClassInfo
		
		function_count.l
		
		Object_Instance.l
	EndStructure
	Global ClassInfo.ClassInfo
	
	
	; Function
	Interface Function
		Free()
		GetClassInfo.i()
	EndInterface
	
	; Structure Data holder
	Structure Struct_DATA
		*vTable
		*Class.ClassInfo
	EndStructure
	
	
	; Creator declaration (a macro for convience)
	Macro Init(_obj_)
		_obj_ = AllocateMemory(SizeOf(Struct_DATA))
		InitializeStructure(_obj_, Struct_DATA)
		
		_obj_\vTable = ClassInfo\vTable
		_obj_\Class = @ClassInfo
		
		ClassInfo\Object_Instance + 1
	EndMacro
	
	Macro Destroy(_obj_)
		FreeMemory(_obj_)
		ClassInfo\Object_Instance - 1
	EndMacro
	
	
	; Macro for vTable manipulation
	Macro Function_INHERIT_FROM_CLASS(_Class_)
		ClassInfo\vTable = AllocateMemory(SizeOf(Function))
		ClassInfo\ClassName = #PB_Compiler_Module
		ClassInfo\ClassParent = _Class_#@ClassInfo
		
		; héritage
		CopyMemory(_Class_#ClassInfo\vTable, ClassInfo\vTable, SizeOf(_Class_#Function))
		ClassInfo\function_count = SizeOf(_Class_#Function) / SizeOf(Integer)
	EndMacro
	
	Macro Function_OVERRIDE(_Function_)
		PokeI(ClassInfo\vTable + OffsetOf(Function\_Function_), @_Function_)
	EndMacro
	
	Macro Function_ADD(_Function_)
		PokeI(ClassInfo\vTable + ClassInfo\function_count * SizeOf(Integer), @_Function_)
		ClassInfo\function_count + 1
	EndMacro
	
	
EndDeclareModule


Module Class
	ClassInfo\vTable = AllocateMemory(SizeOf(Function))
	ClassInfo\ClassName = #PB_Compiler_Module
	
	
	; Commodity
	Procedure.i Get_Class_Info(*obj.Struct_DATA)
		ProcedureReturn *obj\Class
	EndProcedure
	
	
	; Destructor
	Procedure Free(*obj.Struct_DATA)
		
		ClearStructure(*obj, Struct_DATA)
		
		Destroy(*obj)
	EndProcedure
	
	
	; Add function in vTable
	Function_ADD(Free())
	Function_ADD(Get_Class_Info())
EndModule


CompilerEndIf

;}


;{ MODULE CLASS_NAME_HERE : parent =  PARENT_CLASS_NAME_HERE (Template)

CompilerIf 0 ; TO REMOVE

DeclareModule CLASS_NAME_HERE
	
	Global ClassInfo.Class::ClassInfo
	
	; Function
	Interface Function Extends PARENT_CLASS_NAME_HERE::Function
		; TO DO : yourNEW_function.l(param1)
	EndInterface
	
	; Structure Data holder
	Structure Struct_DATA Extends PARENT_CLASS_NAME_HERE::Struct_DATA
		; TO DO : champ1.l
	EndStructure
	
	; Inheritance of existing functions
	Class::Function_INHERIT_FROM_CLASS(PARENT_CLASS_NAME_HERE::)
	
	
	; Creator declaration
	Declare.i Create()
	
EndDeclareModule


Module CLASS_NAME_HERE
	
	
	; Constructor
	Procedure.i Create()
		Class::Init(*obj.Struct_DATA)
		
		; TO DO : *obj\champ1 = ...
		
		
		ProcedureReturn *obj
	EndProcedure
	
	
	; Methods
	
	; TO DO : Procedure.l your_new_function(*obj.Struct_DATA, param1, ...)
	
	
	; Destructor
	Procedure Free(*obj.Struct_DATA)
		; TO DO : ClearStructure(*obj, Struct_DATA)
		
		Class::Destroy(*obj)
	EndProcedure
	
	
	; Destructor override
	Class::Function_OVERRIDE(Free())
	
	; Add function in vTable
	
	; TO DO : Class::Function_ADD(your_new_function())
	
EndModule

CompilerEndIf ; TO REMOVE

;}

Pour coder les autres classes, il faut simplement copier le module template, puis remplacer toutes les occurences de :
- CLASS_NAME_HERE par le nom de votre classe
- PARENT_CLASS_NAME_HERE par le nom de la classe parent ('Class' si il n'y a pas encore de parent)

Pour voir ce que cela donne, nommez le code ci-dessus "MODULE_Class.pb" puis lancez le code ci-dessous :

Code : Tout sélectionner

; EXAMPLE :

IncludeFile "MODULE_Class.pb"


;{ MODULE Voiture : parent = Class

DeclareModule Voiture
	
	Global ClassInfo.Class::ClassInfo
	
	; Function
	Interface Function Extends Class::Function
		Avance(Vitesse.d)
		GetPuissance.l()
	EndInterface
	
	; Structure Data holder
	Structure Struct_DATA Extends Class::Struct_DATA
		Puissance.i
		Couleur.i
		
		x.l
	EndStructure
	
	; Inheritance of existing functions
	Class::Function_INHERIT_FROM_CLASS(Class::)
	
	
	; Creator declaration
	Declare.i Create()
	
EndDeclareModule


Module Voiture
	
	
	; Constructor
	Procedure.i Create()
		Class::Init(*obj.Struct_DATA)
		
		*obj\x = 50
		*obj\Puissance = 1000
		
		ProcedureReturn *obj
	EndProcedure
	
	
	; Methods
	Procedure Avance(*v.Struct_DATA, v.d)
		
		*v\x + v
		
		
		Debug *v\x
	EndProcedure
	
	Procedure.l Get_Puissance(*v.Struct_DATA)
		ProcedureReturn *v\Puissance
	EndProcedure
	
	
	; Destructor
	Procedure Free(*obj.Struct_DATA)
		
		Debug "Destructor for Class : Voiture"
		
		ClearStructure(*obj, Struct_DATA)
		
		Class::Destroy(*obj)
	EndProcedure
	
	
	; Destructor override
	Class::Function_OVERRIDE(Free())
	
	; Add function in vTable
	Class::Function_ADD(Avance())
	Class::Function_ADD(Get_Puissance())
	
EndModule

;}


;{ MODULE Peugeot : parent = Voiture

DeclareModule Peugeot
	
	Global ClassInfo.Class::ClassInfo
	
	; Function
	Interface Function Extends Voiture::Function
		GetName.s()
	EndInterface
	
	; Structure Data holder
	Structure Struct_DATA Extends Voiture::Struct_DATA
		name.s
	EndStructure
	
	; Inheritance of existing functions
	Class::Function_INHERIT_FROM_CLASS(Voiture::)
	
	
	; Creator declaration
	Declare.i Create()
	
EndDeclareModule


Module Peugeot
	
	
	; Constructor
	Procedure.i Create()
		Class::Init(*obj.Struct_DATA)
		
		*obj\x = 50
		*obj\Puissance = 2000
		
		*obj\name = "Ma belle peugeot"
		
		ProcedureReturn *obj
	EndProcedure
	
	
	; Methods
	Procedure.s Get_Name(*v.Struct_DATA)
		ProcedureReturn *v\name
	EndProcedure
	
	
	; Destructor
	Procedure Free(*obj.Struct_DATA)
		
		Debug "Destructor for Class : Peugeot"
		
		ClearStructure(*obj, Struct_DATA)
		
		Class::Destroy(*obj)
EndProcedure
	
	
	; Destructor override
	Class::Function_OVERRIDE(Free())
	
	; Add function in vTable
	Class::Function_ADD(Get_Name())
	
EndModule

;}




Debug "voiture"
Debug " "

*Voiture.Voiture::Function = Voiture::Create()

*Voiture\Avance(1)


Debug *Voiture\GetPuissance()


Debug " "
Debug "Peugeot"
Debug " "

*my_car.Peugeot::Function = Peugeot::Create()

*my_car\Avance(10)
Debug *my_car\GetPuissance()

Debug *my_car\GetName()

Debug ""
Debug "info générale : "

Debug ""

Debug "Class : " + Voiture::ClassInfo\ClassName
Debug "Nb instance : " + Voiture::ClassInfo\Object_Instance
Debug "Class Parent : " + Voiture::ClassInfo\ClassParent\ClassName

Debug ""

Debug "Class : " + Peugeot::ClassInfo\ClassName
Debug "Nb instance : " + Peugeot::ClassInfo\Object_Instance
Debug "Class Parent : " + Peugeot::ClassInfo\ClassParent\ClassName


Debug ""
Debug "info on '*my_car' : "

Debug ""

*class_info.Class::ClassInfo = *my_car\GetClassInfo()

Debug "Class : " + *class_info\ClassName
Debug "Nb instance : " + *class_info\Object_Instance
Debug "Class Parent : " + *class_info\ClassParent\ClassName

Ce n'est pas encore parfait, mais ça fonctionne.
Cela tient au fait que je ne suis pas du tout un expert en POO ! Je ne l'utilise que très rarement en vb.net (Youhou !).
Il y a peut-être des comportements qui sont normalement définit dans les classes des langages POO qui ne sont pas pris en charge ici.

Si vous avez des améliorations, n'hésitez pas à les poster !
Si vous voulez troller, passez votre chemin, la question n'est PAS de savoir si la POO, c'est cool.
Dernière modification par graph100 le mer. 06/août/2014 15:46, modifié 1 fois.
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: POO : Module de Class générique et Template

Message par Ollivier »

Y' a pas un bug dans le FreeMemory(*obj)?

Ce serait pas plutôt _obj_ ?
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

Re: POO : Module de Class générique et Template

Message par graph100 »

effectivement ! c'est corrigé
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: POO : Module de Class générique et Template

Message par microdevweb »

Je vais regarder à cela.... Cela semble fort intéressant merci graph100
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: POO : Module de Class générique et Template

Message par Ollivier »

Je me permets de te montrer un exemple de POO faite avec une version antérieure de PB, directement exécutable en PB, grâce à des macros. Je ne connaissais pas encore les modules.

C'était à titre expérimental. Alors, vu la tronche des macros pour y parvenir, j'ai su d'office que c'était trop contraignant et limité: il manque des fonctionnalités aux macros. Sans parler de l'éditeur qui se prenait un shut down avec le petit message "Contactez Fred svp" avant de tout quitter sans sauvegarder.

Alors mes critiques c'est une chose, mes conseils une autre chose: le compilateur est puissant, et largement à même de supporter un éditeur sur mesure pour la POO. Donc c'est ce que je me suis attelé de construire depuis. Et je te recommande de faire idem. Tu auras alors des sources oo plus simples encore et plus propres que le tas de pattes de mouches ci-dessous!

Code : Tout sélectionner

 ;*****************************************************************************************
; ***************************************** CODE ****************************************
;*****************************************************************************************





      Class(Device,
      
oo(               Sprite.I,
                  Keyboard.I,
                  Mouse.I,
                  ErrorMessage.S,
),

      Init, 

oo(               *Device\Sprite = InitSprite(),
                  If *Device\Sprite,
                        *Device\Keyboard = InitKeyboard(),
                        *Device\Mouse = InitMouse(),
                  EndIf,
),

      SendError,

oo(               MessageRequester("Device error", *Device\ErrorMessage),
                  End,
),

      Check, 

oo(               If *Device\Sprite = #False,
                        *Device\ErrorMessage = "Device subsystem is not installed !",
                        C_(*Device, SendError),
                  EndIf,
                  If *Device\Keyboard = #False,
                        *Device\ErrorMessage = "Keyboard is not installed !",
                        C_(*Device, SendError),
                  EndIf,
                  If *Device\Mouse = #False,
                        *Device\ErrorMessage = "Mouse is not installed !",
                        C_(*Device, SendError),
                  EndIf,
),

      )


      Class(Desktop,
      
oo(               Current.I,
                  Quantity.I,
                  Width.I,
                  Height.I,
                  Depth.I,
                  Frequency.I,
),

      Examine,

oo(               *Desktop\Quantity  = ExamineDesktops(),
                  *Desktop\Width     = DesktopWidth(*Desktop\Current),
                  *Desktop\Height    = DesktopHeight(*Desktop\Current),
                  *Desktop\Depth     = DesktopDepth(*Desktop\Current),
                  *Desktop\Frequency = DesktopFrequency(*Desktop\Current),
),

      )



      Class(Screen,

oo(               Handle.I,
                  Width.I,
                  Height.I,
                  Depth.I,
                  Title.S,
                  Modified.I,
                  Color.I,
                  *Desktop,
),

      Open,

                  *Screen\Handle = OpenScreen(*Screen\Width, *Screen\Height, *Screen\Depth, *Screen\Title),

      Close,

oo(               If *Screen\Handle,
                        CloseScreen(),
                  EndIf,
),

      Clear,

oo(               *Screen\Modified = #True,
                  ClearScreen(*Screen\Color),
),

      Flip,

oo(               If *Screen\Modified = #True,
                        FlipBuffers(),
                  EndIf,
),

      ImportResolutionFromDesktop,

oo(               Inherit(Desktop, Screen),
                  *Screen\Width  = *Desktop\Width,
                  *Screen\Height = *Desktop\Height,
                  *Screen\Depth  = *Desktop\Depth,
),

)


   
      Class(Processor,

oo(               Duration.I,
                  Clock.I,
),

      SetDelay,

                  Delay(*Processor\Duration),

      GetClock,

                  *Processor\Clock = ElapsedMilliseconds(),

      )


#RegionType_Rectangle = 1
#RegionDisplayMode_Direct = 1

      Class(Region,

oo(               *Parent,
                  X1.I,
                  Y1.I,
                  X2.I,
                  Y2.I,
                  Width.I,
                  Height.I,
                  Type.I,           ; Cf constants
                  FrontColor.I,
                  DisplayMode.I,    ; Cf constants
                  *Desktop,
),

      CreateDirectRectangle,

oo(               *Region\Type = #RegionType_Rectangle,
                  *Region\DisplayMode = #RegionDisplayMode_Direct,
),

      SizeFromDesktop,

oo(               Inherit(Desktop, Region),
                  *Region\X1 = 0,
                  *Region\Y1 = 0,
                  *Region\X2 = *Desktop\Width - 1,
                  *Region\Y2 = *Desktop\Height - 1,
                  *Region\Width = *Desktop\Width,
                  *Region\Height = *Desktop\Height,
),

      SizeFromParent,

oo(               Protected *Parent.REGION,
                  *Parent = *Region\Parent,
                  *Region\X1 = *Parent\X1,
                  *Region\Y1 = *Parent\Y1,
                  *Region\X2 = *Parent\X2,
                  *Region\Y2 = *Parent\Y2,
                  *Region\Width = *Parent\Width,
                  *Region\Height = *Parent\Height,
),

      RandomizeColor,

                  *Region\FrontColor = RGB(Random(255), Random(255), Random(255) ),

      Output,

oo(               Select *Region\DisplayMode,

                        Case #RegionDisplayMode_Direct,
                               StartDrawing(ScreenOutput() ),

                  EndSelect,

                  Select *Region\Type,

                        Case #RegionType_Rectangle,
                               Box(*Region\X1, *Region\Y1, *Region\Width, *Region\Height, *Region\FrontColor),

                  EndSelect,

                  StopDrawing(),
),

      )



      Class(Software,

oo(               *Device,
                  *Desktop,
                  *Screen,
                  *Processor,
                  *Region,
                  QuitFlag.I,
                  StandByDelay.I,
                  StandByClock.I,
),

      Init,
oo(               RootInherit(Device, Software),
                  RootInherit(Desktop, Software),
                  RootInherit(Screen, Software),
                  RootInherit(Processor, Software),
                  RootInherit(Region, Software),
),
      
      Start,
oo(               C_(*Software, Init),
                  Inherit(Device, Software),
                  Inherit(Desktop, Software),
                  Inherit(Screen, Software),
      
                  C_(*Device, Init),
                  C_(*Device, Check),
      
                  *Desktop\Current = 0,
                  C_(*Desktop, Examine),  
      
                  *Screen\Desktop = *Desktop,
                  C_(*Screen, ImportResolutionFromDesktop),
      
                  *Screen\Title = "Untitled",
                  C_(*Screen, Open),
      
                  *Screen\Color = RGB(0, 0, 0),
                  C_(*Screen, Clear),
      
                  C_(*Screen, Flip),
),

      Finish,
oo(               Inherit(Screen, Software),
                  C_(*Screen, Close),
),

      Wait,
oo(               Inherit(Processor, Software),
      
                  *Processor\Duration = 2000,
                  C_(*Processor, SetDelay),
),

      StandBy,
oo(               Inherit(Processor, Software),
                  If *Software\StandByClock = 0,
                        *Software\StandByClock = *Processor\Clock + *Software\StandByDelay,
                  Else,
                        If *Processor\Clock > *Software\StandByClock,
                              *Software\QuitFlag = #True,
                        EndIf,
                  EndIf,
),

      Interface,
oo(               C_(*Software, Start),
                  Inherit(Processor, Software),
                  Inherit(Region, Software),
                  Inherit(Desktop, Software),
                  Inherit(Screen, Software),
      
                  *Processor\Duration = 1,       ; (milliseconds)
                  *Software\StandByDelay = 3000, ; (milliseconds)

                  Dim *Region.REGION(255),
                  C_(*Region, CreateDirectRectangle),
                  *Region\Desktop = *Desktop,
                  C_(*Region, SizeFromDesktop),
                  C_(*Region, RandomizeColor),
                  MakeObject(Region, 0),

                  C_(*Region, CreateDirectRectangle),
                  *Region\Parent = *Region(0),
                  C_(*Region, SizeFromParent),
                  *Region\Height = 32,
                  C_(*Region, RandomizeColor),
                  MakeObject(Region, 1),

                  Repeat,
                        C_(*Processor, GetClock),
                        C_(*Processor, SetDelay),
                        C_(*Software, StandBy),
                        *Region = *Region(0),
                        C_(*Region, Output),
                        *Region = *Region(1),
                        C_(*Region, Output),
                        C_(*Screen, Flip),
                  Until *Software\QuitFlag, 
                  C_(*Software, Finish),
),

      )



      ;
      C_(Software, Interface)

 
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: POO : Module de Class générique et Template

Message par Ollivier »

Bonsoir... J'ai enfin retrouvé cet en-tête plein de macros tordues.
Alors c'est "impunchable" donc hors compétition. Et puis surtout, il n'y a rien de spectaculaire. ça fait autour de 30 ans que ça existe en C. Mais c'est vrai que c'est utile. Et puis il manque encore pas mal de fonctionnalités pour faire directement de l'oo mais ce n'est pas grave.

Code : Tout sélectionner

 
;{ Macro }

Macro Quo
"
EndMacro

Macro C_(Object, Method)
      CallFunctionFast(Object#\Method, Object)
EndMacro

Macro Inherit(Inherited, Inheriting)
      Protected *Inherited.Inherited = *Inheriting\Inherited      
EndMacro
      
Macro RootInherit(Inherited, Inheriting)
      Shared Inherited
      *Inheriting\Inherited = Inherited
EndMacro

Macro oo(A,B=,C=,D=,E=,F=,G=,H=,I=,J=,K=,L=,M=,N=,O=,P=,Q=,R=,S=,T=,U=,V=,W=,X=,Y=,Z=,A2=,B2=,C2=,D2=,E2=,F2=)
      A
      B
      C
      D
      E
      F
      G
      H
      I
      J
      K
      L
      M
      N
      O
      P
      Q
      R
      S
      T
      U
      V
      W
      X
      Y
      Z
      A2
      B2
      C2
      D2
      E2
      F2
EndMacro

Macro Builder(Obj, M1, C1)
      Procedure Obj#M1(*Obj.Obj)
      C1
      EndProcedure
      Obj\M1 = @Obj#M1()
EndMacro

Macro Class(Obj,ArgSet,M1,C1,M2=EndC,C2=,M3=EndC,C3=,M4=EndC,C4=,M5=EndC,C5=,M6=EndC,C6=,M7=EndC,C7=)
      Structure Obj
            ArgSet
            *M1
            CompilerIf Quo#M2#Quo <> Quo#EndC#Quo
                  *M2
                  CompilerIf Quo#M3#Quo <> Quo#EndC#Quo
                        *M3
                        CompilerIf Quo#M4#Quo <> Quo#EndC#Quo
                              *M4
                              CompilerIf Quo#M5#Quo <> Quo#EndC#Quo
                                    *M5
                                    CompilerIf Quo#M6#Quo <> Quo#EndC#Quo
                                          *M6
                                          CompilerIf Quo#M7#Quo <> Quo#EndC#Quo
                                                *M7
                                          CompilerEndIf
                                    CompilerEndIf
                              CompilerEndIf
                        CompilerEndIf
                  CompilerEndIf
            CompilerEndIf
      EndStructure
      Define Obj.Obj
      Builder(Obj, M1, C1)
      CompilerIf Quo#M2#Quo <> Quo#EndC#Quo
            Builder(Obj, M2, C2)
            CompilerIf Quo#M3#Quo <> Quo#EndC#Quo
                  Builder(Obj, M3, C3)
                  CompilerIf Quo#M4#Quo <> Quo#EndC#Quo
                        Builder(Obj, M4, C4)
                        CompilerIf Quo#M5#Quo <> Quo#EndC#Quo
                              Builder(Obj, M5, C5)
                              CompilerIf Quo#M6#Quo <> Quo#EndC#Quo
                                    Builder(Obj, M6, C6)
                                    CompilerIf Quo#M7#Quo <> Quo#EndC#Quo
                                          Builder(Obj, M7, C7)
                                    CompilerEndIf
                              CompilerEndIf
                        CompilerEndIf
                  CompilerEndIf
            CompilerEndIf
      CompilerEndIf
EndMacro

Macro MakeObject(Obj, Index)                                        ; In an array
      *Obj(Index) = AllocateMemory(SizeOf(Obj) )
      CopyMemory(*Obj, *Obj(Index), SizeOf(Obj) )
EndMacro

;}


 
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

Re: POO : Module de Class générique et Template

Message par graph100 »

le problème que ça, c'est que l'autocomplétion ne fonctionne pas correctement.
Et c'est un point bloquant pour moi :wink:

En tout cas merci pour toutes ces macros, c'est un autre principe que celui que j'avais trouvé sur le fofo anglais, par luis je crois...
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
kwandjeen
Messages : 204
Inscription : dim. 16/juil./2006 21:44

Re: POO : Module de Class générique et Template

Message par kwandjeen »

Au fil de mes recherches j'ai trouvé plusieurs truc pour faire de la pseudo POO

Exemple 1

Code : Tout sélectionner

Interface essai_IN ;declaration interface
  proc()
EndInterface

Structure essai_MT ;declaration pointeur methode
  *proc
EndStructure


Structure essai_MB ;declaration des membres
  *MT.essai_MT
  version.s
EndStructure

Structure essai ;lien entre les structure
  MT.essai_MT ;lien vers methode
  mb.essai_MB ;lien vers membre
  action.essai_IN ;lien vers interface
EndStructure

; sous classe
; Interface avion_IN Extends essai_IN
;   proc2()
;   proc3()
; EndInterface
; 
; Structure avion_MT Extends essai_MT
;   *proc2
;   *proc3
; EndStructure
; 
; Structure avion_MB Extends essai_MB
;   ;*MTS.avion_MT
;   msn.s
; EndStructure
; 
; Structure avion
;   MT.avion_MT ;lien vers methode
;   lg.avion_MB ;lien vers membre
;   action.avion_IN ;lien vers interface
; EndStructure
Procedure proc(*this.essai_MB)
  Debug *this\version
EndProcedure

  *objet.essai = AllocateMemory(SizeOf(essai))
  *objet\mb\MT = *objet\MT
  *objet\action = @*objet\mb
  *objet\MT\proc = @proc()

  *objet\mb\version = "atr72-500"
  *objet\action\proc()
Exemple 2

Code : Tout sélectionner

;{
Macro class(classname)
  Interface classname#_IN
EndMacro
Macro methode(classname)
  EndInterface
  Structure classname#_MT
EndMacro

Macro membre(classname)
  EndStructure
  Structure classname#_MB
  *MT.classname#_MT  
EndMacro

Macro endclass(classname)
  EndStructure
  Structure classname
    MT.classname#_MT
    mb.classname#_MB
    action.classname#_IN
  EndStructure
EndMacro
;----- CLASS HERITAGE
Macro class_h(classname,classmere)
  Interface classname#_IN Extends classmere#_IN
EndMacro
Macro methode_h(classname,classmere)
  EndInterface
  Structure classname#_MT Extends classmere#_MT
EndMacro

Macro membre_h(classname,classmere)
  EndStructure
  Structure classname#_MB Extends classmere#_MB  
EndMacro
;----- CREATION D'UN OBJET OU LISTE
Macro new_listclass(classname,liste)
  Global NewList liste.classname#()
EndMacro

Macro new_objetclass(classname,objet)
  *objet.classname = AllocateMemory(SizeOf(classname))
  *objet\mb\MT = *objet\MT
  *objet\action = @*objet\mb 
EndMacro
;----- AJOUT ITEM A UNE LISTE
Macro add_item_listclass(liste)
  AddElement(liste#())
  liste#()\mb\MT = liste#()\MT
  liste#()\action = @liste()\mb
EndMacro
;----- AJOUT UNE METHODE A UNE LISTE
Macro add_methode_listclass(liste,methode,proc)
  liste#()\MT\methode = @proc#()
EndMacro
;----- AJOUTE UNE METHODE A UN OBJET
Macro add_methode_objetclass(objet,methode,proc)
  *objet\MT\methode = @proc#()
EndMacro
;----- FONCTION POUR LA CREATION DE PROCEDURE
Macro mb(membre)
  *this\membre
EndMacro

Macro Pointerclass(classname)
  *this.classname
EndMacro

Macro insert_methode(methode,proc)
  *this\MT\methode = @proc#()
EndMacro

Macro PointerMB(classname_MB)
  *this.classname_MB#_MB
EndMacro
;----- FIN MACRO
;}

class(com)
  position(x,y)
methode(com)
  *position
membre(com)
  vie.l
  x.l
  y.l
endclass(com)

class_h(perso,com)
  proc_bidon()
methode_h(perso,com)
  *proc1
membre_h(perso,com)
  arme.s
endclass(perso)

Procedure position(PointerMB(com),x,y)
  mb(x) = x
  mb(y) = y
EndProcedure

Procedure proc_bidon(PointerMB(perso))
  Debug "cette procédure ne sert à rien"
  ProcedureReturn mb(vie)
EndProcedure

Procedure methode_alien(Pointerclass(com)) ;exemple avec les macros
  ;*alien\MT\position = @position()
  add_methode_objetclass(this,position,position)
  ;insert_methode(position,position) ;utilisable seulement dans les procedures commun objet et liste
EndProcedure

Procedure methode_personnage(*this.perso) ;sans les macros
  *this\MT\position = @position()
  *this\MT\proc1 = @proc_bidon()
EndProcedure

new_objetclass(com,alien)
;add_methode_objetclass(alien,position,position)
methode_alien(*alien)

*alien\mb\vie = 100
*alien\action\position(25,30)

new_objetclass(perso,perso1)
;add_methode_objetclass(perso1,position,position)
;add_methode_objetclass(perso1,proc1,proc_bidon)
methode_personnage(*perso1)

*perso1\action\position(13,24)
*perso1\mb\vie = 85
*perso1\mb\arme = "hache"
Debug "proc_bidon vie perso1: "+Str(*perso1\action\proc_bidon())

Debug "ALIEN :"
Debug "position : "+Str(*alien\mb\x)+" : "+Str(*alien\mb\y)
Debug "vie : "+ Str(*alien\mb\vie)
Debug "PERSO 1 :"
Debug "position : "+Str(*perso1\mb\x)+" : "+Str(*perso1\mb\y)
Debug "vie : "+ Str(*perso1\mb\vie)
Debug "Arme : "+ *perso1\mb\arme

If *alien\mb\vie > *perso1\mb\vie
  MessageRequester("Attention","L'alien à plus de vie que vous !"+Chr(13)+"utiliser votre "+*perso1\mb\arme)
EndIf
exemple 3

Code : Tout sélectionner

Interface classei
  Methode1()
  Methode2(argument)
  retour()
EndInterface

Structure Classe
  *vtable  
  attribut1.b
  attribut2.b
  *methode1
  *methode2
EndStructure

Procedure Methode1(*this.Classe)
  MessageRequester("POO avec purebasic",Str(*this\attribut1))
EndProcedure

Procedure Methode2(*this.Classe,argument)
  *this\attribut1 = argument
EndProcedure

Procedure retour(*this.classe)
  ProcedureReturn *this\attribut1
EndProcedure

;Le constructeur
Procedure.i New_Classe(attribut1,attribut2)
  *this.Classe    = AllocateMemory(SizeOf(Classe))
  *this\attribut1 = attribut1
  *this\attribut2 = attribut2

  *this\vtable = ?data_vt  
  ProcedureReturn *this
EndProcedure


*objet.Classei = New_Classe(12,13)

*objet\Methode1()
*objet\Methode2(23)
*objet\Methode1()
Debug *objet\retour()

FreeMemory(*objet)

DataSection
  data_vt:
  Data.i @Methode1()
  Data.i @Methode2()
  Data.i @retour()
EndDataSection
exemple 4

Code : Tout sélectionner

;Code:
;oop example by fsw
;extends the Fantaisie Software "Labels/address in datasection"
;example with Properties - now we have Methods and Properties


;~~~~~~~~~~~~~~~~~~~~
;Start MyObject class
;~~~~~~~~~~~~~~~~~~~~

;define Methods
Interface MyObject
   StoreThis(par.l)
   GetThat()
   ;add more Methods if needed
EndInterface

;define Properties
Structure MyObject_Properties
   *VTable ;this is needed to store the address of the Methods vtable
   ValueOfThat.l ;start with the properties
   ;add more properties if needed
EndStructure

;this method/procedure can have a different name than in the interface
;the only thing that is important is the position in the vtable
Procedure This(*Self.MyObject_Properties, par.l)
   *Self\ValueOfThat = par
   MessageRequester("MyObject", "This: " + Str(par))
EndProcedure

;this method/procedure can have a different name than in the interface
;the only thing that is important is the position in the vtable
Procedure That(*Self.MyObject_Properties)
   MessageRequester("MyObject", "That: " + Str(*Self\ValueOfThat))
EndProcedure


;Create a class list
;this way there can be more than one object of a class
Global NewList MyObject_List.MyObject_Properties()

Procedure CreateThisClass()
   AddElement(MyObject_List())
   MyObject_List()\VTable = ?Procedures
   ProcedureReturn MyObject_List()
EndProcedure

;- start main:
m.MyObject = CreateThisClass()

m\StoreThis(347)
m\GetThat()


End

DataSection
   Procedures:
      Data.i @This(), @That()
EndDataSection
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: POO : Module de Class générique et Template

Message par Ollivier »

graph100 a écrit :le problème que ça, c'est que l'autocomplétion ne fonctionne pas correctement.
Et c'est un point bloquant pour moi
En tout cas merci pour toutes ces macros, c'est un autre principe que celui que j'avais trouvé sur le fofo anglais, par luis je crois...
Mais en fait, l'absence d'auto-complétion, ce n'est pas grave.
C'est DANS ton programme que tu récupères, schématises et exécutes tes méthodes.

Rajoute ça en dernières lignes de la macro Builder()

Code : Tout sélectionner

Debug "Nom de la méthode : " + Quo#Obj#M1#Quo + "()"
Debug "Adresse d'appel = 0x" + RSet(Hex(Obj\M1), 8, "0") + "h"
Debug " "
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

Re: POO : Module de Class générique et Template

Message par graph100 »

Oui, bien sur le code fonctionne.

Mais à la base c'est quand même pour apporter un confort de programmation, plutôt que de se masturber le cerveau,
je n'arrive pas à gérer le nom de toutes tes méthodes de tête !

Et depuis que je travaille en javascript / appsScript, je me rend compte à quel point l'éditeur PB est confortable.
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: POO : Module de Class générique et Template

Message par Ollivier »

Je pense que tout est question de besoin. Devant un terme qui s'auto-complète, tu peux me filmer et me publier au zapping: je suis un hybride entre un shadok qui pompe dans le vide et un lapin crétin. La séquence fera de l'audimat, ça c'est sûr...
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Re: POO : Module de Class générique et Template

Message par nico »

graph100 a écrit :Oui, bien sur le code fonctionne.

Mais à la base c'est quand même pour apporter un confort de programmation, plutôt que de se masturber le cerveau,
je n'arrive pas à gérer le nom de toutes tes méthodes de tête !
J'ai fait un truc, il y a très longtemps, ça peut t'intéresser:
http://www.purebasic.fr/french/viewtopi ... ilit=MACRO
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: POO : Module de Class générique et Template

Message par Ollivier »

Bonjour nico,

En "piquant" ta pédagogie que t'as usé dans le sujet de ton lien, à savoir en montrant un code, des macros et le code source qui en résulte, je poste ce code simpliste d'une classe 'calcul'.

Dans ton rappel, tu indiques bien l'ordre des tables (attributs APRES méthodes, mais les macros ne supportent pas ça si tu veux rajouter la possibilité des arguments, d'où l'obligation d'un éditeur spécifique oo...)

1) On récupère l'en-tête (les grosses macros tordues plus haut)
2) On les inclut en tête de ce code ci-dessous
3) On exécute le code pour vérifier qu'il n'y a pas d'erreur de copie
4) On créée une erreur de macro (rajout d'une parenthèse superflue en fin de classe)
5) On copie le source obtenu dans la fenêtre d'erreur de macro
6) On le colle dans l'éditeur en nouveau fichier
7) On dégage les directives du compilateur

Et voilà! La quasi-pure syntaxe orientée objet supportée en PureBasic dans les limites offertes pas les macros...

Code : Tout sélectionner


      ; ici un 'define' est produit pour pouvoir exécuter le test plus bas...

      Class(Calcul,
      



								Entier.I,



      		MetAZero,

								*Calcul\Entier = 0,

				Incremente,

								*Calcul\Entier + 1,

				Decremente,

								*Calcul\Entier - 1,

				Double,

								*Calcul\Entier * 2,				

				Affiche,

								MessageRequester("Valeur de l'entier", Str(*Calcul\Entier) ),


	      )

			
			
			CalculMetAZero(Calcul)   ; v = 0
			CalculIncremente(Calcul) ; v = v + 1 donc v = 1
			CalculDouble(Calcul)     ; v = v * 2 donc v = 2
			CalculAffiche(Calcul)
            CallFunctionFast(Calcul\Affiche, Calcul) ; une autre méthode d'appel...
            C_(Calcul, Affiche) ; encore une autre...

; Allez une dernière de tête (illuminée, affichera 8)
; (si pas d'erreur)
A$="122445" ; un "programme"
for i=1 to len(a$)
callfunctionfast(Calcul + 4 * (val(mid(A$,i,1))), Calcul)
next

Répondre