Source:Realiser un RPG2D avec PureBasic/Les cartes

[modifier] Pour la version 4.0

Pour que cette démo fonctionne sur la version 4.0, votre main.pb sera comme ceci :

;** main.pb
;**
;** Fichier principal.
;**
;** Rôle:
;** - initialisation des bibliothèques et ouvre un écran en mode plein écran.
;**  

XIncludeFile "main.pbi"
Init()
Main()
End

;**
;** Initialisation du programme
;**

Procedure Init()
    
    ; Initialise l'environnement nécessaire au fonctionnement des sprites.
    If InitSprite()=0
        MessageRequester("Erreur InitSprite()","Impossible d'initialiser DirectX 7 (ou +)",0)
        End
    EndIf
    
    ; Initialise l'environnement propre à la gestion du clavier.
    If InitKeyboard()=0
        MessageRequester("Erreur InitKeyBoard()","Impossible d'initialiser DirectX 7 (ou +)",0)
        End
    EndIf
    
    ; Initialise l'environnement propre à la gestion de la souris.
    If InitMouse()=0
        MessageRequester("Erreur InitMouse()","Impossible d'initialiser DirectX 7 (ou +)",0)
        End
    EndIf
    
    ; Initialise l'environnement propre à la gestion des fichiers multimédias.
    If InitMovie()=0
        MessageRequester("Erreur InitMovie()","Impossible d'initialiser DirectX 7 (ou +)",0)
        End
    EndIf
    
    ; Initialise l'environnement sonore.
    If InitSound()=0
        MessageRequester("Erreur InitSound()","Impossible d'initialiser DirectX 7 (ou +)",0)
        End
    EndIf
    
    ; Ouvre un nouvel écran avec les caractéristiques Largeur, Hauteur et Profondeur.
    If OpenScreen(800,600,32,"RPG 2D - Games Creators Network (http://www.games-creators.org)")=0
        MessageRequester("Erreur OpenScreen()","Impossible d'initialiser DirectX 7 (ou +)",0)
        End
    EndIf
    
    ;Active le support du format PNG (Portable Network Graphic)
    UsePNGImageDecoder()
    
EndProcedure


