A small game turnbased planet exploring game in qbasic glory

planet.bas

DECLARE SUB Pause ()
DECLARE FUNCTION BuildingMenu! (withres!)
DECLARE FUNCTION CheckResources! (needed AS ANY, have AS ANY)
DECLARE SUB SubtractResources (a AS ANY, b AS ANY)
DECLARE FUNCTION Menu! (menuItems$(), length!)
DECLARE SUB printcoor (c AS ANY)
DECLARE SUB Initialize ()
DECLARE SUB PrintPlayer (pi AS INTEGER)
DECLARE SUB PrintPlanet (pi!)
DECLARE SUB TurnBuilding (ip!, ib!)
DECLARE SUB PrintBuilding (pi!, ib!)
DECLARE FUNCTION RandLng! (min AS LONG, max AS LONG)
DECLARE SUB Turn ()
DECLARE SUB PrintResources (res AS ANY)
DECLARE SUB InitPlayer ()
DECLARE SUB CreatePlanets ()
DECLARE FUNCTION RandName$ ()
DECLARE SUB RandCoor (min AS INTEGER, max AS INTEGER, c AS ANY)
DECLARE SUB InitializePlanets ()
DECLARE FUNCTION RandInt! (min AS INTEGER, max AS INTEGER)
' PLANET (C) 2014 by Alexander Weld<weldale@gmail.com>

'CONSTS
CONST Numplanets = 50
CONST NUMMAXBUILDINGS = 10
CONST LENNAME = 5

CONST BLDNONE = 0
CONST BLDGOLDMINE = 1
CONST BLDSANDMINE = 2
CONST BLDIRONMINE = 3

CONST MAXBLDID = BLDIRONMINE

'TYPE DEFINITIONS

TYPE Coor
        x AS INTEGER
        y AS INTEGER
END TYPE

TYPE Resources
        Gold AS LONG
        Sand AS LONG
        Iron AS LONG
END TYPE

TYPE Planet
        planetname AS STRING * LENNAME
        c AS Coor
        res AS Resources
        ownedBy AS INTEGER
END TYPE

TYPE Player
        res AS Resources
END TYPE

TYPE building
        id AS INTEGER
        completion AS INTEGER
END TYPE

TYPE BuildingInfo
        nam AS STRING * 20
        res AS Resources
END TYPE

'shared Dims

DIM SHARED BldInfo(MAXBLDID) AS BuildingInfo
BldInfo(BLDGOLDMINE).nam = "Gold Mine"
BldInfo(BLDGOLDMINE).res.Sand = 5000
BldInfo(BLDGOLDMINE).res.Iron = 5000

BldInfo(BLDSANDMINE).nam = "Sand Mine"
BldInfo(BLDSANDMINE).res.Sand = 5000
BldInfo(BLDSANDMINE).res.Iron = 5000

BldInfo(BLDIRONMINE).nam = "Iron Mine"
BldInfo(BLDIRONMINE).res.Sand = 5000
BldInfo(BLDIRONMINE).res.Iron = 5000

DIM SHARED ActionMenu$(4)
ActionMenu$(1) = "PRINT STATUS"
ActionMenu$(2) = "BUILD"
ActionMenu$(3) = "END TURN"
ActionMenu$(4) = "END GAME"


DIM SHARED planets(Numplanets) AS Planet
DIM SHARED buildings(Numplanets, NUMMAXBUILDINGS) AS building

DIM SHARED Players(1) AS Player

DIM SHARED vowels$(5)
DIM SHARED consonants$(19)

Initialize

RANDOMIZE TIMER
CLS

DO

CLS

PrintPlayer 1

PRINT
PRINT "SELECT NEXT ACTION"

sl = Menu(ActionMenu$(), 4)

SELECT CASE sl
CASE 1
PrintPlayer 1
PrintPlanet 1
Pause
CASE 2

bldSel = BuildingMenu(1)

DO

FOR i = 1 TO NUMMAXBUILDINGS
        IF buildings(1, i).id = BLDNONE THEN PRINT i;
NEXT i
PRINT

INPUT "BUILD PLACE"; place

IF place >= 1 AND place <= NUMMAXBUILDINGS THEN
        IF buildings(1, place).id = BLDNONE THEN
         IF CheckResources(BldInfo(bldSel).res, Players(1).res) THEN
                SubtractResources Players(1).res, BldInfo(bldSel).res
         END IF
         EXIT DO
        END IF
END IF

LOOP

buildings(1, place).id = bldSel
buildings(1, place).completion = 0

CASE 3
PRINT "TURN"
Turn
PRINT "TURN DONE"
Pause
CASE 4
EXIT DO
END SELECT


LOOP


DATA "A","E","I","O","U","Y"
DATA "B","C","D","F","G","H","K","L","M","N","P","R","S","T","V","W","X","Z"

FUNCTION BuildingMenu (withres)

DO

FOR i = 1 TO MAXBLDID
        PRINT i, BldInfo(i).nam
        IF withres <> 0 THEN
                PrintResources BldInfo(i).res
        END IF
NEXT i

INPUT "SELECTION"; s

LOOP WHILE s < 1 OR s > MAXBLDID

BuildingMenu = s

END FUNCTION

FUNCTION CheckResources (needed AS Resources, have AS Resources)

