Developed by Soleau Software for DOS and released in 1993, Ant Run is a variation of Pipe Dream (aka Pipe Mania.) In Pipe Dream, the player is given random pipe pieces that must be placed on a board to connect a faucet to a drainage pipe before the water flows out. In Ant Run, the pieces are already placed on the board and the player is tasked with rotating them to create the longest passageway possible for an ant to walk through. When it reaches the edge of the playing board, the ant warps around the opposite side like a Scooby-Doo character chased by a monster, and then proceeds forward as usual. Like its Windows 3.11 spin-off Beetle Run, the game provides random ant trivia between levels for extra Edutainment(tm) factor.

FUN ANT FACT OF THE DAY: Ants can be found on every single continent except Antarctica. National Geographic Kids would like to stress the irony of the whole situation.

The head-scratching part

Most of these games feature four basic pieces that can sometimes be rotated: a block, a corner pipe, a straight pipe, and a crossing. They look like this:

The "block" piece is usually depicted as empty space and it cannot be crossed. Simple enough. The "straight" and "cross" pieces are straightforward --literally: the ant (or water in the case of Pipe Dream) enters through one side and exits through the other, moving straight forward. But things get a little trickier for the "corner" piece.

If the ant enters the "corner" piece through the bottom border, it will have to take a right turn to reach the exit. But if it enters that exact same piece through the right border, then it has to take a left turn to the exit! The takeaway here is that the turn the ant will take depends on the border that was crossed to enter the piece.

FUN ANT FACT OF THE DAY: While not all ants are blind, most rather rely on their other senses to explore their surroundings. Marking the edges of a piece with pheromones (or an INTEGER code) can inform them of the turn they have to take in order to reach the exit. Not only that, but rubbing some deadly toxin (or an INTEGER code) on the other two edges will instantly kill the ant when it tries to walk through dead-ends!

So that's the secret of (or "one of the solutions to create") Ant Run, Pipe Dream and Pipe Mania. It never was about the pieces themselves: it was about their edges! If you went "oh, so that's HOW!" you're probably good to go.

The gaming board

The board is initially filled with pieces, so let's start there. First, we're going to set up a few constants for the board dimensions (in tiles,) its drawing offset (so we can draw it anywhere on the screen,) and the dimensions of each tile (which is going to be useful if our screen has non-square pixels, or if we just want rectangular tiles...)

' Board position and dimensions
CONST boardX = 16 ' left padding, in pixels
CONST boardY = 16 ' top padding, in pixels
CONST boardW = 10 ' width, in tiles
CONST boardH = 8  ' height, in tiles

' Tile dimensions
CONST tileW = 24            ' width, in pixels
CONST tileH = 21            ' height, in pixels
CONST tileHalfW = tileW \ 2 ' half width, in pixels
CONST tileHalfH = tileH \ 2 ' half height, in pixels

For clarity's sake, we're going to make a distinction between pieces and tiles. Pieces are unique, have a specific look and each of their borders have a code that tells the ant how to react when it enters the area. Tiles on the other hand refer to slots on the board. These slots may contain any piece oriented in one of four direction (this feature is not entirely necessary for Pipe Dream, but it becomes handful for Ant Run.)

Except when it contains a crossing piece, it is impossible to visit the same tile twice because both ends are connected, essentially making pieces single-use paths. However, we're could keep track of that information for scoring purpose and to make sure that visited tiles cannot be rotated again.

TYPE tileType
  id AS INTEGER    ' piece type
  rot AS INTEGER   ' rotation
  visit AS INTEGER ' visit count
END TYPE

Next, we declare a one-dimensional array for the gaming board, because multi-dimensional arrays are notoriously slow in QuickBASIC.

DIM SHARED tile(boardW * boardH - 1) AS tileType ' buffer for board cells

If you're used to two-dimensional arrays and do not know how to convert the tile's position (column and row) into its index in the array (and vice-versa,) here are some helpful formulas (just remember that values are 0-based, meaning that if boardW is 10, then the leftmost column is numbered 0 and the rightmost column is numbered 9.)

' Get the tile index from its position (row and column:)
tileIndex = (row * boardW) + column

' Get the tile position (row and column) from its index:
column = tileIndex MOD boardW
row = tileIndex \ boardW

' Get the tile index according to the ant's X and Y
' coordinates (we assume 0,0 is located in the top
' left corner of the board:)
tileIndex = (antX \ tileW) + ((antY \ tileH) * boardW)

' If we want to use a mouse pointer to click on tiles,
' we may need yet another formula, this one taking into
' account the position of the board on the screen. It
' looks like this:
tileIndex = ((mouseX - boardX) \ tileW) + (((mouseY - boardY) \ tileH) * boardW)

FUN ANT FACT OF THE DAY: Ants cannot do integer divisions because they cannot find the backslash symbol on their keyboard. In QuickBASIC, performing a division with backslash rather than the usual "forward" slash throws away the fractional part of the result: "a \ b" in QuickBASIC is the equivalent of "Math.floor(a / b);" in JavaScript, "math.floor(a / b)" in Python, or "floor(a / b);" in C.

