Screen Flashing...

[markel422]

For some reason everytime I set PlayBasic to run in  Fullscreen mode "Openscreen 640,480,32,2" or "Openscreen 320,240,32,2" after a several seconds I start to see White Flashes occurring on my screen.

Any idea Why? ???

[kevin]

I suspect, it's because full screen exclusive modes are double buffered.   But without some example code that produces the effect, all we can do is guess.     

[markel422]

It practically happens to every program I run full screen.

Here are a few codes as well as a few zip files of the programs that run FullScreen...

Project: AStarDemo

Code Select Expand

; PROJECT : AStarDemo
; AUTHOR  : Alex Henderson
; CREATED : 3/14/2006
; EDITED  : 4/5/2006
; ---------------------------------------------------------------------

RemStart

USER INSTRUCTIONS:

All hexes (nodes) are initialized to a movement cost = 1. 
The hex coordinates of the hex under the cursor are shown in the upper L.
Left-click to increase the movement cost, to a maximum = 9. 
Right-click to decrease the movement cost, to a minimum = 1. 
"X" key = make the hex into blocking terrain.
"S" key = select a start hex for the path.
"D" key = select a destination.
"P" key = calculate & show the path.
"F" key = save terrain map as "TerrainMap.txt".
"L" key = load "TerrainMap.txt".
You can load the included TerrainMap.txt for a quick demo.
The path length in hexes & the total movement cost is displayed.
You can change the start or destination & press "P" again.

copyright: public domain
April 5/06
alexhenderson7@yahoo.ca

RemEnd

; ------------------------------------------------------------------------------

OpenScreen 1024, 768, 16, 2
CenterScreen
TitleScreen "A* Pathfinding Demo"

Global HexSide# = 24
Global NumHexesInRow = 27
Global NumHexesInCol = 17

; Apothem = distance from hex center to center of a horizontal side
Global HexApothem# = Cos(30) * HexSide#
; Cutoff = length of the horizontal side of the triangle in a corner of the
;    rectangle surrounding a hex
Global HexCutoff# = Sin(30) * HexSide#
; Slope = the slope of the diagonal side of a hex.  Type A slopes up from R to L;
;    Type B slopes down.
Global HexSlopeA# = HexApothem# / HexCutoff#
Global HexSlopeB# = - HexApothem# / HexCutoff#

Constant white = RGB(255, 255, 255)
Constant black = RGB(8, 8, 8)
Constant red = RGB(255, 0, 0)
Constant green = RGB(0, 255, 0)
Constant blue = RGB(0, 0, 255)
Constant purple = RGB(255, 0, 180)

; this array holds the movement cost for each hex:
Dim TerrainCost(NumHexesInRow, NumHexesInCol)
ClearArray TerrainCost(), 1

; used to hold a list of the hexes in a path:
Dim HexList(1, 2)
; each hex is a node; the array holds: Xpos, Ypos, movement cost, estimate of
;    movement cost to destination, & total of last 2 items
Dim oldNode(4)
Dim newNode(4)
; listOpen() holds the nodes not yet examined fully
; note that an array can be initialized to - 1, i.e., empty
Dim listOpen(-1)
; listClosed() holds the nodes we are finished examining
Dim listClosed(-1)

; draw 1 hex:
HexShape = GetFreeShape()
CreateConvexShape HexShape, HexSide#, 6

