Code: Select all
; *****************************
; VampyresOfFunnydale.pb *
; *
; by BasicallyPure 01.14.2012 *
; *
; PureBasic 4.60 *
; *****************************
EnableExplicit
#Version = 102
#GameSpeed = 125 ; delay in mS between iterations
Declare Verify(result,text.s)
;gadgets
#Text_Vampyre = 0
#Text_Human = 1
#Font_Score = 2
#Button_Pause = 3
#Button_Skip = 4
#Text_Level = 5
#Button_Restart = 6
#Canvas = 7
#Text_Waypoints = 8
#button_Help = 9
#Editor = 10
#yes = #PB_MessageRequester_Yes
#windowColor = $C3781A
ExamineDesktops()
Define winWidth = DesktopWidth(0) * 0.95
Define winHeight = winWidth * 0.5625
Define text$ = "Vampyres of Funnydale v" + StrF(#Version/100,2)
Define flags = #PB_Window_ScreenCentered | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
Verify(OpenWindow(0, 0, 0, winWidth, winHeight, text$ , flags),"OpenWindow 0")
SetWindowColor(0,#windowColor)
AddWindowTimer(0,0,#GameSpeed)
;define the cell colors
Define human = $59A457
Define vampyer = $0DF4F2
Define slayer = $2517DA
Define empty = $042452
Define waypoint = $FF0000
Frame3DGadget(#PB_Any, 10, 10, 100, 45, "Humans")
Frame3DGadget(#PB_Any, 10, 60, 100, 45, "Vampyres")
Frame3DGadget(#PB_Any, 10, 110, 100, 45, "Level")
Frame3DGadget(#PB_Any, 10, 160, 100, 45, "Waypoints")
LoadFont(#Font_Score, "Courier New", 14, #PB_Font_Bold)
SetGadgetFont(#PB_Default,FontID(#Font_Score))
flags = #PB_Text_Right
TextGadget(#Text_Human, 15, 25, 85, 28, "0" , flags)
SetGadgetColor(#Text_Human, #PB_Gadget_BackColor, #windowColor)
TextGadget(#Text_Vampyre, 15, 75, 85, 28, "0" ,flags)
SetGadgetColor(#Text_Vampyre, #PB_Gadget_BackColor, #windowColor)
TextGadget(#Text_Level, 15, 125, 85, 28, "" ,flags)
SetGadgetColor(#Text_Level, #PB_Gadget_BackColor, #windowColor)
TextGadget(#Text_Waypoints, 15, 175, 85,28, "0", flags)
SetGadgetColor(#Text_Waypoints, #PB_Gadget_BackColor, #windowColor)
ButtonGadget(#button_Help, 10, 230, 100, 35, "Read Me")
GadgetToolTip(#button_Help, "Game description")
ButtonGadget(#Button_Restart, 10, 280, 100, 35, "Restart")
GadgetToolTip(#Button_Restart, "Repeat this level")
ButtonGadget(#Button_Skip, 10, 330, 100, 35, "Level up")
GadgetToolTip(#Button_Skip, "Go to next level")
ButtonGadget(#Button_Pause, 10, 380, 100, 35, "Slay")
GadgetToolTip(#Button_Pause, "Activate the Slayer")
Macro drawCell(x,y)
Box(cell(x,y)\Xloc, cell(x,y)\Yloc, cellSize, cellSize, cell(x,y)\content)
EndMacro
Macro ask(text)
answer = MessageRequester("", text ,#PB_MessageRequester_YesNo)
EndMacro
Define cellSize, columns, rows, width, height, event, humanCount, vampyreCount
Define x, y, n, nx, ny, sx, sy, rc, pixels, target, xOffset
Define flags, trendX, trendY, burst, direction, howfarX, howfarY
Define updatePopulation, wp, wpa, wpx, wpy, wpCost, wpMax, waypointFlag
Define scanRange, nextLevel, answer, evolve, pause = #True
Define.f aspectFactor
Define d$
Structure stats
Xloc.i
Yloc.i
content.i
EndStructure
Define level = 1
Repeat ;- game loop
;{ reconfigure screen for each level
width = winWidth - 130 ; make room for gadgets
height = winHeight
pixels = width * height
aspectFactor = width / height
wpCost = 6 * level ;the cost of waypoints in vampyres slain
wpMax = 15 * wpCost ;set the maximum number of waypoints
SetGadgetText(#Text_Level,Str(level) + " of 9")
;set vampyre detection range, should be 'odd' number
scanRange = level * 2 + 1
target = level * 700 + 700 ; construct the game area with about this many cells
columns = Round(Sqr(target * aspectFactor), #PB_Round_Nearest)
rows = Round(Sqr(target / aspectFactor), #PB_Round_Nearest)
cellSize = height / rows
;readjust width & height to exact values
width = cellSize * columns
height = cellSize * rows
;number of random cells chosen for each iteration
burst = target / 30
;compensate for array's elements starting at zero
columns - 1
rows - 1
cellSize - 1 ;this is for 1 pixel border around each cell
waypointFlag = #False
trendX = 2 * Random(1) - 1 ;set trendX -1 or +1
trendY = 2 * Random(1) - 1 ;set trendY -1 or +1
xOffset = winWidth - width
If IsGadget(#Canvas)
ResizeGadget(#Canvas,xOffset, 0, width, height)
Else
Verify(CanvasGadget(#Canvas, xOffset, 0, width, height),"CanvasGadget")
EndIf
StartDrawing(CanvasOutput(#Canvas))
Box(0,0,width,height,0) ;paint it black
StopDrawing()
Dim cell.stats(columns, rows)
;- populate the world
;{ define the content of each cell
nx = 0 : ny = 0
;calculate & store the x y corner pixel location of each world cell
;start with all cells empty
For y = 1 To height - cellSize
For x = 1 To width - cellSize
With cell(nx,ny)
\Xloc = x : \Yloc = y : \content = empty
EndWith
x + cellSize : nx + 1
Next x
y + cellSize : ny + 1 : nx = 0
Next y
;define the starting population
humanCount = (columns * rows) / 50
vampyreCount = (columns * rows) / 50
SetGadgetText(#Text_Human,Str(humanCount))
SetGadgetText(#Text_Vampyre,Str(vampyreCount))
With cell(x,y)
;distribute the human population
For n = 1 To humanCount
Repeat ; find an empty cell
x = Random(columns) : y = Random(rows)
Until \content = empty
\content = human
Next n
;distribute the vampyre population
For n = 1 To vampyreCount
Repeat ; find an empty cell
x = Random(columns) : y = Random(rows)
Until \content = empty
\content = vampyer
Next n
Repeat ; make the Slayer cell
x = Random(columns) : y = Random(rows)
Until \content = empty
\content = slayer
rc = empty : sx = x : sy = y
EndWith
; draw all cells
If StartDrawing(CanvasOutput(#Canvas))
For y = 0 To rows
For x = 0 To columns
drawCell(x,y) ;macro
Next x
Next y
StopDrawing()
EndIf
Repeat ; level loop
evolve = #False
Repeat ;-event loop
Event = WindowEvent()
Select Event
Case #PB_Event_CloseWindow
ask("Confirm end program?")
If answer = #yes
End
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case #Canvas
Select EventType()
Case #PB_EventType_LeftButtonDown
If wpa ; check for available waypoints
x = GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX)
y = GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY)
Verify(StartDrawing(CanvasOutput(#Canvas)),"StartDrawing")
wp - wpCost
wpa = wp / wpCost
If waypointFlag
drawCell(wpx,wpy) ;macro
EndIf
wpx = x / (cellSize+1)
wpy = y / (cellSize+1)
waypointFlag = #True
Box(cell(wpx,wpy)\Xloc, cell(wpx,wpy)\Yloc, cellSize, cellSize, waypoint)
StopDrawing()
trendX = 2 * Random(1) - 1 ;set trendX -1 or +1
trendY = 2 * Random(1) - 1 ;set trendY -1 or +1
EndIf
EndSelect
Case #Button_Pause ;toggle pause
pause ! #True
If pause
SetGadgetText(#Button_Pause,"Slay")
GadgetToolTip(#Button_Pause, "Activate the Slayer")
Else
SetGadgetText(#Button_Pause,"Pause")
GadgetToolTip(#Button_Pause, "Freeze the game")
EndIf
Case #Button_Skip
ask("skip to next level?")
If answer = #yes
nextLevel = #True : pause = #False
EndIf
Case #Button_Restart
ask("Restart this level?")
If answer = #yes
level - 1 : nextLevel = #True : pause = #False
EndIf
Case #button_Help
flags = #PB_Window_ScreenCentered | #PB_Window_SystemMenu
text$ = "Vampyres of Funnydale - Message -"
Verify(OpenWindow(1,0,0,WindowWidth(0)-50,WindowHeight(0)-50,text$,flags),"openWindow 1")
StickyWindow(1,1)
EditorGadget(#Editor, 0,0,WindowWidth(1),WindowHeight(1),#PB_Editor_ReadOnly)
SetGadgetColor(#Editor, #PB_Gadget_BackColor, $99FFFF)
text$ = ""
Restore message
Read.s d$
While d$ <> "EndMessage"
text$ + d$ + #CRLF$
Read.s d$
Wend
SetGadgetText(#Editor,text$)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
CloseWindow(1)
UseGadgetList(WindowID(0))
EndSelect
Case #PB_Event_Timer
If EventTimer() = 0
evolve = #True
EndIf
EndSelect
If pause : Delay(10) : EndIf
Until (Not Event) And (Not pause) And evolve
;} end event loop
;{ evolve all cells
If StartDrawing(CanvasOutput(#Canvas))
For n = 1 To burst
x = Random(columns) : y = Random(rows)
If cell(x,y)\content <> empty
nx = Random(2) - 1
If x + nx < 0 Or x + nx > columns : nx = 0 : EndIf
ny = Random(2) - 1
If y + ny < 0 Or y + ny > rows : ny = 0 : EndIf
If nx <> 0 Or ny <> 0
nx + x : ny + y
Select cell(x,y)\content
Case human
If cell(nx,ny)\content = empty ;spawn human
cell(nx,ny)\content = human
humanCount + 1
drawCell(nx,ny) ;macro
ElseIf cell(nx,ny)\content = human ;kill human
cell(x,y)\content = empty
humanCount - 1
drawCell(x,y) ;macro
EndIf
Case vampyer
If cell(nx,ny)\content = empty ;move vampyer
cell(x,y)\content = empty
drawCell(x,y) ;macro
cell(nx,ny)\content = vampyer
drawCell(nx,ny) ;macro
ElseIf cell(nx,ny)\content = human ;turn human into vampyre
cell(nx,ny)\content = vampyer
drawCell(nx,ny) ;macro
humanCount - 1 : vampyreCount + 1
EndIf
EndSelect
EndIf
EndIf
Next n
; move the slayer
If waypointFlag ;move toward waypoint
nx = Sign(wpx - sx)
ny = Sign(wpy - sy)
If sx + nx = wpx And sy + ny = wpy
waypointFlag = #False
EndIf
Else ; move normal
x = sx : y = sy ;point to the slayer square
direction = 2 * Random(1) - 1 ; choose -1 or +1
howfarX = 1 : howfarY = 1
Repeat ;this loop runs only once by design
Repeat ;begin scanning for vampyres
For n = 1 To howfarX
x + direction
If x >= 0 And x <= columns ; in bounds
If cell(x,y)\content = vampyer
nx = Sign(x - sx) : ny = Sign(y - sy)
Break 3 ;scan finished
EndIf
Else ; out of bounds
x - direction : howfarX - 1
Break
EndIf
Next n
For n = 1 To howfarY
y + direction
If y >= 0 And y <= rows ; in bounds
If cell(x,y)\content = vampyer
nx = Sign(x - sx) : ny = Sign(y - sy)
Break 3 ; scan finished
EndIf
Else ; out of bounds
y - direction : howfarY -1
Break
EndIf
Next n
howfarX + 1 : howfarY + 1 : direction * -1
Until howfarX > scanRange Or howfarY > scanRange
;no vampyres in scan range so move by trend
If Random(100) < 4 ;change trend before moving
trendX = Random(2) - 1
If trendX <> 0
trendY = Random(2) - 1
Else
trendY = 2 * Random(1) - 1
EndIf
EndIf
nx = trendX : ny = trendY
; prevent out of bounds movement
If sx + nx < 0 Or sx + nx > columns
nx * -1 : trendX * -1
EndIf
If sy + ny < 0 Or sy + ny > rows
ny * -1 : trendY * -1
EndIf
Until #True ;this loop never repeats
EndIf ; End move the slayer
With cell(sx,sy)
Select rc ; restore previous human or kill vampyre
Case human ; restore the previous human cell
\content = human
Case vampyer ; kill the vampyre cell
\content = empty
vampyreCount - 1
If wp < wpMax : wp + 1 : EndIf
wpa = wp / wpCost
Default
\content = empty
EndSelect
drawCell(sx,sy) ;macro
sx + nx : sy + ny ; update slayer coordinates
rc = \content ; remember what the cell content was
\content = slayer
drawCell(sx,sy) ;macro
EndWith
StopDrawing()
EndIf
updatePopulation + 1
If updatePopulation = 10
updatePopulation = 0
SetGadgetText(#Text_Human,Str(humanCount))
SetGadgetText(#Text_Vampyre,Str(vampyreCount))
SetGadgetText(#Text_Waypoints,Str(wpa))
If Not vampyreCount
If level < 9
Delay(1000)
text$ = "level " + Str(level) + " complete!"
text$ + #CRLF$ + "continue?"
ask(text$)
If answer = #yes
nextLevel = #True
Else
End
EndIf
Else
nextLevel = #True
EndIf
EndIf
If Not humanCount
MessageRequester("Game Over"," You Lose! ")
End
EndIf
EndIf
;}
Until nextLevel
nextLevel = #False
pause = #True
SetGadgetText(#Button_Pause,"Slay")
GadgetToolTip(#Button_Pause, "Activate the Slayer")
wp = 0
SetGadgetText(#Text_Waypoints,Str(wp))
level + 1
If level = 9
DisableGadget(#Button_Skip, #True)
EndIf
Until level = 10
MessageRequester("","Congratulations!" + #CRLF$ + "You have won!")
End
Procedure Verify(result,text.s)
If result = #False
text + " failed To initialize."
MessageRequester("Error!",text)
End
EndIf
ProcedureReturn result
EndProcedure
DataSection
message:
Data.s "Welcome to Funnydale."
Data.s #CRLF$
Data.s "Funnydale is a town with a problem, it seems the town is infested with vampyres."
Data.s "The humans (green squares) are being turned into vampyres (yellow squares)."
Data.s "Fortunately for the humans they have a protector, a 'Vampyre Slayer' (red square)."
Data.s "You Robert Miles, are here To help the Slayer exterminate the vampyres from Funnydale."
Data.s "The Vampyre Slayer does quite well alone but with your guidance can be even more effective."
Data.s "Your only way To help is to use the mouse to set 'waypoint' markers to guide the slayer."
Data.s "When waypoints become available you click on a cell and the Slayer will move to that cell."
Data.s ""
Data.s "Like all humans the people of Funnydale multiply if left alone."
Data.s "Because they are mortal they also sometimes die of natural causes."
Data.s "Vampyres can only increase their numbers by turning a human into a vampyre."
Data.s "Vampyres are immortal, only the Slayer can destroy a vampyre."
Data.s ""
Data.s "The game consists of nine different levels, each level more difficult than the one before."
Data.s "To complete a level you must destroy all of the vampyres on that level."
Data.s "If all of the humans are eliminated on any level the game will end."
Data.s "To win the game you must complete all levels."
Data.s ""
Data.s "Close this window to continue."
Data.s "EndMessage"
EndDataSectionEdit2: Fixed waypoint bug.