Here's some sample code to fill the board with random pieces and display the result on the screen. Tiles are colored according to the index of the piece they contain:

DECLARE SUB drawBoard()
DECLARE SUB resetBoard()

' Set randomizer seed to timer.
RANDOMIZE TIMER

' Enter graphic mode 13 (320x200, 256 colors.)
SCREEN 13

' Reset board with random pieces
resetBoard

' Draw board
drawBoard

''
'' BOARD RENDERING
''
SUB drawBoard
  DIM rowIndex AS INTEGER ' index of the first tile on row r%
  DIM ofsY AS INTEGER     ' vertical display offset

  rowIndex = 0  ' start at tile 0
  ofsY = boardY ' start drawing boardY pixels away from the top edge

  ' Now, row by row, ...
  FOR r% = 0 TO boardH - 1
    ' ... and column by column...
    FOR c% = 0 TO boardW - 1
      ' ... draw tiles. Use the piece index number as a color.
      LINE (boardX + c% * tileW, ofsY)-STEP(tileW - 1, tileH - 1), tile(rowIndex + c%).id, BF
    NEXT c%
    ' Row complete, update vertical display offset
    ofsY = ofsY + tileH
    ' Update index of the first tile of the row
    rowIndex = rowIndex + boardW
  NEXT r%
END SUB

''
'' RESET BOARD
''
SUB resetBoard
  ' Fill each cell of the board with one of the 4 types of pieces at random.
  FOR t% = 0 TO boardW * boardH - 1 ' RND() returns a decimal value between 0
    tile(t%).id = INT(RND * 4)      ' (included) and 1 (excluded.) If we multiply
    tile(t%).rot = 0                ' by 4, we get a value between 0 and 4 (excluded.)
    tile(t%).visit = 0              ' Then we use INT() to remove the fractional part
  NEXT t%                           ' and obtain a value in range 0 to 3 (included.)
END SUB

The ants go marching one by one