; create the map:
x = NumHexesInRow * (HexSide# + HexCutoff#) + HexCutoff# + 1
y = NumHexesInCol * (HexApothem# * 2) + 1
Global HexMap = GetFreeImage()
CreateImage HexMap, x, y
RenderToImage HexMap

Cls white
Ink black
ScreenFont = GetFreeFont()
LoadFont "Arial", ScreenFont, 16, 0
SetFont ScreenFont

startX# = HexCutoff# + HexSide# / 2
startY# = HexApothem#
OffsetX# = HexCutoff# + HexSide#

If NumHexesInRow > NumHexesInCol
endPoint = NumHexesInRow
Else
endPoint = NumHexesInCol
EndIf
col = 1 : row = 1

Repeat
If Even(col)
OffsetY# = HexApothem#
Else
OffsetY# = 0
EndIf
DrawShape HexShape, startX# + (col - 1) * OffsetX#, _
startY# + (row - 1) * (HexApothem# * 2) + OffsetY#, 1
Inc row
If row > NumHexesInCol
row = 1
Inc col
EndIf
Until ((col > endPoint) Or (row > endPoint))

; ------------------------------------------------------------------------------

Mouse Off
SetMouse 320, 320

; MAIN LOOP:

Do
RenderToScreen
Cls white
DrawImage HexMap, 0, 0, 0

MapPixelX = MouseX() : MapPixelY = MouseY()
; draw the cursor
CircleC MapPixelX, MapPixelY, 5, 1, purple

HexNumX, HexNumY = Hex_GetHexNumCoordsVERT(MapPixelX, MapPixelY)
; check to see if the cursor is over a valid map hex
ValidHex = Hex_ValidHexCheck(HexNumX, HexNumY)
If ValidHex = True
Ink blue
; display coordinates of hex under the cursor
Text 8, 12, Str$(HexnumX) + ", " + Str$(HexNumY)
Ink black
EndIf

ButtonFlag = MouseButton()
If (ButtonFlag > 0) And (ValidHex = True)

Select ButtonFlag
  Case 1
  ; left mouse button pressed: increment hex movement cost
    TerrainCost(HexNumX, HexNumY) = TerrainCost(HexNumX, HexNumY) + 1
  Case 2
  ; right mouse button pressed: decrement hex movement cost
    TerrainCost(HexNumX, HexNumY) = TerrainCost(HexNumX, HexNumY) - 1
EndSelect

; movement cost must be in range 1 - 9
TerrainCost(HexNumX, HexNumY) = ClipRange(TerrainCost(HexNumX, _
    HexNumY), 1, 9)

MapPixelX, MapPixelY = Hex_GetHexCenter(HexNumX, HexNumY)
RenderToImage HexMap
; blank out previous value
BoxC MapPixelX - 4, MapPixelY - 19, MapPixelX + 11, MapPixelY - 4, 1, white
; display new movement cost in hex
Text MapPixelX - 4, MapPixelY - 20, Str$(TerrainCost(HexNumX, HexNumY))
dotsFlag = Off
FlushMouse
EndIf

KeyCode = ScanCode()
  If (KeyCode > 0) And (ValidHex = True)
    ; a key has been pressed
      Select KeyCode
      Case 31
      ; S = set start hex
      ; blank out old marker
    AStar_MarkHex(startX, startY, white)
        startX = HexNumX : startY = HexNumY
        AStar_MarkHex(startX, startY, green)
        dotsFlag = Off
       
    Case 32
    ; D = set destination hex
    AStar_MarkHex(destX, destY, white)
    destX = HexNumX : destY = HexNumY
    AStar_MarkHex(destX, destY, red)
    dotsFlag = Off
   
  Case 25
  ; P = show A* path
    If (startX > 0) And (startY > 0) And (destX > 0) And (destY > 0)
    ReDim HexList(1, 2)
    result = AStar_GetAStarPath(startX, startY, destX, destY, _
    HexList())
    If result = True
      dotsFlag = On
    EndIf
    EndIf
 
  Case 45
  ; X = mark hex as blocking terrain; we use an impossibly high value
    TerrainCost(HexNumX, HexNumY) = 99999
    MapPixelX, MapPixelY = Hex_GetHexCenter(HexNumX, HexNumY)
    RenderToImage HexMap
    BoxC MapPixelX - 4, MapPixelY - 19, MapPixelX + 11, _
    MapPixelY - 4, 1, white
    Text MapPixelX - 4, MapPixelY - 20, "X"
    dotsFlag = Off
   
  Case 33
  ; F = save terrain map File
    MapFile = GetFreeFile()
    WriteFile CurrentDir$() + "\TerrainMap.txt", MapFile
    x$ = Str$(startX) + "," + Str$(startY) + "," + Str$(destX) + "," + _
    Str$(destY)
    WriteString MapFile, x$
    For n = 1 To NumHexesInCol
    x$ = ""
    For m = 1 To NumHexesInRow - 1
      x$ = x$ + Str$(TerrainCost(m, n)) + ","
    Next m
    x$ = x$ + Str$(TerrainCost(NumHexesInRow, n))
    WriteString MapFile, x$
    Next n
    CloseFile MapFile
   
  Case 38
  ; L = Load terrain map file
    MapFile = GetFreeFile()
  ReadFile CurrentDir$() + "\TerrainMap.txt", MapFile
   
    x$ = ReadString$(MapFile)
    Dim temp(4)
  ; note how much this function accomplishes:
    x = SplitToArray(x$, ",", temp(), 1)
   
    AStar_MarkHex(startX, startY, white)
    startX = temp(1)
    startY = temp(2)
    AStar_MarkHex(startX, startY, green)
   
    AStar_MarkHex(destX, destY, white)
    destX = temp(3)
    destY = temp(4)
    AStar_MarkHex(destX, destY, red)
   
    Dim temp(NumHexesInRow)
    For n = 1 To NumHexesInCol
    x$ = ReadString$(MapFile)
    x = SplitToArray(x$, ",", temp(), 1)
    For m = 1 To NumHexesInRow
      TerrainCost(m, n) = temp(m)
    Next m
    Next n
    CloseFile MapFile
   
  ; display saved terrain map costs:
    For n = 1 To NumHexesInCol
    For m = 1 To NumHexesInRow
      MapPixelX, MapPixelY = Hex_GetHexCenter(m, n)
      BoxC MapPixelX - 4, MapPixelY - 19, MapPixelX + 11, _
      MapPixelY - 4, 1, white
      If TerrainCost(m, n) = 99999
      Text MapPixelX - 4, MapPixelY - 20, "X"
      Else
      If TerrainCost(m, n) > 1
        Text MapPixelX - 4, MapPixelY - 20, _
        Str$(TerrainCost(m, n))
      EndIf
      EndIf
    Next m
    Next n
    dotsFlag = Off
   
  Case 1
  ; ESC = quit
    End
  EndSelect
  FlushKeys
EndIf

   If dotsFlag = On
    ; display the movement path with blue dots
    For n = 1 To HexList(0, 0)
    x, y = Hex_GetHexCenter(HexList(n, 0), HexList(n, 1))
    CircleC x, y, 3, 1, blue
    Next n
  ; display path hex count & total movement cost
    MapPixelX, MapPixelY = Hex_GetHexCenter(destX, destY)
    Ink red
    Text MapPixelX + 25, MapPixelY + 5, Str$(HexList(0, 0) - 1) + " hexes"
    Text MapPixelX + 25, MapPixelY + 20, Str$(HexList(0, 1)) + " MPs"
    Ink black
  EndIf

Sync

Loop

; ------------------------------------------------------------------------------

Psub AStar_MarkHex(x, y, color)
; mark hex x,y as a start or dest hex

PxlX, PxlY = Hex_GetHexCenter(x, y)
RenderToImage HexMap
BoxC PxlX - 6, PxlY, PxlX + 6, PxlY + 12, 1, color
   
EndPsub

; ------------------------------------------------------------------------------

Psub Hex_GetHexNumCoordsVERT(MapPixelX, MapPixelY)
; returns the x,y coordinates of the hex array indices in which
    ;     screen pixel x,y is located, for VERTICAL Orientation

    Local SectX, SectY, SectPxlX#, SectPxlY#

; get the Section x,y position:
    SectX = RoundDown(Float(MapPixelX) / (HexCutoff# + HexSide#))
    SectY = RoundDown(Float(MapPixelY) / HexApothem#)

; start with the assumption that the pixel is in the quad, not the triangle,
;     and set HexNumX,Y accordingly:
    HexNumX = SectX + 1
    HexNumY = (SectY + 1.5) / 2
    If Odd(SectX) And Even(SectY) Then Dec HexNumY

; now, test to see if the pixel is in the triangle:
    ; it is only in this case that the assumption will need adjustment
    ; get X offset of the pixel into the Section:
    SectPxlX# = MapPixelX - SectX * (HexCutoff# + HexSide#) - 1

    If (Even(SectX) And Even(SectY)) Or (Odd(SectX) And Odd(SectY))
    ; this is a Type A Section
      ; get Y offset of the pixel into the Section:
      SectPxlY# = MapPixelY - SectY * HexApothem# - 1
      ; use the y-intercept form of the linear equation to test the pixel:
      If SectPxlY# < HexApothem# - HexSlopeA# * SectPxlX#
      ; pixel is inside triangle, so adjust the assumption:
         Dec HexNumX
         If Even(SectX) Then Dec HexNumY
      EndIf
    Else
       ; this is a Type B Section
       ; get Y offset of the pixel into the Section:
       SectPxlY# = HexApothem# - (MapPixelY - SectY * HexApothem#) - 1
       
       ; use the y-intercept form of the linear equation to test the pixel:
       If SectPxlY# < HexApothem# + HexSlopeB# * SectPxlX#
        ; pixel is inside triangle, so adjust the assumption:
         Dec HexNumX
         If Odd(SectX) Then Inc HexNumY
      EndIf
    EndIf

EndPsub HexNumX, HexNumY

; ------------------------------------------------------------------------------

Psub Hex_GetHexCenter(HexNumX, HexNumY)
; returns the map pixel coordinates of the center point of the current hex

Local x1, y1
   
x1 = HexNumX - 1 : y1 = HexNumY - 1
     
MapPixelX = x1 * (HexCutoff# + HexSide#) + (HexCutoff# + HexSide# / 2)
MapPixelY = y1 * (2 * HexApothem#) + Odd(x1) * HexApothem# + HexApothem#

EndPsub MapPixelX, MapPixelY

; ------------------------------------------------------------------------------

Psub Hex_ValidHexCheck(HexNumX, HexNumY)
; returns True if this is a valid hex

Local result

result = True

If (HexNumX < 1) Or (HexNumX > NumHexesInRow) Then result = False
If (HexNumY < 1) Or (HexNumY > NumHexesInCol) Then result = False
    ; every even numbered column has 1 less hex:
If (Even(HexNumX)) And (HexNumY = NumHexesInCol) Then result = False

EndPsub result

; ------------------------------------------------------------------------------

; A-STAR PATH-FINDING ROUTINE:

Function AStar_GetAStarPath(startX, startY, destX, destY, HexList())
RemStart
returns HexList() containing an AStar movement path
HexList(0, 0) = number of hexes in path (excluding start hex)
HexList(0, 1) = total movement cost of the path
returns False if no path found, otherwise True
RemEnd

; these are the node array offsets:
Constant hexHash = 0
Constant parentHash = 1
Constant pathCost = 2
Constant costEst = 3
Constant totalCost = 4

; this is a cutoff point, above which we do not consider the node further
Constant maxCost = 1000

Local destHash, oldX, oldY, newX, newY, thisCost
Local posOpen, posClosed, thisNode, finalIndex

; the hex array indices increments for 6 adjacency tests:
Dim adjacent$(1)
; adjacent$(0) holds the string for parent hexes whose X value is an
;    EVEN number; ODD numbered Xs are in (1)
adjacent$(0) = "+0+1-1+1-1+0+0-1+1+0+1+1"
adjacent$(1) = "+0+1-1+0-1-1+0-1+1-1+1+0"

RemStart
initialize first node:
we compress the hex numbers into a single unique integer.
This allows us to identify the hex by 1 integer and consequently to use
the fast array searches, etc., in PB.
RemEnd
oldNode(hexHash) = AStar_HashHex(startX, startY)
oldNode(parentHash) = 0
oldNode(pathCost) = 0
; estimate the movement cost from hex x,y to destX,Y
oldNode(costEst) = AStar_Heuristic(startX, startY, destX, destY, _
startX, startY)
oldNode(totalCost) = oldNode(pathCost) + oldNode(costEst)
AStar_PushNode(oldNode(), listOpen())

; this is the goal node, hashed:
destHash = AStar_HashHex(destX, destY)

While GetArrayElements(listOpen(), 1) <> -1
; after an array is redimmed below (0), GetArrayElements returns -1

; get the open node with lowest totalCost
AStar_PopNodeFromOpen(oldNode(), listOpen())

If oldNode(hexHash) = destHash
; this is the goal node, so construct path & return it
 
  HexList(1, 0) = destX
  HexList(1, 1) = destY
; store and return the full movement cost of the path
  HexList(0, 1) = oldNode(pathCost)
  finalIndex = 1
 
  Repeat
  ; search Open list for next node on the path
  ; note that we are building the list of path hexes in BACKWARDS order
    posOpen = AStar_ListSearch(listOpen(), oldNode(parentHash))
     
    If posOpen > -1
    ; the next node was found, so store it in the path
    Inc finalIndex
    ReDim HexList(finalIndex, 2)
    oldX, oldY = AStar_UnhashHex(listOpen(posOpen))
    oldNode(parentHash) = listOpen(posOpen + parentHash)
   
    Else
    ; next node not found in Open list so we must search Closed list
    posClosed = AStar_ListSearch(listClosed(), oldNode(parentHash))
   
    If posClosed > -1
      Inc finalIndex
      ReDim HexList(finalIndex, 2)
      oldX, oldY = AStar_UnhashHex(listClosed(posClosed))
      oldNode(parentHash) = listClosed(posClosed + parentHash) 
    EndIf
    EndIf
 
    HexList(finalIndex, 0) = oldX
    HexList(finalIndex, 1) = oldY
   
  ; when the next hashed HexNum = 0, we have placed the start hex on list
  Until oldNode(parentHash) = 0
 
; store the number of hexes in path
  HexList(0, 0) = finalIndex

  ClearArray oldNode(), 0
  ClearArray newNode(), 0
  ReDim listOpen(-1)
  ReDim listClosed(-1)

  Exitfunction True
EndIf

; decompress the hexnum integer:
oldX, oldY = AStar_UnhashHex(oldNode(hexHash))

; get appropriate search string:
If Even(oldX)
; even-numbered rows:
  adjacent$ = adjacent$(0)
Else
  adjacent$ = adjacent$(1)
EndIf

For n = 0 To 5
; for each adjacent hex ...
 
; get a prospective hex:
; add increments:
  newX = oldX + Val(Mid$(adjacent$, n * 4 + 1, 2))
  newY = oldY + Val(Mid$(adjacent$, n * 4 + 3, 2))
 
; if this is not a valid hex, skip it:
  If Hex_ValidHexCheck(newX, newY) = False Then Continue
; we assume that any movement cost > maxCost is blocking terrain
  If TerrainCost(newX, newY) > maxCost Then Continue
 
; compress new node:
  newNode(hexHash) = AStar_HashHex(newX, newY)
; get movement cost of move from oldX,Y to newX,Y
  thisCost = oldNode(pathCost) + TerrainCost(newX, newY)
 
; search listOpen() for newNode:
  posOpen = AStar_ListSearch(listOpen(), newNode(hexHash))
  If posOpen <> -1
  ; the new node has been found in the Open list, so compare it
    If listOpen(posOpen + pathCost) <= thisCost
    ; listOpen() already has a lower-cost path to this node,
    ;     so skip to next 1
    Continue
    Else
    ; our current node is lower cost than the one on the Open List,
    ;    so delete it from the list
    AStar_DeleteNodeFromOpen(posOpen)
    EndIf
  EndIf

; search listClosed() for newNode:
  posClosed = AStar_ListSearch(listClosed(), newNode(hexHash))
  If posClosed <> -1
    If listClosed(posClosed + pathCost) <= thisCost
    Continue
    EndIf
  EndIf
 
; create the new node:
  newNode(parentHash) = oldNode(hexHash)
  newNode(pathCost) = thisCost
  newNode(costEst) = AStar_Heuristic(newX, newY, destX, destY, _
  startX, startY)
  newNode(totalCost) = newNode(pathCost) + newNode(costEst)
 
  RemStart
; Use this to show each node as having been examined:
  x, y = Hex_GetHexCenter(newX, newY)
  RenderToImage HexMap
  DrawGFXImmediate
  CircleC x, y, 3, 1, green
  RenderToScreen
  RemEnd
 
  If posClosed <> -1
  ; the new node is already on the Closed list, so delete it from list
  ; we do that by filling the node with "-1"
    ClearArrayCells listClosed(), posClosed, 1, 5, -1
  EndIf

  If posOpen = -1
  ; the new node is not yet on the Open list, so add it
    AStar_PushNode(newNode(), listOpen())
EndIf
 
Next n

; we are finished with the old node for now, so store it on the Closed list
AStar_PushNode(oldNode(), listClosed())
 
EndWhile

ClearArray oldNode(), 0
ClearArray newNode(), 0
ReDim listOpen(-1)
ReDim listClosed(-1)

; if execution comes here, we have failed to find a path so return "failure"

EndFunction False

; ------------------------------------------------------------------------------

Psub AStar_PushNode(thisNode(), thisList())
; push 1 node onto the specified list

Local start

start = GetArrayElements(thisList(), 1)
ReDim thisList(start + 5)
CopyArrayCells thisNode(), 0, 1, thisList(), start + 1, 1, 5

EndPsub

; ------------------------------------------------------------------------------

Psub AStar_PopNodeFromOpen(oldNode(), listOpen())
RemStart
pop the node (as represented by its compressed hexnum) from listOpen()
which has the lowest totalCost & shrink the list.
i.e., listOpen() is treated as a priority queue.
when the list has been emptied, it will be redimmed to -1 and
GetArrayElements will return -1.
This code implements an A* "tie-breaker."  It does a backward search for the
lowest totalCost but, if there is a tie between 2 or more nodes, selects
the node pushed onto the Open list most recently.
RemEnd

Local steps, start, pos

start = GetArrayElements(listOpen(), 1)

; "steps" is a count from the start of array EVEN for a backward search
steps = SearchLowestArrayCell(listOpen(), start, -5, (start + 1) / 5, 99999)
; get node data
pos = start - steps * 5 - 4
CopyArrayCells listOpen(), pos, 1, oldNode(), 0, 1, 5

; shrink the list:
CopyArrayCells listOpen(), pos + 5, 1, listOpen(), pos, 1, (steps + 1) * 5
ReDim listOpen(start - 5)

EndPsub

; ------------------------------------------------------------------------------

Psub AStar_DeleteNodeFromOpen(posOpen)
; posOpen is the node's index on listOpen()

Local size, length

size = GetArrayElements(listOpen(), 1)
length = size - posOpen - 4
; shrink the list:
CopyArrayCells listOpen(), posOpen + 5, 1, listOpen(), posOpen, 1, length
ReDim listOpen(size - 5)

EndPsub

; ------------------------------------------------------------------------------

Psub AStar_HashHex(x, y)
; compress the hexnum x,y integers to 1 integer

hashedHex = NumHexesInCol * (x - 1) + y

EndPsub hashedHex

; ------------------------------------------------------------------------------

Psub AStar_UnhashHex(hashedHex)
; decompress the hexnum integer

hexX = ((hashedHex - 1) / NumHexesInCol) + 1
hexY = Mod(hashedHex - 1, NumHexesInCol) + 1

EndPsub hexX, hexY

; ------------------------------------------------------------------------------

Psub AStar_ListSearch(thisList(), thisNode)
RemStart
search thisList() BACKWARDS for thisNode's hexHash value & return the
index of that value in the list.
the routine should be faster with a backwards search.
RemEnd

Local start, steps, index

start = GetArrayElements(thisList(), 1)
steps = FindArrayCell(thisList(),  start - 4, -5, (start + 1) / 5, thisNode)
; steps = - 1 if thisNode is not found
If steps <> - 1
index = start - (steps * 5) - 4
Else
index = - 1
EndIf
   
EndPsub index

; ------------------------------------------------------------------------------

Psub AStar_Heuristic(thisX, thisY, destX, destY, startX, startY)
RemStart

The heuristic provides a quick estimate of the movement cost from
the current node x,y to the goal x1,y1. The lower the costPerHex, the
broader the search. 
If costPerHex = 0, the A* algorithm turns into Djikstra's algorithm, which is
guaranteed to find a shortest path (slowly).
A value of costPerHex higher than all the terrain cost yields the same as
Best-First Search. 
If est is always lower than (or equal to) the cost of moving from x,y to
x1,y1, then A* is guaranteed to find a shortest path. The lower est is,
the more nodes A* expands, making it slower. If est is sometimes greater
than the cost of moving from x,y to x1,y1, then A* is not guaranteed to
find a shortest path but it will run faster.

RemEnd

; adjust as needed to improve speed or accuracy:
Constant costPerHex# = 1.2
; Djikstra's algorithm:
; Constant costPerHex# = 0
; Best-First Search:
; Constant costPerHex# = 10

Local deltaX, deltaY, result, straight, diagonal
Local deltaX1, deltaY1, deltaX2, deltaY2, tieBreaker#, estimate

; 1)   Max(dx, dy) distance heuristic:
deltaX = Abs(thisX - destX) : deltaY = Abs(thisY - destY)
If deltaX > deltaY
result = deltaX
Else
result = deltaY
EndIf

; 2)  diagonal shortcut heuristic:
;deltaX = Abs(thisX - destX) : deltaY = Abs(thisY - destY)
;If deltaX < deltaY
;diagonal = deltaX
;Else
;diagonal = deltaY
;EndIf
;straight = deltaX + deltaY
;result = diagonal + straight

; 3)  my variation (fast):
;result = GetDistance2D(thisX, thisY, destX, destY)

; 4)  tie-breaker - calculates the vector cross-product:
deltaX1 = thisX - destX : deltaY1 = thisY - destY
deltaX2 = startX - destX : deltaY2 = startY - destY
tieBreaker# = Abs(Float(deltaX1) * deltaY2 - Float(deltaX2) * deltaY1) * 0.1

estimate = result * costPerHex# + tieBreaker#

EndPsub estimate

; ==============================================================================


Draco's Pong Game

Code Select Expand

`A Very simple pong game

`Lock the screens Frame rate-
`We do this because this will stablise
`our game on different machines (to an extent)
SetFPS 60
`Now set the screen to 640 x 480 pixels
`And 16 bitmode in resolution, Also make it fullscreen
OpenScreen 640,480,16,2


`Make a type for our pong ball,
`This will hold all of the balls information
`such as screen position and its velocities
Type tPongBall
X#,Y#,XVelo#,YVelo#
EndType
Dim PongBall As TpongBall
`Set the balls position to the very centre of the screen
`Using the screens width and height
PongBall.X#=(GetScreenWidth()/2)
PongBall.Y#=(GetScreenHeight()/2)
`Now give the ball some velocity, so it will move once we start.
`However it would probably be better if there was a delay at first,
`But we'll keep it simple.
`A negative value for velocity will make the ball go left.
PongBall.XVelo#=-4


`Now we'll make a type for the paddles in our game,
`Note that we're dimming this array for two paddles.
Type TPaddles
X#,Y#,SizeX#,SizeY#
EndType
Dim Paddles(2) As Tpaddles
`Now let's set the position of our human player-
`He or she will be on the left side of the screen
`and about 20 pixels from the edge.
`Notice that the human player will have the
`first paddle in our array.
`We're going to give these paddles size values
`to help us with collision and centering and use a for next loop to set both.
For X=1 To 2
Paddles(X).SizeX#=10: Paddles(X).SizeY#=32
Next X
`Now give this human paddle a position
Paddles(1).X#=20: Paddles(1).Y#=(GetScreenHeight()/2)-(Paddles(1).SizeY#/2)
`Now give this computer paddle a position
Paddles(2).X#=GetScreenWidth()-40: Paddles(2).Y#=(GetScreenHeight()/2)-(Paddles(1).SizeY#/2)


`Now how about an array for player the players score and lives?
Type TPlayerData
Score, Lives
EndType
Dim PlayerData As TPlayerData
`set lives to 3
PlayerData.Lives=3

`We need to make a camera so we can see stuff on our screen
`if we choose to use captureToscene.
CreateCamera 1
`******************************* OUR MAIN LOOP **************************************
Do
`This will begin capturing to the scene buffer,
`Thus allowing us to draw everything using a handy dandy camera :P
CaptureToScene: ClsScene


`Put the players score in the top corner of the screen
`When combining varibles with strings like "Your score",
`We must use STR$ to turn the varible into a string.
Text 10,10,"Your Score is "+Str$(PlayerData.Score)
Text 10,30,"You have "+Str$(PlayerData.Lives)+" Lives"


`Handle the paddles***
`Use temporary values to help us position these paddles and make
`this code easier to read. We're also using a for next loop
`to conveniently go through all the paddles and draw them.
For X=1 To 2
  X#=Paddles(X).X#: Y#=Paddles(X).Y#
  Box X#,Y#,X#+Paddles(X).SizeX#,Y#+Paddles(X).SizeY#,1
Next X
`We're going to make the computer unbeatable for
`this game, just to keep it simple.
`This computers position will stay with the ball.
Paddles(2).Y#=PongBall.Y#-15


`Handle the pong ball***
`Move the ball according to its velocites-
`We will add the velocites to the positions,
`making sure we add to the right ones...
PongBall.X#= PongBall.X#+PongBall.Xvelo#
PongBall.Y#= PongBall.Y#+PongBall.Yvelo#
`Draw the ball- using its stored positions
Circle PongBall.X#,PongBall.Y#,10,1


`Handle Collision between ball, paddles, and screen edges***
`We'll use a for Next loop to go through the paddle positions
`and check for collsion between that and the ball.
`IF there was a collision, simply reverse the balls velocity.
`This may look confusing, but all we're doing here is
`Checking all four sides of the paddles of collision.
For X=1 To 2
  If (PongBall.Y#+5)>Paddles(X).Y#
  If (PongBall.Y#-5)<Paddles(X).Y#+Paddles(X).SizeY#
    If PongBall.X#<Paddles(X).X#+10
    If PongBall.X#>Paddles(X).X#
      PongBall.XVelo#=PongBall.XVelo#*-1
      `Make the ball bounce off randomly
      PongBall.YVelo#=Rnd(2)+1
      If Rnd(1)=1
      PongBall.YVelo#=-PongBall.YVelo#
      EndIf
      `If the player defended the ball- add score
      If X=1
      PlayerData.Score=PlayerData.Score+10
      EndIf
    EndIf
    EndIf
  EndIf
  EndIf
Next X 
`Now we'll check to see if the ball went off screen.
`IF it does go off screen, reset the ball and set the scores.
`The pong ball went through the players defence...
`IF the ball went off the top or bottom of the screen-
If PongBall.Y#<0
  PongBall.YVelo#=PongBall.YVelo#*-1
EndIf
If PongBall.Y#>GetScreenHeight()
  PongBall.YVelo#=PongBall.YVelo#*-1
EndIf
`IF the ball went off the players side-
If PongBall.X#<-10
  `Reset ball positions
  PongBall.X#=(GetScreenWidth()/2): PongBall.Y#=(GetScreenHeight()/2)
  PongBall.YVelo#=0
  `reset player position
  Paddles(1).Y#=(GetScreenHeight()/2)-(Paddles(1).SizeY#/2)
  `Decrease lives and exit if it goes below 1
  PlayerData.Lives=PlayerData.Lives-1
  If PlayerData.Lives<1
  End
  EndIf
EndIf


`Handle Controls
`This is a fairly simple control sceheme, it should really
`be based on time, but that's up to you.
If UpKey()=1
  Paddles(1).Y#=Paddles(1).Y#-4
EndIf
If DownKey()=1
  Paddles(1).Y#=Paddles(1).Y#+4
EndIf


`Draw the camera, allowing stuff to be seen on the screen
DrawCamera 1
Sync
Loop


[kevin]

 In future, rather than post examples that already on the  board, post a link to them.

  None of those 'flash' here,  although I think you might mean tearing.    By default, Vsync is disabled during sync, so the screen refresh doesn't wait for the vertical beam while refreshing the screen to the monitor.     You can enable (well request) it, but this locks your program to the end users video hardware refresh rate. 

  ScreenVsync ON

Code Select Expand




;A Very simple pong game

`Lock the screens Frame rate-
`We do this because this will stablise
`our game on different machines (to an extent)
;SetFPS 60
`Now set the screen to 640 x 480 pixels
`And 16 bitmode in resolution, Also make it fullscreen
OpenScreen 640,480,16,2

screenvsync on


`Make a type for our pong ball,
`This will hold all of the balls information
`such as screen position and its velocities
Type tPongBall
X#,Y#,XVelo#,YVelo#
EndType
Dim PongBall As TpongBall
`Set the balls position to the very centre of the screen
`Using the screens width and height
PongBall.X#=(GetScreenWidth()/2)
PongBall.Y#=(GetScreenHeight()/2)
`Now give the ball some velocity, so it will move once we start.
`However it would probably be better if there was a delay at first,
`But we'll keep it simple.
`A negative value for velocity will make the ball go left.
PongBall.XVelo#=-4


`Now we'll make a type for the paddles in our game,
`Note that we're dimming this array for two paddles.
Type TPaddles
X#,Y#,SizeX#,SizeY#
EndType
Dim Paddles(2) As Tpaddles
`Now let's set the position of our human player-
`He or she will be on the left side of the screen
`and about 20 pixels from the edge.
`Notice that the human player will have the
`first paddle in our array.
`We're going to give these paddles size values
`to help us with collision and centering and use a for next loop to set both.
For X=1 To 2
Paddles(X).SizeX#=10: Paddles(X).SizeY#=32
Next X
`Now give this human paddle a position
Paddles(1).X#=20: Paddles(1).Y#=(GetScreenHeight()/2)-(Paddles(1).SizeY#/2)
`Now give this computer paddle a position
Paddles(2).X#=GetScreenWidth()-40: Paddles(2).Y#=(GetScreenHeight()/2)-(Paddles(1).SizeY#/2)


`Now how about an array for player the players score and lives?
Type TPlayerData
Score, Lives
EndType
Dim PlayerData As TPlayerData
`set lives to 3
PlayerData.Lives=3

`We need to make a camera so we can see stuff on our screen
`if we choose to use captureToscene.
CreateCamera 1
`******************************* OUR MAIN LOOP **************************************
Do
`This will begin capturing to the scene buffer,
`Thus allowing us to draw everything using a handy dandy camera :P
CaptureToScene: ClsScene


`Put the players score in the top corner of the screen
`When combining varibles with strings like "Your score",
`We must use STR$ to turn the varible into a string.
Text 10,10,"Your Score is "+Str$(PlayerData.Score)
Text 10,30,"You have "+Str$(PlayerData.Lives)+" Lives"


`Handle the paddles***
`Use temporary values to help us position these paddles and make
`this code easier to read. We're also using a for next loop
`to conveniently go through all the paddles and draw them.
For X=1 To 2
  X#=Paddles(X).X#: Y#=Paddles(X).Y#
  Box X#,Y#,X#+Paddles(X).SizeX#,Y#+Paddles(X).SizeY#,1
Next X
`We're going to make the computer unbeatable for
`this game, just to keep it simple.
`This computers position will stay with the ball.
Paddles(2).Y#=PongBall.Y#-15


`Handle the pong ball***
`Move the ball according to its velocites-
`We will add the velocites to the positions,
`making sure we add to the right ones...
PongBall.X#= PongBall.X#+PongBall.Xvelo#
PongBall.Y#= PongBall.Y#+PongBall.Yvelo#
`Draw the ball- using its stored positions
Circle PongBall.X#,PongBall.Y#,10,1


`Handle Collision between ball, paddles, and screen edges***
`We'll use a for Next loop to go through the paddle positions
`and check for collsion between that and the ball.
`IF there was a collision, simply reverse the balls velocity.
`This may look confusing, but all we're doing here is
`Checking all four sides of the paddles of collision.
For X=1 To 2
  If (PongBall.Y#+5)>Paddles(X).Y#
  If (PongBall.Y#-5)<Paddles(X).Y#+Paddles(X).SizeY#
    If PongBall.X#<Paddles(X).X#+10
    If PongBall.X#>Paddles(X).X#
      PongBall.XVelo#=PongBall.XVelo#*-1
      `Make the ball bounce off randomly
      PongBall.YVelo#=Rnd(2)+1
      If Rnd(1)=1
      PongBall.YVelo#=-PongBall.YVelo#
      EndIf
      `If the player defended the ball- add score
      If X=1
      PlayerData.Score=PlayerData.Score+10
      EndIf
    EndIf
    EndIf
  EndIf
  EndIf
Next X 
`Now we'll check to see if the ball went off screen.
`IF it does go off screen, reset the ball and set the scores.
`The pong ball went through the players defence...
`IF the ball went off the top or bottom of the screen-
If PongBall.Y#<0
  PongBall.YVelo#=PongBall.YVelo#*-1
EndIf
If PongBall.Y#>GetScreenHeight()
  PongBall.YVelo#=PongBall.YVelo#*-1
EndIf
`IF the ball went off the players side-
If PongBall.X#<-10
  `Reset ball positions
  PongBall.X#=(GetScreenWidth()/2): PongBall.Y#=(GetScreenHeight()/2)
  PongBall.YVelo#=0
  `reset player position
  Paddles(1).Y#=(GetScreenHeight()/2)-(Paddles(1).SizeY#/2)
  `Decrease lives and exit if it goes below 1
  PlayerData.Lives=PlayerData.Lives-1
  If PlayerData.Lives<1
  End
  EndIf
EndIf


`Handle Controls
`This is a fairly simple control sceheme, it should really
`be based on time, but that's up to you.
If UpKey()=1
  Paddles(1).Y#=Paddles(1).Y#-4
EndIf
If DownKey()=1
  Paddles(1).Y#=Paddles(1).Y#+4
EndIf


`Draw the camera, allowing stuff to be seen on the screen
DrawCamera 1
Sync
Loop


 

[markel422]

Haha, Thanks!

That fixed the Problem. :)

[kevin]

   Added to Graphics Questions FAQ