IF have.Gold >= needed.Gold AND have.Iron >= needed.Iron AND have.Sand >= needed.Sand THEN
CheckResources = 1
ELSE
CheckResources = 0
END IF

END FUNCTION

SUB CreatePlanets

RANDOMIZE 1

FOR i = 1 TO Numplanets
        planets(i).planetname = RandName
        RandCoor 0, 100, planets(i).c
        RandCoor 0, 100, planets(i).c
        planets(i).res.Gold = RandLng(5000, 10000)
        planets(i).res.Sand = RandLng(50000, 100000)
        planets(i).res.Iron = RandLng(10000, 50000)
NEXT i


END SUB

SUB Initialize
FOR i = 1 TO 5
        READ vowels$(i)
NEXT i
FOR i = 1 TO 19
        READ consonants$(i)
NEXT i


CLS

PRINT "CREATING PLANETS"

CreatePlanets

InitPlayer


END SUB

SUB InitPlayer
        planets(1).ownedBy = 1
        Players(1).res.Sand = 500000
        Players(1).res.Gold = 50000
        Players(1).res.Iron = 100000

        buildings(1, 1).id = BLDIRONMINE
        buildings(1, 1).completion = 90
END SUB

FUNCTION Menu (menuItems$(), length)

DO

FOR i = 1 TO length
PRINT i, menuItems$(i)
NEXT i

INPUT "SELECTION"; s

IF s >= 1 AND s <= length THEN EXIT DO

LOOP

Menu = s

END FUNCTION

SUB Pause
PRINT ">> PRESS ANY KEY TO CONTINUE"
DO
tmp$ = INPUT$(1)
LOOP UNTIL ASC(tmp$) = 13
END SUB

SUB PrintBuilding (pi, ib)
PRINT "BUILDING", BldInfo(buildings(pi, ib).id).nam
PRINT "COMPLETION", buildings(pi, ib).completion
END SUB

SUB printcoor (c AS Coor)
PRINT c.x; ", "; c.y
END SUB

SUB PrintPlanet (pi)
PRINT "PLANET "; planets(pi).planetname
printcoor planets(pi).c
PrintResources planets(pi).res

FOR ib = 1 TO NUMMAXBUILDINGS
        IF buildings(pi, ib).id <> BLDNONE THEN
                PrintBuilding pi, ib
        END IF
NEXT ib

END SUB

SUB PrintPlayer (pi AS INTEGER)
PRINT "PLAYER"
PrintResources Players(pi).res
END SUB

SUB PrintResources (res AS Resources)

PRINT "GOLD: ", res.Gold
PRINT "SAND: ", res.Sand
PRINT "IRON: ", res.Iron

END SUB

SUB RandCoor (min AS INTEGER, max AS INTEGER, c AS Coor)
        c.x = RandInt(min, max)
        c.y = RandInt(min, max)
END SUB

FUNCTION RandInt (min AS INTEGER, max AS INTEGER)
RandInt = INT(RND * (max - min) + min)
END FUNCTION

FUNCTION RandLng (min AS LONG, max AS LONG)
RandLng = INT(RND * (max - min) + min)
END FUNCTION

FUNCTION RandName$
DIM result$
DIM r AS INTEGER

FOR i = 1 TO LENNAME

       IF i MOD 2 = 0 THEN
        r = RandInt(1, 6)
        result$ = result$ + vowels$(r)
       ELSE
        r = RandInt(1, 20)
        result$ = result$ + consonants$(r)
       END IF

NEXT i

RandName$ = result$

END FUNCTION

SUB SubtractResources (a AS Resources, b AS Resources)

a.Gold = a.Gold - b.Gold
a.Iron = a.Iron - b.Iron
a.Sand = a.Sand - b.Sand

END SUB

SUB Turn

FOR ip = 1 TO Numplanets
        FOR ib = 1 TO NUMMAXBUILDINGS
                        TurnBuilding ip, ib
        NEXT ib
NEXT ip

END SUB

SUB TurnBuilding (ip, ib)
IF buildings(ip, ib).id <> BLDNONE THEN

IF buildings(ip, ib).completion < 100 THEN
        buildings(ip, ib).completion = buildings(ip, ib).completion + 10
        IF buildings(ip, ib).completion > 100 THEN buildings(ip, ib).completion = 100
ELSE
SELECT CASE buildings(ip, ib).id

CASE BLDNONE
CASE BLDGOLDMINE
        IF planets(ip).res.Gold > 0 THEN
                                        planets(ip).res.Gold = planets(ip).res.Gold - 100
                                        Players(planets(ip).ownedBy).res.Gold = Players(planets(ip).ownedBy).res.Gold + 100
                                END IF
                        CASE BLDSANDMINE
                                IF planets(ip).res.Sand > 0 THEN
                                        planets(ip).res.Sand = planets(ip).res.Sand - 100
                                        Players(planets(ip).ownedBy).res.Sand = Players(planets(ip).ownedBy).res.Sand + 100
                                END IF
                        CASE BLDIRONMINE
                                IF planets(ip).res.Iron > 0 THEN
                                        planets(ip).res.Iron = planets(ip).res.Iron - 100
                                        Players(planets(ip).ownedBy).res.Iron = Players(planets(ip).ownedBy).res.Iron + 100
                                END IF
                        END SELECT



END IF

END IF

END SUB