The ant (or water flow) is fairly simple to define. It needs X and Y coordinates (relative to the board,) an angle (so movements are relative to the ant's facing direction rather than absolute,) a way to know in which tile it is currently located (so we know when another tile is reached.)

Now, we know that the ant MAY have to take a left or right turn in corners, and we also know that the turn has to happen in the center of the piece. So, we're going to include a steps countdown to the center (because pieces may be rectangular, that value may be initialized to either tileHalfW when entering the tile horizontally or tileHalfH when entering the tile vertically.)

TYPE antType
  x AS INTEGER     ' horizontal axis
  y AS INTEGER     ' vertical axis
  angle AS INTEGER ' facing direction
  tile AS INTEGER  ' current location
  steps AS INTEGER ' number of steps remaining
  turn AS INTEGER  ' next turn value
END TYPE

DIM SHARED ant AS antType

Since the ant can only walk in four directions (North, West, South, East,) its angle will be described as a value between 0 and 3, organized counter-clockwise, and starting from North (up:)

From there, if we want the ant to turn left, we simply increase its angle value by 1. To turn right, we decrease its angle value by 1. Of course, we have to cap the value so it stays in range 0 to 3. But thanks to modular math we can do this instead:

' The modulo operator (MOD) returns the remainder of an integral division.
ant.angle = (ant.angle + 0) MOD 4 ' Keep going forward.
ant.angle = (ant.angle + 1) MOD 4 ' Turn left.
ant.angle = (ant.angle + 2) MOD 4 ' Go backward.
ant.angle = (ant.angle + 3) MOD 4 ' Turn right.

Or we can use boolean operators, that's perfectly acceptable too:

' Here, the AND boolean operator masks the two least significant bits (2 + 1.)
ant.angle = (ant.angle + 0) AND &H3 ' Keep going forward.
ant.angle = (ant.angle + 1) AND &H3 ' Turn left.
ant.angle = (ant.angle + 2) AND &H3 ' Go backward.
ant.angle = (ant.angle + 3) AND &H3 ' Turn right.

As long as ant.angle is positive, both techniques return the same values; it's just a matter of preference. Now onto the actual movement: how do we modify the X and Y coordinates of the ant according to the facing direction? We could use conditional branching, or keep things sane by simply creating a small array of 4 entries (one per angle:)

TYPE vecType
  x AS INTEGER ' horizontal axis
  y AS INTEGER ' vertical axis
END TYPE

DECLARE SUB initVectors()

DIM SHARED angleVec(3) AS vecType ' buffer for four movement vectors

initVectors

''
'' INITIALIZE MOVEMENT VECTORS
''
SUB initVectors
  angleVec(0).x = 0: angleVec(0).y = -1 ' move North / up
  angleVec(1).x = -1: angleVec(1).y = 0 ' move West / left
  angleVec(2).x = 0: angleVec(2).y = 1  ' move South / down
  angleVec(3).x = 1: angleVec(3).y = 0  ' move East / right
END SUB

The use of relative turns makes the game logic that much simpler: since we know the ant will take either a left or right turn depending on the border it crossed to enter the tile, all we have to do is put a sign on the border informing the ant which turn it should take when it reaches the center of the tile. When does the ant reach the center? When its steps countdown is 0 of course! More dramatization incoming:

' When the ant enters a new tile, set ant.turn to the turn value
' it must take to reach the exit, and set ant.steps to tileHalfW or
' tileHalfH depending on the border crossed.

' Move forward...
ant.x = ant.x + angleVec(ant.angle).x
ant.y = ant.y + angleVec(ant.angle).y
ant.steps = ant.steps - 1

' The ant reached the center! Change direction.
IF (ant.steps = 0) THEN
  ant.angle = (ant.angle + ant.turn) AND &H3
END IF

FUN ANT FACT OF THE DAY: Despite what their name implies, Blue Ants are not ants. Similarly, Langton's ant is a 2D Turing machine and not an actual ant (but still pretty mesmerizing.) Other things that are not ants: Jackie Chan.

Defining the pieces

Pieces have few properties: an image index of some sort (for display,) the number of extra angles the piece can face, and a border code to denote turns and dead-ends. Before we get to the piece definition itself, let's think about the border's winding for a second.

If the ant can face 0 (North,) 1 (West,) 2 (South,) or 3 (East,) then it would make sense to use the reverse values for borders: 0 (Bottom,) 1 (Right,) 2 (Top,) and 3 (Left.) I know it sounds absolutely weird, but: if the ant is facing North (its angle is 0,) and it walks forward until it reaches another tile, then we can determine that it crossed the Bottom border of the tile which also happens to be index 0.

By numbering the borders in reverse order, we can determine which border was crossed right away because the border index number matches the facing angle of the ant at that moment.

In other words:

' thruSide is the index of the border crossed by the
' ant, which happens to match the direction the ant is
' currently facing.
thruSide = ant.angle

We're going to store the special code (turning direction or dead-end signal) for each border on a byte, so a 4-character string will do. The first character will be the turn value for the "natural" Bottom edge, second character for the "natural" Right edge, etc. Since the turn value is in range 0 to 3, any other value can be used for special effects (dead-end, teleport, extra speed, bonus points... anything we want.) Here, we'll use 4 to set the border to "barred;" if the ant attempts to cross that border, it's game over.

' Border codes
CONST bcNoTurn = 0 ' keep going forward
CONST bcTurnLf = 1 ' turn left
CONST bcTurnRt = 3 ' turn right
CONST bcBarred = 4 ' border cannot be crossed

TYPE pieceType
  image AS INTEGER   ' image to use for the "natural" orientation
  extra AS INTEGER   ' extra facing angles
  code AS STRING * 4 ' special code for each border
END TYPE

DECLARE SUB initPieces()

DIM SHARED piece(3) AS pieceType ' buffer for 4 pieces

initPieces

''
'' INITIALIZE PIECES
''
SUB initPieces
  ' Block (1 image)
  piece(0).image = 0
  piece(0).extra = 0
  piece(0).code = CHR$(bcBarred) + CHR$(bcBarred) + CHR$(bcBarred) + CHR$(bcBarred)

  ' Corner (4 images)
  piece(1).image = 1
  piece(1).extra = 3
  piece(1).code = CHR$(bcTurnRt) + CHR$(bcTurnLf) + CHR$(bcBarred) + CHR$(bcBarred)

  ' Straight piece (2 images)
  piece(2).image = 5
  piece(2).extra = 1
  piece(2).code = CHR$(bcNoTurn) + CHR$(bcBarred) + CHR$(bcNoTurn) + CHR$(bcBarred)

  ' Crossing (1 image)
  piece(3).image = 7
  piece(3).extra = 0
  piece(3).code = CHR$(bcNoTurn) + CHR$(bcNoTurn) + CHR$(bcNoTurn) + CHR$(bcNoTurn)
END SUB

FUN ANT FACT OF THE DAY: You probably know that during World War II, kamikaze pigeons were trained to control explosive devices by pecking a screen with their beaks. "Project Pigeon," as it was called, was cancelled by the National Defense Research Committee in early October 1944. But did you know this fact has absolutely nothing to do with ants?

Tiles rotation

Thanks to tileType.rot, we can rotate individual tiles. As a reminder, the "natural" order of borders is counter-clockwise, starting from the Bottom: 0 is Bottom, 1 is Right, etc. And even though I just did it, DO NOT associate the border index number with its "natural" position. Border 0 is ONLY located at the Bottom of the piece when NO ROTATION has taken place. What you can be sure of though, is that the order will always be counter-clockwise, no matter how many times the tile is rotated.

This is where things get tricky: if we rotate the tile once (tileType.rot is 1,) the "new" Bottom edge is actually the "natural" Right border (index 1.) This means that antType.angle doesn't match the index of the crossed border anymore! If the ant is entering the rotated tile while going North (antType.angle is 0,) it will actually cross border 1, not 0! Now, if the tile was rotated twice (tileType.rot is 2,) then the Bottom border is actually the "natural" Top border (index 2!)

Okay, to recap: the "natural" index of the crossed border matches the ant direction, pieces are rotated clockwise according to the tile rotation value. So essentially, what we need to do is tweak the ant's facing direction so it matches the tile rotation!

' Yep. It's "just" that.
thruSide = ((ant.angle + tile(ant.tile).rot) AND &H3)

Hey, that was much easier than I thought! And since we know how many times each piece can be rotated, and how to determine which border was crossed, now would be a great time to tweak the board reset routine to also shuffle pieces facing direction.

''
'' RESET BOARD
''
SUB resetBoard
  DIM pieceId AS INTEGER

  ' Fill each cell of the board with one of the 4 types of pieces at random.
  FOR t% = 0 TO boardW * boardH - 1
    pieceId = INT(RND * 4)
    tile(t%).id = pieceId
    tile(t%).rot = INT(RND * (piece(pieceId).extra + 1))
    tile(t%).visit = 0
  NEXT t%
END SUB

Alright. But how do we know what image should be displayed exactly? First, we reserve some memory for the graphics. We're going to eyeball it to 1024 bytes per graphic tile; it is just enough to contain a 32x32, 8-bit per pixel image if we omit the image descriptor (our tiles are actually smaller than that, so we'll be fine.) We're going to need 8 graphic tiles, so that's 8192 bytes total. Since we're reserving memory through an INTEGER array (16-bit values,) we only need 4096 entries.

