08-31-2025, 01:24 PM
(This post was last modified: 08-31-2025, 01:28 PM by Jules Marchildon.)
As you know I always like to complicate a Ham sandwich, this is what I was thinking, maybe I'm backwards, wrong, NOT thinking. I'll be tied up for the next 2 days, tiling my shower stall at home, will check back later.
Trial, No Fill...
Trial, No Fill...
Code:
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
%DEBUG_MODE = 1 '-draw red grid
TYPE Tile
IsPath AS BYTE '<-*1 if this is a path tile, 0 if wall
Connection AS BYTE '<-*4-bit connection value (top=1, right=2, bottom=4, left=8)
END TYPE
GLOBAL grid() AS Tile
GLOBAL gmaze() AS STRING
GLOBAL gtile_size AS LONG
'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
FUNCTION WINMAIN(BYVAL hInstance AS LONG, BYVAL hPrevInstance AS LONG, BYVAL lpCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG
LOCAL i, lRow, lCol AS LONG
LOCAL value AS BYTE
DIM gmaze(0 TO 30) AS GLOBAL STRING '-31 rows
gtile_size = 24 '-tile size
DIM grid(0 TO 30, 0 TO 27) AS GLOBAL Tile '-28 wide by 31 high
'-define our Pac-Man maze layout, original 28x31, no padding
gmaze(0) = "XXXXXXXXXXXXXXXXXXXXXXXXXXXX"
gmaze(1) = "X XX X"
gmaze(2) = "X XXXX XXXXX XX XXXXX XXXX X"
gmaze(3) = "X XXXX XXXXX XX XXXXX XXXX X"
gmaze(4) = "X XXXX XXXXX XX XXXXX XXXX X"
gmaze(5) = "X X"
gmaze(6) = "X XXXX XX XXXXXXXX XX XXXX X"
gmaze(7) = "X XXXX XX XXXXXXXX XX XXXX X"
gmaze(8) = "X XX XX XX X"
gmaze(9) = "XXXXXX XXXXX XX XXXXX XXXXXX"
gmaze(10) = " X XXXXX XX XXXXX X "
gmaze(11) = " X XX XX X "
gmaze(12) = " X XX XXXXXXXX XX X "
gmaze(13) = "XXXXXX XX X X XX XXXXXX"
gmaze(14) = " X X "
gmaze(15) = "XXXXXX XX X X XX XXXXXX"
gmaze(16) = " X XX XXXXXXXX XX X "
gmaze(17) = " X XX XX X "
gmaze(18) = " X XX XXXXXXXX XX X "
gmaze(19) = "XXXXXX XX XXXXXXXX XX XXXXXX"
gmaze(20) = "X XX X"
gmaze(21) = "X XXXX XXXXX XX XXXXX XXXX X"
gmaze(22) = "X XXXX XXXXX XX XXXXX XXXX X"
gmaze(23) = "X XX XX X"
gmaze(24) = "XXX XX XX XXXXXXXX XX XX XXX"
gmaze(25) = "XXX XX XX XXXXXXXX XX XX XXX"
gmaze(26) = "X XX XX XX X"
gmaze(27) = "X XXXXXXXXXX XX XXXXXXXXXX X"
gmaze(28) = "X XXXXXXXXXX XX XXXXXXXXXX X"
gmaze(29) = "X X"
gmaze(30) = "XXXXXXXXXXXXXXXXXXXXXXXXXXXX"
'-prepare the connection values for our path tiles
FOR lRow = 0 TO 30
FOR lCol = 0 TO 27
IF MID$(gmaze(lRow), lCol + 1, 1) = " " THEN
grid(lRow, lCol).IsPath = 1
value = 0
IF lRow > 0 AND MID$(gmaze(lRow - 1), lCol + 1, 1) = " " THEN value = value OR 1 '-*Top
IF lCol < 27 AND MID$(gmaze(lRow), lCol + 2, 1) = " " THEN value = value OR 2 '-*Right
IF lRow < 30 AND MID$(gmaze(lRow + 1), lCol + 1, 1) = " " THEN value = value OR 4 '-*Bottom
IF lCol > 0 AND MID$(gmaze(lRow), lCol, 1) = " " THEN value = value OR 8 '-*Left
grid(lRow, lCol).Connection = value
ELSE
grid(lRow, lCol).IsPath = 0
grid(lRow, lCol).Connection = 0
END IF
NEXT lCol
NEXT lRow
'-window setup
LOCAL wce AS WNDCLASSEX
LOCAL szAppName AS ASCIIZ * 80
szAppName = "GAMEBOARD32"
wce.cbSize = SIZEOF(wce)
wce.style = %CS_HREDRAW OR %CS_VREDRAW
wce.lpfnWndProc = CODEPTR(WndProc)
wce.hInstance = hInstance
wce.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
wce.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wce.hbrBackground = GetStockObject(%WHITE_BRUSH)
wce.lpszClassName = VARPTR(szAppName)
wce.hIconSm = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
RegisterClassEx wce
LOCAL hWnd AS LONG
hWnd = CreateWindowEx(0, szAppName, "Pac-Man Layout Trials:", %WS_OVERLAPPEDWINDOW, _
%CW_USEDEFAULT, %CW_USEDEFAULT, _
28 * gtile_size + GetSystemMetrics(%SM_CXFRAME) * 2, _
31 * gtile_size + GetSystemMetrics(%SM_CYFRAME) + GetSystemMetrics(%SM_CYCAPTION), _
%NULL, %NULL, hInstance, BYVAL %NULL)
ShowWindow hWnd, iCmdShow
UpdateWindow hWnd
LOCAL uMsg AS tagMSG
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
FUNCTION = uMsg.wParam
END FUNCTION
'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
FUNCTION WndProc(BYVAL hWnd AS LONG, BYVAL uMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
SELECT CASE uMsg
CASE %WM_PAINT
LOCAL ps AS PAINTSTRUCT
LOCAL hDC AS LONG
hDC = BeginPaint(hWnd, ps)
LOCAL lRow, lCol AS LONG
LOCAL hPen, hDebugPen AS LONG
LOCAL x, y AS LONG
'-create colored pen for maze outlines, no fill while testing
LOCAL lb AS LOGBRUSH
lb.lbStyle = %BS_SOLID
lb.lbColor = RGB(0, 0, 0)
hPen = ExtCreatePen(%PS_GEOMETRIC OR %PS_ENDCAP_ROUND OR %PS_JOIN_ROUND, 2, lb, 0, BYVAL %NULL)
SelectObject hDC, hPen
#IF %DEBUG_MODE
'-ceate hatched red pen for debug outlines
LOCAL lbDebug AS LOGBRUSH
lbDebug.lbStyle = %BS_HATCHED
lbDebug.lbColor = RGB(255, 0, 0)
lbDebug.lbHatch = %HS_DIAGCROSS
hDebugPen = ExtCreatePen(%PS_GEOMETRIC, 1, lbDebug, 0, BYVAL %NULL)
SelectObject hDC, hDebugPen
'-draw debug outlines for all tiles
FOR lRow = 0 TO 30
FOR lCol = 0 TO 27
x = lCol * gtile_size
y = lRow * gtile_size
MoveToEx hDC, x, y, BYVAL %NULL
LineTo hDC, x + gtile_size, y
LineTo hDC, x + gtile_size, y + gtile_size
LineTo hDC, x, y + gtile_size
LineTo hDC, x, y
NEXT lCol
NEXT lRow
DeleteObject hDebugPen
SelectObject hDC, hPen '-switch back to gmaze pen
#ENDIF
'-draw outer edges of wall structures
FOR lRow = 0 TO 30
FOR lCol = 0 TO 27
IF MID$(gmaze(lRow), lCol + 1, 1) = "X" THEN
x = lCol * gtile_size
y = lRow * gtile_size
'-draw top edge if no wall above or at top edge
IF lRow = 0 OR MID$(gmaze(lRow - 1), lCol + 1, 1) = " " THEN
MoveToEx hDC, x, y, BYVAL %NULL
LineTo hDC, x + gtile_size, y
END IF
'-draw right edge if no wall to right or at right edge
IF lCol = 27 OR MID$(gmaze(lRow), lCol + 2, 1) = " " THEN
MoveToEx hDC, x + gtile_size, y, BYVAL %NULL
LineTo hDC, x + gtile_size, y + gtile_size
END IF
'-draw bottom edge if no wall below or at bottom edge
IF lRow = 30 OR MID$(gmaze(lRow + 1), lCol + 1, 1) = " " THEN
MoveToEx hDC, x + gtile_size, y + gtile_size, BYVAL %NULL
LineTo hDC, x, y + gtile_size
END IF
'-draw left edge if no wall to left or at left edge
IF lCol = 0 OR MID$(gmaze(lRow), lCol, 1) = " " THEN
MoveToEx hDC, x, y + gtile_size, BYVAL %NULL
LineTo hDC, x, y
END IF
END IF
NEXT lCol
NEXT lRow
'-clean up
DeleteObject hPen
EndPaint hWnd, ps
FUNCTION = 0
EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION