Isometric map with scroll and zoom
Posted: Thu May 29, 2014 5:21 pm
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.
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)