' Images
CONST imgLength = 512 ' size of a 32x32 image, in INTEGERs
CONST imgCount = 8    ' total number of images

' Buffer for 8 images
DIM SHARED gfxData(imgLength * imgCount - 1) AS INTEGER

Then, we're going to draw the graphics on screen and capture them with QuickBASIC's built-in GET() instruction. To make things simpler, we're going to store the graphic data in consecutive clockwise rotations, so we can retrieve the offset of each image with a simple formula. The routine is a little bit bloated because it writes the value of each border as well as the current rotation count within the graphic tile. It's helpful to visualize what's going on, but you can turn that off by setting the debugDigits constant to 0.

' Display border indices and rotation on tiles, set
' this value to 0 if the numbers are too distracting.
CONST debugDigits = 1

DECLARE SUB initGraphics

initGraphics

''
'' DRAW PIECES AND THEIR ROTATIONS ON SCREEN, SAVE TO GRAPHIC BUFFER.
''
SUB initGraphics
  CONST sqrW = tileW \ 3
  CONST sqrH = tileH \ 3

  DIM digit(3) AS STRING
  DIM alignLf AS STRING, alignCn AS STRING, alignRt AS STRING
  DIM alignUp AS STRING, alignMd AS STRING, alignDn AS STRING
  DIM imgOffset AS INTEGER, rotation AS INTEGER, pattern AS STRING

  ' Digit drawing code
  digit(0) = " bm+1,0g1d2f1e1u2"
  digit(1) = " bm+0,1e1d3g1r2"
  digit(2) = " r1f1g2d1r2"
  digit(3) = " r1f1g1f1g1l1"

  ' Digit alignment
  alignLf = "1"                         ' left
  alignRt = LTRIM$(STR$(tileW - 4))     ' right
  alignCn = LTRIM$(STR$(tileHalfW - 1)) ' horizontal center
  alignUp = "1"                         ' top
  alignDn = LTRIM$(STR$(tileH - 5))     ' bottom
  alignMd = LTRIM$(STR$(tileHalfH - 2)) ' vertical middle

  ' Block
  rotation = 0: pattern = "222222222": GOSUB initGraphicsDo

  ' Corner
  rotation = 0: pattern = "222266262": GOSUB initGraphicsDo ' South and East
  rotation = 1: pattern = "222662262": GOSUB initGraphicsDo ' North and East
  rotation = 2: pattern = "262662222": GOSUB initGraphicsDo ' North and West
  rotation = 3: pattern = "262266222": GOSUB initGraphicsDo ' South and West

  ' Straight
  rotation = 0: pattern = "262262262": GOSUB initGraphicsDo ' North and South
  rotation = 1: pattern = "222666222": GOSUB initGraphicsDo ' West and East

  ' Crossing
  rotation = 0: pattern = "262666262": GOSUB initGraphicsDo

  EXIT SUB

initGraphicsDo:
  ' Each tile is drawn out of 9 smaller rectangles.
  FOR i% = 0 TO 8
    clr = VAL("&H" + MID$(pattern, i% + 1, 1))
    LINE ((i% MOD 3) * sqrW, (i% \ 3) * sqrH)-STEP(sqrW - 1, sqrH - 1), clr, BF
  NEXT i%

  ' Add an extra edge to each tile.
  LINE (0, 0)-STEP(tileW - 1, tileH - 1), 0, B

  ' Border indices (green) and rotation count (red.)
  IF (debugDigits) THEN
    DRAW "c48 bm" + alignCn + "," + alignDn + digit(rotation)
    DRAW "c48 bm" + alignLf + "," + alignMd + digit((rotation - 1) AND &H3)
    DRAW "c48 bm" + alignCn + "," + alignUp + digit((rotation - 2) AND &H3)
    DRAW "c48 bm" + alignRt + "," + alignMd + digit((rotation - 3) AND &H3)
    DRAW "c4 bm0,0" + digit(rotation)
  END IF

  ' Capture to graphic buffer
  GET (0, 0)-(tileW - 1, tileH - 1), gfxData(imgOffset)
  imgOffset = imgOffset + imgLength

  RETURN