Procedure Main()
map.s_map
    
    RandomizeMap(@map,100,100,"tiles\mchip0.bmp");
    SaveMap(@map,"map\save.map", "musique\Opening1.mid", "tiles\mchip0.bmp");

    Repeat
       
        FlipBuffers()
        ClearScreen(RGB($00,$00,$00))
        MapEvent(@map)
        HandleMap(@map)
        
    Until KeyboardPushed(#PB_Key_Escape) 
    
    FreeMap(@map)

EndProcedure
; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 9
; Folding = -

votre main.pbi sera comme ceci :

;/*
;** main.pb
;**
;** Fichier principal.
;**
;** Rôle:
;** - 
XIncludeFile "map.pb"
Declare Init()
Declare Main()
; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 7
; Folding = -

votre map.pb sera comme ceci :

;** map.pb
;**
;** Gestion des cartes.
;**
;** Rôle:
;** - chargement / sauvegarde des cartes
;** - affichage des cartes
;** - génération automatique d'une carte

XIncludeFile "map.pbi"



Procedure InitMap(*map.s_map)
    *map\n_tile=0
    *map\width=0
    *map\Height=0
    *map\offsetX=0
    *map\offsetY=0
    *map\surf_chipset\Id=0
    *map\bg_sound=0
EndProcedure

Procedure FreeMap(*map.s_map)
    ;Remarque , PureBasic se charge de libérer la mémoire lorsqu'on quitte le programme 
    ;Cette fonction est tout de même conservée pour rester similaire au programme d'origine.
    FreeSprite(*map\surf_chipset\Id)
    Dim DataMap(0)
    Dim chipset.s_chipset(0)
   
    If IsMovie(*map\bg_sound)
        StopMovie(0)
        FreeMovie(*map\bg_sound)
    EndIf   
 
EndProcedure

Procedure RandomizeMap(*map.s_map, width.l, Height.l, NomChipset.s)
    Protected i,x,y
    
    InitMap(*map);
    
    ;Charge le chipset et mémorise son identifiant
    *map\surf_chipset\Id=LoadSprite(#PB_Any,NomChipset)

    If *map\surf_chipset\Id=0
        MessageRequester("Erreur","Impossible de charger " + NomChipset,0)
       End
    EndIf    

    ;Change la couleur transparente du sprite
    TransparentSpriteColor(*map\surf_chipset\Id, RGB($08,$33,$82))
    
    ;Stock les dimensions du sprite
    *map\surf_chipset\w=SpriteWidth(*map\surf_chipset\Id)
    *map\surf_chipset\h=SpriteHeight(*map\surf_chipset\Id)
    
    ;Calcule le nombre de tiles disponibles sur le chipset
    *map\n_tile=(*map\surf_chipset\w/#TILE_WIDTH)*(*map\surf_chipset\h/#TILE_HEIGHT);
    
    ;Tableau contenant les caractéristiques de chaque tile du chipset
    Dim chipset.s_chipset(*map\n_tile);

    x=0
    y=0
    
    For i=0 To *map\n_tile-1
        chipset(i)\x=x;
        chipset(i)\y=y;
        chipset(i)\Collision=0;
        chipset(i)\nextTile=0;
        x + #TILE_WIDTH
        If x>*map\surf_chipset\w-#TILE_WIDTH
            x=0;
            y + #TILE_HEIGHT;
        EndIf
    Next i
    
    *map\width = width;
    *map\Height = Height;
    
    ;Tableau contenant les données de la carte
    Dim DataMap.l(*map\width * *map\Height)
    
     
    For x=0 To *map\width-1
        For y=0 To *map\Height-1
            DataMap(GET_TILE(x,y,*map))=Random(*map\n_tile-1);
        Next y
    Next x
    
EndProcedure

Procedure HandleMap(*map.s_map)
    
    Protected x,y,tx,ty,src.point 

    x=-(*map\offsetX%#TILE_WIDTH)
    y=-(*map\offsetY%#TILE_HEIGHT)
    tx=*map\offsetX/#TILE_WIDTH
    ty=*map\offsetY/#TILE_HEIGHT
     
    While(y<600)
        
        x=-(*map\offsetX%#TILE_WIDTH)
        tx=*map\offsetX/#TILE_WIDTH
        
        While(x<800)
            
            src\x=chipset(DataMap(GET_TILE(tx,ty,*map)))\x
            src\y=chipset(DataMap(GET_TILE(tx,ty,*map)))\y
            
            ClipSprite(*map\surf_chipset\Id, src\x, src\y,#TILE_WIDTH, #TILE_HEIGHT)
            
            DisplayTransparentSprite(*map\surf_chipset\Id,x,y)
            
       
            x+ #TILE_WIDTH;
            tx + 1;
        Wend
        y + #TILE_HEIGHT;
        ty + 1
    Wend
    
EndProcedure

Procedure SaveMap2(*map.s_map, filename.s, bg_sound.s, chipset.s)
    
    Protected i,x,y, filenumber
    *Buffer=AllocateMemory(256)
    
    If *map=0
        ProcedureReturn
    EndIf
    
    filenumber = OpenFile(0,filename)
    
    If filenumber=0
        ProcedureReturn
    EndIf
    
    
    WriteData(@bg_sound,*buffer,Len(bg_sound));
    ;WriteData(*Buffer,255-Len(bg_sound))
    
    
    WriteData(@chipset,*Buffer,Len(chipset));
    ;WriteData(*Buffer,255-Len(chipset))

    WriteLong(filenumber,*map\n_tile)
    WriteLong(filenumber,*map\width)
    WriteLong(filenumber,*map\Height)
    WriteLong(filenumber,*map\offsetX)
    WriteLong(filenumber,*map\offsetY)
    
    For i=0 To i<*map\n_tile-1
        WriteLong(filenumber,chipset(i)\x)
        WriteLong(filenumber,chipset(i)\y)
        WriteByte(filenumber,chipset(i)\Collision)
        WriteLong(filenumber,chipset(i)\nextTile)
    Next i
    
    For x=0 To *map\width-1
        For y=0 To *map\Height-1
            WriteLong(filenumber,DataMap(GET_TILE(x,y,*map)));
        Next y
    Next x    
    CloseFile(0)
EndProcedure

Procedure SaveMap(*map.s_map, filename.s, bg_sound.s, chipset.s)
    
    Protected i,x,y, filenumber
    *Buffer=AllocateMemory(256)
    If *map=0
        ProcedureReturn
    EndIf
    filenumber=OpenFile(0,filename)
    If filenumber=0
        ProcedureReturn
    EndIf
    
    PokeS(*buffer, bg_sound,Len(bg_sound)) 
    WriteData(0,*Buffer,Len(bg_sound));
    PokeS(*buffer,chipset,Len(chipset) ) 
    WriteData(0,*Buffer,Len(chipset));
    
    WriteLong(0,*map\n_tile)
    WriteLong(0,*map\width)
    WriteLong(0,*map\Height)
    WriteLong(0,*map\offsetX)
    WriteLong(0,*map\offsetY)
    
    WriteData(0,chipset(),*map\n_tile*SizeOf(s_chipset))
  
    WriteData(0,DataMap(),*map\width * *map\Height*SizeOf(LONG))
 
    CloseFile(0)
EndProcedure

Procedure LoadMap(*map.s_map,filename.s)

    Protected i,x,y, filenumber
    
    If *map=0
        ProcedureReturn
    EndIf   
    
    filenumber=OpenFile(0,filename)
    
    If filenumber=0
        ProcedureReturn
    EndIf
    
    
    ;BG SOUND   
    ;Musique.s=ReadString()
    FichierMusique.s=Space(256)
    ReadData(filenumber,@FichierMusique,255)

    *map\bg_sound = LoadMovie(#PB_Any,FichierMusique);
    If *map\bg_sound=0
        MessageRequester("Erreur","Erreur lors du chargement de la carte: impossible de charger " + FichierMusique)
        End
    EndIf    
    
    ;chipset 
    FichierChipset.s=Space(256)
    ReadData(filenumber,@FichierChipset,255)

    *map\surf_chipset\Id=LoadSprite(#PB_Any,FichierChipset)
    
    If *map\surf_chipset\Id=0
        MessageRequester("Erreur","Impossible de charger " + FichierChipset,0)
        End
    EndIf    
    
    ;Change la couleur transparente du sprite
    TransparentSpriteColor(*map\surf_chipset\Id, RGB($08,$33,$82))
    
    *map\surf_chipset\Id=LoadSprite(#PB_Any,FichierChipset);
    *map\surf_chipset\w=SpriteWidth(*map\surf_chipset\Id)
    *map\surf_chipset\h=SpriteHeight(*map\surf_chipset\Id)
    
    *map\n_tile=ReadLong(0)
    *map\width=ReadLong(0)
    *map\Height=ReadLong(0)
    *map\offsetX=ReadLong(0)
    *map\offsetY=ReadLong(0)
    
    Dim chipset.s_chipset(*map\n_tile)
    
    For i=0 To *map\n_tile-1
        chipset(i)\x=ReadLong(0)
        chipset(i)\y=ReadLong(0)
        chipset(i)\Collision=ReadByte(0)
        chipset(i)\nextTile=ReadLong(0)
    Next i
    
    Dim DataMap.l(*map\width * *map\Height)
    
    For x=0 To *map\width-1
        For y=0 To *map\Height-1
            
            NoTile=ReadLong(0)
            If NoTile>=*map\n_tile
                MessageRequester("Erreur","Carte corrompue à la position => " +Str(x) + " / " + Str(y),0)
                NoTile=0;
            EndIf    
            DataMap(GET_TILE(x,y,*map))=NoTile;
        Next y
    Next x
    CloseFile(0)
    
    ;Joue la musique 
    PlayMovie(*map\bg_sound,ScreenID())
    
EndProcedure

Procedure MapEvent(*map.s_map)
    
    If ExamineKeyboard()
        
        If KeyboardPushed(#PB_Key_Right)
            
            If *map\offsetX<*map\width*#TILE_WIDTH-800
                *map\offsetX + 1
            EndIf    
            
        ElseIf KeyboardPushed(#PB_Key_Left)
            
            If (*map\offsetX<>0)
                *map\offsetX - 1
            EndIf
        EndIf
        
        If KeyboardPushed(#PB_Key_Down)
            
            If *map\offsetY<*map\Height*#TILE_HEIGHT-600 
                *map\offsetY + 1
            EndIf
            
        ElseIf KeyboardPushed(#PB_Key_Up)
            
            If *map\offsetY<>0
                *map\offsetY - 1
            EndIf 
            
        EndIf
        
    EndIf
    
EndProcedure


; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 264
; FirstLine = 236
; Folding = --

votre map.pbi sera comme ceci :

;
; map.pbi
;
; Gestion des cartes.
;
;

#TILE_WIDTH  = 32
#TILE_HEIGHT = 32

Structure s_chipset
  x.l
  y.l
  Collision.b
  nextTile.l
EndStructure

Structure Surface
    Id.l
    w.l
    h.l
EndStructure    

Structure s_map
    n_tile.l             ; nombre de tiles dont est composé la carte 
    surf_chipset.Surface ; Sprite contenant le chipset
    width.l              ; largeur de la carte
    Height.l             ; hauteur de la carte
    offsetX.l            ; décalage sur l'axe X lors de l'affichage de la carte 
    offsetY.l            ; décalage sur l'axe Y lors de l'affichage de la carte 
    bg_sound.l           ; Identifiant de la musique de fond jouée pendant cette carte 
EndStructure

;Les tableaux seront redimensionnés dans les procédures qui les utilisent
Global Dim chipset.s_chipset(1)  ;Tableau contenant les données de chaque tile du chipset
Global Dim DataMap.l(1)          ;Tableau contenant les données de la carte

Declare InitMap(*map.s_map)
Declare RandomizeMap(*map.s_map, width.l, Height.l, chipset.s)
Declare HandleMap(*map.s_map)
Declare MapEvent(*map.s_map)

Declare FreeMap(*map.s_map)
Declare LoadMap(*map.s_map, filename.s)
Declare SaveMap(*map.s_map, filename.s, bg_sound.s, chipset.s)

;Calcul la case du tableau DataMap() correspondant aux coordonnées x et y
Procedure GET_TILE(x,y,*map.s_map)
    ProcedureReturn (x+y* *map\width)
EndProcedure    
; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 43
; Folding = -