Isometric map with scroll and zoom

Advanced game related topics
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Isometric map with scroll and zoom

Post by Fig »

A short exemple, may be usefull to someone.
This code bring two news compare with previous codes: zoom and only display the tiles on the screen (usefull on large map).
Zoom with mouse wheel, mouse on the fringe to scroll.

Code: Select all

    ;windows' resolution
    #x=1024:#y=768
    If InitSprite() = 0 Or InitKeyboard()=0 Or InitMouse()=0:MessageRequester("Error","Error DirectX",0):EndIf
    If OpenWindow(0,200,0,#x,#y, "test carte isometric zoomable ", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
        If OpenWindowedScreen(WindowID(0),0,0,#x,#y,0,0,0,#PB_Screen_WaitSynchronization)=0:MessageRequester("Erreur", "Impossible d'ouvrir un écran dans la fenêtre!", 0):End:EndIf
    EndIf
    ;size of the map
    #xmax=512:#ymax=512
    ;colors constants usefull for nonwindows Os.
    ;#yellow=$FFFF00:#red=$FF0000:#blue=$0000FF:#black=$000000
    ;cste ground
    ;max size tile:320
    Global GroundTileWidth.i=320
    Global GroundTilewidthInit.i=GroundTileWidth
    Global GroundTileWidthHalf.i=GroundTileWidth/2
    Global GroundTileHeight.i=GroundTileWidth/2
    Global GroundTileHeightHalf.i=GroundTileHeight/2
    ;scroll speed
    Global CameraSpeed.i=10
    Global zoom.i=100

    #herbe1=0
    #mouse=101

    ;camera starting point
    Global XCamera.i=-#x/2
    Global YCamera.i=-#y/2

    Dim ground(#xmax-1,#ymax-1)

    ;convertcoordonate from screen to iso
    Macro XScreenToMap(x,y)
    Int(((X/GroundTileWidthhalf) + (Y/GroundTileheighthalf))/2)
    EndMacro
    Macro YScreenToMap(x,y)
    Int(((Y/GroundTileheighthalf) - (X/GroundTilewidthhalf))/2)
    EndMacro
    ;reverse from iso to screen
    Macro XMapToScreen(x,y)
    (x-y)*GroundTileWidthHALf
    EndMacro
    Macro YMapToScreen(x,y)
    (x+y)*GroundTileheightHALF
    EndMacro


    ;{ CreateIsoSprite()
    CreateSprite(#mouse,10,10)
    StartDrawing(SpriteOutput(#mouse))
    Box(0,0,10,10,#Yellow)
    StopDrawing()
    CreateSprite(#herbe1,GroundTileWidth,GroundTileheight)
    StartDrawing(SpriteOutput(#herbe1))
    Box(0,0,GroundTileWidth,GroundTileheight,#Red)
    Box(2,2,GroundTileWidth-2,GroundTileheight-2,#Blue)
    StopDrawing()
    TransformSprite(#herbe1,GroundTileWidthHalf,0,GroundTileWidth,GroundTileheightHalf,GroundTileWidthHalf,GroundTileHeight,0,GroundTileHeightHalf)
    ;}

    Macro affiche_dimetric()
    nbtile.i=0
      x1 =XScreenToMap(Xcamera,ycamera)-2
      y1 =YScreenToMap(xcamera,ycamera)
      x2=x1
      y2=y1
      Repeat
          Repeat
              If x1>-1 And x1<#Xmax And y1>-1 And y1<#ymax
                  DisplaySprite(ground(x1,y1),XMapToScreen(x1,y1)-GroundTileWidthHalf-xcamera,yMapToScreen(x1,y1)-ycamera)
                  nbtile+1
              EndIf
              x1+1
              y1-1
          Until XMapToScreen(x1,y1)-GroundTileWidthHalf-xcamera>#X
          y2+1
          x1=x2:y1=y2
          Repeat
              If x1>-1 And x1<#Xmax And y1>-1 And y1<#ymax
                  DisplaySprite(ground(x1,y1),XMapToScreen(x1,y1)-GroundTileWidthHalf-xcamera,yMapToScreen(x1,y1)-ycamera)
                  nbtile+1
              EndIf
              x1+1
              y1-1
          Until XMapToScreen(x1,y1)-GroundTileWidthHalf-xcamera>#X
          x2+1
          x1=x2:y1=y2
      Until yMapToScreen(x1,y1)-ycamera>#y
    EndMacro

    Macro Mouse()
    ExamineMouse()
    Mx=MouseX()+XCamera
    My=MouseY()+YCamera
    DisplayTransparentSprite(#mouse,MouseX(),MouseY())
    ;tile coordonate of the mouse. Usefull !
    IsoMouseX=XScreenToMap(Mx,My)
    IsoMouseY=YScreenToMap(Mx,My)
    Debug "Mouse map coordinate X"+ Str(XScreenToMap(Mx,My))
    Debug "Mouse map coordinate Y"+ Str(YScreenToMap(Mx,My))
    Debug "Tile's Width: "+Str(GroundTileWidth)
    Debug "nb tiles displayed :"+Str(nbtile)
    Debug " "
    ;offset Camera
    If MouseX()=0 And IsoMouseX>-1 And IsoMouseY<#ymax:XCamera-CameraSpeed:EndIf
    If MouseX()=#X-1 And IsoMouseX<#xmax And IsoMouseY>-1:XCamera+CameraSpeed:EndIf
    If MouseY()=0 And IsoMouseX>-1 And IsoMouseY>-1:YCamera-CameraSpeed:EndIf
    If MouseY()=#Y-1 And IsoMouseX<#xmax And IsoMouseY<#ymax:YCamera+CameraSpeed:EndIf
    ;zoom
    wheel=MouseWheel()
    If (Wheel>0 And zoom<100) Or (Wheel<0 And zoom>5)
    Zoom+Wheel
    GroundTileWidth.i=GroundTilewidthInit*zoom/100
    GroundTileWidthHalf.i=GroundTileWidth/2
    GroundTileHeight.i=GroundTileWidth/2
    GroundTileHeightHalf.i=GroundTileHeight/2
    TransformSprite(#herbe1,GroundTileWidthHalf,0,GroundTileWidth,GroundTileheightHalf,GroundTileWidthHalf,GroundTileHeight,0,GroundTileHeightHalf)
    EndIf
    EndMacro

    Repeat
    FlipBuffers()
    ClearScreen(#Black)
    ExamineKeyboard()
    WindowEvent()

    affiche_dimetric()
    Mouse()
    Until KeyboardPushed(#PB_Key_Escape)
Last edited by Fig on Sat Nov 29, 2014 9:48 pm, edited 3 times in total.
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Isometric map with scroll and zoom

Post by Kwai chang caine »

Works fine here :D
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
tdc69
New User
New User
Posts: 3
Joined: Fri Aug 15, 2014 9:47 am

Re: Isometric map with scroll and zoom

Post by tdc69 »

I have had a problem with the definition of colors ... I added this line to the top without problems ...;-)

Code: Select all

;colors
#yellow=$FFFF00:#red=$FF0000:#blue=$0000FF:#black=$000000
Great job!
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Re: Isometric map with scroll and zoom

Post by Fig »

Which version of pb do you use ?

Color constants are supposed to be native in pb (? !)
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
User avatar
Demivec
Addict
Addict
Posts: 4085
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Isometric map with scroll and zoom

Post by Demivec »

Fig wrote:Color constants are supposed to be native in pb (? !)
I believe that the color constants you used are windows API constants. They wouldn't necessarily be available under other operating systems.
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Re: Isometric map with scroll and zoom

Post by Fig »

Sorry, i thought that constants were purebasic not windows only.
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
Post Reply