END SUB

Let's also update the board rendering routine accordingly; the magic happens in the column (c%) loop:

''
'' BOARD RENDERING
''
SUB drawBoard
  DIM rowIndex AS INTEGER  ' index of the first tile on row r%
  DIM imgOffset AS INTEGER ' offset to the proper image
  DIM ofsY AS INTEGER      ' vertical display offset

  rowIndex = 0  ' start at tile 0
  ofsY = boardY ' start drawing boardY pixels away from the top edge

  ' Now, row by row, ...
  FOR r% = 0 TO boardH - 1
    ' ... and column by column...
    FOR c% = 0 TO boardW - 1
      ' ... get the image index,
      imgOffset = (piece(tile(rowIndex + c%).id).image + tile(rowIndex + c%).rot) * imgLength
      ' and draw!
      PUT (boardX + c% * tileW, ofsY), gfxData(imgOffset), PSET
    NEXT c%
    ' Row complete, update vertical display offset
    ofsY = ofsY + tileH
    ' Update index of the first tile of the row
    rowIndex = rowIndex + boardW
  NEXT r%
END SUB

Aaaand I think that's about it; make place for the usual mundanities! Oh, and by the way:

FUN ANT FACT OF THE DAY: As it turns out, pigeons DO eat ants! So that previous random fact was actually somewhat tangentially related to ants.

The Game Code

It would be a good idea to reset the ant's position when it either crosses a border, or reaches the center of a tile, especially when the tile's dimensions are not multiple of two; odd values make the ant drift away from the center.

Additionnaly, while the board is now populated using a slightly improved system that ensures a fair distribution of pieces, a maze algorithm followed by a random rotation of the tiles would probably be a much better idea. Although you probably don't need any of this if you're creating a Pipe Dream/Pipe Mania clone.

In the following program, you may rotate any tile at any time as long as the ant is not standing on it. For an Ant Run clone, it might be a good idea to destroy tiles after the ant leaves them once (straight pipes and corners,) or twice (crossings.) Finally, it should be trivial to implement new types of blocks, such as one-way pipes, or speed bumpers...

' Display border indices and rotation on tiles, set
' this value to 0 if the numbers are too distracting.
CONST debugDigits = 1

' Board position and dimensions
CONST boardX = 16 ' left padding, in pixels
CONST boardY = 16 ' top padding, in pixels
CONST boardW = 10 ' width, in tiles
CONST boardH = 8  ' height, in tiles

' Tile dimensions
CONST tileW = 24            ' width, in pixels
CONST tileH = 21            ' height, in pixels
CONST tileHalfW = tileW \ 2 ' half width, in pixels
CONST tileHalfH = tileH \ 2 ' half height, in pixels

' Border codes
CONST bcNoTurn = 0 ' keep going forward
CONST bcTurnLf = 1 ' turn left
CONST bcTurnRt = 3 ' turn right
CONST bcBarred = 4 ' border cannot be crossed

' Images
CONST imgLength = 512 ' size of an image, in INTEGERs
CONST imgCount = 8    ' total number of images

TYPE tileType
  id AS INTEGER    ' piece type
  rot AS INTEGER   ' rotation
  visit AS INTEGER ' visit count
END TYPE

TYPE antType
  x AS INTEGER     ' horizontal axis
  y AS INTEGER     ' vertical axis
  angle AS INTEGER ' facing direction
  tile AS INTEGER  ' current location
  steps AS INTEGER ' number of steps remaining
  turn AS INTEGER  ' next turn value
END TYPE

TYPE vecType
  x AS INTEGER ' horizontal axis
  y AS INTEGER ' vertical axis
END TYPE

TYPE pieceType
  image AS INTEGER   ' image to use for the "natural" orientation
  extra AS INTEGER   ' extra facing angles
  code AS STRING * 4 ' special code for each border
END TYPE

DECLARE SUB drawBoard ()
DECLARE SUB drawTile (index AS INTEGER)
DECLARE SUB initVectors ()
DECLARE SUB initPieces ()
DECLARE SUB initGraphics ()
DECLARE SUB mainLoop ()
DECLARE SUB resetAnt ()
DECLARE SUB resetBoard ()

DIM SHARED tile(boardW * boardH - 1) AS tileType ' buffer for board cells
DIM SHARED ant AS antType
DIM SHARED angleVec(3) AS vecType ' buffer for four movement vectors
DIM SHARED piece(3) AS pieceType ' buffer for 4 pieces
DIM SHARED gfxData(imgLength * imgCount - 1) AS INTEGER ' Buffer for 8 images

