Code: (Select All)
Type MapInfo
Wall As _Unsigned _Byte
Distance As _Byte
End Type
Const min = 1, max = 20
Const TopLeftX = 50, TopLeftY = 50 'just where I want to put my top left corner of my map on the screen
Const HexSize = 16 'Size of Hex
Const NE = 1, East = 2, SE = 4, SW = 8, West = 16, NW = 32
Dim Shared HeroPointer, HeroHeading, Difficulty
Dim Shared map(min - 1 To max + 1, min - 1 To max + 1) As MapInfo
Difficulty = 140
Screen _NewImage(800, 600, 32)
Color -1
Randomize Timer
HeroX = 1: HeroY = 1: HeroHeading = SE: direction = 2
HeroPointer = TextToImage("", 16, &HFFFF0000, 0, 0)
CreateMap
TargetX = Int(Rnd * max) + min: TargetY = Int(Rnd * max) + min
Do
_Limit 30
Cls , 0
_DontBlend: DrawMap
_Blend: DrawHero HeroX, HeroY
k = _KeyHit
Select Case k
Case 19200 'left arrow
direction = direction - 1: If direction < 0 Then direction = 5
HeroHeading = 2 ^ direction
Case 20480 'down arrow
Select Case HeroHeading
Case NE: HeroX = HeroX - .5: HeroY = HeroY + 1
Case East: HeroX = HeroX - 1
Case SE: HeroX = HeroX - .5: HeroY = HeroY - 1
Case SW: HeroX = HeroX + .5: HeroY = HeroY - 1
Case West: HeroX = HeroX + 1
Case NW: HeroX = HeroX + .5: HeroY = HeroY + 1
End Select
Case 19712 'right arrow
direction = direction + 1: If direction > 5 Then direction = 0
HeroHeading = 2 ^ direction
Case 18432 'up arrow
Select Case HeroHeading
Case NE: If (map(_Ceil(HeroX), HeroY).Wall And 1) = 0 Then HeroX = HeroX + .5: HeroY = HeroY - 1
Case East: If (map(_Ceil(HeroX), HeroY).Wall And 2) = 0 Then HeroX = HeroX + 1
Case SE: If (map(_Ceil(HeroX), HeroY).Wall And 4) = 0 Then HeroX = HeroX + .5: HeroY = HeroY + 1
Case SW: If (map(_Ceil(HeroX), HeroY).Wall And 8) = 0 Then HeroX = HeroX - .5: HeroY = HeroY + 1
Case West: If (map(_Ceil(HeroX), HeroY).Wall And 16) = 0 Then HeroX = HeroX - 1
Case NW: If (map(_Ceil(HeroX), HeroY).Wall And 32) = 0 Then HeroX = HeroX - .5: HeroY = HeroY - 1
End Select
Case Asc("r"), Asc("R")
TargetX = Int(Rnd * max) + min: TargetY = Int(Rnd * max) + min
End Select
_PrintString (680, 100), "AV: " + Str$(HeroX) + "," + Str$(HeroY)
_PrintString (680, 130), "TV: " + Str$(_Ceil(HeroX)) + "," + Str$(HeroY)
_PrintString (680, 160), "WL: " + Str$(map(_Ceil(HeroX), HeroY).Wall)
DrawHex TargetX, TargetY, &HFFFF00FF
If _Ceil(HeroX) = TargetX And HeroY = TargetY Then
CreateMap
Difficulty = Difficulty + 5
TargetX = Int(Rnd * max) + min: TargetY = Int(Rnd * max) + min
End If
_Display
Loop Until k = 27
System
Sub CreateMap
For x = min - 1 To max + 1 'Reset the map to just borders
For y = min - 1 To max + 1
map(x, y).Distance = -1: map(x, y).Wall = 0
Next y, x
For x = min - 1 To max + 1 'borders are non-moveable
map(x, min - 1).Wall = -1
map(x, max + 1).Wall = -1
map(min - 1, x).Wall = -1
map(max + 1, x).Wall = -1
Next
D = 256 - Difficulty: If D < 63 Then D = 63
For x = min To max
For y = min To max
r = Int(Rnd * D)
If r > 63 Then r = 0
If r > 0 Then map(x, y).Wall = map(x, y).Wall Or r
Next
Next
For x = min - 1 To max + 1
For y = min - 1 To max + 1
If y Mod 2 = 0 Then xmod = 0 Else xmod = 1
If map(x, y).Wall And NE And x <= max And y >= min Then map(x + xmod, y - 1).Wall = map(x + xmod, y - 1).Wall Or SW
If map(x, y).Wall And East And x <= max Then map(x + 1, y).Wall = map(x + 1, y).Wall Or West
If map(x, y).Wall And SE And y <= max And x <= max Then map(x + xmod, y + 1).Wall = map(x + xmod, y + 1).Wall Or NW
If xmod = 0 Then xmod = 1 Else xmod = 0
If map(x, y).Wall And SW And x >= min And y <= max Then map(x - xmod, y + 1).Wall = map(x - xmod, y + 1).Wall Or NE
If map(x, y).Wall And West And x >= min Then map(x - 1, y).Wall = map(x - 1, y).Wall Or East
If map(x, y).Wall And NW And x >= min And y >= min Then map(x - xmod, y - 1).Wall = map(x - xmod, y - 1).Wall Or SE
Next
Next
End Sub
Sub DrawHero (TempX, Y)
X = _Ceil(TempX)
HexWidth = Sqr(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
CenterX = TopLeftX + X * HexWidth
CenterY = TopLeftY + Y * HexHeight * 0.75
If Y Mod 2 Then CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
Select Case HeroHeading
Case NE: Angle = -30
Case East: Angle = -90
Case SE: Angle = -150
Case SW: Angle = 150
Case West: Angle = 90
Case NW: Angle = 30
End Select
DisplayImage HeroPointer, CenterX, CenterY, Angle, 0
End Sub
Sub DrawHex (X, Y, C As _Unsigned Long)
HexWidth = Sqr(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
CenterX = TopLeftX + X * HexWidth
CenterY = TopLeftY + Y * HexHeight * 0.75
If Y Mod 2 Then CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
Color C
Point1X = CenterX - HexWidth / 2
Point2X = CenterX
Point3x = CenterX + HexWidth / 2
Point1y = CenterY - HexHeight / 2
Point2y = CenterY - HexHeight / 4
Point3y = CenterY + HexHeight / 4
Point4y = CenterY + HexHeight / 2
Line (Point1X, Point2y)-(Point2X, Point1y) 'NorthWest
Line (Point2X, Point1y)-(Point3x, Point2y) 'NorthEast
Line (Point3x, Point2y)-(Point3x, Point3y) 'East
Line (Point3x, Point3y)-(Point2X, Point4y) 'SouthEast
Line (Point2X, Point4y)-(Point1X, Point3y) 'SouthWest
Line (Point1X, Point3y)-(Point1X, Point2y) 'West
Paint (CenterX, CenterY), C
Color -1
End Sub
Sub DrawMap
HexWidth = Sqr(3) * HexSize: HexHeight = 2 * HexSize 'Height and Width of each individual hex
For X = min - 1 To max + 1
For Y = min - 1 To max + 1
CenterX = TopLeftX + X * HexWidth
CenterY = TopLeftY + Y * HexHeight * 0.75
If Y Mod 2 Then CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
Point1X = CenterX - HexWidth / 2
Point2X = CenterX
Point3x = CenterX + HexWidth / 2
Point1y = CenterY - HexHeight / 2
Point2y = CenterY - HexHeight / 4
Point3y = CenterY + HexHeight / 4
Point4y = CenterY + HexHeight / 2
If map(X, Y).Wall And NW Then Line (Point1X, Point2y)-(Point2X, Point1y) 'NorthWest
If map(X, Y).Wall And NE Then Line (Point2X, Point1y)-(Point3x, Point2y) 'NorthEast
If map(X, Y).Wall And East Then Line (Point3x, Point2y)-(Point3x, Point3y) 'East
If map(X, Y).Wall And SE Then Line (Point3x, Point3y)-(Point2X, Point4y) 'SouthEast
If map(X, Y).Wall And SW Then Line (Point2X, Point4y)-(Point1X, Point3y) 'SouthWest
If map(X, Y).Wall And West Then Line (Point1X, Point3y)-(Point1X, Point2y) 'West
If (map(X, Y).Wall And 63) = 63 Then Paint (CenterX, CenterY)
Next
Next
End Sub
Sub DisplayImage (Image As Long, x As Integer, y As Integer, angle As Single, mode As _Byte)
'Image is the image handle which we use to reference our image.
'x,y is the X/Y coordinates where we want the image to be at on the screen.
'angle is the angle which we wish to rotate the image.
'mode determines HOW we place the image at point X,Y.
'Mode 0 we center the image at point X,Y
'Mode 1 we place the Top Left corner of oour image at point X,Y
'Mode 2 is Bottom Left
'Mode 3 is Top Right
'Mode 4 is Bottom Right
Dim px(3) As Integer, py(3) As Integer, w As Integer, h As Integer
Dim sinr As Single, cosr As Single, i As _Byte
w = _Width(Image): h = _Height(Image)
Select Case mode
Case 0 'center
px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
Case 1 'top left
px(0) = 0: py(0) = 0: px(3) = w: py(3) = 0
px(1) = 0: py(1) = h: px(2) = w: py(2) = h
Case 2 'bottom left
px(0) = 0: py(0) = -h: px(3) = w: py(3) = -h
px(1) = 0: py(1) = 0: px(2) = w: py(2) = 0
Case 3 'top right
px(0) = -w: py(0) = 0: px(3) = 0: py(3) = 0
px(1) = -w: py(1) = h: px(2) = 0: py(2) = h
Case 4 'bottom right
px(0) = -w: py(0) = -h: px(3) = 0: py(3) = -h
px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0
End Select
sinr = Sin(angle / 57.2957795131): cosr = Cos(angle / 57.2957795131)
For i = 0 To 3
x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
px(i) = x2: py(i) = y2
Next
_MapTriangle (0, 0)-(0, h - 1)-(w - 1, h - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
Function TextToImage& (text$, font&, fc&, bfc&, mode As _Byte)
'text$ is the text that we wish to transform into an image.
'font& is the handle of the font we want to use.
'fc& is the color of the font we want to use.
'bfc& is the background color of the font.
'Mode 1 is print forwards
'Mode 2 is print backwards
'Mode 3 is print from top to bottom
'Mode 4 is print from bottom up
'Mode 0 got lost somewhere, but it's OK. We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
If mode < 1 Or mode > 4 Then mode = 1
dc& = _DefaultColor: bgc& = _BackgroundColor
D = _Dest
F = _Font
T2Idown = CsrLin: T2Iright = Pos(0)
If font& <> 0 Then _Font font&
If mode < 3 Then
'print the text lengthwise
w& = _PrintWidth(text$): h& = _FontHeight
Else
'print the text vertically
For i = 1 To Len(text$)
If w& < _PrintWidth(Mid$(text$, i, 1)) Then w& = _PrintWidth(Mid$(text$, i, 1))
Next
h& = _FontHeight * (Len(text$))
End If
TextToImage_temp& = _NewImage(w&, h&, 32)
TextToImage = TextToImage_temp&
_Dest TextToImage_temp&
If font& <> 0 Then _Font font&
Color fc&, bfc&
Select Case mode
Case 1
'Print text forward
_PrintString (0, 0), text$
Case 2
'Print text backwards
temp$ = ""
For i = 0 To Len(text$) - 1
temp$ = temp$ + Mid$(text$, Len(text$) - i, 1)
Next
_PrintString (0, 0), temp$
Case 3
'Print text upwards
'first lets reverse the text, so it's easy to place
temp$ = ""
For i = 0 To Len(text$) - 1
temp$ = temp$ + Mid$(text$, Len(text$) - i, 1)
Next
'then put it where it belongs
For i = 1 To Len(text$)
fx = (w& - _PrintWidth(Mid$(temp$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
_PrintString (fx, _FontHeight * (i - 1)), Mid$(temp$, i, 1)
Next
Case 4
'Print text downwards
For i = 1 To Len(text$)
fx = (w& - _PrintWidth(Mid$(text$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
_PrintString (fx, _FontHeight * (i - 1)), Mid$(text$, i, 1)
Next
End Select
_Dest D
Color dc&, bgc&
_Font F
Locate T2Idown, T2Iright
End Function^ An old hex maze generator which I wrote several years back.
Notice that the game gets consistently harder as you progress, with more walls blocking your path, and I must admit: I didn't bother to have the program check to make certain that you can actually reach the target location. In fact, I freely confess, if you keep playing, you'll eventually get to a stage where you WON'T be able to reach the target -- the non-intelligent randomness of this little demo WILL make it an impossible task eventually.
ESC stops the program.
R will Relocate the target location.
Left/Right allows us to change heading.
Up moves us in the direction we're facing.
Down is a terrible cheat (intentionally left at this point, to allow full map movement), which moves us away from the direction we're facing.
Try it out and see what you think; it's definitely different than most other quad-directional maze-generators which I've seen and played around with in the past.
