daily pastebin goal
59%
SHARE
TWEET

Untitled

a guest Feb 19th, 2018 90 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Const SCREENX = 800
  2. Const SCREENY = 600
  3. Const SCROLLSPEED = 15
  4.  
  5. SCREEN SCREENX,SCREENY,32,1
  6.  
  7. FrameLimit 40
  8.  
  9. //Initialization begins
  10. zoom = 100
  11. scrollx = 0
  12. scrolly = 0
  13. selectx = 0
  14. selecty = 0
  15.  
  16.  
  17. Const MAPX = 8
  18. Const MAPY = 4
  19. Dim map(MAPX,MAPY,20) //All information about map. X/Y/Data wanted
  20. Const MAP_TERRAIN = 0
  21.     Const OPEN = 0
  22.     Const PLAINS = 1
  23.     Const FOREST = 2
  24.     Const HILL = 3
  25.     Const MOUNTAIN = 4
  26.     Const LAKE = 5
  27.     Const DESERT = 6
  28.     Const SNOW = 7
  29. Const MAP_RESOURCE = 1
  30.     Const EMPTY = 0
  31.     Const IRON = 1
  32.     Const DMAGIC = 2
  33.     Const HORSE = 3
  34. Const MAP_VARIATION1 = 2
  35. Const MAP_VARIATION2 = 3
  36.  
  37. For i = 0 To MAPX
  38.     For j = 0 To MAPY
  39.         Select Rand(0,7)
  40.             Case 0
  41.                 map(i,j,MAP_TERRAIN) = OPEN
  42.             Case 1
  43.                 map(i,j,MAP_TERRAIN) = PLAIN
  44.             Case 2
  45.                 map(i,j,MAP_TERRAIN) = FOREST
  46.             Case 3
  47.                 map(i,j,MAP_TERRAIN) = HILL
  48.             Case 4
  49.                 map(i,j,MAP_TERRAIN) = MOUNTAIN
  50.             Case 5
  51.                 map(i,j,MAP_TERRAIN) = LAKE
  52.             Case 6
  53.                 map(i,j,MAP_TERRAIN) = DESERT
  54.             Case 7
  55.                 map(i,j,MAP_TERRAIN) = SNOW
  56.         End Select
  57.        
  58.         Select Rand(0,3)
  59.             Case 0
  60.                 map(i,j,MAP_RESOURCE) = EMPTY
  61.             Case 1
  62.                 map(i,j,MAP_RESOURCE) = IRON
  63.             Case 2
  64.                 map(i,j,MAP_RESOURCE) = DMAGIC
  65.             Case 3
  66.                 map(i,j,MAP_RESOURCE) = HORSE
  67.         End Select
  68.        
  69.         map(i,j,MAP_VARIATION1) = Rand(0,19)
  70.         map(i,j,MAP_VARIATION2) = Rand(0,19)
  71.     Next j
  72. Next i
  73.  
  74. //Initialization ends
  75.  
  76.  
  77. Repeat //Main loop begins
  78.     ClearText
  79.     Color cbwhite
  80.     AddText "" + terraininfo(map(selectx,selecty,MAP_TERRAIN))
  81.     AddText "" + resourceinfo(map(selectx,selecty,MAP_RESOURCE))
  82.     //Selecting tiles
  83.     If MouseHit(1) Then //Select the current Hex. Because of my inferior math skills at 2:40 AM, i used a Circle-based collision detection inside the hexes.
  84.         clickx = MouseX()-scrollx
  85.         clicky = MouseY()-scrolly
  86.         For i = 0 To MAPX
  87.             For j = 0 To MAPY
  88.                 midpointx = zoom/2 + zoom*i*3/4
  89.                 Select i Mod 2
  90.                     Case 0
  91.                         midpointy = zoom+zoom*j
  92.                     Case 1
  93.                         midpointy = zoom/2+zoom*j
  94.                 End Select
  95.                 If Distance(clickx,clicky,midpointx,midpointy) < zoom/2 Then
  96.                     selectx = i
  97.                     selecty = j
  98.                 EndIf
  99.             Next j
  100.         Next i
  101.     EndIf
  102.  
  103.  
  104.     //Scrolling&Zooming
  105.     If KeyDown(cbkeyleft) Then scrollx = scrollx + SCROLLSPEED
  106.     If KeyDown(cbkeyright) Then scrollx = scrollx - SCROLLSPEED
  107.     If KeyDown(cbkeyup) Then scrolly = scrolly + SCROLLSPEED
  108.     If KeyDown(cbkeydown) Then scrolly = scrolly - SCROLLSPEED
  109.  
  110.     scrolled=MouseMoveZ()
  111.     zoombefore = zoom
  112.     zoom = zoom + scrolled*8
  113.     If zoom < 40 Or zoom > 200 Then
  114.    
  115.     Else
  116.         scrollx = scrollx - scrolled*12
  117.         scrolly = scrolly - scrolled*12
  118.     EndIf
  119.     If zoom < 40 Then zoom = 40
  120.     If zoom > 200 Then zoom = 200
  121.  
  122.     If MouseDown(3) Then
  123.         scrollx = scrollx + MouseMoveX()
  124.         scrolly = scrolly + MouseMoveY()
  125.     Else
  126.         lastx=MouseMoveX()
  127.         lasty=MouseMoveY()
  128.     EndIf
  129.  
  130.     //Graphixs
  131.     For i = 0 To MAPX //Draw the hexagons
  132.         For j = 0 To MAPY
  133.             selected = False
  134.             If i = selectx And j = selecty Then selected = 1
  135.             If i-1 = selectx And j = selecty Then selected = 2
  136.             If i+1 = selectx And j = selecty Then selected = 3
  137.             If i = selectx And j+1 = selecty Then selected = 4
  138.             If i = selectx And j-1 = selecty Then selected = 5
  139.             If i+1 = selectx And j-((i Mod 2)*2-1) = selecty Then selected = 6
  140.             If i-1 = selectx And j-((i Mod 2)*2-1) = selecty Then selected = 7
  141.  
  142.             Select (i Mod 2)
  143.                 Case 0
  144.                     drawhex(i*zoom*3/4+scrollx,j*zoom+zoom/2+scrolly,zoom,selected,map(i,j,MAP_TERRAIN),map(i,j,MAP_RESOURCE),map(i,j,MAP_VARIATION1),map(i,j,MAP_VARIATION2))
  145.                 Case 1
  146.                     drawhex(i*zoom*3/4+scrollx,j*zoom+scrolly,zoom,selected,map(i,j,MAP_TERRAIN),map(i,j,MAP_RESOURCE),map(i,j,MAP_VARIATION1),map(i,j,MAP_VARIATION2))
  147.             End Select
  148.         Next j
  149.     Next i
  150.    
  151.     DrawScreen
  152. Forever //Main loop ends
  153.  
  154.  
  155.  
  156. Function drawhex(x,y,zoom,selected,land,resource,variation1,variation2) //Zoom is the lenght of every side in pixels.
  157.     If selected = 0 Then
  158.         Color 222,246,222
  159.     ElseIf selected = 1 Then
  160.         Color cbred
  161.     Else
  162.         Color cbgreen
  163.     EndIf
  164.    
  165.     zoom = zoom/4
  166.     Line zoom-1+x,0+y,zoom*3-1+x,0+y
  167.     Line zoom*3-1+x,0+y,zoom*4-1+x,zoom*2-1+y
  168.     Line zoom*4-1+x,zoom*2-1+y,zoom*3-1+x,zoom*4-1+y
  169.     Line zoom*3-1+x,zoom*4-1+y,zoom-1+x,zoom*4-1+y
  170.     Line zoom-1+x,zoom*4-1+y,0+x,zoom*2-1+y
  171.     Line 0+x,zoom*2-1+y,zoom-1+x,0+y
  172.    
  173.     If selected > 0 Then
  174.         For i = 0 To 3
  175.             zoom=zoom-1
  176.             x=x+2
  177.             y=y+2
  178.             Color getRGB(RED)-30,getRGB(GREEN)+25,getRGB(BLUE)+4
  179.             Line zoom-1+x,0+y,zoom*3-1+x,0+y
  180.             Line zoom*3-1+x,0+y,zoom*4-1+x,zoom*2-1+y
  181.             Line zoom*4-1+x,zoom*2-1+y,zoom*3-1+x,zoom*4-1+y
  182.             Line zoom*3-1+x,zoom*4-1+y,zoom-1+x,zoom*4-1+y
  183.             Line zoom-1+x,zoom*4-1+y,0+x,zoom*2-1+y
  184.             Line 0+x,zoom*2-1+y,zoom-1+x,0+y
  185.         Next i
  186.     EndIf
  187.    
  188.     If land = OPEN Then Color cbwhiteskin
  189.     If land = PLAINS Then Color cblightred
  190.     If land = FOREST Then Color cbgreen
  191.     If land = HILL Then Color 136,136,136
  192.     If land = MOUNTAIN Then Color cbdark
  193.     If land = LAKE Then Color cbblue
  194.     If land = DESERT Then Color cbdarkyellow
  195.     If land = SNOW Then Color 240,240,255
  196.  
  197.     Circle x+zoom*2-10,y+zoom*2-10,20
  198.    
  199.     If resource <> EMPTY Then
  200.         If resource = IRON Then Color cbsilver
  201.         If resource = DMAGIC Then Color cbblack
  202.         If resource = HORSE Then Color cbdarkred
  203.     EndIf  
  204.     Circle x+zoom*2-4,y+zoom*2-4,8
  205.    
  206.     Color cbsilver
  207.     Text x+zoom*2-20,y+zoom*2-36,""+variation1
  208.     Text x+zoom*2-20,y+zoom*2+20,""+variation2
  209. End Function
  210.  
  211. Function terraininfo(wantedinfo)
  212.     infotxt$ = "Error"
  213.     Select wantedinfo
  214.         Case 0
  215.             infotxt="Open"
  216.         Case 1
  217.             infotxt="Plains"
  218.         Case 2
  219.             infotxt="Forest"
  220.         Case 3
  221.             infotxt="Hill"
  222.         Case 4
  223.             infotxt="Mountain"
  224.         Case 5
  225.             infotxt="Lake"
  226.         Case 6
  227.             infotxt="Desert"
  228.         Case 7
  229.             infotxt="Snow"
  230.     End Select
  231.     Return infotxt
  232. End Function
  233.  
  234. Function resourceinfo(wantedinfo)
  235.     infotxt$ = "Error"
  236.     Select wantedinfo
  237.         Case 0
  238.             infotxt="No resources"
  239.         Case 1
  240.             infotxt="Iron"
  241.         Case 2
  242.             infotxt="Dark Magic"
  243.         Case 3
  244.             infotxt="Horses"
  245.     End Select
  246.     Return infotxt
  247. End Function
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top