' Set randomizer seed to timer.
RANDOMIZE TIMER

' Enter graphic mode 13 (320x200, 256 colors.)
SCREEN 13

'' Initialize game components
initVectors
initPieces
initGraphics

'' Enter main game loop
mainLoop

''
'' BOARD RENDERING
''
SUB drawBoard
  DIM rowIndex AS INTEGER  ' index of the first tile on row r%
  DIM imgOffset AS INTEGER ' offset to the proper image
  DIM ofsY AS INTEGER      ' vertical display offset

  rowIndex = 0  ' start at tile 0
  ofsY = boardY ' start drawing boardY pixels away from the top edge

  ' Now, row by row, ...
  FOR r% = 0 TO boardH - 1
    ' ... and column by column...
    FOR c% = 0 TO boardW - 1
      ' ... get the image index,
      imgOffset = (piece(tile(rowIndex + c%).id).image + tile(rowIndex + c%).rot) * imgLength
      ' and draw!
      PUT (boardX + c% * tileW, ofsY), gfxData(imgOffset), PSET
    NEXT c%
    ' Row complete, update vertical display offset
    ofsY = ofsY + tileH
    ' Update index of the first tile of the row
    rowIndex = rowIndex + boardW
  NEXT r%
END SUB

''
'' TILE RENDERING, REDRAW ONLY ONE TILE
''
SUB drawTile (index AS INTEGER)
  DIM row AS INTEGER, col AS INTEGER, imgOffset

  ' Convert tile index to row and column
  row = index \ boardW
  col = index MOD boardW

  ' Get image offset
  imgOffset = (piece(tile(index).id).image + tile(index).rot) * imgLength

  '' Draw on screen
  PUT (boardX + col * tileW, boardY + row * tileH), gfxData(imgOffset), PSET
END SUB

''
'' DRAW PIECES AND THEIR ROTATIONS ON SCREEN, SAVE TO GRAPHIC BUFFER.
''
SUB initGraphics
  CONST sqrW = tileW \ 3
  CONST sqrH = tileH \ 3

  DIM digit(3) AS STRING
  DIM alignLf AS STRING, alignCn AS STRING, alignRt AS STRING
  DIM alignUp AS STRING, alignMd AS STRING, alignDn AS STRING
  DIM imgOffset AS INTEGER, rotation AS INTEGER, pattern AS STRING

  ' Digit drawing code
  digit(0) = " bm+1,0g1d2f1e1u2"
  digit(1) = " bm+0,1e1d3g1r2"
  digit(2) = " r1f1g2d1r2"
  digit(3) = " r1f1g1f1g1l1"

  ' Digit alignment
  alignLf = "1"                         ' left
  alignRt = LTRIM$(STR$(tileW - 4))     ' right
  alignCn = LTRIM$(STR$(tileHalfW - 1)) ' horizontal center
  alignUp = "1"                         ' top
  alignDn = LTRIM$(STR$(tileH - 5))     ' bottom
  alignMd = LTRIM$(STR$(tileHalfH - 2)) ' vertical middle

  ' Block
  rotation = 0: pattern = "222222222": GOSUB initGraphicsDo

  ' Corner
  rotation = 0: pattern = "222266262": GOSUB initGraphicsDo ' South and East
  rotation = 1: pattern = "222662262": GOSUB initGraphicsDo ' North and East
  rotation = 2: pattern = "262662222": GOSUB initGraphicsDo ' North and West
  rotation = 3: pattern = "262266222": GOSUB initGraphicsDo ' South and West

  ' Straight
  rotation = 0: pattern = "262262262": GOSUB initGraphicsDo ' North and South
  rotation = 1: pattern = "222666222": GOSUB initGraphicsDo ' West and East

  ' Crossing
  rotation = 0: pattern = "262666262": GOSUB initGraphicsDo

  EXIT SUB

initGraphicsDo:
  ' Each tile is drawn out of 9 smaller rectangles.
  FOR i% = 0 TO 8
    clr = VAL("&H" + MID$(pattern, i% + 1, 1))
    LINE ((i% MOD 3) * sqrW, (i% \ 3) * sqrH)-STEP(sqrW - 1, sqrH - 1), clr, BF
  NEXT i%

  ' Add an extra edge to each tile.
  LINE (0, 0)-STEP(tileW - 1, tileH - 1), 0, B

  ' Border indices (green) and rotation count (red.)
  IF (debugDigits) THEN
    DRAW "c48 bm" + alignCn + "," + alignDn + digit(rotation)
    DRAW "c48 bm" + alignLf + "," + alignMd + digit((rotation - 1) AND &H3)
    DRAW "c48 bm" + alignCn + "," + alignUp + digit((rotation - 2) AND &H3)
    DRAW "c48 bm" + alignRt + "," + alignMd + digit((rotation - 3) AND &H3)
    DRAW "c4 bm0,0" + digit(rotation)
  END IF

  ' Capture to graphic buffer
  GET (0, 0)-(tileW - 1, tileH - 1), gfxData(imgOffset)
  imgOffset = imgOffset + imgLength

  RETURN
END SUB

''
'' INITIALIZE PIECES
''
SUB initPieces
  ' Block (1 image)
  piece(0).image = 0
  piece(0).extra = 0
  piece(0).code = CHR$(bcBarred) + CHR$(bcBarred) + CHR$(bcBarred) + CHR$(bcBarred)

  ' Corner (4 images)
  piece(1).image = 1
  piece(1).extra = 3
  piece(1).code = CHR$(bcTurnRt) + CHR$(bcTurnLf) + CHR$(bcBarred) + CHR$(bcBarred)

  ' Straight piece (2 images)
  piece(2).image = 5
  piece(2).extra = 1
  piece(2).code = CHR$(bcNoTurn) + CHR$(bcBarred) + CHR$(bcNoTurn) + CHR$(bcBarred)

  ' Crossing (1 image)
  piece(3).image = 7
  piece(3).extra = 0
  piece(3).code = CHR$(bcNoTurn) + CHR$(bcNoTurn) + CHR$(bcNoTurn) + CHR$(bcNoTurn)
END SUB

''
'' INITIALIZE MOVEMENT VECTORS
''
SUB initVectors
  angleVec(0).x = 0: angleVec(0).y = -1 ' move North / up
  angleVec(1).x = -1: angleVec(1).y = 0 ' move West / left
  angleVec(2).x = 0: angleVec(2).y = 1  ' move South / down
  angleVec(3).x = 1: angleVec(3).y = 0  ' move East / right
END SUB

''
'' MAIN GAME LOOP
''
SUB mainLoop
  DIM selRow AS INTEGER, selCol AS INTEGER, selAdr AS INTEGER
  DIM newRow AS INTEGER, newCol AS INTEGER, selX AS INTEGER, selY AS INTEGER
  DIM userStr AS STRING, userInt AS INTEGER
  DIM antThink AS SINGLE, antThinkDelay AS SINGLE
  DIM antTile AS INTEGER, antThru AS INTEGER
  DIM refreshlst(7) AS INTEGER, numRefresh AS INTEGER

  GOSUB mainLoopReset

  DO

    '' CATCH USER INPUT ''

    userStr = INKEY$
    IF LEN(userStr) THEN
      IF (LEN(userStr) = 1) THEN
        userInt = ASC(userStr)
      ELSE
        userInt = CVI(userStr)
      END IF
      SELECT CASE userInt
        CASE &H4800 ' up
          newRow = selRow + (selRow > 0)
        CASE &H5000 ' down
          newRow = selRow - (selRow < boardH - 1)
        CASE &H4B00 ' left
          newCol = selCol + (selCol > 0)
        CASE &H4D00 ' right
          newCol = selCol - (selCol < boardW - 1)
        CASE &H1B  ' escape (quit)
          EXIT SUB
        CASE &H52, &H72 ' R (reset)
          GOSUB mainLoopReset
        CASE &H20 ' space (speed up)
          antThinkDelay = .05
        CASE &HD  ' enter (rotate)
          IF (selAdr <> ant.tile) THEN
            ' We can rotate that tile...
            tile(selAdr).rot = (tile(selAdr).rot + 1) MOD (piece(tile(selAdr).id).extra + 1)
            ' Place the tile into the refresh list
            refreshlst(numRefresh) = selAdr
            numRefresh = numRefresh + 1
          END IF
      END SELECT
      ' Cursor has moved, place tile into refresh list
      IF ((newCol <> selCol) OR (newRow <> selRow)) THEN
        refreshlst(numRefresh) = selAdr
        numRefresh = numRefresh + 1
      END IF
    END IF

    '' ANT THINK ''
    IF (antThink <= TIMER) THEN
      ' Reset thinking counter
      antThink = TIMER + antThinkDelay

      ' Move ant forward
      ant.x = ant.x + angleVec(ant.angle).x
      ant.y = ant.y + angleVec(ant.angle).y
      ant.steps = ant.steps - 1

      ' Ant went past the center, test border crossing now
      IF (ant.steps < 0) THEN
        ' Warping around
        IF (ant.x < 0) THEN
          ant.x = ant.x + boardW * tileW
        ELSEIF (ant.y < 0) THEN
          ant.y = ant.y + boardH * tileH
        ELSE
          ant.x = ant.x MOD (boardW * tileW)
          ant.y = ant.y MOD (boardH * tileH)
        END IF
        ' Tile beneath the ant
        antTile = (ant.x \ tileW) + ((ant.y \ tileH) * boardW)
        ' Entered a new tile!
        IF (antTile <> ant.tile) THEN
          ' Queue old tile for refresh
          refreshlst(numRefresh) = ant.tile
          numRefresh = numRefresh + 1
          ' Update current position in tile
          ant.tile = antTile
          ' Increment visit counter (usually, the player may earn an extra
          ' bonus when visiting a crossing for the second time)
          tile(ant.tile).visit = tile(ant.tile).visit + 1
          ' Get the border that was crossed
          antThru = ((ant.angle + tile(ant.tile).rot) AND &H3)
          ' We got the border index, now get the code. Reminder that antThru
          ' is a value between 0 and 3, while the first character of a string
          ' is at index 1, not 0. Thus, we have to increment antThru by 1 in
          ' the following line:
          ant.turn = ASC(MID$(piece(tile(ant.tile).id).code, 1 + antThru, 1))
          ' The code denotes is a dead-end, game over.
          IF (ant.turn = bcBarred) THEN EXIT SUB
          ' Update steps countdown to the center
          IF (antThru AND &H1) THEN ' odd, horizontal movement
            ant.steps = tileHalfW
          ELSE ' even, vertical movement
            ant.steps = tileHalfH
          END IF
        END IF

      ' Ant has reached the center of the tile
      ELSEIF (ant.steps = 0) THEN
        ant.angle = (ant.angle + ant.turn) AND &H3
      END IF

      ' Queue current tile for refresh
      refreshlst(numRefresh) = ant.tile
      numRefresh = numRefresh + 1
    END IF

    '' RENDER ''

    ' Refresh tiles
    IF (numRefresh) THEN
      FOR i% = 0 TO numRefresh - 1
        drawTile refreshlst(i%)
      NEXT i%
      numRefresh = 0
    END IF

    ' Update selection coordinates
    IF ((newCol <> selCol) OR (newRow <> selRow)) THEN
      ' Update cursor position
      selCol = newCol
      selRow = newRow
      selAdr = selCol + (selRow * boardW)
      ' Update on-screen position
      selX = boardX + selCol * tileW
      selY = boardY + selRow * tileH
      ' Redraw
      LINE (selX, selY)-STEP(tileW - 1, tileH - 1), 15, B
    END IF

    ' Draw ant
    CIRCLE (boardX + ant.x, boardY + ant.y), 2, 1
    PAINT (boardX + ant.x, boardY + ant.y), 1
  LOOP

  EXIT SUB

mainLoopReset:
    ' Reset board with random pieces
    resetBoard
    ' Place ant somewhere on the board
    resetAnt
    ' Wait for a while
    antThink = TIMER + 2
    antThinkDelay = .35

    ' Draw board
    CLS
    drawBoard
    numRefresh = 0

    ' Place selection cursor in the middle of the board
    selCol = -1
    selRow = -1
    newCol = boardW \ 2
    newRow = boardH \ 2
    RETURN
END SUB

''
'' FIND A RANDOM STARTING POINT FOR THE ANT
''
SUB resetAnt
  DIM found AS INTEGER

  '' Assume we can't find an empty tile
  found = -1

  '' Look for an empty tile
  FOR t% = 0 TO boardW * boardH - 1
    IF (tile(t%).id = 0) THEN
      found = t%
      EXIT FOR
    END IF
  NEXT t%

  '' No empty tile, pick one at random
  IF (found = -1) THEN found = INT(RND * boardW * boardH)

  '' Place straight pipe in tile
  tile(found).id = 2
  tile(found).rot = 0
  tile(found).visit = 1

  '' Set the ant's position
  ant.tile = found
  ant.x = (ant.tile MOD boardW) * tileW + tileHalfW
  ant.y = (ant.tile \ boardW) * tileH + tileHalfH

  '' Set the ant's facing direction
  ant.angle = INT(RND * 2) * 2

  '' Ant is already in the center of the tile
  ant.steps = -1
END SUB

''
'' RESET BOARD
''
SUB resetBoard
  CONST boardCells = boardW * boardH
  CONST pctCorners = boardCells * 40 \ 100
  CONST pctLines = boardCells * 35 \ 100
  CONST pctCrosses = boardCells * 15 \ 100

  DIM tileId AS INTEGER

  ' Insert corners
  FOR i% = 0 TO pctCorners - 1
    tile(i%).id = 1
  NEXT i%
  tileId = tileId + pctCorners

  ' Insert straight lines
  FOR i% = 0 TO pctLines - 1
    tile(tileId + i%).id = 2
  NEXT i%
  tileId = tileId + pctLines

  ' Insert crosses
  FOR i% = 0 TO pctCrosses - 1
    tile(tileId + i%).id = 3
  NEXT i%
  tileId = tileId + pctCrosses

  ' Everything else is blank
  FOR i% = tileId TO boardCells - 1
    tile(i%).id = 0
  NEXT i%

  ' Shuffle
  FOR t% = 0 TO boardCells - 1
    SWAP tile(t%).id, tile(INT(RND * boardCells)).id
  NEXT t%

  ' Set rotations and reset visits
  FOR t% = 0 TO boardCells - 1
    tile(t%).rot = INT(RND * (piece(tile(t%).id).extra + 1))
    tile(t%).visit = 0
  NEXT t%
END SUB

- Mike Hawk