Print Page - Rogue-Like (work in progress)

Title: Rogue-Like (work in progress)
Post by: SMcNeill on September 07, 2019, 09:26:57 am

Having a little free time once more, I decided to play around with one of those old game concepts from ages lost, and toss my hat into the ring with trying to create a "Rogue-like" game. (You can watch this poor fellow try out the game for the first time in a video here:

OR, you can have fun and test out this timeless classic yourself with a modern emulator here: https://www.myabandonware.com/game/rogue-4n/play-4n )

So, here's my little start to the game, which generates us a rogue-like map and lets us roam our hero around it and explore:

Code: QB64: [Select]

TYPE Light_Type
    Name AS STRING * 20
    Reach AS INTEGER
    Left AS INTEGER
END TYPE
 
TYPE Hero_Type
    X AS INTEGER
    Y AS INTEGER
    HP AS INTEGER
    Level AS INTEGER
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
END TYPE
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS INTEGER: Level = 1
 
 
SCREEN _NEWIMAGE(800, 600, 32)
REDIM SHARED MapArray(0, 0) AS _BYTE
RANDOMIZE TIMER
_CONTROLCHR OFF
_FONT 8
 
Init
CreateMap 99, 74, 10, 1
DO
    CLS
    DrawMap
    _DISPLAY
    GetInput
LOOP
 
SUB Init
    Hero.HP = 10
    Hero.Level = 1
    Hero.EXP_Earned = 0
    Hero.EXP_Needed = 1000
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2
    Hero.Light.Left = -1 'infinite
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT
        SELECT CASE k
            CASE 18432 'up
                IF Hero.Y > LBOUND(maparray, 2) THEN 'if we can move up
                    IF MapArray(Hero.X, Hero.Y - 1) AND (2 OR 4) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y - 1
                    END IF
                END IF
            CASE 19200 'left
                IF Hero.X > LBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X - 1, Hero.Y) AND (2 OR 4) THEN 'and it's a room or passageway
                        Hero.X = Hero.X - 1
                    END IF
                END IF
            CASE 20480 'down
                IF Hero.Y < UBOUND(maparray, 2) THEN 'if we can move down
                    IF MapArray(Hero.X, Hero.Y + 1) AND (2 OR 4) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y + 1
                    END IF
                END IF
            CASE 19712 'right
                IF Hero.X < UBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X + 1, Hero.Y) AND (2 OR 4) THEN 'and it's a room or passageway
                        Hero.X = Hero.X + 1
                    END IF
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                Level = Level + 1
                IF MapArray(Hero.X, Hero.Y) AND 8 THEN CreateMap 99, 74, 10, Level
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 5 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
        END SELECT
        _LIMIT 60
    LOOP UNTIL k
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB Illuminate (TX, TY, Range)
    X = TX: Y = TY
    XL = LBOUND(MapArray, 1): XH = UBOUND(MapArray, 1)
    YL = LBOUND(MapArray, 2): YH = UBOUND(MapArray, 2)
    IF X >= XL AND X <= XH AND Y >= YL AND Y <= YH THEN
        IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 16 'illuminate the room
        IF Range > 0 THEN
            IF X > XL THEN IF MapArray(X - 1, Y) <> 0 THEN Illuminate X - 1, Y, Range - 1
            IF X < XH THEN IF MapArray(X + 1, Y) <> 0 THEN Illuminate X + 1, Y, Range - 1
            IF Y > YL THEN IF MapArray(X, Y - 1) <> 0 THEN Illuminate X, Y - 1, Range - 1
            IF Y < YH THEN IF MapArray(X, Y + 1) <> 0 THEN Illuminate X, Y + 1, Range - 1
        END IF
    END IF
END SUB
 
 
SUB DrawMap
    XL = LBOUND(MapArray, 1): XH = UBOUND(MapArray, 1)
    YL = LBOUND(MapArray, 2): YH = UBOUND(MapArray, 2)
 
    Illuminate Hero.X, Hero.Y, Hero.Light.Reach
 
    FOR y = 0 TO YH
        FOR x = 0 TO XH
            LOCATE y + 1, x + 1
            IF MapArray(x, y) AND 1 THEN 'It's a visible part of the map, draw it
                IF MapArray(x, y) AND 2 THEN 'it's a visible room
                    COLOR 0, &HFF000000
                    _PRINTSTRING (x * _FONTWIDTH, y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(x, y) AND 4 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (x * _FONTWIDTH, y * _FONTHEIGHT), "."
                END IF
                IF MapArray(x, y) AND 8 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (x * _FONTWIDTH, y * _FONTHEIGHT), CHR$(240)
                END IF
                IF MapArray(x, y) AND 16 THEN 'it's currently illuminated by the lightsource
                    COLOR &H40FFFF00, 0
                    _PRINTSTRING (x * _FONTWIDTH, y * _FONTHEIGHT), CHR$(219)
                    MapArray(x, y) = MapArray(x, y) AND NOT 16
                END IF
 
            ELSE
                COLOR &HFF0000FF, &HFF000000
                _PRINTSTRING (x * _FONTWIDTH, y * _FONTHEIGHT), CHR$(219)
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms, Level)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _BYTE
 
    DIM RoomCenterX(Rooms) AS _BYTE, RoomCenterY(Rooms) AS _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR y = 0 TO RoomSize: FOR x = 0 TO RoomSize
                    IF MapArray(RoomX + x, RoomY + y) = 2 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT x, y
        LOOP UNTIL good
        FOR y = 0 TO RoomSize: FOR x = 0 TO RoomSize
                MapArray(RoomX + x, RoomY + y) = 2 'go ahead and draw a room
        NEXT x, y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 4
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 2 'place the hero randomly, until they're in a room somewhere
    DO
        x = INT(RND * XLimit + 1)
        y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(x, y) AND 2 'get a random spot in a room, for the stairs to the next level
    MapArray(x, y) = MapArray(x, y) OR 8
 
END SUB

I'm actually rather happy with what I've got here so far, and I really like the illumination code, which can be used to simulate various light sources for us. A candle has a minor glow, only illuminating the ground close to our hero, whereas a torch might illuminate further, and a lantern even more than that...

Navigation/Key commands
For testing purposes, at this point, you can alter your light's range manually with the "+" and "-" keys.
Arrow keys move your hero across the screen.
The "<" key allows you to go down stairs to the next level.

Test it out, see what you think of things as they currently exist, and let me know how it performs on your machine/OS. The illumination routine isn't half as efficient as it could be, as it recursively calls itself over and over and repeats lighting checks on the same areas multiple times, but I don't think it should really be that big an issue since a lightsource should never be larger than 5 or 6 tiles. If I was going to have the light extend dozens of tiles, I'd work on fixing the repetitive recursive calls, but in this case it seems minor enough to keep it simple as it is. On my machine, it runs perfectly fine with no issue, but if it lags or uses too much CPU power on somebody else's, I'll redo it with a little better logic checking.

Try it out, tell me what you think, and if there's any issues with navigation, illumination, or such, let me know and I'll work on correcting it before I move on and start adding monsters, gear, and everything else into the game one step at a time.

Title: Re: Rogue-Like (work in progress)
Post by: Ashish on September 07, 2019, 09:59:32 am

Hi Steve! Nice.. The only issue is that it lags. Seems like it wait for a bit to respond to keys.

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 07, 2019, 10:12:46 am

Quote from: Ashish on September 07, 2019, 09:59:32 am

Hi Steve! Nice.. The only issue is that it lags. Seems like it wait for a bit to respond to keys.

I was a little worried that it might on lower-end systems.

Quick question: Is the lag in general, or when you've got a strong light illuminating your surroundings? The game should be one which operates on a "turn-based" style, where nothing changes or happens, until the player makes a keypress. It's not a "real-time" game, where monsters and such will move independently and the game progresses consistantly; instead it only updates with each keystroke from the player. (And even then, only from registered keystrokes. Arrow keys to move, Space to wait and skip a turn, "<" to go down stairs... Other keys for future functionality...)

Are you seeing a general sluggishness to respond, with high CPU usage (such as the light calling itself over and over in an unregulated loop), or is it just the style which might not be what you were expecting? I know a lot of you younger folks have probably never been exposed to Rogue (after all, it was a 1980 text game which ran on consoles/terminals), and I think the movement seems fairly faithful on my system, but I'm still worried there might be an issue in there somewhere for folks with older machines. ;)

Title: Re: Rogue-Like (work in progress)
Post by: Ashish on September 07, 2019, 10:35:44 am

Quote from: SMcNeill on September 07, 2019, 10:12:46 am

The game should be one which operates on a "turn-based" style, where nothing changes or happens, until the player makes a keypress.

Ok. Got it. No, no high cpu usage.

Title: Re: Rogue-Like (work in progress)
Post by: Cobalt on September 07, 2019, 12:07:33 pm

Plays pretty smooth for me, looks a lot like ye old ROGUE games. Which I have to admit I always found them particularly hard with the lack of a visible interface and usually a lack of instructions\information on game play.

I find the lighting trick rather cool, lots of possibilities with that one; blindness, candle, torch, ect...

The mapping always interested me. I was once told, by a guy who made probably my fave roguish type game ever 'Reaping the Dungeon', that he generated some 'rooms' then had a 'worm' make tunnels connecting them. Alas I have tried many a time to get that to work and just never really succeed, the maps are either big messes of tunnels everywhere or half the rooms can never be reached. couldn't get a good balance.

I've done a lot of work on my own Reaping clone, thats when I asked Galleon about being able to change the BIOS font and he set that up for me way back when. But never was happy with the maps I was able to generate, and that always held me back from finishing it.

Anyway it looks really awesome and nostalgic!

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 07, 2019, 12:35:54 pm

Quote from: Cobalt on September 07, 2019, 12:07:33 pm

Plays pretty smooth for me, looks a lot like ye old ROGUE games. Which I have to admit I always found them particularly hard with the lack of a visible interface and usually a lack of instructions\information on game play.

I find the lighting trick rather cool, lots of possibilities with that one; blindness, candle, torch, ect...

The mapping always interested me. I was once told, by a guy who made probably my fave roguish type game ever 'Reaping the Dungeon', that he generated some 'rooms' then had a 'worm' make tunnels connecting them. Alas I have tried many a time to get that to work and just never really succeed, the maps are either big messes of tunnels everywhere or half the rooms can never be reached. couldn't get a good balance.

I've done a lot of work on my own Reaping clone, thats when I asked Galleon about being able to change the BIOS font and he set that up for me way back when. But never was happy with the maps I was able to generate, and that always held me back from finishing it.

Anyway it looks really awesome and nostalgic!

The lighting trick is also going to become an “awareness trick”. Using the same behavior as the light, with the monsters, I’ll be able to give the monsters a “sight” and “hearing” range. The way I envision it, something like a bat will have almost 0 sight but a decent hearing range, so sneaking might allow you to bypass it without being found, whereas an invisibility potion would be useless. A different creature might have a high visibility, but be deaf...

Just as we produce a light around us, monsters should have an awareness range around them. At least, that’s my intention for how things should work... ;)

Title: Re: Rogue-Like (work in progress)
Post by: Cobalt on September 07, 2019, 02:19:52 pm

wow that lighting system is really slow! I played around with it a bit and when you get up near 10-11 distance it darn near locks. no super site abilities I guess! which makes me wonder just how well the performance will hold up if your using something similar for awareness, 2 or 3 creatures and that would be it.

Though looking at the Illuminate code I don't see anything directly that makes it look slow unless its all the recursion? even at 10 should only be checking what, 220-221 spaces?

anyways, I did add a little info area, very very basic.

Code: QB64: [Select]

SUB Display_Info_Area
 LOCATE 1, 1: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
 FOR i%% = 0 TO 2
  LOCATE 2 + i%%, 1: PRINT "³"; TAB(94); "³"
 NEXT i%%
 LOCATE 2 + i%%, 1: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
 LOCATE 2, 2: PRINT "HP:"; Hero.HP; TAB(12); "Map X:"; Hero.X; TAB(24); "Map Y:"; Hero.Y; TAB(36); "Level:"; Hero.Level;
 PRINT TAB(46); "Candle Power:"; Hero.Light.Reach; TAB(62); "Aflliction:";
 LOCATE 3, 2: PRINT "Load:"; TAB(15); "Right Hand:"; TAB(35); "Left Hand:"
 
END SUB

kept it all text based but the border might be better as a line statement or something. Granted the map can go into the area, but it was just an idea.

It might be on your list but did you see this code?

Code: QB64: [Select]

   CASE 60 ' "<" key
    Level = Level + 1
    IF MapArray(Hero.X, Hero.Y) AND 8 THEN CreateMap 99, 74, 10, Level
 

so every time the player hits the "<" key level increases! even if there is no 'ladder' there.

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 07, 2019, 03:46:49 pm

Quote from: Cobalt on September 07, 2019, 02:19:52 pm

wow that lighting system is really slow! I played around with it a bit and when you get up near 10-11 distance it darn near locks. no super site abilities I guess! which makes me wonder just how well the performance will hold up if your using something similar for awareness, 2 or 3 creatures and that would be it.

Though looking at the Illuminate code I don't see anything directly that makes it look slow unless its all the recursion? even at 10 should only be checking what, 220-221 spaces?

I agree with all you said here 100%. The lag generated with higher values is completely beyond my expectations, and I honestly don't see why it's as extreme as it is. And, I think you're right with it either limiting the creatures to a minute awareness range, or else becoming an anchor on the program which will lag it to the point of insanity...

To correct the issue, I've replaced it with this little set of code:

Code: QB64: [Select]

TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS INTEGER
    Left AS INTEGER
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS INTEGER
    Damage AS Damage_Type
    HitBonus AS INTEGER
    DamageBonus AS INTEGER
    Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS INTEGER 'Passive Defense (dodge)
    DR AS INTEGER 'Damage Resistance (absorption)
    Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
 
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS INTEGER
    Y AS INTEGER
    Life AS Damage_Type
    Level AS INTEGER
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS INTEGER: Level = 1
DIM SHARED XL, XH, YL, YH
 
 
SCREEN _NEWIMAGE(800, 700, 32)
REDIM SHARED MapArray(0, 0) AS _BYTE
REDIM SHARED Distance(0, 0) AS _BYTE
RANDOMIZE TIMER
_CONTROLCHR OFF
_FONT 8
 
Init
CreateMap 99, 74, 10, 1
DO
    CLS , &HFF0000FF
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
LOOP
 
SUB DisplayCharacter
    LINE (0, 601)-(_WIDTH - 1, _HEIGHT - 1), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10
    Hero.Life.High = 10
    Hero.Level = 1
    Hero.EXP_Earned = 0
    Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2
    Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1
    Hero.Weapon1.Damage.Low = 1
    Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0
    Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0
    Hero.Weapon2.Damage.Low = 0
    Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0
    Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0
    Hero.Armor.DR = 0
    Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT
        SELECT CASE k
            CASE 18432 'up
                IF Hero.Y > LBOUND(maparray, 2) THEN 'if we can move up
                    IF MapArray(Hero.X, Hero.Y - 1) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y - 1
                    END IF
                END IF
            CASE 19200 'left
                IF Hero.X > LBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X - 1, Hero.Y) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.X = Hero.X - 1
                    END IF
                END IF
            CASE 20480 'down
                IF Hero.Y < UBOUND(maparray, 2) THEN 'if we can move down
                    IF MapArray(Hero.X, Hero.Y + 1) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y + 1
                    END IF
                END IF
            CASE 19712 'right
                IF Hero.X < UBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X + 1, Hero.Y) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.X = Hero.X + 1
                    END IF
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10, Level
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
        END SELECT
        _LIMIT 60
    LOOP UNTIL k
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB Illuminate (TX, TY, TRange)
    X = TX: Y = TY: Range = TRange
    PathFind TX, TY, TRange
    FOR X = 0 TO XH
        FOR Y = 0 TO YH
            IF Distance(X, Y) <> 0 THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
        NEXT
    NEXT
END SUB
 
 
SUB DrawMap
    Illuminate Hero.X, Hero.Y, Hero.Light.Reach
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms, Level)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _BYTE
    XL = LBOUND(MapArray, 1): XH = UBOUND(MapArray, 1)
    YL = LBOUND(MapArray, 2): YH = UBOUND(MapArray, 2)
 
    DIM RoomCenterX(Rooms) AS _BYTE, RoomCenterY(Rooms) AS _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
END SUB
 
SUB PathFind (FromX, FromY, Range)
    REDIM Distance(XH, YH) AS _BYTE
    DIM Temp(XH, YH) AS _BYTE
    DIM m AS _MEM, m1 AS _MEM
    m = _MEM(Distance()): m1 = _MEM(Temp())
    Temp(FromX, FromY) = -1
    FOR i = 1 TO Range
        FOR x = 0 TO XH
            FOR y = 0 TO YH
                IF x < XH THEN
                    IF Temp(x + 1, y) <> 0 THEN Distance(x, y) = Distance(x, y) + 1
                END IF
                IF x > 0 THEN
                    IF Temp(x - 1, y) <> 0 THEN Distance(x, y) = Distance(x, y) + 1
                END IF
                IF y < YH THEN
                    IF Temp(x, y + 1) <> 0 THEN Distance(x, y) = Distance(x, y) + 1
                END IF
                IF y > 0 THEN
                    IF Temp(x, y - 1) <> 0 THEN Distance(x, y) = Distance(x, y) + 1
                END IF
            NEXT
        NEXT
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
    NEXT
    _MEMFREE m
    _MEMFREE m1
END SUB

Now I don't just have an illumination routine; I have a full fledged pathfinding routine in place to make use of later. Since I can map all points distance from the character, all I need to do is check to see if the tile a mob is on has a distance value <= their awareness levels.... If so, all I have to do is check the tiles around them and move them to the tile with the next lowest value so they can approach the hero, one menacing step at a time.

Testing this, we can move our lightsource up to a whopping 25 tiles (NUKE!!) and still move around without any lag or issues with gamplay. (Higher light values probably work just as well, but I didn't bother to test beyond 25.)

I think the lag from illumination issue has probably been solved for good with this change, and I hope all it'll need is a slight tweak or so, so that it'll work for mob awareness levels and such as well.

Title: Re: Rogue-Like (work in progress)
Post by: Cobalt on September 07, 2019, 04:40:13 pm

Yep, much more 'stable' in performance. I was going to ask if you were going to use a path finding routine to allow the creatures to follow or intercept the player, guess there is my answer. Looking really good.

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 07, 2019, 04:49:50 pm

A slight tweak to illumination/pathfinding... Now we no longer count steps through a solid wall. :P

Code: QB64: [Select]

TYPE Damage_Type
    Low AS _UNSIGNED _BYTE
    High AS _UNSIGNED _BYTE
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
 
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH
 
 
SCREEN _NEWIMAGE(800, 700, 32)
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
_FONT 8
 
Init
CreateMap 99, 74, 10, 1
DO
    CLS , &HFF0000FF
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
LOOP
 
SUB DisplayCharacter
    LINE (0, 601)-(_WIDTH - 1, _HEIGHT - 1), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10
    Hero.Life.High = 10
    Hero.Level = 1
    Hero.EXP_Earned = 0
    Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2
    Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1
    Hero.Weapon1.Damage.Low = 1
    Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0
    Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0
    Hero.Weapon2.Damage.Low = 0
    Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0
    Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0
    Hero.Armor.DR = 0
    Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT
        SELECT CASE k
            CASE 18432 'up
                IF Hero.Y > LBOUND(maparray, 2) THEN 'if we can move up
                    IF MapArray(Hero.X, Hero.Y - 1) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y - 1
                        PathFind
                    END IF
                END IF
            CASE 19200 'left
                IF Hero.X > LBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X - 1, Hero.Y) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.X = Hero.X - 1
                        PathFind
                    END IF
                END IF
            CASE 20480 'down
                IF Hero.Y < UBOUND(maparray, 2) THEN 'if we can move down
                    IF MapArray(Hero.X, Hero.Y + 1) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y + 1
                        PathFind
                    END IF
                END IF
            CASE 19712 'right
                IF Hero.X < UBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X + 1, Hero.Y) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.X = Hero.X + 1
                        PathFind
                    END IF
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10, Level
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
        END SELECT
        _LIMIT 60
    LOOP UNTIL k
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB Illuminate (Range)
    FOR X = 0 TO XH
        FOR Y = 0 TO YH
            IF Distance(X, Y) <= Range THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
        NEXT
    NEXT
END SUB
 
 
SUB DrawMap
    Illuminate Hero.Light.Reach
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms, Level)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XH, YH) AS _UNSIGNED _BYTE
    REDIM Temp(XH, YH) AS _UNSIGNED _BYTE
 
    XL = LBOUND(MapArray, 1): XH = UBOUND(MapArray, 1)
    YL = LBOUND(MapArray, 2): YH = UBOUND(MapArray, 2)
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
    PathFind
END SUB
 
SUB PathFind
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
END SUB

I think this is a much better way for everything to behave, and by using the + key to set your lightsource to an insane level now, you can see how the monster awareness is going to work. If a bat has a hearing rating of 10, and you boost your lightsource up to a 10, you can see how close you'd have to get to the creature for it to notice and react to your hero. ;)

Unless somebody sees an issue with something at this point in time, it seems as if it's about time to start adding a few random monsters into the game and then work on the basics of combat, experience, and leveling up. :)

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 09, 2019, 01:25:39 pm

The game now generates monsters for us and places them randomly on the map so we can wander around and .... do nothing at this point... with them.

Code: QB64: [Select]

TYPE Damage_Type
    Low AS _UNSIGNED _BYTE
    High AS _UNSIGNED _BYTE
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
 
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
TYPE Map_Identifer_TYPE
    Symbol AS _UNSIGNED _BYTE
    Color AS _UNSIGNED LONG
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    ID AS Map_Identifer_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
REDIM SHARED Monster(100) AS Monster_TYPE
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH
 
 
SCREEN _NEWIMAGE(800, 700, 32)
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
_FONT 8
 
Init
CreateMap 99, 74, 10, 1
DO
    CLS , &HFF0000FF
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
LOOP
 
SUB DisplayCharacter
    LINE (0, 601)-(_WIDTH - 1, _HEIGHT - 1), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10
    Hero.Life.High = 10
    Hero.Level = 1
    Hero.EXP_Earned = 0
    Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2
    Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1
    Hero.Weapon1.Damage.Low = 1
    Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0
    Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0
    Hero.Weapon2.Damage.Low = 0
    Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0
    Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0
    Hero.Armor.DR = 0
    Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT
        SELECT CASE k
            CASE 18432 'up
                IF Hero.Y > LBOUND(maparray, 2) THEN 'if we can move up
                    IF MapArray(Hero.X, Hero.Y - 1) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y - 1
                        PathFind
                    END IF
                END IF
            CASE 19200 'left
                IF Hero.X > LBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X - 1, Hero.Y) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.X = Hero.X - 1
                        PathFind
                    END IF
                END IF
            CASE 20480 'down
                IF Hero.Y < UBOUND(maparray, 2) THEN 'if we can move down
                    IF MapArray(Hero.X, Hero.Y + 1) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y + 1
                        PathFind
                    END IF
                END IF
            CASE 19712 'right
                IF Hero.X < UBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X + 1, Hero.Y) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.X = Hero.X + 1
                        PathFind
                    END IF
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10, Level
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
        END SELECT
        _LIMIT 60
    LOOP UNTIL k
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB Illuminate (Range)
    FOR X = 0 TO XH
        FOR Y = 0 TO YH
            IF Distance(X, Y) <= Range THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
        NEXT
    NEXT
END SUB
 
 
SUB DrawMap
    Illuminate Hero.Light.Reach
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR i = 1 TO EncounterLimit
                    IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
                        COLOR Monster(Encounter(i).M).ID.Color
                        t$ = CHR$(Monster(Encounter(i).M).ID.Symbol)
                        _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), t$
                    END IF
                    Encounter(i).M = RandomMonster
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms, Level)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        DO
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 'get a random spot in a room, for the stairs to the next level
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
            Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
        NEXT
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB

Play around with the lightsource a little, and you can really see how much it'll affect game play for us in the future, once things start coming all together. The monsters are there all the time (unless you defeat them, which is impossible at the moment with no combat implemented yet), but you can now move around and see how they pop on and off our screen, as they come into and out of our light's range. I have a feeling, strong light sources might end up becoming a treasured resource in this game -- after all, the sooner you see a monster, the sooner you can react to it. (Shoot it with a bow from a range; zap it with magic from a distance... If you can't see it, you're just shooting blindly into the dark!)

Currently, all monsters appear as a red question mark on the map, but that's intentional. You're going to need to encounter and fight a monster at least once, before YOU get to assign the color and symbol you want to use to represent it on your map. The idea I have here is that the more you progress, and the more you explore in the dungeon, the less you encounter those mysterious and dreaded question marks -- and it allows you to create a custom symbol set for each game, so you can create one which seems familiar, comfortable, and easy to remember/interact with for YOU.

Progress seems to be coming along rather nicely to this point. Now I just need to add the very basics of combat to the game, and then I'll have the "core" of my rogue-like set, where all I'll do from that point on is flesh it out with extra weapons/armor/gear/minor mechanics...

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 11, 2019, 02:00:44 am

Code: QB64: [Select]

TYPE Damage_Type
    Low AS _UNSIGNED _BYTE
    High AS _UNSIGNED _BYTE
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
 
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
TYPE Map_Identifer_TYPE
    Symbol AS _UNSIGNED _BYTE
    Color AS _UNSIGNED LONG
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    ID AS Map_Identifer_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
REDIM SHARED Monster(100) AS Monster_TYPE
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
 
 
SCREEN _NEWIMAGE(800, 700, 32)
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
_FONT 8
 
Init
CreateMap 99, 74, 10
DO
    CLS , &HFF0000FF
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
LOOP
 
SUB DisplayCharacter
    LINE (0, 601)-(_WIDTH - 1, _HEIGHT - 1), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10
    Hero.Life.High = 10
    Hero.Level = 1
    Hero.EXP_Earned = 0
    Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2
    Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1
    Hero.Weapon1.Damage.Low = 1
    Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0
    Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0
    Hero.Weapon2.Damage.Low = 0
    Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0
    Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0
    Hero.Armor.DR = 0
    Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT
        SELECT CASE k
            CASE 18432 'up
                IF Hero.Y > LBOUND(maparray, 2) THEN 'if we can move up
                    IF MapArray(Hero.X, Hero.Y - 1) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y - 1
                        PathFind
                    END IF
                END IF
            CASE 19200 'left
                IF Hero.X > LBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X - 1, Hero.Y) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.X = Hero.X - 1
                        PathFind
                    END IF
                END IF
            CASE 20480 'down
                IF Hero.Y < UBOUND(maparray, 2) THEN 'if we can move down
                    IF MapArray(Hero.X, Hero.Y + 1) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.Y = Hero.Y + 1
                        PathFind
                    END IF
                END IF
            CASE 19712 'right
                IF Hero.X < UBOUND(maparray, 1) THEN 'if we can move right
                    IF MapArray(Hero.X + 1, Hero.Y) AND (4 OR 8) THEN 'and it's a room or passageway
                        Hero.X = Hero.X + 1
                        PathFind
                    END IF
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
        END SELECT
        _LIMIT 60
    LOOP UNTIL k > 0
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB MonstersTurn
    '    Sight AS INTEGER
    '    Hearing AS INTEGER
    '    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
 
 
 
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).M 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
 
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
 
                    _TITLE "ATTACK!"
                    _CONTINUE
                END IF
                IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
                    'insert attack code here
                    _CONTINUE
                END IF
 
                IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
                    IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                        IF D > Distance(MX - 1, MY) THEN
                            Encounter(i).X = Encounter(i).X - 1 'move left
                            _CONTINUE
                        END IF
                    END IF
                    IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                        IF D > Distance(MX, MY - 1) THEN
                            Encounter(i).Y = Encounter(i).Y - 1 'move up
                            _CONTINUE
                        END IF
                    END IF
                    IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                        IF D > Distance(MX + 1, MY) THEN
                            Encounter(i).X = Encounter(i).X + 1 'move right
                            _CONTINUE
                        END IF
                    END IF
                    IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                        IF D > Distance(MX, MY + 1) THEN
                            Encounter(i).Y = Encounter(i).Y + 1 'move down
                            _CONTINUE
                        END IF
                    END IF
                END IF
 
 
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB Illuminate (Range)
    FOR X = 0 TO XH
        FOR Y = 0 TO YH
            IF Distance(X, Y) <= Range THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
        NEXT
    NEXT
END SUB
 
 
SUB DrawMap
    Illuminate Hero.Light.Reach
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR i = 1 TO EncounterLimit
                    IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
                        COLOR Monster(Encounter(i).M).ID.Color
                        t$ = CHR$(Monster(Encounter(i).M).ID.Symbol)
                        _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), t$
                    END IF
                    Encounter(i).M = RandomMonster
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
        DO
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 'get a random spot in a room, for the stairs to the next level
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
            Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
        NEXT
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 

Our monsters are now detecting the hero and responding to him. At the moment, they do nothing but move up and stand close enough to the hero to attack him, and they do absolutely nothing else... After all, I still haven't added any actual combat routines in the game yet! :P

Currently monsters will stack on top of each other, as they're completely unaware of each other's presence, but I plan on correcting that with the next update. Movement should be limited to open tiles only; not ones where another creature is currently standing up; but I'm happy with what I've got here so far. From what I can tell (sans combat), monster movement seems very similar to what we used to see in the actual game Rogue, waaay back in the day. I still remember being beat up and almost dying, and then having to run backwards to take time to heal, all while hoping I didn't run into a second monster while the first one was still right on my heels....

:D

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 11, 2019, 11:05:58 am

And the monsters now block each other and the hero's movement. (As well as the hero blocking the monster's movement.) At this point, there's still no combat, but you can have fun challenging yourself to a simple little game of, "How many levels can I run through before the monsters catch me and trap me in a corner...) :P

Code: QB64: [Select]

$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS _UNSIGNED _BYTE
    High AS _UNSIGNED _BYTE
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
 
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
TYPE Map_Identifer_TYPE
    Symbol AS _UNSIGNED _BYTE
    Color AS _UNSIGNED LONG
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    ID AS Map_Identifer_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
REDIM SHARED Monster(100) AS Monster_TYPE
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
 
 
SCREEN _NEWIMAGE(800, 700, 32)
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
_FONT 8
 
Init
CreateMap 99, 74, 10
DO
    CLS , &HFF0000FF
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
LOOP
 
SUB DisplayCharacter
    LINE (0, 601)-(_WIDTH - 1, _HEIGHT - 1), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10
    Hero.Life.High = 10
    Hero.Level = 1
    Hero.EXP_Earned = 0
    Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2
    Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1
    Hero.Weapon1.Damage.Low = 1
    Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0
    Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0
    Hero.Weapon2.Damage.Low = 0
    Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0
    Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0
    Hero.Armor.DR = 0
    Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432: IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
            CASE 19200: IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
            CASE 20480: IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
            CASE 19712: IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB MoveHero (MoveX, MoveY)
    IF MapArray(Hero.X + MoveX, Hero.Y + MoveY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(Hero.X + MoveX, Hero.Y + MoveY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        END IF
    END IF
END SUB
 
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).M 'the actual monster in question
 
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).M 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
 
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
 
                    _TITLE "ATTACK!"
                    _CONTINUE
                END IF
                IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
                    'insert attack code here
                    _CONTINUE
                END IF
 
                IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
                    IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                        IF D > Distance(MX - 1, MY) THEN
                            IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                        END IF
                    END IF
                    IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                        IF D > Distance(MX, MY - 1) THEN
                            IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                        END IF
                    END IF
                    IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                        IF D > Distance(MX + 1, MY) THEN
                            IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                        END IF
                    END IF
                    IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                        IF D > Distance(MX, MY + 1) THEN
                            IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                        END IF
                    END IF
                END IF
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB DrawMap
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR i = 1 TO EncounterLimit
                    IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
                        E = Encounter(i).M
                        COLOR Monster(E).ID.Color
                        _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(Monster(E).ID.Symbol)
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
        valid = -1
        DO
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
            Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
        NEXT
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB

To still be coming in at less than 500 lines total, I'm quite impressed with what all this little code is actually doing so far. It's got lighting, navigation, trivial monster AI, random level generation, and basic collision detection. Basic combat should be the next element I add into the game, so expect to see us being able to actually kill those mysterious monsters soon(tm)! (Or be killed by them...)

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 11, 2019, 02:39:38 pm

Our hero can now attack, but the monsters can't attack back. Soon(tm) they shall though!

Code: QB64: [Select]

TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
 
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
TYPE Map_Identifer_TYPE
    Symbol AS _UNSIGNED _BYTE
    Color AS _UNSIGNED LONG
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    ID AS Map_Identifer_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
REDIM SHARED Monster(100) AS Monster_TYPE
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
 
SCREEN _NEWIMAGE(800, 700, 32)
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
_FONT 8
 
Init
CreateMap 99, 74, 10
DO
 
    DrawMap
    DisplayCharacter
 
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
END SUB
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        BEEP
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DELAY 5
        SYSTEM
    END IF
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432: IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
            CASE 19200: IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
            CASE 20480: IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
            CASE 19712: IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i, 1 'swing with the right hand
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom, HandUsed)
    M = Encounter(AtWhom).M
    BaseChancetohit = 10 'base 10 chance to hit
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        IF Hero.Weapon1.Reach > 0 THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll \ 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
            PrintOut PrintArea, out$
        END IF
        IF Hero.Weapon2.Reach > 0 THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll \ 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
            PrintOut PrintArea, out$
        END IF
 
        IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
            SetTextColor PrintArea, &HFFFF0000, 0
            out$ = _TRIM$(Monster(M).Name) + " died!"
            PrintOut PrintArea, out$
            Encounter(AtWhom).Active = 0
            Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
            MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) = MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
        END IF
    ELSE 'it's a monster attacking
 
    END IF
 
END SUB
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).M 'the actual monster in question
 
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).M 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
 
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
 
                    _TITLE "ATTACK!"
                    _CONTINUE
                END IF
                IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
                    'insert attack code here
                    _CONTINUE
                END IF
 
                IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
                    IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                        IF D > Distance(MX - 1, MY) THEN
                            IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                        END IF
                    END IF
                    IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                        IF D > Distance(MX, MY - 1) THEN
                            IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                        END IF
                    END IF
                    IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                        IF D > Distance(MX + 1, MY) THEN
                            IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                        END IF
                    END IF
                    IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                        IF D > Distance(MX, MY + 1) THEN
                            IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                        END IF
                    END IF
                END IF
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB DrawMap
    LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR i = 1 TO EncounterLimit
                    IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
                        E = Encounter(i).M
                        COLOR Monster(E).ID.Color
                        _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(Monster(E).ID.Symbol)
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
        valid = -1
        DO
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
            Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
        NEXT
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
 
 
    u = UBOUND(TextHandles)
    fh = _FONTHEIGHT
    pw = _PRINTWIDTH(What)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    h = TextHandles(Handle).h - 4
    w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ _FONTWIDTH 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
 
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
 
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB
 

The code has doubled in size, but that's because I plugged in my text frame library and am using it to wordwrap/justify/scroll text on the screen for me, without interfering with the rest of the program. A lot of the library I can strip out later, as I don't think I'll need to be able to move/hide/restore frames, or anything of that sort, in this program, so honestly things aren't half as complex as they might seem at first glance in the program now. ;)

Title: Re: Rogue-Like (work in progress)
Post by: bplus on September 11, 2019, 03:18:33 pm

Hi Steve,

Getting interesting and the text frame library too, but text is kinda small for these old eyes.

I have allot of room on left or right of graphics area for large text areas, aren't most screen wider than high? Might be better use of screen area, just an idea. Maybe you prefer preserving retro look?

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 12, 2019, 01:49:35 am

Quote from: bplus on September 11, 2019, 03:18:33 pm

Hi Steve,

Getting interesting and the text frame library too, but text is kinda small for these old eyes.

I have allot of room on left or right of graphics area for large text areas, aren't most screen wider than high? Might be better use of screen area, just an idea. Maybe you prefer preserving retro look?

See what you think of my "Scale System" implementation:

Code: QB64: [Select]

DEFLNG A-Z 'default to long instead of single
TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
 
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
TYPE Map_Identifer_TYPE
    Symbol AS _UNSIGNED _BYTE
    Color AS _UNSIGNED LONG
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    ID AS Map_Identifer_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG
DIM SHARED TextFont
 
WorkScreen = _NEWIMAGE(800, 600, 32)
DisplayScreen = _NEWIMAGE(800, 700, 32)
SCREEN DisplayScreen
Scale = 1
_FONT 8
 
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
 
 
 
 
Init
CreateMap 99, 74, 10
DO
 
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
END SUB
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        BEEP
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DELAY 5
        SYSTEM
    END IF
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432 'up
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Scale = Scale + .1
                    IF Scale > 4 THEN Scale = 4
                ELSE
                    IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
                END IF
            CASE 19200: 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Scale = Scale - .1
                    IF Scale < 1 THEN Scale = 1
                ELSE
                    IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
                END IF
            CASE 20480: 'down
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Scale = Scale - .1
                    IF Scale < 1 THEN Scale = 1
                ELSE
                    IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
                END IF
            CASE 19712: 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Scale = Scale + .1
                    IF Scale > 4 THEN Scale = 4
                ELSE
                    IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB Box (X, Y, Wide, High, Caption AS STRING, Kolor AS _UNSIGNED LONG)
    LINE (X, Y)-STEP(Wide, High), Kolor, BF
    LINE (X, Y)-STEP(Wide, High), &HFFFFFFFF, B
    pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
    _PRINTSTRING (X + (Wide - pw) \ 2, Y + (High - ph) \ 2), Caption
END SUB
 
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i, 1 'swing with the right hand
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom, HandUsed)
    M = Encounter(AtWhom).M
    BaseChancetohit = 10 'base 10 chance to hit
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        IF Hero.Weapon1.Reach > 0 THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll \ 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
            PrintOut PrintArea, out$
        END IF
        IF Hero.Weapon2.Reach > 0 THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll \ 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
            PrintOut PrintArea, out$
        END IF
 
        IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
            SetTextColor PrintArea, &HFFFF0000, 0
            out$ = _TRIM$(Monster(M).Name) + " died!"
            PrintOut PrintArea, out$
            Encounter(AtWhom).Active = 0
            Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
            MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) = MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
 
            RedSet = 128: 'GreenSet = 128: BlueSet = 128
            IF Monster(M).ID.Symbol = 63 THEN 'it's a first time kill!
                TempArea = NewTextArea(200, 100, 600, 500, True)
                ColorTextArea TempArea, _RGB32(255, 255, 255), _RGB32(128, 128, 128)
                DrawTextArea TempArea
                SetPrintPositionX TempArea, CenterJustify
                SetPrintUpdate TempArea, NewLine
                SetTextColor TempArea, &HFFFFFFFF, 0
                out$ = "CONGRATULATIONS!  You just killed " + _TRIM$(Monster(M).Name) + " for the first time!"
                PrintOut TempArea, out$
                DO
                    SetTextColor TempArea, _RGB32(RedSet, GreenSet, BlueSet), 0
                    COLOR _RGB32(RedSet, GreenSet, BlueSet), 0
                    FOR y = 0 TO 15
                        FOR x = 0 TO 15
                            Box x * 16 + 275, y * 16 + 150, 16, 16, CHR$(y * 16 + x), _RGB32(200, 200, 200)
                        NEXT
                    NEXT
                    Box 275, 425, 256, 20, "", _RGB32(200, 200, 200)
                    Box 275, 425, RedSet, 20, "", _RGB32(255, 0, 0)
                    Box 275, 450, 256, 20, "", _RGB32(200, 200, 200)
                    Box 275, 450, GreenSet, 20, "", _RGB32(0, 256, 0)
                    Box 275, 475, 256, 20, "", _RGB32(200, 200, 200)
                    Box 275, 475, BlueSet, 20, "", _RGB32(0, 0, 256)
                    _DISPLAY
                    WHILE _MOUSEINPUT: WEND
                    IF _MOUSEBUTTON(1) THEN
                        IF _MOUSEX > 250 AND _MOUSEX < 556 THEN 'we're clicked at the right mouse coordinate
                            SELECT CASE _MOUSEY
                                CASE 425 TO 445
                                    RedSet = _MOUSEX - 275
                                    IF RedSet < 0 THEN RedSet = 0
                                    IF RedSet > 255 THEN RedSet = 255
                                CASE 450 TO 470
                                    GreenSet = _MOUSEX - 275
                                    IF GreenSet < 0 THEN GreenSet = 0
                                    IF GreenSet > 255 THEN GreenSet = 255
                                CASE 475 TO 495
                                    BlueSet = _MOUSEX - 275
                                    IF BlueSet < 0 THEN BlueSet = 0
                                    IF BlueSet > 255 THEN BlueSet = 255
                            END SELECT
                        END IF
                    END IF
                    _LIMIT 60
                LOOP
 
            END IF
        END IF
    ELSE 'it's a monster attacking
 
    END IF
 
END SUB
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).M 'the actual monster in question
 
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).M 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
 
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
 
                    _TITLE "ATTACK!"
                    _CONTINUE
                END IF
                IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
                    'insert attack code here
                    _CONTINUE
                END IF
 
                IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
                    IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                        IF D > Distance(MX - 1, MY) THEN
                            IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                        END IF
                    END IF
                    IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                        IF D > Distance(MX, MY - 1) THEN
                            IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                        END IF
                    END IF
                    IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                        IF D > Distance(MX + 1, MY) THEN
                            IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                        END IF
                    END IF
                    IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                        IF D > Distance(MX, MY + 1) THEN
                            IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                        END IF
                    END IF
                END IF
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB DrawMap
    _DEST WorkScreen
    _FONT 8
    LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR i = 1 TO EncounterLimit
                    IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
                        E = Encounter(i).M
                        COLOR Monster(E).ID.Color
                        _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(Monster(E).ID.Symbol)
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
    XOffset## = 400 / Scale
    YOffset## = 300 / Scale
    CenterX = Hero.X * 8 'convert hero coordinate to grid coordinate
    CenterY = Hero.Y * 8
    _DEST DisplayScreen
    LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
    _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
        valid = -1
        DO
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
            Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
        NEXT
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
 
 
    u = UBOUND(TextHandles)
    fh = _FONTHEIGHT
    pw = _PRINTWIDTH(What)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    h = TextHandles(Handle).h - 4
    w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ _FONTWIDTH 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
 
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
 
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB
 

I was working on implementing the custom icon system for when you defeat a monster or find an item (you can choose your own icons and colors to represent them!), when I read your post and thought, "I too don't see as well as I used to back in the day. It'd be nice to have some sort of system in place so we can scale the screen to make it easier to read and interact with..."

So, I came up with this little concept, which was amazingly simple to implement actually!

Try it out, and then use SHIFT plus the arrow keys to scale the screen. For now, only the map is zoomable, but I figure changing the fonts to scale as well shouldn't be that difficult to do. After all, the text frames are pretty self-contained already. It should be just a simple change to fix them to scale font size up and down for us...

In the end, I imagine Shift-Up and Shift-Down will scale the map, while Shift-left and Shift-Right will scale the text. There's no reason for us old fogies to strain our eyes when playing a game, when we can just zoom in and make things much more visible for us, as needed! :D

******************

(Also, if you do kill a monster now, you can see the start of my concept for the icon representation system. You can't actually choose any icons yet, but you can freeze up the game nice and good while waiting for the next update to the game which will offer the option fully...)

Title: Re: Rogue-Like (work in progress)
Post by: bplus on September 12, 2019, 10:22:07 am

oops! I killed a rat just by wandering around sorry Mr Rat ;-)

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 12, 2019, 10:25:31 am

The scaling routines now works as I envisioned -- we can now scale both the map and the text, by using the SHIFT and ARROW keys.

SHIFT-UP -- increase the screen zoom.
SHIFT-DOWN -- decrease the screen zoom.
SHIFT-LEFT -- increase the text font.
SHIFT-DOWN -- decrease the text font.

Code: QB64: [Select]

DEFLNG A-Z 'default to long instead of single
TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
    Font AS LONG 'NEW! Change fonts for each independent font area
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
 
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
TYPE Map_Identifer_TYPE
    Symbol AS _UNSIGNED _BYTE
    Color AS _UNSIGNED LONG
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    ID AS Map_Identifer_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG
DIM SHARED TextFont
 
WorkScreen = _NEWIMAGE(800, 600, 32)
DisplayScreen = _NEWIMAGE(800, 700, 32)
SCREEN DisplayScreen
Scale = 1
_FONT 8
 
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
 
 
 
 
Init
CreateMap 99, 74, 10
DO
 
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    SetTextFont PrintArea, "courbd.ttf", 24
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    SetTextFont PrintArea, "courbd.ttf", 18
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
    TextFont = 18
END SUB
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        BEEP
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DELAY 5
        SYSTEM
    END IF
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432 'up
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Scale = Scale + .1
                    IF Scale > 4 THEN Scale = 4
                ELSE
                    IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
                END IF
            CASE 19200: 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont - 1
                    IF TextFont < 8 THEN TextFont = 8
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
                END IF
            CASE 20480: 'down
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Scale = Scale - .1
                    IF Scale < 1 THEN Scale = 1
                ELSE
                    IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
                END IF
            CASE 19712: 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont + 1
                    IF TextFont > 48 THEN TextFont = 48
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB Box (X, Y, Wide, High, Caption AS STRING, Kolor AS _UNSIGNED LONG)
    LINE (X, Y)-STEP(Wide, High), Kolor, BF
    LINE (X, Y)-STEP(Wide, High), &HFFFFFFFF, B
    pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
    _PRINTSTRING (X + (Wide - pw) \ 2, Y + (High - ph) \ 2), Caption
END SUB
 
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i, 1 'swing with the right hand
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom, HandUsed)
    M = Encounter(AtWhom).M
    BaseChancetohit = 10 'base 10 chance to hit
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        IF Hero.Weapon1.Reach > 0 THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll \ 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
            PrintOut PrintArea, out$
        END IF
        IF Hero.Weapon2.Reach > 0 THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll \ 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
            PrintOut PrintArea, out$
        END IF
 
        IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
            SetTextColor PrintArea, &HFFFF0000, 0
            out$ = _TRIM$(Monster(M).Name) + " died!"
            PrintOut PrintArea, out$
            Encounter(AtWhom).Active = 0
            Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
            MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) = MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
 
            RedSet = 128: 'GreenSet = 128: BlueSet = 128
            IF Monster(M).ID.Symbol = 63 THEN 'it's a first time kill!
                TempArea = NewTextArea(200, 100, 600, 500, True)
                ColorTextArea TempArea, _RGB32(255, 255, 255), _RGB32(128, 128, 128)
                DrawTextArea TempArea
                SetPrintPositionX TempArea, CenterJustify
                SetPrintUpdate TempArea, NewLine
                SetTextColor TempArea, &HFFFFFFFF, 0
                out$ = "CONGRATULATIONS!  You just killed " + _TRIM$(Monster(M).Name) + " for the first time!"
                PrintOut TempArea, out$
                DO
                    SetTextColor TempArea, _RGB32(RedSet, GreenSet, BlueSet), 0
                    COLOR _RGB32(RedSet, GreenSet, BlueSet), 0
                    FOR y = 0 TO 15
                        FOR x = 0 TO 15
                            Box x * 16 + 275, y * 16 + 150, 16, 16, CHR$(y * 16 + x), _RGB32(200, 200, 200)
                        NEXT
                    NEXT
                    Box 275, 425, 256, 20, "", _RGB32(200, 200, 200)
                    Box 275, 425, RedSet, 20, "", _RGB32(255, 0, 0)
                    Box 275, 450, 256, 20, "", _RGB32(200, 200, 200)
                    Box 275, 450, GreenSet, 20, "", _RGB32(0, 256, 0)
                    Box 275, 475, 256, 20, "", _RGB32(200, 200, 200)
                    Box 275, 475, BlueSet, 20, "", _RGB32(0, 0, 256)
                    _DISPLAY
                    WHILE _MOUSEINPUT: WEND
                    IF _MOUSEBUTTON(1) THEN
                        IF _MOUSEX > 250 AND _MOUSEX < 556 THEN 'we're clicked at the right mouse coordinate
                            SELECT CASE _MOUSEY
                                CASE 425 TO 445
                                    RedSet = _MOUSEX - 275
                                    IF RedSet < 0 THEN RedSet = 0
                                    IF RedSet > 255 THEN RedSet = 255
                                CASE 450 TO 470
                                    GreenSet = _MOUSEX - 275
                                    IF GreenSet < 0 THEN GreenSet = 0
                                    IF GreenSet > 255 THEN GreenSet = 255
                                CASE 475 TO 495
                                    BlueSet = _MOUSEX - 275
                                    IF BlueSet < 0 THEN BlueSet = 0
                                    IF BlueSet > 255 THEN BlueSet = 255
                            END SELECT
                        END IF
                    END IF
                    _LIMIT 60
                LOOP
 
            END IF
        END IF
    ELSE 'it's a monster attacking
 
    END IF
 
END SUB
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).M 'the actual monster in question
 
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).M 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
 
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
 
                    _TITLE "ATTACK!"
                    _CONTINUE
                END IF
                IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
                    'insert attack code here
                    _CONTINUE
                END IF
 
                IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
                    IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                        IF D > Distance(MX - 1, MY) THEN
                            IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                        END IF
                    END IF
                    IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                        IF D > Distance(MX, MY - 1) THEN
                            IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                        END IF
                    END IF
                    IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                        IF D > Distance(MX + 1, MY) THEN
                            IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                        END IF
                    END IF
                    IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                        IF D > Distance(MX, MY + 1) THEN
                            IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                        END IF
                    END IF
                END IF
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB DrawMap
    _DEST WorkScreen
    _FONT 8
    LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR i = 1 TO EncounterLimit
                    IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
                        E = Encounter(i).M
                        COLOR Monster(E).ID.Color
                        _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(Monster(E).ID.Symbol)
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
    XOffset## = 400 / Scale
    YOffset## = 300 / Scale
    CenterX = Hero.X * 8 'convert hero coordinate to grid coordinate
    CenterY = Hero.Y * 8
    _DEST DisplayScreen
    LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
    _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
        valid = -1
        DO
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
            Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
        NEXT
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
    F = _FONT
 
    u = UBOUND(TextHandles)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    _FONT TextHandles(Handle).Font
    fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
    h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ _FONTWIDTH 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
 
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _FONT F
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE TextHandles(Handle).Font
        CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
        CASE IS > 1
            'we have the font already in use
            'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
            _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
    END SELECT
 
    temp = _LOADFONT(FontName, FontSize, "monospace")
    IF temp > 1 THEN
        TextHandles(Handle).Font = temp
    ELSE
        TextHandles(Handle).Font = 16 'default to font 16, in case
    END IF
 
END SUB
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    TextHandles(Handle).Font = 16 'default to font 16
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB

(I'll need to update the text frame library later so others can make use of the ability to use independent fonts with their independent text frames. It was a quick addition, and one which I'm shocked that I hadn't made use of already!)

Next is finishing up the symbol association system so it'll stop locking the screen up on us, and we can actually complete the process as intended. :D

Title: Re: Rogue-Like (work in progress)
Post by: bplus on September 12, 2019, 10:32:05 am

Hi Steve,

I am getting allot of "division by 0" errors in last update, font sizing works nice though (unless that is what is causing errors).

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 12, 2019, 10:44:27 am

Quote from: bplus on September 12, 2019, 10:32:05 am

Hi Steve,

I am getting allot of "division by 0" errors in last update, font sizing works nice though (unless that is what is causing errors).

Those are in debugging even now. I dunno when I broke something, but I'll get it sorted out soon(tm), I hope. :)

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 12, 2019, 12:41:48 pm

Quote from: SMcNeill on September 12, 2019, 10:44:27 am

Those are in debugging even now. I dunno when I broke something, but I'll get it sorted out soon(tm), I hope. :)

The issue here isn't that I broke something (well, I did, but it was actually AGES ago...), it's that QB64 itself was broken.

Waaaay back before version 1.0 was even released, I patched _LOADFONT so that us windows users can have it try and load automatically from our default font directory for us. A lot of folks were having issues even remembering where their font folder was, and since it's usually in "C:\Windows\Fonts\", it seemed a simple enough thing to tell QB64, "If you don't find it with the program, take just a moment and see if it's in that standard default folder before tossing an error code..."

And, it really *is* a simple little thing to do -- the issue is I did it *at the wrong time* inside the source of QB64....

An user passes _LOADFONT a sting to process, like "MONOSPACE, BOLD, ITALIC", and _loadfont then breaks that down section by section to parse it.... By the time we get around to reapplying that "C:\Windows\Fonts" back to the font name, we've parsed our requirement list down to nothing, and the second pass gives us the font without that "MONOSPACE, BOLD, ITALIC" working for us.

The fix to QB64 is rather simple, and I've highlighted how to correct the issue permanently for folks here: https://www.qb64.org/forum/index.php?topic=1704.msg109428#msg109428

The fix for the program is even simpler: Place the courbd.ttf in your QB64 folder and the issue goes away.

BUT, since I really can't trust that folks will have either of those fixes in place, I went in and altered the code so that we should now be error-proof with our routines. The only issue here is that there WILL be a slight delay to text printing as we manually check letter by letter to get the max font size, when resizing, if the font size = 0. If necessary, I'll optimize that out for us, but honestly, I'd prefer to just leave it in there to encourage folks to either patch libqb.cpp, or just put the dang "courbd.ttf" font file in the same folder with the source and be done with it. :P

Fix (with delay for those who don't want to indulge in either true fix) is below:

Code: QB64: [Select]

DEFLNG A-Z 'default to long instead of single
TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
    Font AS LONG 'NEW! Change fonts for each independent font area
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
 
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
END TYPE
 
TYPE Map_Identifer_TYPE
    Symbol AS _UNSIGNED _BYTE
    Color AS _UNSIGNED LONG
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    ID AS Map_Identifer_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG
DIM SHARED TextFont
 
WorkScreen = _NEWIMAGE(800, 600, 32)
DisplayScreen = _NEWIMAGE(800, 700, 32)
SCREEN DisplayScreen
Scale = 1
_FONT 8
 
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
 
 
ON ERROR GOTO errorhandler
 
GOTO skiperrorhandler
errorhandler:
 
_DEST _CONSOLE
PRINT ERR; "Error on "; _ERRORLINE
_DEST DisplayScreen
RESUME NEXT
skiperrorhandler:
 
Init
CreateMap 99, 74, 10
DO
 
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    SetTextFont PrintArea, "courbd.ttf", 24
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    SetTextFont PrintArea, "courbd.ttf", 18
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
    SetTextFont PrintArea, "courbd.ttf", 14
    TextFont = 14
END SUB
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        BEEP
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DELAY 5
        SYSTEM
    END IF
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432 'up
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Scale = Scale + .1
                    IF Scale > 4 THEN Scale = 4
                ELSE
                    IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
                END IF
            CASE 19200: 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont - 1
                    IF TextFont < 8 THEN TextFont = 8
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
                END IF
            CASE 20480: 'down
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Scale = Scale - .1
                    IF Scale < 1 THEN Scale = 1
                ELSE
                    IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
                END IF
            CASE 19712: 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont + 1
                    IF TextFont > 48 THEN TextFont = 48
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
END SUB
 
SUB Box (X, Y, Wide, High, Caption AS STRING, Kolor AS _UNSIGNED LONG)
    LINE (X, Y)-STEP(Wide, High), Kolor, BF
    LINE (X, Y)-STEP(Wide, High), &HFFFFFFFF, B
    pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
    _PRINTSTRING (X + (Wide - pw) \ 2, Y + (High - ph) \ 2), Caption
END SUB
 
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
 
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i 'hero swings at the monster
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom)
    M = Encounter(AtWhom).M
    BaseChancetohit = 10 'base 10 chance to hit
 
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        IF Hero.Weapon1.Reach > 0 THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
            PrintOut PrintArea, out$
        END IF
        IF Hero.Weapon2.Reach > 0 THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
            PrintOut PrintArea, out$
        END IF
 
        IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
            SetTextColor PrintArea, &HFFFF0000, 0
            out$ = _TRIM$(Monster(M).Name) + " died!"
            PrintOut PrintArea, out$
            Encounter(AtWhom).Active = 0
            Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
            MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) = MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
            IF Monster(M).ID.Symbol = 63 THEN 'it's a first time kill!
                DIM ub AS _UNSIGNED _BYTE, ul AS _UNSIGNED LONG
                SetSymbol ub, ul, "CONGRATULATIONS!  You just killed " + _TRIM$(Monster(M).Name) + " for the first time!"
 
            END IF
        END IF
    ELSE 'it's a monster attacking
 
    END IF
 
END SUB
 
SUB SetSymbol (ReturnSymbol AS _UNSIGNED _BYTE, ReturnColor AS _UNSIGNED LONG, out$)
    'Make certain that the routine that calls this one uses the same variable types so we can pass values back and forth
    RedSet = 128: 'GreenSet = 128: BlueSet = 128
 
    TempArea = NewTextArea(200, 100, 600, 500, True)
    ColorTextArea TempArea, _RGB32(255, 255, 255), _RGB32(128, 128, 128)
    DrawTextArea TempArea
    SetPrintPositionX TempArea, CenterJustify
    SetPrintUpdate TempArea, NewLine
    SetTextColor TempArea, &HFFFFFFFF, 0
    PrintOut TempArea, out$
    SetTextFont TempArea, "courbd.ttf", 8
    DO
        SetTextColor TempArea, _RGB32(RedSet, GreenSet, BlueSet), 0
        COLOR _RGB32(RedSet, GreenSet, BlueSet), 0
        FOR y = 0 TO 15
            FOR x = 0 TO 15
                Box x * 16 + 275, y * 16 + 150, 16, 16, CHR$(y * 16 + x), _RGB32(200, 200, 200)
            NEXT
        NEXT
        Box 275, 425, 256, 20, "", _RGB32(200, 200, 200)
        Box 275, 425, RedSet, 20, "", _RGB32(255, 0, 0)
        Box 275, 450, 256, 20, "", _RGB32(200, 200, 200)
        Box 275, 450, GreenSet, 20, "", _RGB32(0, 256, 0)
        Box 275, 475, 256, 20, "", _RGB32(200, 200, 200)
        Box 275, 475, BlueSet, 20, "", _RGB32(0, 0, 256)
        _DISPLAY
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN
            IF _MOUSEX > 250 AND _MOUSEX < 556 THEN 'we're clicked at the right mouse coordinate
                SELECT CASE _MOUSEY
                    CASE 425 TO 445
                        RedSet = _MOUSEX - 275
                        IF RedSet < 0 THEN RedSet = 0
                        IF RedSet > 255 THEN RedSet = 255
                    CASE 450 TO 470
                        GreenSet = _MOUSEX - 275
                        IF GreenSet < 0 THEN GreenSet = 0
                        IF GreenSet > 255 THEN GreenSet = 255
                    CASE 475 TO 495
                        BlueSet = _MOUSEX - 275
                        IF BlueSet < 0 THEN BlueSet = 0
                        IF BlueSet > 255 THEN BlueSet = 255
                END SELECT
            END IF
        END IF
        _LIMIT 60
    LOOP
 
 
END SUB
 
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).M 'the actual monster in question
 
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).M 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
 
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
 
                    _TITLE "ATTACK!"
                    _CONTINUE
                END IF
                IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
                    'insert attack code here
                    _CONTINUE
                END IF
 
                IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
                    IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                        IF D > Distance(MX - 1, MY) THEN
                            IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                        END IF
                    END IF
                    IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                        IF D > Distance(MX, MY - 1) THEN
                            IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                        END IF
                    END IF
                    IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                        IF D > Distance(MX + 1, MY) THEN
                            IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                        END IF
                    END IF
                    IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                        IF D > Distance(MX, MY + 1) THEN
                            IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                        END IF
                    END IF
                END IF
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB DrawMap
    _DEST WorkScreen
    _FONT 8
    LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    COLOR &HFF000000, 0
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    COLOR &HFF000000, &HFF777777
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    COLOR &HFF00FF00, &HFFFFFF00
                    _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                COLOR &H40FFFF00, 0
                _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR i = 1 TO EncounterLimit
                    IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
                        E = Encounter(i).M
                        COLOR Monster(E).ID.Color
                        _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(Monster(E).ID.Symbol)
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
    XOffset## = 400 / Scale
    YOffset## = 300 / Scale
    CenterX = Hero.X * 8 'convert hero coordinate to grid coordinate
    CenterY = Hero.Y * 8
    _DEST DisplayScreen
    LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
    _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0
            IF StartY < 0 THEN StartY = 0
            IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
            IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
        LOOP
    NEXT
    DO
        Hero.X = INT(RND * XLimit + 1)
        Hero.Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
    MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
    DO
        X = INT(RND * XLimit + 1)
        Y = INT(RND * YLimit + 1)
    LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
    MapArray(X, Y) = MapArray(X, Y) OR 16
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
        valid = -1
        DO
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
            Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
        NEXT
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
    OldFont = _FONT
 
    u = UBOUND(TextHandles)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    _FONT TextHandles(Handle).Font
    fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
    IF _FONTWIDTH = 0 THEN
        FOR i = 1 TO 255
            IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
        NEXT
    ELSE
        fw = _FONTWIDTH
    END IF
 
    h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
 
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
 
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _FONT OldFont
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE TextHandles(Handle).Font
        CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
        CASE IS > 1
            'we have the font already in use
            'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
            _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
    END SELECT
 
    temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
    IF temp > 1 THEN
        TextHandles(Handle).Font = temp
    ELSE
        TextHandles(Handle).Font = 16 'default to font 16, in case
    END IF
 
END SUB
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    TextHandles(Handle).Font = 16 'default to font 16
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB

Now, if you applied either of the two true fixes, you can run the code, resize your font, and watch as QB64 auto spaces things to make each character the same size, and -- oddly enough -- see where some larger fonts are, in fact, LESS wide than smaller fonts...

Scaling up fonts changes height/width, and apparently due to rounding sometimes, the ratio between height/width isn't always consistent, which can lead to some of the taller fonts actually being narrower than some of the shorter fonts before them. Who knew?!!

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 13, 2019, 03:16:32 am

2 Steps forward, 1 Step back....

I've completely ripped a lot of my poor little game apart and rebuilt it from the ground up, so I can use a basic sprite set instead of sticking with text characters for everything. Just because I'm shooting to create a Rogue-like experience, it doesn't mean I need to stay limited to become a Rogue-clone. The lighting, map zooming, text sizing, and discovery system are all something which isn't native to Rogue, so I figured, "What the heck -- if I'm going to customize things this much, why not just go ahead and use some low resolution sprites for things, since they allow a greater range of representation than the old A-Z of monsters in Rogue."

So, what we have now has to be zipped up and placed into a 7z file for sharing, so the resource files stay available -- and you can see it below:

Title: Re: Rogue-Like (work in progress)
Post by: bplus on September 13, 2019, 11:05:10 am

Hi Steve,

I definitely like the graphics improvements!

Say are all those lefts and rights in the paths part of the charm of rogue?

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 13, 2019, 11:16:37 am

Quote from: bplus on September 13, 2019, 11:05:10 am

Hi Steve,

I definitely like the graphics improvements!

Say are all those lefts and rights in the paths part of the charm of rogue?

They are. They get even more charming at deeper levels when you start running into “dark rooms” where your light doesn’t illuminate, and “secret paths” which don’t have any graphic on your map. (You just look like you’re walking through the walls...). And then you have the completely hidden passages, which you have to search the room before they even appear...

There’s still a lot to go for this little game, but I have to say, I really like the core mechanics which we’re seeing in it already. I think it’s about time to have the monsters attack back for us. ;)

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 13, 2019, 08:46:04 pm

Code: QB64: [Select]

DEFLNG A-Z 'default to long instead of single
TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
    Font AS LONG 'NEW! Change fonts for each independent font area
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
 
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    HealingRate AS _UNSIGNED _BYTE
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    Found AS INTEGER
    IconX AS LONG
    IconY AS LONG
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG
DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
 
WorkScreen = _NEWIMAGE(3200, 2400, 32)
DisplayScreen = _NEWIMAGE(800, 700, 32)
SCREEN DisplayScreen
Scale = 2
_FONT 8
 
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
 
 
ON ERROR GOTO errorhandler
 
GOTO skiperrorhandler
errorhandler:
 
_DEST _CONSOLE
PRINT ERR; "Error on "; _ERRORLINE
_DEST DisplayScreen
RESUME NEXT
skiperrorhandler:
 
Init
CreateMap 99, 74, 10
DO
 
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
    Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    SetTextFont PrintArea, "courbd.ttf", 24
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    SetTextFont PrintArea, "courbd.ttf", 18
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
    SetTextFont PrintArea, "courbd.ttf", 12
    TextFont = 12
END SUB
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DISPLAY
        BEEP
        _DELAY 5
        SYSTEM
    END IF
    IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
        IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
    END IF
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR &HFFFFFFFF, 0
    _PRINTSTRING (0, 605), "HERO : " + Hero.Name
    _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
 
    _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
    _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
    _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
    _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432 'up
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 1.5: Scale = 2 'It's as small as we go
                        CASE 2: Scale = 3
                        CASE 3: Scale = 4
                        CASE 4: Scale = 6
                        CASE 6: Scale = 8
                        CASE 8: Scale = 12
                    END SELECT
                ELSE
                    IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
                END IF
            CASE 19200: 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont - 1
                    IF TextFont < 8 THEN TextFont = 8
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
                END IF
            CASE 20480: 'down
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 2: Scale = 1.5 'It's as small as we go
                        CASE 3: Scale = 2
                        CASE 4: Scale = 3
                        CASE 6: Scale = 4
                        CASE 8: Scale = 6
                        CASE 12: Scale = 8
                    END SELECT
                ELSE
                    IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
                END IF
            CASE 19712: 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont + 1
                    IF TextFont > 48 THEN TextFont = 48
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
    StepsTaken = StepsTaken + 1
END SUB
 
SUB Box (X, Y, Wide, High, Caption AS STRING, Kolor AS _UNSIGNED LONG)
    LINE (X, Y)-STEP(Wide, High), Kolor, BF
    LINE (X, Y)-STEP(Wide, High), &HFFFFFFFF, B
    pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
    _PRINTSTRING (X + (Wide - pw) \ 2, Y + (High - ph) \ 2), Caption
END SUB
 
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i 'hero swings at the monster
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom)
 
    BaseChancetohit = 10 'base 10 chance to hit
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        M = Encounter(AtWhom).M
        IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon2.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
            SetTextColor PrintArea, &HFFFF0000, 0
            out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
            PrintOut PrintArea, out$
            Encounter(AtWhom).Active = 0
            Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
            MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) = MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
            IF Monster(M).Found = 0 THEN
                Monster(M).Found = -1 'it's a first time kill!
                SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
                out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
                PrintOut PrintArea, out$
            END IF
        END IF
    ELSE 'it's a monster attacking
        M = Encounter(Who).M
        IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Monster(M).Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Monster(M).Life.Low = Monster(M).Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
                Hero.Life.Low = Hero.Life.Low - damage
            END IF
        ELSEIF Monster(M).Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
    END IF
 
END SUB
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).M 'the actual monster in question
 
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).M 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
 
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
                    Swing i, 0
                    _CONTINUE
                END IF
 
                'if the monster didn't attack, it can now move towards the hero.
                IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                    IF D > Distance(MX - 1, MY) THEN
                        IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                    END IF
                END IF
                IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                    IF D > Distance(MX, MY - 1) THEN
                        IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                    END IF
                END IF
                IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                    IF D > Distance(MX + 1, MY) THEN
                        IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                    END IF
                END IF
                IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                    IF D > Distance(MX, MY + 1) THEN
                        IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                    END IF
                END IF
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB DrawMap
    STATIC Icons AS LONG
    IF Icons = 0 THEN
        temp = _NEWIMAGE(480, 480, 32)
        _DEST temp: _CONTROLCHR OFF
        COLOR &HFFFFFF00, 0 'Yellow Hero
        _PRINTSTRING (0, 0), CHR$(1) 'the hero
        COLOR &HFFFF0000, 0 'Red Question Mark
        _PRINTSTRING (16, 0), "?" 'a question mark
        Icons = _LOADIMAGE("Sprites.png", 32)
        _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
        _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
        '        SCREEN Icons: DO: SLEEP: LOOP
    END IF
    _DEST WorkScreen
    CLS
    'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR I = 1 TO EncounterLimit
                    IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
                        E = Encounter(I).M
                        IF Monster(E).Found THEN
                            _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
                        ELSE
                            _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
                        END IF
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
    XOffset## = 1600 / Scale
    YOffset## = 1200 / Scale
    CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
    CenterY = Hero.Y * 32
    _DEST DisplayScreen
    LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
    _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    StairRoom = INT(RND * Rooms) + 1
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
        IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
            Hero.X = RoomX + INT(RND * RoomSize)
            Hero.Y = RoomY + INT(RND * RoomSize)
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
        END IF
        IF i = StairRoom THEN 'place the stairs in one of the random rooms
            DO 'But lets not place the stairs directly on top of the hero to begin with
                StairX = RoomX + INT(RND * RoomSize)
                StairY = RoomY + INT(RND * RoomSize)
            LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
            MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
        END IF
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
            IF StartY < 0 THEN StartY = 0
            IF StartX > XH THEN StartX = XH
            IF StartY > YH THEN StartY = YH
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
        LOOP
    NEXT
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
        valid = -1: EndlessLoopExit = 0
        DO
            EndlessLoopExit = EndlessLoopExit + 1
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
            IF EndlessLoopExit = 1000 THEN EXIT DO 'if we can't place the monster in a room after 1000 tries, just place it wherever and call it a "wandering monster".
            'Of course, "wandering monsters" may end up inside a wall, in which case they simply become "lost monsters" and do nothing to affect the level.  It's the same as if they never existed at all.
            'BUT, we *should* generally be able to place a monster after 1000 tries.  This segment is just in the off-chance that the Random Number Gods are out to get us and to prevent any chance for an endless loop.
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
    OldFont = _FONT
 
    u = UBOUND(TextHandles)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    _FONT TextHandles(Handle).Font
    fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
    IF _FONTWIDTH = 0 THEN
        FOR i = 1 TO 255
            IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
        NEXT
    ELSE
        fw = _FONTWIDTH
    END IF
 
    h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
 
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
 
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _FONT OldFont
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE TextHandles(Handle).Font
        CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
        CASE IS > 1
            'we have the font already in use
            'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
            _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
    END SELECT
 
    temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
    IF temp > 1 THEN
        TextHandles(Handle).Font = temp
    ELSE
        TextHandles(Handle).Font = 16 'default to font 16, in case
    END IF
 
END SUB
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    TextHandles(Handle).Font = 16 'default to font 16
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB
 

Several improvements into the game now.

Attacks are now limited by range, and not just by a monster blocking movement, which allows me to implement longer ranged weapons and manual attacks into the game in a future update. (A sword may only have a reach of 1 and hit the tile in front of the hero, but a spear could have a reach of 2, and a bow a range of 10 and shoot across a room.)

Enemies now attack back. You can now get injured, and not just by critically failing an attack and hitting yourself!

Since you now get injured, you also now heal slowly over time, as you rest or explore the map.

At this point, I'd say the combat system is now more-or-less in place and working as intended. Various weapons and gear can be swapped in and out to change attack values/damage ranges and such in the future, but the core of the battle system is now up and working as intended.

So what's coming next??

The hero needs the ability to level up from all the experience they can earn now...

Food and hunger needs to be introduced into the game, so the hero can starve to death if they just find a far corner and sit and let 300 rounds pass while they heal back to full health. (Food management was always an important part of Rogue, and is something which I think is essential to manage when making a Rogue-like.)

It's about time to get rid of the adjustable magic candle and start adding some other light sources into the game, such as torches or lanterns....

... which means the inventory system is going to have to be implemented sometime soon...

... So, that's basically where we're at so far, and a general idea of where I'll be going to with the next stages of development.

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 14, 2019, 11:20:59 am

Hero's are now leveling up, and I've overhauled the display system a bit more. I think things are starting to shape up nicely, as you can see from the attached screen shot.

Code: QB64: [Select]

DEFLNG A-Z 'default to long instead of single
TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
    Font AS LONG 'NEW! Change fonts for each independent font area
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
$COLOR:32
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
END TYPE
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Mana AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    HealingRate AS _UNSIGNED _BYTE
    Hunger AS SINGLE
    HungerRate AS SINGLE
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    Found AS INTEGER
    IconX AS LONG
    IconY AS LONG
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    M AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG, Icons AS LONG
DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
 
WorkScreen = _NEWIMAGE(3200, 2400, 32)
DisplayScreen = _NEWIMAGE(800, 700, 32)
SCREEN DisplayScreen
Scale = 2
_FONT 8
 
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
 
 
ON ERROR GOTO errorhandler
 
GOTO skiperrorhandler
errorhandler:
 
_DEST _CONSOLE
PRINT ERR; "Error on "; _ERRORLINE
_DEST DisplayScreen
RESUME NEXT
skiperrorhandler:
 
Init
CreateMap 99, 74, 10
DO
 
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    D = _DEST
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.Mana.Low = 10: Hero.Mana.High = 10
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Light.Name = "Magic Candle"
    Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
    Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
    Hero.HungerRate = 0.1 'Let's start heros out with a full belly and a low hunger growth rate
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    SetTextFont PrintArea, "courbd.ttf", 24
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    SetTextFont PrintArea, "courbd.ttf", 18
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
    SetTextFont PrintArea, "courbd.ttf", 12
    TextFont = 12
 
 
 
    temp = _NEWIMAGE(480, 480, 32)
    _DEST temp: _CONTROLCHR OFF
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (0, 0), CHR$(1) 'the hero
    COLOR &HFFFF0000, 0 'Red Question Mark
    _PRINTSTRING (16, 0), "?" 'a question mark
    Icons = _LOADIMAGE("Sprites.png", 32)
    _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
    _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
    '        SCREEN Icons: DO: SLEEP: LOOP
 
 
    _DEST D
END SUB
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DISPLAY
        BEEP
        _DELAY 5
        SYSTEM
    END IF
    IF Hero.EXP_Earned >= Hero.EXP_Needed THEN 'let's check to see if the hero has leveled up
        PrintOut PrintArea, "Congratulations!  You have gained a level!"
        DO
            r = INT(RND * 6) + 1
            lifegained = lifegained + r
        LOOP UNTIL r <> 6
        Hero.Life.Low = Hero.Life.Low + r
        Hero.Life.High = Hero.Life.High + r
        Hero.EXP_Earned = 0
        Hero.Level = Hero.Level + 1
        Hero.EXP_Needed = Hero.EXP_Needed + Hero.Level + 1
    END IF
    IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
        IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
    END IF
    Hero.Hunger = Hero.Hunger + Hero.HungerRate
 
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR -1, 0
 
    Box 0, 601, 229, 62, 0, 0, "", Silver, 0
    Box 0, 601, 229, 12, Black, 0, _TRIM$(Hero.Name), Silver, 0
    Box 0, 626, 229 * Hero.Life.Low / Hero.Life.High, 12, 0, 0, "", Red, Black
    Box 0, 639, 229 * Hero.Mana.Low / Hero.Mana.High, 12, 0, 0, "", Blue, Black
    Box 0, 652, 229 * Hero.EXP_Earned / Hero.EXP_Needed, 12, 0, 0, "", Green, Black
    _PRINTSTRING (10, 616), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (10, 629), "LIFE :" + STR$(Hero.Life.Low) + " / " + _TRIM$(STR$(Hero.Life.High))
    _PRINTSTRING (10, 642), "MANA :" + STR$(Hero.Mana.Low) + " / " + _TRIM$(STR$(Hero.Mana.High))
    _PRINTSTRING (10, 655), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
 
    FOR i = 0 TO 5 'six boxes for information : left hand, right hand, armor, and 3 more for later....
        Box 36 * i + 8, 665, 34, 34, 0, 0, "", Black, Silver
    NEXT
    FOR i = 0 TO 1
        IF i = 0 THEN WeaponName$ = _TRIM$(Hero.Weapon1.Name) ELSE WeaponName$ = _TRIM$(Hero.Weapon2.Name)
 
        SELECT CASE WeaponName$
            CASE "Bare Fist": X = 2 * 32: Y = 47 * 32
            CASE "Magic Candle": X = 52 * 32: Y = 42 * 32
            CASE ELSE: X = -100: Y = -100
        END SELECT
        _PUTIMAGE (9 + 36 * i, 666)-STEP(32, 32), Icons, DisplayScreen, (X, Y)-STEP(32, 32)
    NEXT
    SELECT CASE _TRIM$(Hero.Armor.Name)
        CASE "Naked": X = 46 * 32: Y = 42 * 32
        CASE ELSE: X = -100: Y = -100
    END SELECT
    _PUTIMAGE (81, 666)-STEP(32, 32), Icons, DisplayScreen, (X, Y)-STEP(32, 32)
 
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432 'up
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 1.5: Scale = 2 'It's as small as we go
                        CASE 2: Scale = 3
                        CASE 3: Scale = 4
                        CASE 4: Scale = 6
                        CASE 6: Scale = 8
                        CASE 8: Scale = 12
                    END SELECT
                ELSE
                    IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
                END IF
            CASE 19200: 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont - 1
                    IF TextFont < 8 THEN TextFont = 8
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
                END IF
            CASE 20480: 'down
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 2: Scale = 1.5 'It's as small as we go
                        CASE 3: Scale = 2
                        CASE 4: Scale = 3
                        CASE 6: Scale = 4
                        CASE 8: Scale = 6
                        CASE 12: Scale = 8
                    END SELECT
                ELSE
                    IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
                END IF
            CASE 19712: 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont + 1
                    IF TextFont > 48 THEN TextFont = 48
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
    StepsTaken = StepsTaken + 1
END SUB
 
SUB Box (X, Y, Wide, High, FontColor as _unsigned long, _
         FontBackGround as _unsigned long, Caption AS STRING, Kolor AS _UNSIGNED LONG, BackGround AS _UNSIGNED LONG)
    DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    COLOR FontColor, FontBackGround
    LINE (X, Y)-STEP(Wide, High), Kolor, BF
    LINE (X, Y)-STEP(Wide, High), BackGround, B
    pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
    _PRINTSTRING (X + (Wide - pw + 1) \ 2, Y + (High - ph + 1) \ 2), Caption
    COLOR DC, BG
END SUB
 
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i 'hero swings at the monster
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom)
 
    BaseChancetohit = 10 'base 10 chance to hit
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        M = Encounter(AtWhom).M
        IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon2.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
            SetTextColor PrintArea, &HFFFF0000, 0
            out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
            PrintOut PrintArea, out$
            Encounter(AtWhom).Active = 0
            Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
            MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) = MapArray(Encounter(AtWhom).X, Encounter(AtWhom).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
            IF Monster(M).Found = 0 THEN
                Monster(M).Found = -1 'it's a first time kill!
                SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
                out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
                PrintOut PrintArea, out$
            END IF
        END IF
    ELSE 'it's a monster attacking
        M = Encounter(Who).M
        IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Monster(M).Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Monster(M).Life.Low = Monster(M).Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
                Hero.Life.Low = Hero.Life.Low - damage
            END IF
        ELSEIF Monster(M).Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
    END IF
 
END SUB
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).M 'the actual monster in question
 
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).M 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
 
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
                    Swing i, 0
                    _CONTINUE
                END IF
 
                'if the monster didn't attack, it can now move towards the hero.
                IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                    IF D > Distance(MX - 1, MY) THEN
                        IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                    END IF
                END IF
                IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                    IF D > Distance(MX, MY - 1) THEN
                        IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                    END IF
                END IF
                IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                    IF D > Distance(MX + 1, MY) THEN
                        IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                    END IF
                END IF
                IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                    IF D > Distance(MX, MY + 1) THEN
                        IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                    END IF
                END IF
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB DrawMap
    _DEST WorkScreen
    CLS
    'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR I = 1 TO EncounterLimit
                    IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
                        E = Encounter(I).M
                        IF Monster(E).Found THEN
                            _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
                        ELSE
                            _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
                        END IF
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
    XOffset## = 1600 / Scale
    YOffset## = 1200 / Scale
    CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
    CenterY = Hero.Y * 32
    _DEST DisplayScreen
    LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
    _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    StairRoom = INT(RND * Rooms) + 1
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
        IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
            Hero.X = RoomX + INT(RND * RoomSize)
            Hero.Y = RoomY + INT(RND * RoomSize)
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
        END IF
        IF i = StairRoom THEN 'place the stairs in one of the random rooms
            DO 'But lets not place the stairs directly on top of the hero to begin with
                StairX = RoomX + INT(RND * RoomSize)
                StairY = RoomY + INT(RND * RoomSize)
            LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
            MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
        END IF
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
            IF StartY < 0 THEN StartY = 0
            IF StartX > XH THEN StartX = XH
            IF StartY > YH THEN StartY = YH
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
        LOOP
    NEXT
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).M = RandomMonster
        Encounter(i).Active = -1
        Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
        valid = -1: EndlessLoopExit = 0
        DO
            EndlessLoopExit = EndlessLoopExit + 1
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
            IF EndlessLoopExit = 1000 THEN EXIT DO 'if we can't place the monster in a room after 1000 tries, just place it wherever and call it a "wandering monster".
            'Of course, "wandering monsters" may end up inside a wall, in which case they simply become "lost monsters" and do nothing to affect the level.  It's the same as if they never existed at all.
            'BUT, we *should* generally be able to place a monster after 1000 tries.  This segment is just in the off-chance that the Random Number Gods are out to get us and to prevent any chance for an endless loop.
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    'Shared variable level tells us what level of the dungeon we're on.
    STATIC MC, DS 'monster count and data set
    IF NOT DS THEN
        DS = -1
        Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
        Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
        Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
        Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
        Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
        'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
        'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
        'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
        'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
        'Monster(1).Armor.Name = ""
        'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
 
        Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
        Monster(2).Level = 1: Monster(2).ExpBonus = 0
        Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
        Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
        Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
        Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
        Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
        Monster(3).Level = 1: Monster(3).ExpBonus = 0
        Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
        Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
        Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
        Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
    END IF
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
    OldFont = _FONT
 
    u = UBOUND(TextHandles)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    _FONT TextHandles(Handle).Font
    fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
    IF _FONTWIDTH = 0 THEN
        FOR i = 1 TO 255
            IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
        NEXT
    ELSE
        fw = _FONTWIDTH
    END IF
 
    h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
 
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
 
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _FONT OldFont
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE TextHandles(Handle).Font
        CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
        CASE IS > 1
            'we have the font already in use
            'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
            _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
    END SELECT
 
    temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
    IF temp > 1 THEN
        TextHandles(Handle).Font = temp
    ELSE
        TextHandles(Handle).Font = 16 'default to font 16, in case
    END IF
 
END SUB
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    TextHandles(Handle).Font = 16 'default to font 16
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 14, 2019, 10:45:07 pm

Once again, an almost complete overhaul to the way I was doing things. I really am taking two steps forwards and one step back with this little project. /sigh

Code: QB64: [Select]

DEFLNG A-Z 'default to long instead of single
TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
    Font AS LONG 'NEW! Change fonts for each independent font area
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
$COLOR:32
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Reach AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE
END TYPE
 
TYPE Weapon_Type
    Name AS STRING * 20
    Reach AS _UNSIGNED _BYTE
    Damage AS Damage_Type
    HitBonus AS _UNSIGNED _BYTE
    DamageBonus AS _UNSIGNED _BYTE
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
    IconX AS LONG
    IconY AS LONG
    Light AS Light_Type
END TYPE
 
TYPE Armor_Type
    Name AS STRING * 20
    PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
    DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
    Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
    IconX AS LONG
    IconY AS LONG
END TYPE
 
TYPE Food_Type
    Name AS STRING * 20
    HungerFill AS SINGLE 'how much said food fills one's stomach
    HungerRate AS SINGLE 'how fast it digests before we get hunry again
    IconX AS LONG
    IconY AS LONG
END TYPE
 
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Mana AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    HealingRate AS _UNSIGNED _BYTE
    Hunger AS SINGLE
    HungerRate AS SINGLE
END TYPE
 
TYPE Treasure_TYPE
    Chance AS SINGLE
    Type AS _UNSIGNED _BYTE '1 weapon, 2 armor, 3 food, 4 item
    Index AS INTEGER 'the number of the type... Weapon(0) = "Bare Fist", so tyoe = 1, index = 0.
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    Found AS INTEGER
    IconX AS LONG
    IconY AS LONG
    Loot1 AS Treasure_TYPE
    Loot2 AS Treasure_TYPE
    loot3 AS Treasure_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    Type AS INTEGER '0 monster, 1 weapon, 2 armor, 3 food, 4 item
    Index AS INTEGER
    Life AS INTEGER
END TYPE
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(1000) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
'These are all base items and weapons.  The sets which the character actually carries will vary significantly from wear/tear, enchantments, and other in-game factors.
REDIM SHARED Weapon(100) AS Weapon_Type
REDIM SHARED Armor(100) AS Armor_Type
REDIM SHARED Food(100) AS Food_Type
 
DIM SHARED Hero AS Hero_Type
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG, Icons AS LONG
DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
 
WorkScreen = _NEWIMAGE(3200, 2400, 32)
DisplayScreen = _NEWIMAGE(800, 700, 32)
SCREEN DisplayScreen
Scale = 2
_FONT 8
 
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
'128 is an item on the ground
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
 
 
ON ERROR GOTO errorhandler
 
GOTO skiperrorhandler
errorhandler:
 
_DEST _CONSOLE
PRINT ERR; "Error on "; _ERRORLINE
_DEST DisplayScreen
RESUME NEXT
skiperrorhandler:
 
Init
CreateMap 99, 74, 10
DO
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    D = _DEST
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.Mana.Low = 10: Hero.Mana.High = 10
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon1.IconX = 2 * 32: Hero.Weapon1.IconY = 47 * 32
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Weapon2.IconX = 52 * 32: Hero.Weapon2.IconY = 42 * 32
    Hero.Weapon2.Light.Reach = 2: Hero.Weapon2.Light.Left = -1 'infinite
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
    Hero.Armor.IconX = 46 * 32: Hero.Armor.IconY = 42 * 32
    Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
    Hero.HungerRate = 0.1 'Let's start heros out with a full belly and a low hunger growth rate
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    SetTextFont PrintArea, "courbd.ttf", 24
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    SetTextFont PrintArea, "courbd.ttf", 18
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
    SetTextFont PrintArea, "courbd.ttf", 12
    TextFont = 12
 
    temp = _NEWIMAGE(480, 480, 32)
    _DEST temp: _CONTROLCHR OFF
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (0, 0), CHR$(1) 'the hero
    COLOR &HFFFF0000, 0 'Red Question Mark
    _PRINTSTRING (16, 0), "?" 'a question mark
    Icons = _LOADIMAGE("Sprites.png", 32)
    _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
    _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
    '        SCREEN Icons: DO: SLEEP: LOOP
    _DEST D
 
    'Init some basic weapons which we can find
 
    'These first two should always be available for us to use/enjoy.
    Weapon(0).Name = "Bare Fist"
    Weapon(0).Reach = 1: Weapon(0).Damage.Low = 1: Weapon(0).Damage.High = 2
    Weapon(0).HitBonus = 0: Weapon(0).DamageBonus = 0
    Weapon(0).Left = -1 'your fist is indestructible!
    Weapon(0).IconX = 2 * 32: Weapon(0).IconY = 47 * 32
    Weapon(0).Light.Reach = 0: Weapon(0).Light.Left = 0
    Weapon(1).Name = "Magic Candle"
    Weapon(1).Reach = 0: Weapon(1).Damage.Low = 0: Weapon(1).Damage.High = 0
    Weapon(1).HitBonus = 0: Weapon(1).DamageBonus = 0
    Weapon(1).Left = 0 'you can't attack with a candle
    Weapon(1).IconX = 52 * 32: Weapon(1).IconY = 42 * 32
    Weapon(1).Light.Reach = 2: Weapon(1).Light.Left = -1 'infinite
 
    Armor(0).Name = "Naked"
    Armor(0).PD = 0: Armor(0).DR = 0: Armor(0).Left = -1 'you might be naked, but at least you can't break your armor!
    Armor(0).IconX = 46 * 32: Armor(0).IconY = 42 * 32
 
    Food(1).Name = "Bat Meat"
    Food(1).HungerFill = 10: Food(1).HungerRate = .1
    Food(1).IconX = 36 * 32: Food(1).IconY = 23 * 32
 
    Food(2).Name = "Rat Meat"
    Food(2).HungerFill = 10: Food(2).HungerRate = .1
    Food(2).IconX = 36 * 32: Food(2).IconY = 23 * 32
 
    Food(3).Name = "Snake Meat"
    Food(3).HungerFill = 10: Food(3).HungerRate = .1
    Food(3).IconX = 36 * 32: Food(3).IconY = 23 * 32
 
    InitMonsters
END SUB
 
SUB InitMonsters
 
    Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
    Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
    Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
    Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
    Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
    Monster(1).Loot1.Chance = 95: Monster(1).Loot1.Type = 3: Monster(1).Loot1.Index = 1
    'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
    'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
    'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
    'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
    'Monster(1).Armor.Name = ""
    'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
    Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
    Monster(2).Level = 1: Monster(2).ExpBonus = 0
    Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
    Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
    Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
    Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
    Monster(2).Loot1.Chance = 25: Monster(2).Loot1.Type = 3: Monster(2).Loot1.Index = 2
    Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
    Monster(3).Level = 1: Monster(3).ExpBonus = 0
    Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
    Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
    Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
    Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
    Monster(3).Loot1.Chance = 25: Monster(3).Loot1.Type = 3: Monster(3).Loot1.Index = 3
END SUB
 
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DISPLAY
        BEEP
        _DELAY 5
        SYSTEM
    END IF
    IF Hero.EXP_Earned >= Hero.EXP_Needed THEN 'let's check to see if the hero has leveled up
        PrintOut PrintArea, "Congratulations!  You have gained a level!"
        DO
            r = INT(RND * 6) + 1
            lifegained = lifegained + r
        LOOP UNTIL r <> 6
        Hero.Life.Low = Hero.Life.Low + r
        Hero.Life.High = Hero.Life.High + r
        Hero.EXP_Earned = 0
        Hero.Level = Hero.Level + 1
        Hero.EXP_Needed = Hero.EXP_Needed + Hero.Level + 1
    END IF
    IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
        IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
    END IF
    Hero.Hunger = Hero.Hunger + Hero.HungerRate
    IF Hero.Weapon1.Light.Left > -1 THEN Hero.Weapon1.Light.Left = Hero.Weapon1.Light.Left - 1 'durability on our light sources wear down over time
    IF Hero.Weapon2.Light.Left > -1 THEN Hero.Weapon2.Light.Left = Hero.Weapon2.Light.Left - 1
 
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR -1, 0
    Box 0, 601, 229, 62, 0, 0, "", Silver, 0
    Box 0, 601, 229, 12, Black, 0, _TRIM$(Hero.Name), Silver, 0
    Box 0, 626, 229 * Hero.Life.Low / Hero.Life.High, 12, 0, 0, "", Red, Black
    Box 0, 639, 229 * Hero.Mana.Low / Hero.Mana.High, 12, 0, 0, "", Blue, Black
    Box 0, 652, 229 * Hero.EXP_Earned / Hero.EXP_Needed, 12, 0, 0, "", Green, Black
    _PRINTSTRING (10, 616), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (10, 629), "LIFE :" + STR$(Hero.Life.Low) + " / " + _TRIM$(STR$(Hero.Life.High))
    _PRINTSTRING (10, 642), "MANA :" + STR$(Hero.Mana.Low) + " / " + _TRIM$(STR$(Hero.Mana.High))
    _PRINTSTRING (10, 655), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    FOR i = 0 TO 5 'six boxes for information : left hand, right hand, armor, and 3 more for later....
        Box 36 * i + 8, 665, 34, 34, 0, 0, "", Black, Silver
    NEXT
    _PUTIMAGE (9, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon1.IconX, Hero.Weapon1.IconY)-STEP(32, 32)
    _PUTIMAGE (45, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon2.IconX, Hero.Weapon2.IconY)-STEP(32, 32)
    _PUTIMAGE (81, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Armor.IconX, Hero.Armor.IconY)-STEP(32, 32)
END SUB
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432 'up
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 1.5: Scale = 2 'It's as small as we go
                        CASE 2: Scale = 3
                        CASE 3: Scale = 4
                        CASE 4: Scale = 6
                        CASE 6: Scale = 8
                        CASE 8: Scale = 12
                    END SELECT
                ELSE
                    IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
                END IF
            CASE 19200: 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont - 1
                    IF TextFont < 8 THEN TextFont = 8
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
                END IF
            CASE 20480: 'down
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 2: Scale = 1.5 'It's as small as we go
                        CASE 3: Scale = 2
                        CASE 4: Scale = 3
                        CASE 6: Scale = 4
                        CASE 8: Scale = 6
                        CASE 12: Scale = 8
                    END SELECT
                ELSE
                    IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
                END IF
            CASE 19712: 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont + 1
                    IF TextFont > 48 THEN TextFont = 48
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("+"), ASC("=")
                IF Hero.Weapon2.Light.Reach < 25 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Weapon2.Light.Reach > -1 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
    StepsTaken = StepsTaken + 1
END SUB
 
SUB Box (X, Y, Wide, High, FontColor as _unsigned long, _
         FontBackGround as _unsigned long, Caption AS STRING, Kolor AS _UNSIGNED LONG, BackGround AS _UNSIGNED LONG)
    DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    COLOR FontColor, FontBackGround
    LINE (X, Y)-STEP(Wide, High), Kolor, BF
    LINE (X, Y)-STEP(Wide, High), BackGround, B
    pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
    _PRINTSTRING (X + (Wide - pw + 1) \ 2, Y + (High - ph + 1) \ 2), Caption
    COLOR DC, BG
END SUB
 
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i 'hero swings at the monster
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom)
 
    BaseChancetohit = 10 'base 10 chance to hit
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        M = Encounter(AtWhom).Index
        IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon2.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Encounter(AtWhom).Life <= 0 THEN MonsterDied (AtWhom) 'the monster died!
    ELSE 'it's a monster attacking
        M = Encounter(Who).Index
        IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Monster(M).Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Monster(M).Life.Low = Monster(M).Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
                Hero.Life.Low = Hero.Life.Low - damage
            END IF
        ELSEIF Monster(M).Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
    END IF
END SUB
 
SUB MonsterDied (Who)
    M = Encounter(Who).Index
    SetTextColor PrintArea, &HFFFF0000, 0
    out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
    PrintOut PrintArea, out$
    Encounter(Who).Active = 0
    Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
    MapArray(Encounter(Who).X, Encounter(Who).Y) = MapArray(Encounter(Who).X, Encounter(Who).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
    IF Monster(M).Found = 0 THEN
        Monster(M).Found = -1 'it's a first time kill!
        SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
        out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
        PrintOut PrintArea, out$
    END IF
 
    'monster loot!!
    IF UBOUND(Encounter) <= EncounterLimit THEN REDIM _PRESERVE Encounter(EncounterLimit + 100) AS Encounter_TYPE 'make certain our array is large enough to hold all the loot on the map.
    'if the player starts dumping items onto the ground, we could concievably fill the screen with tons of loots.
    R# = RND * 100
    IF R# < Monster(M).Loot1.Chance THEN
        GOSUB addloot
        Encounter(E).Type = Monster(M).Loot1.Type
        Encounter(E).Index = Monster(M).Loot1.Index
    ELSEIF R# < Monster(M).Loot2.Chance THEN
        GOSUB addloot
    ELSEIF R# < Monster(M).loot3.Chance THEN
        GOSUB addloot
    END IF
 
    EXIT SUB
 
    addloot: 'a small sub proceedure to reduce copy/paste code
    EncounterLimit = EncounterLimit + 1
    E = EncounterLimit 'just for ease of typing below
    Encounter(E).Active = -1
    Encounter(E).X = Encounter(Who).X
    Encounter(E).Y = Encounter(Who).Y
    PrintOut PrintArea, _TRIM$(Monster(M).Name) + " left something behind."
    RETURN
 
END SUB
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).Index 'the actual monster in question
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active AND (Encounter(i).Type = 0) THEN 'Only if it's a monster, and the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).Index 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
                    Swing i, 0
                    _CONTINUE
                END IF
                'if the monster didn't attack, it can now move towards the hero.
                IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                    IF D > Distance(MX - 1, MY) THEN
                        IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                    END IF
                END IF
                IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                    IF D > Distance(MX, MY - 1) THEN
                        IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                    END IF
                END IF
                IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                    IF D > Distance(MX + 1, MY) THEN
                        IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                    END IF
                END IF
                IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                    IF D > Distance(MX, MY + 1) THEN
                        IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                    END IF
                END IF
            END IF
        END IF
 
    NEXT
 
END SUB
 
 
 
SUB DrawMap
    _DEST WorkScreen
    CLS
    'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
    IF Hero.Weapon1.Light.Reach > Hero.Weapon2.Light.Reach THEN LightReach = Hero.Weapon1.Light.Reach ELSE LightReach = Hero.Weapon2.Light.Reach
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= LightReach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR I = 1 TO EncounterLimit
                    IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
                        E = Encounter(I).Index
                        T = Encounter(I).Type
                        SELECT CASE T
                            CASE 0 'it's a monster
                                IF Monster(E).Found THEN
                                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
                                ELSE
                                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
                                END IF
                            CASE 1 'weapon
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Weapon(E).IconX, Weapon(E).IconY)-STEP(31, 31)
                            CASE 2 'armor
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Armor(E).IconX, Armor(E).IconY)-STEP(31, 31)
                            CASE 3 'food
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Food(E).IconX, Food(E).IconY)-STEP(31, 31)
                            CASE 4 'item
                        END SELECT
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
    XOffset## = 1600 / Scale
    YOffset## = 1200 / Scale
    CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
    CenterY = Hero.Y * 32
    _DEST DisplayScreen
    LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
    _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    StairRoom = INT(RND * Rooms) + 1
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
        IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
            Hero.X = RoomX + INT(RND * RoomSize)
            Hero.Y = RoomY + INT(RND * RoomSize)
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
        END IF
        IF i = StairRoom THEN 'place the stairs in one of the random rooms
            DO 'But lets not place the stairs directly on top of the hero to begin with
                StairX = RoomX + INT(RND * RoomSize)
                StairY = RoomY + INT(RND * RoomSize)
            LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
            MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
        END IF
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
            IF StartY < 0 THEN StartY = 0
            IF StartX > XH THEN StartX = XH
            IF StartY > YH THEN StartY = YH
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
        LOOP
    NEXT
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).Type = 0 'type 0 is a monster
        Encounter(i).Index = RandomMonster
        Encounter(i).Active = -1
        M = Encounter(i).Index
        Encounter(i).Life = INT(RND * Monster(M).Life.High - Monster(M).Life.Low + 1) + Monster(M).Life.Low
        valid = -1: EndlessLoopExit = 0
        DO
            EndlessLoopExit = EndlessLoopExit + 1
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
            IF EndlessLoopExit = 1000 THEN EXIT DO 'if we can't place the monster in a room after 1000 tries, just place it wherever and call it a "wandering monster".
            'Of course, "wandering monsters" may end up inside a wall, in which case they simply become "lost monsters" and do nothing to affect the level.  It's the same as if they never existed at all.
            'BUT, we *should* generally be able to place a monster after 1000 tries.  This segment is just in the off-chance that the Random Number Gods are out to get us and to prevent any chance for an endless loop.
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
    LootLimit = 0 'no loot on the map at this time.  Too bad for joo!
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    STATIC MC 'monster count
    SELECT CASE Level 'the starting level
        CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
    OldFont = _FONT
 
    u = UBOUND(TextHandles)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    _FONT TextHandles(Handle).Font
    fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
    IF _FONTWIDTH = 0 THEN
        FOR i = 1 TO 255
            IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
        NEXT
    ELSE
        fw = _FONTWIDTH
    END IF
 
    h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
 
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
 
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _FONT OldFont
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE TextHandles(Handle).Font
        CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
        CASE IS > 1
            'we have the font already in use
            'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
            _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
    END SELECT
 
    temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
    IF temp > 1 THEN
        TextHandles(Handle).Font = temp
    ELSE
        TextHandles(Handle).Font = 16 'default to font 16, in case
    END IF
 
END SUB
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    TextHandles(Handle).Font = 16 'default to font 16
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB
 

So what did all the ripping out, restructuring, and rebuilding accomplish for me??

Monsters are now starting to drop loot and place it on the ground for us! YAY!

.
.
.
... Too bad we still can't pick it up and make use of it in any meaningful way. Right now, the monsters you fight just happen to sometimes poop meat which you can't pick up or interact with in any way. Yaaaay, meat poopers!!

But, now that I (am soon to) have a means to help replenish the food that a player can consume, I can start having them actually need to eat and get hungry. (Well, we've been going hungry all along; we've just been completely ignoring all messages or effects from hunger, since there wasn't any means to actually eat implemented into the game.)

I suppose the next step now is to work on implementing the inventory system so players can actually pick up those chunks of meat which poop out when a creature dies, and save them for use later, when they're hungry...

Who the heck knew that sorting out something as simple as "Does it drop food or not?" would be so complicated to implement. :P

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 15, 2019, 12:27:11 pm

The inventory system has now been implemented into the game, though we still don't have commands yet to actually pick up or interact with any of the (only food) items in the game so far. /sigh... So much to do, and so far to go!

Code: QB64: [Select]

DEFLNG A-Z 'default to long instead of single
TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
    Font AS LONG 'NEW! Change fonts for each independent font area
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
$COLOR:32
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Reach AS INTEGER
    Left AS INTEGER
END TYPE
 
TYPE Weapon_Type
    Identified AS _UNSIGNED _BYTE
    Name AS STRING * 20
    DisplayedName AS STRING * 20
    Reach AS INTEGER
    Damage AS Damage_Type
    HitBonus AS INTEGER
    DamageBonus AS INTEGER
    Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
    IconX AS LONG
    IconY AS LONG
    Light AS Light_Type
END TYPE
 
TYPE Armor_Type
    Identified AS _UNSIGNED _BYTE
    Name AS STRING * 20
    DisplayedName AS STRING * 20
    PD AS INTEGER 'Passive Defense (dodge)
    DR AS INTEGER 'Damage Resistance (absorption)
    Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
    IconX AS LONG
    IconY AS LONG
END TYPE
 
TYPE Food_Type
    Identified AS _UNSIGNED _BYTE
    Name AS STRING * 20
    DisplayedName AS STRING * 20
    HungerFill AS SINGLE 'how much said food fills one's stomach
    HungerRate AS SINGLE 'how fast it digests before we get hunry again
    IconX AS LONG
    IconY AS LONG
END TYPE
 
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Mana AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    HealingRate AS INTEGER 'number of turns before the hero heals a point
    Hunger AS SINGLE
    HungerRate AS SINGLE
END TYPE
 
TYPE Treasure_TYPE
    Chance AS SINGLE
    Type AS _UNSIGNED _BYTE '1 weapon, 2 armor, 3 food, 4 item
    Index AS INTEGER 'the number of the type... Weapon(0) = "Bare Fist", so tyoe = 1, index = 0.
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    Found AS INTEGER
    IconX AS LONG
    IconY AS LONG
    Loot1 AS Treasure_TYPE
    Loot2 AS Treasure_TYPE
    loot3 AS Treasure_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    Type AS INTEGER '0 monster, 1 weapon, 2 armor, 3 food, 4 item
    Index AS INTEGER
    Life AS INTEGER
END TYPE
 
TYPE Inventory_Type
    Weapon AS Weapon_Type
    Armor AS Armor_Type
    Food AS Food_Type
    'Item as item_type 'to come later, once general items get added
END TYPE
 
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(1000) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
'These are all base items and weapons.  The sets which the character actually carries will vary significantly from wear/tear, enchantments, and other in-game factors.
REDIM SHARED Weapon(100) AS Weapon_Type
REDIM SHARED Armor(100) AS Armor_Type
REDIM SHARED Food(100) AS Food_Type
 
DIM SHARED Hero AS Hero_Type
REDIM SHARED Inventory(103) AS Inventory_Type '103 slots each to carry weapons/armor/food/items
DIM SHARED WeaponsOwned AS _UNSIGNED _BYTE, ArmorOwned AS _UNSIGNED _BYTE, FoodOwned AS _UNSIGNED _BYTE, ItemsOwned AS _UNSIGNED _BYTE 'a count of each which we own.  Should always be a value between 0 and 103.
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG, Icons AS LONG
DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
 
WorkScreen = _NEWIMAGE(3200, 2400, 32)
DisplayScreen = _NEWIMAGE(800, 700, 32)
SCREEN DisplayScreen
Scale = 2
_FONT 8
 
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
 
Init
CreateMap 99, 74, 10
DO
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    D = _DEST
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.Mana.Low = 10: Hero.Mana.High = 10
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon1.IconX = 2 * 32: Hero.Weapon1.IconY = 47 * 32
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Weapon2.IconX = 52 * 32: Hero.Weapon2.IconY = 42 * 32
    Hero.Weapon2.Light.Reach = 2: Hero.Weapon2.Light.Left = -1 'infinite
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
    Hero.Armor.IconX = 46 * 32: Hero.Armor.IconY = 42 * 32
    Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
    Hero.HungerRate = 0.1 'Let's start heros out with a full belly and a low hunger growth rate
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    SetTextFont PrintArea, "courbd.ttf", 24
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    SetTextFont PrintArea, "courbd.ttf", 18
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
    SetTextFont PrintArea, "courbd.ttf", 12
    TextFont = 12
 
    temp = _NEWIMAGE(480, 480, 32)
    _DEST temp: _CONTROLCHR OFF
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (0, 0), CHR$(1) 'the hero
    COLOR &HFFFF0000, 0 'Red Question Mark
    _PRINTSTRING (16, 0), "?" 'a question mark
    Icons = _LOADIMAGE("Sprites.png", 32)
    _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
    _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
    '        SCREEN Icons: DO: SLEEP: LOOP
    _DEST D
 
    'Init some basic weapons which we can find
 
    'These first two should always be available for us to use/enjoy.
    Weapon(0).Name = "Bare Fist"
    Weapon(0).Reach = 1: Weapon(0).Damage.Low = 1: Weapon(0).Damage.High = 2
    Weapon(0).HitBonus = 0: Weapon(0).DamageBonus = 0
    Weapon(0).Left = -1 'your fist is indestructible!
    Weapon(0).IconX = 2 * 32: Weapon(0).IconY = 47 * 32
    Weapon(0).Light.Reach = 0: Weapon(0).Light.Left = 0
    Weapon(1).Name = "Magic Candle"
    Weapon(1).Reach = 0: Weapon(1).Damage.Low = 0: Weapon(1).Damage.High = 0
    Weapon(1).HitBonus = 0: Weapon(1).DamageBonus = 0
    Weapon(1).Left = 0 'you can't attack with a candle
    Weapon(1).IconX = 52 * 32: Weapon(1).IconY = 42 * 32
    Weapon(1).Light.Reach = 2: Weapon(1).Light.Left = -1 'infinite
 
    Armor(0).Name = "Naked"
    Armor(0).PD = 0: Armor(0).DR = 0: Armor(0).Left = -1 'you might be naked, but at least you can't break your armor!
    Armor(0).IconX = 46 * 32: Armor(0).IconY = 42 * 32
 
    Food(1).Name = "Bat Meat"
    Food(1).HungerFill = 10: Food(1).HungerRate = .1
    Food(1).IconX = 36 * 32: Food(1).IconY = 23 * 32
 
    Food(2).Name = "Rat Meat"
    Food(2).HungerFill = 10: Food(2).HungerRate = .1
    Food(2).IconX = 36 * 32: Food(2).IconY = 23 * 32
 
    Food(3).Name = "Snake Meat"
    Food(3).HungerFill = 10: Food(3).HungerRate = .1
    Food(3).IconX = 36 * 32: Food(3).IconY = 23 * 32
 
    WeaponsOwned = 2
    Inventory(0).Weapon.Identified = -1
    Inventory(0).Weapon.Name = "Bare Fist"
    Inventory(0).Weapon.Reach = 1: Inventory(0).Weapon.Damage.Low = 1: Inventory(0).Weapon.Damage.High = 2
    Inventory(0).Weapon.HitBonus = 0: Inventory(0).Weapon.DamageBonus = 0
    Inventory(0).Weapon.Left = -1 'your fist is indestructible!
    Inventory(0).Weapon.IconX = 2 * 32: Inventory(0).Weapon.IconY = 47 * 32
    Inventory(0).Weapon.Light.Reach = 0: Inventory(0).Weapon.Light.Left = -1
    Inventory(1).Weapon.Identified = -1
    Inventory(1).Weapon.Name = "Magic Candle"
    Inventory(1).Weapon.Reach = 0: Inventory(1).Weapon.Damage.Low = 0: Inventory(1).Weapon.Damage.High = 0
    Inventory(1).Weapon.HitBonus = 0: Inventory(1).Weapon.DamageBonus = 0
    Inventory(1).Weapon.Left = -1 'magic candle is indestructible
    Inventory(1).Weapon.IconX = 52 * 32: Inventory(1).Weapon.IconY = 42 * 32
    Inventory(1).Weapon.Light.Reach = 2: Inventory(1).Weapon.Light.Left = -1 'infinite
 
    ArmorOwnded = 1
    Inventory(0).Armor.Identified = -1
    Inventory(0).Armor.Name = "Naked"
    Inventory(0).Armor.PD = 0: Inventory(0).Armor.DR = 0: Inventory(0).Armor.Left = -1 'you might be naked, but at least you can't break your armor!
    Inventory(0).Armor.IconX = 46 * 32: Inventory(0).Armor.IconY = 42 * 32
 
    InitMonsters
END SUB
 
SUB InitMonsters
 
    Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
    Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
    Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
    Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
    Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
    Monster(1).Loot1.Chance = 95: Monster(1).Loot1.Type = 3: Monster(1).Loot1.Index = 1
    'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
    'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
    'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
    'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
    'Monster(1).Armor.Name = ""
    'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
    Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
    Monster(2).Level = 1: Monster(2).ExpBonus = 0
    Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
    Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
    Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
    Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
    Monster(2).Loot1.Chance = 25: Monster(2).Loot1.Type = 3: Monster(2).Loot1.Index = 2
    Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
    Monster(3).Level = 1: Monster(3).ExpBonus = 0
    Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
    Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
    Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
    Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
    Monster(3).Loot1.Chance = 25: Monster(3).Loot1.Type = 3: Monster(3).Loot1.Index = 3
END SUB
 
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DISPLAY
        BEEP
        _DELAY 5
        SYSTEM
    END IF
    IF Hero.EXP_Earned >= Hero.EXP_Needed THEN 'let's check to see if the hero has leveled up
        PrintOut PrintArea, "Congratulations!  You have gained a level!"
        DO
            r = INT(RND * 6) + 1
            lifegained = lifegained + r
        LOOP UNTIL r <> 6
        Hero.Life.Low = Hero.Life.Low + r
        Hero.Life.High = Hero.Life.High + r
        Hero.EXP_Earned = 0
        Hero.Level = Hero.Level + 1
        Hero.EXP_Needed = Hero.EXP_Needed + Hero.Level + 1
    END IF
    IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
        IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
    END IF
    Hero.Hunger = Hero.Hunger + Hero.HungerRate
    IF Hero.Weapon1.Light.Left > -1 THEN Hero.Weapon1.Light.Left = Hero.Weapon1.Light.Left - 1 'durability on our light sources wear down over time
    IF Hero.Weapon2.Light.Left > -1 THEN Hero.Weapon2.Light.Left = Hero.Weapon2.Light.Left - 1
 
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR -1, 0
    Box 0, 601, 229, 62, 0, 0, "", Silver, 0
    Box 0, 601, 229, 12, Black, 0, _TRIM$(Hero.Name), Silver, 0
    Box 0, 626, 229 * Hero.Life.Low / Hero.Life.High, 12, 0, 0, "", Red, Black
    Box 0, 639, 229 * Hero.Mana.Low / Hero.Mana.High, 12, 0, 0, "", Blue, Black
    Box 0, 652, 229 * Hero.EXP_Earned / Hero.EXP_Needed, 12, 0, 0, "", Green, Black
    _PRINTSTRING (10, 616), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (10, 629), "LIFE :" + STR$(Hero.Life.Low) + " / " + _TRIM$(STR$(Hero.Life.High))
    _PRINTSTRING (10, 642), "MANA :" + STR$(Hero.Mana.Low) + " / " + _TRIM$(STR$(Hero.Mana.High))
    _PRINTSTRING (10, 655), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    FOR i = 0 TO 5 'six boxes for information : left hand, right hand, armor, and 3 more for later....
        Box 36 * i + 8, 665, 34, 34, 0, 0, "", Black, Silver
    NEXT
    _PUTIMAGE (9, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon1.IconX, Hero.Weapon1.IconY)-STEP(32, 32)
    _PUTIMAGE (45, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon2.IconX, Hero.Weapon2.IconY)-STEP(32, 32)
    _PUTIMAGE (81, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Armor.IconX, Hero.Armor.IconY)-STEP(32, 32)
END SUB
 
SUB ManageInventory
    STATIC Header AS LONG, MainFont AS LONG, ItemNameFont AS LONG
    STATIC Selection AS INTEGER, Page AS INTEGER, Item AS INTEGER
    PCOPY 0, 1
    D = _DEST: S = _SOURCE
    OldFont = _FONT
    IF Header = 0 THEN Header = _LOADFONT("courbd.ttf", 24, "monospace")
    IF MainFont = 0 THEN MainFont = _LOADFONT("courbd.ttf", 14, "monospace")
    IF ItemNameFont = 0 THEN ItemNameFont = _LOADFONT("courbd.ttf", 18, "monospace")
    IF Selection = 0 THEN Selection = 1 'there's 4 categories which we can choose from (Weapon, Armor, Food, Item)
    'Page = 0 'there's 4 pages of info for each category, from 0 to 3
    'Item = 0 'and there's 26 items on each page, from 0 to 25.
    DO
        _LIMIT 30
        valid = -1
        LINE (50, 50)-STEP(700, 500), SkyBlue, BF 'erase the background
        LINE (300, 106)-(725, 450), LightGray, BF
        _FONT Header
        SELECT CASE Selection 'redraw the selection we're working with
            CASE 1
                Box 51, 51, 174, 50, Black, 0, "Weapons", SkyBlue, SkyBlue
                Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
                Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
                Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
                _FONT MainFont
                FOR i = 26 * Page TO 26 * Page + 25
                    out$ = CHR$(65 + i MOD 26) + ")" + Inventory(i).Weapon.Name
                    _PRINTSTRING (56, 106 + _FONTHEIGHT * (i MOD 26)), out$
                NEXT
                S = Item MOD 26
                Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
                out$ = CHR$(65 + S) + ")" + Inventory(Item).Weapon.Name
                _PRINTSTRING (56, 106 + _FONTHEIGHT * S), out$
 
                COLOR Black, 0
                _FONT ItemNameFont
                IF Inventory(Item).Weapon.Identified THEN
                    Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Weapon.Name), 0, 0
                    _FONT 8
                    _PRINTSTRING (305, 145), "Reach  :" + STR$(Inventory(Item).Weapon.Reach)
                    _PRINTSTRING (305, 165), "Min Dmg:" + STR$(Inventory(Item).Weapon.Damage.Low)
                    _PRINTSTRING (305, 175), "Max Dmg:" + STR$(Inventory(Item).Weapon.Damage.High)
                    _PRINTSTRING (305, 185), "Hit Mod:" + STR$(Inventory(Item).Weapon.HitBonus)
                    _PRINTSTRING (305, 195), "Dmg Mod:" + STR$(Inventory(Item).Weapon.DamageBonus)
                    _PRINTSTRING (305, 205), "Light  :" + STR$(Inventory(Item).Weapon.Light.Reach)
                ELSE
                    Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Weapon.DisplayedName), 0, 0
                    _FONT 8
                    _PRINTSTRING (305, 145), "Reach  : ???"
                    _PRINTSTRING (305, 165), "Min Dmg: ???"
                    _PRINTSTRING (305, 175), "Max Dmg: ???"
                    _PRINTSTRING (305, 185), "Hit Mod: ???"
                    _PRINTSTRING (305, 195), "Dmg Mod: ???"
                    _PRINTSTRING (305, 205), "Light  : ???"
                END IF
                out$ = "Cond   : "
                SELECT CASE Inventory(Item).Weapon.Left 'the durability left on a weapon
                    CASE -1: out$ = out$ + "Ind."
                    CASE 0: out$ = out$ + "Broken"
                    CASE IS < 26: out$ = out$ + "Worn"
                    CASE IS < 50: out$ = out$ + "Used"
                    CASE IS < 75: out$ = out$ + "Good"
                    CASE IS < 90: out$ = out$ + "Mint"
                    CASE ELSE: out$ = out$ + "New"
                END SELECT
                _PRINTSTRING (305, 155), out$
                LINE (422, 134)-STEP(130, 130), Black, BF
                _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Weapon.IconX, Inventory(Item).Weapon.IconY)-STEP(31, 31)
            CASE 2
                Box 225, 51, 174, 50, Black, 0, "Armors", SkyBlue, SkyBlue
                Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
                Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
                Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
                _FONT MainFont
                FOR i = 0 TO 25
                    out$ = CHR$(65 + i) + ")" + Inventory(i).Armor.Name
                    _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
                NEXT
                Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
                out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Armor.Name
                _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
 
                COLOR Black, 0
                _FONT ItemNameFont
                IF Inventory(Item).Armor.Identified THEN
                    Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Armor.Name), 0, 0
                    _FONT 8
                    _PRINTSTRING (305, 145), "PD   :" + STR$(Inventory(Item).Armor.PD)
                    _PRINTSTRING (305, 155), "DR   :" + STR$(Inventory(Item).Armor.DR)
                ELSE
                    Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Armor.DisplayedName), 0, 0
                    _FONT 8
                    _PRINTSTRING (305, 145), "PD   : ???"
                    _PRINTSTRING (305, 155), "DR   : ???"
                END IF
                out$ = "Cond : "
                SELECT CASE Inventory(Item).Armor.Left 'the durability left on armor
                    CASE -1: out$ = out$ + "Ind."
                    CASE 0: out$ = out$ + "Broken"
                    CASE IS < 26: out$ = out$ + "Worn"
                    CASE IS < 50: out$ = out$ + "Used"
                    CASE IS < 75: out$ = out$ + "Good"
                    CASE IS < 90: out$ = out$ + "Mint"
                    CASE ELSE: out$ = out$ + "New"
                END SELECT
                _PRINTSTRING (305, 175), out$
                LINE (422, 134)-STEP(130, 130), Black, BF
                _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Armor.IconX, Inventory(Item).Armor.IconY)-STEP(31, 31)
            CASE 3
                Box 400, 51, 174, 50, Black, 0, "Food", SkyBlue, SkyBlue
                Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
                Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
                Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
                _FONT MainFont
                FOR i = 0 TO 25
                    out$ = CHR$(65 + i) + ")" + Inventory(i).Food.Name
                    _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
                NEXT
                Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
                out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Food.Name
                _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
 
                COLOR Black, 0
                _FONT ItemNameFont
                IF Inventory(Item).Food.Identified THEN
                    Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Food.Name), 0, 0
                ELSE
                    Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Food.DisplayedName), 0, 0
                END IF
                LINE (422, 134)-STEP(130, 130), Black, BF
                _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Food.IconX, Inventory(Item).Food.IconY)-STEP(31, 31)
            CASE 4
                Box 575, 51, 174, 50, Black, 0, "Items", SkyBlue, SkyBlue
                Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
                Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
                Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
                _FONT MainFont
                FOR i = 0 TO 25
                    out$ = CHR$(65 + i) + ")" '+ Inventory(i).Item.Name 'not defined yet
                    _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
                NEXT
                Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
                out$ = CHR$(65 + Item MOD 26) + ")" '+ Inventory(Item).Item.Name
                _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
        END SELECT
        _FONT MainFont
        Box 55, 485, 95, 50, Black, 0, "Page" + STR$(Page + 1), 0, 0
        Box 170, 485, 95, 50, Black, 0, "(D)rop", LightGray, Black
        Box 285, 485, 95, 50, Black, 0, "(E)quip", LightGray, Black
        Box 410, 485, 95, 50, Black, 0, "(U)se", LightGray, Black
        Box 525, 485, 95, 50, Black, 0, "nothing", LightGray, Black
        Box 640, 485, 95, 50, Black, 0, "(C)lose", LightGray, Black
        k = _KEYHIT
        SELECT CASE k
            CASE 18432 'up
                Item = Item - 1
                IF Item < 0 THEN Item = 25
            CASE 19200 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Page = Page - 1
                    IF Page < 0 THEN Page = 3
                ELSE
                    Selection = Selection - 1
                    IF Selection < 1 THEN Selection = 4
                END IF
            CASE 20480 'down
                Item = Item + 1
                IF Item > 25 THEN Item = 0
            CASE 19712 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Page = Page + 1
                    IF Page > 3 THEN Page = 0
                ELSE
                    Selection = Selection + 1
                    IF Selection > 4 THEN Selection = 1
                END IF
            CASE ASC("C"), ASC("c"), 27
                EXIT DO
            CASE ELSE
                valid = 0
        END SELECT
        _DISPLAY
        PCOPY 1, 0
    LOOP
 
    _FONT OldFont
    _DEST D: _SOURCE S
END SUB
 
 
 
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432 'up
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 1.5: Scale = 2 'It's as small as we go
                        CASE 2: Scale = 3
                        CASE 3: Scale = 4
                        CASE 4: Scale = 6
                        CASE 6: Scale = 8
                        CASE 8: Scale = 12
                    END SELECT
                ELSE
                    IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
                END IF
            CASE 19200: 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont - 1
                    IF TextFont < 8 THEN TextFont = 8
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
                END IF
            CASE 20480: 'down
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 2: Scale = 1.5 'It's as small as we go
                        CASE 3: Scale = 2
                        CASE 4: Scale = 3
                        CASE 6: Scale = 4
                        CASE 8: Scale = 6
                        CASE 12: Scale = 8
                    END SELECT
                ELSE
                    IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
                END IF
            CASE 19712: 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont + 1
                    IF TextFont > 48 THEN TextFont = 48
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
                END IF
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("I"), ASC("i")
                ManageInventory
            CASE ASC("+"), ASC("=")
                IF Hero.Weapon2.Light.Reach < 25 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Weapon2.Light.Reach > -1 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
    StepsTaken = StepsTaken + 1
END SUB
 
SUB Box (X, Y, Wide, High, FontColor as _unsigned long, _
         FontBackGround as _unsigned long, Caption AS STRING, Kolor AS _UNSIGNED LONG, BackGround AS _UNSIGNED LONG)
    DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    COLOR FontColor, FontBackGround
    LINE (X, Y)-STEP(Wide, High), Kolor, BF
    LINE (X, Y)-STEP(Wide, High), BackGround, B
    pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
    _PRINTSTRING (X + (Wide - pw + 1) \ 2, Y + (High - ph + 1) \ 2), Caption
    COLOR DC, BG
END SUB
 
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i 'hero swings at the monster
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom)
 
    BaseChancetohit = 10 'base 10 chance to hit
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        M = Encounter(AtWhom).Index
        IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon2.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Encounter(AtWhom).Life <= 0 THEN MonsterDied (AtWhom) 'the monster died!
    ELSE 'it's a monster attacking
        M = Encounter(Who).Index
        IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Monster(M).Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Monster(M).Life.Low = Monster(M).Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
                Hero.Life.Low = Hero.Life.Low - damage
            END IF
        ELSEIF Monster(M).Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
    END IF
END SUB
 
SUB MonsterDied (Who)
    M = Encounter(Who).Index
    SetTextColor PrintArea, &HFFFF0000, 0
    out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
    PrintOut PrintArea, out$
    Encounter(Who).Active = 0
    Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
    MapArray(Encounter(Who).X, Encounter(Who).Y) = MapArray(Encounter(Who).X, Encounter(Who).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
    IF Monster(M).Found = 0 THEN
        Monster(M).Found = -1 'it's a first time kill!
        SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
        out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
        PrintOut PrintArea, out$
    END IF
 
    'monster loot!!
    IF UBOUND(Encounter) <= EncounterLimit THEN REDIM _PRESERVE Encounter(EncounterLimit + 100) AS Encounter_TYPE 'make certain our array is large enough to hold all the loot on the map.
    'if the player starts dumping items onto the ground, we could concievably fill the screen with tons of loots.
    R# = RND * 100
    IF R# < Monster(M).Loot1.Chance THEN
        GOSUB addloot
        Encounter(E).Type = Monster(M).Loot1.Type
        Encounter(E).Index = Monster(M).Loot1.Index
    ELSEIF R# < Monster(M).Loot2.Chance THEN
        GOSUB addloot
    ELSEIF R# < Monster(M).loot3.Chance THEN
        GOSUB addloot
    END IF
 
    EXIT SUB
 
    addloot: 'a small sub proceedure to reduce copy/paste code
    EncounterLimit = EncounterLimit + 1
    E = EncounterLimit 'just for ease of typing below
    Encounter(E).Active = -1
    Encounter(E).X = Encounter(Who).X
    Encounter(E).Y = Encounter(Who).Y
    PrintOut PrintArea, _TRIM$(Monster(M).Name) + " left something behind."
    RETURN
 
END SUB
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).Index 'the actual monster in question
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active AND (Encounter(i).Type = 0) THEN 'Only if it's a monster, and the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).Index 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
                    Swing i, 0
                    _CONTINUE
                END IF
                'if the monster didn't attack, it can now move towards the hero.
                IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                    IF D > Distance(MX - 1, MY) THEN
                        IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                    END IF
                END IF
                IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                    IF D > Distance(MX, MY - 1) THEN
                        IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                    END IF
                END IF
                IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                    IF D > Distance(MX + 1, MY) THEN
                        IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                    END IF
                END IF
                IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                    IF D > Distance(MX, MY + 1) THEN
                        IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                    END IF
                END IF
            END IF
        END IF
    NEXT
END SUB
 
 
 
SUB DrawMap
    _DEST WorkScreen
    CLS
    'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
    IF Hero.Weapon1.Light.Reach > Hero.Weapon2.Light.Reach THEN LightReach = Hero.Weapon1.Light.Reach ELSE LightReach = Hero.Weapon2.Light.Reach
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= LightReach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR I = 1 TO EncounterLimit
                    IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
                        E = Encounter(I).Index
                        T = Encounter(I).Type
                        SELECT CASE T
                            CASE 0 'it's a monster
                                IF Monster(E).Found THEN
                                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
                                ELSE
                                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
                                END IF
                            CASE 1 'weapon
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Weapon(E).IconX, Weapon(E).IconY)-STEP(31, 31)
                            CASE 2 'armor
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Armor(E).IconX, Armor(E).IconY)-STEP(31, 31)
                            CASE 3 'food
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Food(E).IconX, Food(E).IconY)-STEP(31, 31)
                            CASE 4 'item
                        END SELECT
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
    XOffset## = 1600 / Scale
    YOffset## = 1200 / Scale
    CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
    CenterY = Hero.Y * 32
    _DEST DisplayScreen
    LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
    _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    StairRoom = INT(RND * Rooms) + 1
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
        IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
            Hero.X = RoomX + INT(RND * RoomSize)
            Hero.Y = RoomY + INT(RND * RoomSize)
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
        END IF
        IF i = StairRoom THEN 'place the stairs in one of the random rooms
            DO 'But lets not place the stairs directly on top of the hero to begin with
                StairX = RoomX + INT(RND * RoomSize)
                StairY = RoomY + INT(RND * RoomSize)
            LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
            MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
        END IF
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
            IF StartY < 0 THEN StartY = 0
            IF StartX > XH THEN StartX = XH
            IF StartY > YH THEN StartY = YH
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
        LOOP
    NEXT
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).Type = 0 'type 0 is a monster
        Encounter(i).Index = RandomMonster
        Encounter(i).Active = -1
        M = Encounter(i).Index
        Encounter(i).Life = INT(RND * Monster(M).Life.High - Monster(M).Life.Low + 1) + Monster(M).Life.Low
        valid = -1: EndlessLoopExit = 0
        DO
            EndlessLoopExit = EndlessLoopExit + 1
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
            IF EndlessLoopExit = 1000 THEN EXIT DO 'if we can't place the monster in a room after 1000 tries, just place it wherever and call it a "wandering monster".
            'Of course, "wandering monsters" may end up inside a wall, in which case they simply become "lost monsters" and do nothing to affect the level.  It's the same as if they never existed at all.
            'BUT, we *should* generally be able to place a monster after 1000 tries.  This segment is just in the off-chance that the Random Number Gods are out to get us and to prevent any chance for an endless loop.
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
    LootLimit = 0 'no loot on the map at this time.  Too bad for joo!
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    SELECT CASE Level 'the level we're on
        CASE 1 TO 3: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
        CASE ELSE: MC = 3 'since there's only 3 whole monsters in our monster database at the moment, don't expect to find a ton of them to choose from yet!
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
    OldFont = _FONT
 
    u = UBOUND(TextHandles)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    _FONT TextHandles(Handle).Font
    fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
    IF _FONTWIDTH = 0 THEN
        FOR i = 1 TO 255
            IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
        NEXT
    ELSE
        fw = _FONTWIDTH
    END IF
 
    h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
 
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
 
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _FONT OldFont
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE TextHandles(Handle).Font
        CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
        CASE IS > 1
            'we have the font already in use
            'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
            _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
    END SELECT
 
    temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
    IF temp > 1 THEN
        TextHandles(Handle).Font = temp
    ELSE
        TextHandles(Handle).Font = 16 'default to font 16, in case
    END IF
 
END SUB
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    TextHandles(Handle).Font = 16 'default to font 16
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB

One step at a time to develop this thing, I suppose. :P

A screenshot of the inventory system is attached below, and I think folks should find it simple enough to interact with that it won't need much explanation. Left/Right arrows keys swap between the tabs up top. Up/Down arrow keys select an item. Shift-Left/Shift-Right will change pages (characters can have up to 104 of each category type in their inventory, at the moment).

Now, as I slowly add various drops to the monsters in the game, and implement loot to be found, I'll add to my list of available actions and commands, and the game should get ever more complex and vibrant as I go. ;D

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on September 16, 2019, 02:45:28 am

And we can now start picking up the food that the monsters drop! (Which was actually one of the most complicated little additions to the game engine which I've worked on so far!)

Code: QB64: [Select]

DEFLNG A-Z 'default to long instead of single
TYPE TextArea
    InUse AS INTEGER
    x1 AS LONG 'left
    y1 AS LONG 'top
    w AS LONG 'width
    h AS LONG 'height
    FrameColor AS _UNSIGNED LONG
    BackColor AS _UNSIGNED LONG
    Xpos AS INTEGER
    Ypos AS INTEGER
    VerticalAlignment AS INTEGER
    Justification AS INTEGER
    UpdateMethod AS INTEGER
    TextColor AS _UNSIGNED LONG
    TextBackgroundColor AS _UNSIGNED LONG
    SavedBackground AS INTEGER
    HideFrame AS INTEGER
    ScreenX AS INTEGER
    ScreenY AS INTEGER
    Font AS LONG 'NEW! Change fonts for each independent font area
END TYPE
 
REDIM SHARED TextHandles(0) AS TextArea
 
CONST True = -1, False = 0
CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
'********************************************************
'* Text Frames before this line
'********************************************************
 
 
$COLOR:32
 
 
 
$CONSOLE
_CONSOLE ON 'for debugging purposes while making/testing things
 
TYPE Damage_Type
    Low AS INTEGER
    High AS INTEGER
END TYPE
 
TYPE Light_Type
    Reach AS INTEGER
    Left AS INTEGER
END TYPE
 
TYPE Weapon_Type
    Identified AS _UNSIGNED _BYTE
    Name AS STRING * 20
    DisplayedName AS STRING * 20
    Reach AS INTEGER
    Damage AS Damage_Type
    HitBonus AS INTEGER
    DamageBonus AS INTEGER
    Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
    IconX AS LONG
    IconY AS LONG
    Light AS Light_Type
END TYPE
 
TYPE Armor_Type
    Identified AS _UNSIGNED _BYTE
    Name AS STRING * 20
    DisplayedName AS STRING * 20
    PD AS INTEGER 'Passive Defense (dodge)
    DR AS INTEGER 'Damage Resistance (absorption)
    Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
    IconX AS LONG
    IconY AS LONG
END TYPE
 
TYPE Food_Type
    Count AS INTEGER 'food is stackable
    Identified AS _UNSIGNED _BYTE
    Name AS STRING * 20
    DisplayedName AS STRING * 20
    HungerFill AS SINGLE 'how much said food fills one's stomach
    HungerRate AS SINGLE 'how fast it digests before we get hunry again
    IconX AS LONG
    IconY AS LONG
END TYPE
 
 
TYPE Hero_Type
    Name AS STRING * 20
    X AS _UNSIGNED _BYTE
    Y AS _UNSIGNED _BYTE
    Life AS Damage_Type
    Mana AS Damage_Type
    Level AS _UNSIGNED _BYTE
    EXP_Earned AS LONG
    EXP_Needed AS LONG
    Light AS Light_Type
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    HealingRate AS INTEGER 'number of turns before the hero heals a point
    Hunger AS SINGLE
    HungerRate AS SINGLE
END TYPE
 
TYPE Treasure_TYPE
    Chance AS SINGLE
    Type AS _UNSIGNED _BYTE '1 weapon, 2 armor, 3 food, 4 item
    Index AS INTEGER 'the number of the type... Weapon(0) = "Bare Fist", so tyoe = 1, index = 0.
END TYPE
 
TYPE Monster_TYPE
    Name AS STRING * 20
    Life AS Damage_Type
    Level AS INTEGER
    ExpBonus AS INTEGER
    Sight AS INTEGER
    Hearing AS INTEGER
    Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
    Weapon1 AS Weapon_Type
    Weapon2 AS Weapon_Type
    Armor AS Armor_Type
    Found AS INTEGER
    IconX AS LONG
    IconY AS LONG
    Loot1 AS Treasure_TYPE
    Loot2 AS Treasure_TYPE
    loot3 AS Treasure_TYPE
END TYPE
 
TYPE Encounter_TYPE
    Active AS INTEGER
    X AS INTEGER
    Y AS INTEGER
    Type AS INTEGER '0 monster, 1 weapon, 2 armor, 3 food, 4 item
    Index AS INTEGER
    Life AS INTEGER
END TYPE
 
TYPE Inventory_Type
    Weapon AS Weapon_Type
    Armor AS Armor_Type
    Food AS Food_Type
    'Item as item_type 'to come later, once general items get added
END TYPE
 
 
REDIM SHARED Monster(100) AS Monster_TYPE
REDIM SHARED Encounter(1000) AS Encounter_TYPE, EncounterLimit AS INTEGER
 
'These are all base items and weapons.  The sets which the character actually carries will vary significantly from wear/tear, enchantments, and other in-game factors.
REDIM SHARED Weapon(100) AS Weapon_Type
REDIM SHARED Armor(100) AS Armor_Type
REDIM SHARED Food(100) AS Food_Type
 
DIM SHARED Hero AS Hero_Type
REDIM SHARED Inventory(103) AS Inventory_Type '103 slots each to carry weapons/armor/food/items
DIM SHARED WeaponsInGame AS INTEGER, ArmorInGame AS INTEGER, FoodInGame AS INTEGER, ItemsInGame AS INTEGER
DIM SHARED WeaponsOwned AS _UNSIGNED _BYTE, ArmorOwned AS _UNSIGNED _BYTE, FoodOwned AS _UNSIGNED _BYTE, ItemsOwned AS _UNSIGNED _BYTE 'a count of each which we own.  Should always be a value between 0 and 103.
DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG, Icons AS LONG
DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
 
WorkScreen = _NEWIMAGE(3200, 2400, 32)
DisplayScreen = _NEWIMAGE(800, 700, 32)
SCREEN DisplayScreen
Scale = 2
_FONT 8
 
REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
'1 map is illuminated
'2 map is uncovered
'4 map is a wall
'8 map is a pathway
'16 map is a stairway
'32 map is simply blocked (perhaps with a monster?)
'64 map is secret (can not be uncovered)
 
REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
REDIM SHARED Temp(0, 0) AS _UNSIGNED _BYTE
 
RANDOMIZE TIMER
_CONTROLCHR OFF
 
Init
CreateMap 99, 74, 10
DO
    DrawMap
    DisplayCharacter
    _DISPLAY
    GetInput
    MonstersTurn
    CheckForHeroGrowth
LOOP
 
SUB Init
    D = _DEST
    Hero.Name = "Steve The Tester!"
    Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
    Hero.Mana.Low = 10: Hero.Mana.High = 10
    Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
    Hero.Weapon1.Name = "Bare Fist"
    Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
    Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
    Hero.Weapon1.Left = -1 'your fist is indestructible!
    Hero.Weapon1.IconX = 2 * 32: Hero.Weapon1.IconY = 47 * 32
    Hero.Weapon2.Name = "Magic Candle"
    Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
    Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
    Hero.Weapon2.Left = 0 'you can't attack with a candle
    Hero.Weapon2.IconX = 52 * 32: Hero.Weapon2.IconY = 42 * 32
    Hero.Weapon2.Light.Reach = 2: Hero.Weapon2.Light.Left = -1 'infinite
    Hero.Armor.Name = "Naked"
    Hero.Armor.PD = 0: Hero.Armor.DR = 0: Hero.Armor.Left = -1 'you might be naked, but at least you can't break your armor!
    Hero.Armor.IconX = 46 * 32: Hero.Armor.IconY = 42 * 32
    Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
    Hero.HungerRate = 0.1 'Let's start heros out with a full belly and a low hunger growth rate
 
    PrintArea = NewTextArea(230, 601, 799, 699, False)
    ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    SetTextFont PrintArea, "courbd.ttf", 24
    DrawTextArea PrintArea
    SetPrintPositionX PrintArea, CenterJustify
    SetPrintUpdate PrintArea, NewLine
    PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
    SetTextFont PrintArea, "courbd.ttf", 18
    PrintOut PrintArea, "created by STEVE!"
    PrintOut PrintArea, ""
    SetPrintPositionX PrintArea, LeftJustify
    SetTextFont PrintArea, "courbd.ttf", 12
    TextFont = 12
 
    temp = _NEWIMAGE(480, 480, 32)
    _DEST temp: _CONTROLCHR OFF
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PRINTSTRING (0, 0), CHR$(1) 'the hero
    COLOR &HFFFF0000, 0 'Red Question Mark
    _PRINTSTRING (16, 0), "?" 'a question mark
    Icons = _LOADIMAGE("Sprites.png", 32)
    _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
    _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
    '        SCREEN Icons: DO: SLEEP: LOOP
    _DEST D
 
    'Init some basic weapons which we can find
 
    'These first two should always be available for us to use/enjoy.
    WeaponOwned = 1: ArmorOwned = 1: FoodOwned = 1
    Weapon(0).Name = "Bare Fist": Weapon(0).Identified = -1
    Weapon(0).Reach = 1: Weapon(0).Damage.Low = 1: Weapon(0).Damage.High = 2
    Weapon(0).HitBonus = 0: Weapon(0).DamageBonus = 0
    Weapon(0).Left = -1 'your fist is indestructible!
    Weapon(0).IconX = 2 * 32: Weapon(0).IconY = 47 * 32
    Weapon(0).Light.Reach = 0: Weapon(0).Light.Left = 0
    Weapon(1).Name = "Magic Candle": Weapon(1).Identified = -1
    Weapon(1).Reach = 0: Weapon(1).Damage.Low = 0: Weapon(1).Damage.High = 0
    Weapon(1).HitBonus = 0: Weapon(1).DamageBonus = 0
    Weapon(1).Left = 0 'you can't attack with a candle
    Weapon(1).IconX = 52 * 32: Weapon(1).IconY = 42 * 32
    Weapon(1).Light.Reach = 2: Weapon(1).Light.Left = -1 'infinite
 
    Armor(0).Name = "Naked": Armor(0).Identified = -1
    Armor(0).PD = 0: Armor(0).DR = 0: Armor(0).Left = -1 'you might be naked, but at least you can't break your armor!
    Armor(0).IconX = 46 * 32: Armor(0).IconY = 42 * 32
 
    Food(0).Name = "Nothing": Food(0).Identified = -1
    Food(0).HungerFill = 10: Food(0).HungerRate = 0
    Food(0).IconX = 0: Food(0).IconY = 0
 
    Food(1).Name = "Bat Meat"
    Food(1).HungerFill = 10: Food(1).HungerRate = .1
    Food(1).IconX = 36 * 32: Food(1).IconY = 23 * 32
 
    Food(2).Name = "Rat Meat"
    Food(2).HungerFill = 10: Food(2).HungerRate = .1
    Food(2).IconX = 36 * 32: Food(2).IconY = 23 * 32
 
    Food(3).Name = "Snake Meat"
    Food(3).HungerFill = 10: Food(3).HungerRate = .1
    Food(3).IconX = 36 * 32: Food(3).IconY = 23 * 32
 
    WeaponsOwned = 1: ArmorOwnded = 0: FoodOwned = 0 'You start the game with a magic candle and nothing else.
    Inventory(0).Weapon = Weapon(0): Inventory(1).Weapon = Weapon(1)
    Inventory(0).Armor = Armor(0)
    Inventory(0).Food = Food(0)
 
    WeaponsInGame = 1: ArmorInGame = 0: FoodInGame = 3
    InitMonsters
END SUB
 
SUB InitMonsters
 
    Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
    Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
    Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
    Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
    Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
    Monster(1).Loot1.Chance = 95: Monster(1).Loot1.Type = 3: Monster(1).Loot1.Index = 1
    'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
    'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
    'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
    'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
    'Monster(1).Armor.Name = ""
    'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
    Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
    Monster(2).Level = 1: Monster(2).ExpBonus = 0
    Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
    Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
    Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
    Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
    Monster(2).Loot1.Chance = 25: Monster(2).Loot1.Type = 3: Monster(2).Loot1.Index = 2
    Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
    Monster(3).Level = 1: Monster(3).ExpBonus = 0
    Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
    Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
    Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
    Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
    Monster(3).Loot1.Chance = 25: Monster(3).Loot1.Type = 3: Monster(3).Loot1.Index = 3
END SUB
 
 
SUB CheckForHeroGrowth
    IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
        CLS
        PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
        _DISPLAY
        BEEP
        _DELAY 5
        SYSTEM
    END IF
    IF Hero.EXP_Earned >= Hero.EXP_Needed THEN 'let's check to see if the hero has leveled up
        PrintOut PrintArea, "Congratulations!  You have gained a level!"
        DO
            r = INT(RND * 6) + 1
            lifegained = lifegained + r
        LOOP UNTIL r <> 6
        Hero.Life.Low = Hero.Life.Low + r
        Hero.Life.High = Hero.Life.High + r
        Hero.EXP_Earned = 0
        Hero.Level = Hero.Level + 1
        Hero.EXP_Needed = Hero.EXP_Needed + Hero.Level + 1
    END IF
    IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
        IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
    END IF
    Hero.Hunger = Hero.Hunger + Hero.HungerRate
    IF Hero.Weapon1.Light.Left > -1 THEN Hero.Weapon1.Light.Left = Hero.Weapon1.Light.Left - 1 'durability on our light sources wear down over time
    IF Hero.Weapon2.Light.Left > -1 THEN Hero.Weapon2.Light.Left = Hero.Weapon2.Light.Left - 1
 
END SUB
 
 
SUB DisplayCharacter
    LINE (0, 601)-(229, 799), &HFF000000, BF
    COLOR -1, 0
    Box 0, 601, 229, 62, 0, 0, "", Silver, 0
    Box 0, 601, 229, 12, Black, 0, _TRIM$(Hero.Name), Silver, 0
    Box 0, 626, 229 * Hero.Life.Low / Hero.Life.High, 12, 0, 0, "", Red, Black
    Box 0, 639, 229 * Hero.Mana.Low / Hero.Mana.High, 12, 0, 0, "", Blue, Black
    Box 0, 652, 229 * Hero.EXP_Earned / Hero.EXP_Needed, 12, 0, 0, "", Green, Black
    _PRINTSTRING (10, 616), "LEVEL:" + STR$(Hero.Level)
    _PRINTSTRING (10, 629), "LIFE :" + STR$(Hero.Life.Low) + " / " + _TRIM$(STR$(Hero.Life.High))
    _PRINTSTRING (10, 642), "MANA :" + STR$(Hero.Mana.Low) + " / " + _TRIM$(STR$(Hero.Mana.High))
    _PRINTSTRING (10, 655), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
    FOR i = 0 TO 5 'six boxes for information : left hand, right hand, armor, and 3 more for later....
        Box 36 * i + 8, 665, 34, 34, 0, 0, "", Black, Silver
    NEXT
    _PUTIMAGE (9, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon1.IconX, Hero.Weapon1.IconY)-STEP(32, 32)
    _PUTIMAGE (45, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon2.IconX, Hero.Weapon2.IconY)-STEP(32, 32)
    _PUTIMAGE (81, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Armor.IconX, Hero.Armor.IconY)-STEP(32, 32)
END SUB
 
SUB ManageInventory
    STATIC Header AS LONG, MainFont AS LONG, ItemNameFont AS LONG
    STATIC Selection AS INTEGER, Page AS INTEGER, Item AS INTEGER
    PCOPY 0, 1
    D = _DEST: S = _SOURCE
    OldFont = _FONT
    IF Header = 0 THEN Header = _LOADFONT("courbd.ttf", 24, "monospace")
    IF MainFont = 0 THEN MainFont = _LOADFONT("courbd.ttf", 14, "monospace")
    IF ItemNameFont = 0 THEN ItemNameFont = _LOADFONT("courbd.ttf", 18, "monospace")
    IF Selection = 0 THEN Selection = 1 'there's 4 categories which we can choose from (Weapon, Armor, Food, Item)
    'Page = 0 'there's 4 pages of info for each category, from 0 to 3
    'Item = 0 'and there's 26 items on each page, from 0 to 25.
    DO
        _LIMIT 30
        valid = -1
        LINE (50, 50)-STEP(700, 500), SkyBlue, BF 'erase the background
        LINE (300, 106)-(725, 450), LightGray, BF
        _FONT Header
        SELECT CASE Selection 'redraw the selection we're working with
            CASE 1
                Box 51, 51, 174, 50, Black, 0, "Weapons", SkyBlue, SkyBlue
                Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
                Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
                Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
                _FONT MainFont
                FOR i = 26 * Page TO 26 * Page + 25
                    out$ = CHR$(65 + i MOD 26) + ")" + Inventory(i).Weapon.Name
                    _PRINTSTRING (56, 106 + _FONTHEIGHT * (i MOD 26)), out$
                NEXT
                S = Item MOD 26
                Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
                out$ = CHR$(65 + S) + ")" + Inventory(Item).Weapon.Name
                _PRINTSTRING (56, 106 + _FONTHEIGHT * S), out$
 
                COLOR Black, 0
                _FONT ItemNameFont
                IF Inventory(Item).Weapon.Identified THEN
                    Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Weapon.Name), 0, 0
                    _FONT 8
                    _PRINTSTRING (305, 145), "Reach  :" + STR$(Inventory(Item).Weapon.Reach)
                    _PRINTSTRING (305, 165), "Min Dmg:" + STR$(Inventory(Item).Weapon.Damage.Low)
                    _PRINTSTRING (305, 175), "Max Dmg:" + STR$(Inventory(Item).Weapon.Damage.High)
                    _PRINTSTRING (305, 185), "Hit Mod:" + STR$(Inventory(Item).Weapon.HitBonus)
                    _PRINTSTRING (305, 195), "Dmg Mod:" + STR$(Inventory(Item).Weapon.DamageBonus)
                    _PRINTSTRING (305, 205), "Light  :" + STR$(Inventory(Item).Weapon.Light.Reach)
                ELSE
                    Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Weapon.DisplayedName), 0, 0
                    _FONT 8
                    _PRINTSTRING (305, 145), "Reach  : ???"
                    _PRINTSTRING (305, 165), "Min Dmg: ???"
                    _PRINTSTRING (305, 175), "Max Dmg: ???"
                    _PRINTSTRING (305, 185), "Hit Mod: ???"
                    _PRINTSTRING (305, 195), "Dmg Mod: ???"
                    _PRINTSTRING (305, 205), "Light  : ???"
                END IF
                out$ = "Cond   : "
                SELECT CASE Inventory(Item).Weapon.Left 'the durability left on a weapon
                    CASE -1: out$ = out$ + "Ind."
                    CASE 0: out$ = out$ + "Broken"
                    CASE IS < 26: out$ = out$ + "Worn"
                    CASE IS < 50: out$ = out$ + "Used"
                    CASE IS < 75: out$ = out$ + "Good"
                    CASE IS < 90: out$ = out$ + "Mint"
                    CASE ELSE: out$ = out$ + "New"
                END SELECT
                _PRINTSTRING (305, 155), out$
                LINE (422, 134)-STEP(130, 130), Black, BF
                _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Weapon.IconX, Inventory(Item).Weapon.IconY)-STEP(31, 31)
            CASE 2
                Box 225, 51, 174, 50, Black, 0, "Armors", SkyBlue, SkyBlue
                Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
                Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
                Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
                _FONT MainFont
                FOR i = 0 TO 25
                    out$ = CHR$(65 + i) + ")" + Inventory(i).Armor.Name
                    _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
                NEXT
                Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
                out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Armor.Name
                _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
 
                COLOR Black, 0
                _FONT ItemNameFont
                IF Inventory(Item).Armor.Identified THEN
                    Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Armor.Name), 0, 0
                    _FONT 8
                    _PRINTSTRING (305, 145), "PD   :" + STR$(Inventory(Item).Armor.PD)
                    _PRINTSTRING (305, 155), "DR   :" + STR$(Inventory(Item).Armor.DR)
                ELSE
                    Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Armor.DisplayedName), 0, 0
                    _FONT 8
                    _PRINTSTRING (305, 145), "PD   : ???"
                    _PRINTSTRING (305, 155), "DR   : ???"
                END IF
                out$ = "Cond : "
                SELECT CASE Inventory(Item).Armor.Left 'the durability left on armor
                    CASE -1: out$ = out$ + "Ind."
                    CASE 0: out$ = out$ + "Broken"
                    CASE IS < 26: out$ = out$ + "Worn"
                    CASE IS < 50: out$ = out$ + "Used"
                    CASE IS < 75: out$ = out$ + "Good"
                    CASE IS < 90: out$ = out$ + "Mint"
                    CASE ELSE: out$ = out$ + "New"
                END SELECT
                _PRINTSTRING (305, 175), out$
                LINE (422, 134)-STEP(130, 130), Black, BF
                _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Armor.IconX, Inventory(Item).Armor.IconY)-STEP(31, 31)
            CASE 3
                Box 400, 51, 174, 50, Black, 0, "Food", SkyBlue, SkyBlue
                Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
                Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
                Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
                _FONT MainFont
                FOR i = 0 TO 25
                    IF Inventory(i).Food.Identified THEN
                        out$ = CHR$(65 + i MOD 26) + ")" + Inventory(i).Food.Name
                    ELSE
                        out$ = CHR$(65 + i MOD 26) + ")" + Inventory(i).Food.DisplayedName
                    END IF
                    _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
                NEXT
                Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
 
                IF Inventory(Item).Food.Identified THEN
                    out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Food.Name
                ELSE
                    out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Food.DisplayedName
                END IF
                IF Inventory(Item).Food.Count > 1 THEN out$ = out$ + "(" + _TRIM$(STR$(Inventory(Item).Food.Count)) + ")"
                _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
 
                COLOR Black, 0
                _FONT ItemNameFont
                IF Inventory(Item).Food.Identified THEN
                    Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Food.Name), 0, 0
                ELSE
                    Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Food.DisplayedName), 0, 0
                END IF
                LINE (422, 134)-STEP(130, 130), Black, BF
                _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Food.IconX, Inventory(Item).Food.IconY)-STEP(31, 31)
            CASE 4
                Box 575, 51, 174, 50, Black, 0, "Items", SkyBlue, SkyBlue
                Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
                Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
                Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
                _FONT MainFont
                FOR i = 0 TO 25
                    out$ = CHR$(65 + i) + ")" '+ Inventory(i).Item.Name 'not defined yet
                    _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
                NEXT
                Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
                out$ = CHR$(65 + Item MOD 26) + ")" '+ Inventory(Item).Item.Name
                _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
        END SELECT
        _FONT MainFont
        Box 55, 485, 95, 50, Black, 0, "Page" + STR$(Page + 1), 0, 0
        Box 170, 485, 95, 50, Black, 0, "(D)rop", LightGray, Black
        Box 285, 485, 95, 50, Black, 0, "(E)quip", LightGray, Black
        Box 410, 485, 95, 50, Black, 0, "(U)se", LightGray, Black
        Box 525, 485, 95, 50, Black, 0, "nothing", LightGray, Black
        Box 640, 485, 95, 50, Black, 0, "(C)lose", LightGray, Black
        k = _KEYHIT
        SELECT CASE k
            CASE 18432 'up
                Item = Item - 1
                IF Item < 0 THEN Item = 25
            CASE 19200 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Page = Page - 1
                    IF Page < 0 THEN Page = 3
                ELSE
                    Selection = Selection - 1
                    IF Selection < 1 THEN Selection = 4
                END IF
            CASE 20480 'down
                Item = Item + 1
                IF Item > 25 THEN Item = 0
            CASE 19712 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    Page = Page + 1
                    IF Page > 3 THEN Page = 0
                ELSE
                    Selection = Selection + 1
                    IF Selection > 4 THEN Selection = 1
                END IF
            CASE ASC("C"), ASC("c"), 27
                EXIT DO
            CASE ELSE
                valid = 0
        END SELECT
        _DISPLAY
        PCOPY 1, 0
    LOOP
 
    _FONT OldFont
    _DEST D: _SOURCE S
END SUB
 
 
 
 
SUB GetInput
    DO
        k = _KEYHIT: valid = -1
        SELECT CASE k
            CASE 18432 'up
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 1.5: Scale = 2 'It's as small as we go
                        CASE 2: Scale = 3
                        CASE 3: Scale = 4
                        CASE 4: Scale = 6
                        CASE 6: Scale = 8
                        CASE 8: Scale = 12
                    END SELECT
                ELSE
                    IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
                END IF
            CASE 19200: 'left
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont - 1
                    IF TextFont < 8 THEN TextFont = 8
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
                END IF
            CASE 20480: 'down
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    SELECT CASE Scale
                        CASE 2: Scale = 1.5 'It's as small as we go
                        CASE 3: Scale = 2
                        CASE 4: Scale = 3
                        CASE 6: Scale = 4
                        CASE 8: Scale = 6
                        CASE 12: Scale = 8
                    END SELECT
                ELSE
                    IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
                END IF
            CASE 19712: 'right
                IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
                    TextFont = TextFont + 1
                    IF TextFont > 48 THEN TextFont = 48
                    SetTextFont PrintArea, "courbd.ttf", TextFont
                    ClearTextArea PrintArea
                    SetPrintPosition PrintArea, 1, 1
                    PrintOut PrintArea, "Font Size Changed"
                ELSE
                    IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
                END IF
            CASE 27 'escape key
                SYSTEM
            CASE 32 'space to just wait and skip a turn
            CASE 60 ' "<" key
                IF MapArray(Hero.X, Hero.Y) AND 16 THEN
                    Level = Level + 1
                    CreateMap 99, 74, 10
                    PathFind
                END IF
            CASE ASC("I"), ASC("i")
                ManageInventory
            CASE ASC("P"), ASC("p")
                PickUpSomething
            CASE ASC("+"), ASC("=")
                IF Hero.Weapon2.Light.Reach < 25 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach + 1
            CASE ASC("-"), ASC("_")
                IF Hero.Weapon2.Light.Reach > -1 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach - 1
            CASE ELSE
                valid = 0 'it's a key press which we don't recognize.  Ignore it
        END SELECT
        _LIMIT 60
    LOOP UNTIL k AND valid
    _KEYCLEAR 'one keystroke at a time
    StepsTaken = StepsTaken + 1
END SUB
 
SUB Box (X, Y, Wide, High, FontColor as _unsigned long, _
         FontBackGround as _unsigned long, Caption AS STRING, Kolor AS _UNSIGNED LONG, BackGround AS _UNSIGNED LONG)
    DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    COLOR FontColor, FontBackGround
    LINE (X, Y)-STEP(Wide, High), Kolor, BF
    LINE (X, Y)-STEP(Wide, High), BackGround, B
    pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
    _PRINTSTRING (X + (Wide - pw + 1) \ 2, Y + (High - ph + 1) \ 2), Caption
    COLOR DC, BG
END SUB
 
 
SUB MoveHero (MoveX, MoveY)
    TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
    IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
        IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
            IF MoveX THEN Hero.X = Hero.X + MoveX
            IF MoveY THEN Hero.Y = Hero.Y + MoveY
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
            PathFind
        ELSE
            'chances are it's blocked by a monster.  Since we're one step away from it, let's see which monster it is and attack it!
            FOR i = 1 TO EncounterLimit
                IF Encounter(i).Active THEN 'Check for active/alive monsters only
                    MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
                    IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
                        Swing 0, i 'hero swings at the monster
                    END IF
                END IF
            NEXT
        END IF
    END IF
END SUB
 
SUB Swing (Who, AtWhom)
 
    BaseChancetohit = 10 'base 10 chance to hit
    IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
        M = Encounter(AtWhom).Index
        IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
            damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Hero.Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FF00, 0
                out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
                damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
                Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
            END IF
        ELSEIF Hero.Weapon2.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
        IF Encounter(AtWhom).Life <= 0 THEN MonsterDied (AtWhom) 'the monster died!
    ELSE 'it's a monster attacking
        M = Encounter(Who).Index
        IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
            Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
            Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
            totalroll = 0
            DO
                roll = INT(RND * 20) + 1
                IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
                IF roll = 20 THEN totalroll = totalroll + 20
                totalroll = totalroll + roll
            LOOP UNTIL roll <> 1 AND roll <> 20
            damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
            damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
            out$ = _TRIM$(Monster(M).Name)
            IF totalroll < Chancetohit - 20 THEN 'you critically failed!
                SetTextColor PrintArea, &HFFF000F0, 0
                out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Monster(M).Life.Low = Monster(M).Life.Low - damage
            ELSEIF totalroll < Chancetohit THEN
                SetTextColor PrintArea, &HFFF0F000, 0
                out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
            ELSEIF totalroll > Chancetohit + 20 THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
                damage = damage * (totalroll / 20 + 1)
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
                Hero.Life.Low = Hero.Life.Low - damage
            ELSEIF totalroll >= Chancetohit THEN
                SetTextColor PrintArea, &HFF00FFFF, 0
                out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
                out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
                Hero.Life.Low = Hero.Life.Low - damage
            END IF
        ELSEIF Monster(M).Weapon1.Reach > 0 THEN
            SetTextColor PrintArea, &HFFF000F0, 0
            out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
        ELSE
            out$ = ""
        END IF
        IF out$ <> "" THEN PrintOut PrintArea, out$
    END IF
END SUB
 
SUB PickUpSomething
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active THEN 'Check for active/alive monsters only
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            IF MX = Hero.X AND MY = Hero.Y THEN 'we found something active to interact with
                N = Encounter(i).Index 'for easy of typing
                SELECT CASE Encounter(i).Type
                    CASE 0 'it's a monster
                        PrintOut PrintArea, "WTF?! How the hell did you step on an active monster?  You found a game bug.  Please cry a lot for me!"
                        EXIT SUB
                    CASE 1 'it's a weapon
                    CASE 2 'it's armor
                    CASE 3 'it's food
                        'first see if it matches any of our existing food stocks.
                        FOR j = 0 TO FoodOwned
                            IF Food(N).Name = Inventory(j).Food.Name THEN 'our food matches some existing
                                Inventory(j).Food.Count = Inventory(j).Food.Count + 1
                                Encounter(i).Active = 0
                                GOTO exitchecks 'no need to check any further; we just add to the existing count of that type
                            END IF
                            'At this point, we can assume it's not an existing food we're carrying.
                            IF FoodOwned < 103 THEN 'then we have room for more food
                                FoodOwned = FoodOwned + 1
                                Inventory(FoodOwned).Food = Food(N)
                                out$ = "You picked up a " + _TRIM$(Food(N).DisplayedName) + "."
                                PrintOut PrintArea, out$
                                Encounter(i).Active = 0
                                GOTO exitchecks 'we have now added that food to our inventory.
                            ELSE
                                out$ = "You try to pick up a " + _TRIM$(Food(N).DisplayedName) + ", but have no room to carry it."
                                PrintOut PrintArea, out$
                                GOTO exitchecks 'we don't have room to loot the item currently.
                            END IF
                        NEXT
                    CASE 4 'its an item (which hasn't been added into the game yet)
                END SELECT
            END IF
        END IF
        exitchecks:
    NEXT
 
END SUB
 
SUB MonsterDied (Who)
    M = Encounter(Who).Index
    SetTextColor PrintArea, &HFFFF0000, 0
    out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
    PrintOut PrintArea, out$
    Encounter(Who).Active = 0
    Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
    MapArray(Encounter(Who).X, Encounter(Who).Y) = MapArray(Encounter(Who).X, Encounter(Who).Y) AND NOT 32 'the way is no longer blocked once we kill the monster!
    IF Monster(M).Found = 0 THEN
        Monster(M).Found = -1 'it's a first time kill!
        SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
        out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
        PrintOut PrintArea, out$
    END IF
 
    'monster loot!!
    R# = RND * 100
    IF R# < Monster(M).Loot1.Chance THEN
        GOSUB addloot
 
        Encounter(EncounterLimit).Type = Monster(M).Loot1.Type
        IF Monster(M).Loot1.Type = 3 THEN 'Food can have various states when found
            '(Other things will in time as well, but I haven't gotten to adding any them into the game yet.)
            R1# = RND * 100
            SELECT CASE R1#
                CASE IS < 10: cond$ = "Sickly "
                CASE IS < 25: cond$ = "Nasty "
                CASE IS < 75: cond$ = "Normal "
                CASE IS < 90: cond$ = "Good "
                CASE ELSE: cond$ = "Tasty "
            END SELECT
            DIM foodname AS STRING * 20
            foodname = cond$ + _TRIM$(Food(Monster(M).Loot1.Index).Name)
 
            FOR i = 0 TO FoodInGame
                IF foodname = Food(i).Name THEN 'the food already exists
                    Encounter(EncounterLimit).Index = i
                    EXIT SUB
                END IF
            NEXT
            'At this point, we're adding a new food to our index
            FoodInGame = FoodInGame + 1
            F = FoodInGame
            Food(F) = Food(Monster(M).Loot1.Index) 'take the base values of our food
            Food(F).Name = foodname
            foodname = "Unknown " + _TRIM$(Food(Monster(M).Loot1.Index).Name)
            Food(F).DisplayedName = foodname
            Encounter(EncounterLimit).Index = FoodInGame
        ELSE
            Encounter(EncounterLimit).Index = Monster(M).Loot1.Index
        END IF
 
 
 
    ELSEIF R# < Monster(M).Loot2.Chance THEN
        GOSUB addloot
    ELSEIF R# < Monster(M).loot3.Chance THEN
        GOSUB addloot
    END IF
 
    EXIT SUB
 
    addloot: 'a small sub proceedure to reduce copy/paste code
    EncounterLimit = EncounterLimit + 1
    E = EncounterLimit 'just for ease of typing below
    IF UBOUND(Encounter) < E THEN REDIM _PRESERVE Encounter(E + 100) AS Encounter_TYPE 'on the off chance that we need to increase our encounter limits for a floor
    Encounter(E).Active = -1
    Encounter(E).X = Encounter(Who).X
    Encounter(E).Y = Encounter(Who).Y
 
 
    PrintOut PrintArea, _TRIM$(Monster(M).Name) + " left something behind."
    RETURN
 
END SUB
 
FUNCTION MoveMonster (Monster, MoveX, MoveY)
    MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
    D = Distance(MX, MY) 'distance from monster to the hero
    E = Encounter(i).Index 'the actual monster in question
    IF D > Distance(MX + MoveX, MY + MoveY) THEN
        IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
            MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
            Encounter(Monster).X = Encounter(Monster).X + MoveX
            Encounter(Monster).Y = Encounter(Monster).Y + MoveY
            MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
            MoveMonster = -1
        END IF
    END IF
END SUB
 
 
 
SUB MonstersTurn
    FOR i = 1 TO EncounterLimit
        IF Encounter(i).Active AND (Encounter(i).Type = 0) THEN 'Only if it's a monster, and the monster is still alive and active do we need to actually do anything else.
            MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
            D = Distance(MX, MY) 'distance from monster to the hero
            E = Encounter(i).Index 'the actual monster in question
            IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
                attack = 0
                IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
                    'insert attack code here
                    Swing i, 0
                    _CONTINUE
                END IF
                'if the monster didn't attack, it can now move towards the hero.
                IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
                    IF D > Distance(MX - 1, MY) THEN
                        IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
                    END IF
                END IF
                IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
                    IF D > Distance(MX, MY - 1) THEN
                        IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
                    END IF
                END IF
                IF MX < XH THEN 'check to see if moving right moves us towards the hero.
                    IF D > Distance(MX + 1, MY) THEN
                        IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
                    END IF
                END IF
                IF MY < YH THEN 'check to see if moving down moves us towards the hero.
                    IF D > Distance(MX, MY + 1) THEN
                        IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
                    END IF
                END IF
            END IF
        END IF
    NEXT
END SUB
 
 
 
SUB DrawMap
    _DEST WorkScreen
    CLS
    'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
    IF Hero.Weapon1.Light.Reach > Hero.Weapon2.Light.Reach THEN LightReach = Hero.Weapon1.Light.Reach ELSE LightReach = Hero.Weapon2.Light.Reach
    FOR Y = 0 TO YH
        FOR X = 0 TO XH
            IF Distance(X, Y) <= LightReach THEN 'It's close enough to check for illumination
                IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
            END IF
            IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
                IF MapArray(X, Y) AND 4 THEN 'it's a visible room
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
                END IF
                IF MapArray(X, Y) AND 8 THEN 'it's a visible path
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
                    '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
                END IF
                IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
                END IF
            END IF
            'note: highlighting for the light should come AFTER the map is drawn
            IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
                LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
                MapArray(X, Y) = MapArray(X, Y) - 1
                FOR I = 1 TO EncounterLimit
                    IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
                        E = Encounter(I).Index
                        T = Encounter(I).Type
                        SELECT CASE T
                            CASE 0 'it's a monster
                                IF Monster(E).Found THEN
                                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
                                ELSE
                                    _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
                                END IF
                            CASE 1 'weapon
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Weapon(E).IconX, Weapon(E).IconY)-STEP(31, 31)
                            CASE 2 'armor
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Armor(E).IconX, Armor(E).IconY)-STEP(31, 31)
                            CASE 3 'food
                                _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Food(E).IconX, Food(E).IconY)-STEP(31, 31)
                            CASE 4 'item
                        END SELECT
                    END IF
                NEXT
 
            END IF
        NEXT
    NEXT
    COLOR &HFFFFFF00, 0 'Yellow Hero
    _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
    XOffset## = 1600 / Scale
    YOffset## = 1200 / Scale
    CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
    CenterY = Hero.Y * 32
    _DEST DisplayScreen
    LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
    _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
END SUB
 
 
 
 
 
SUB CreateMap (XLimit, YLimit, Rooms)
    ERASE MapArray 'clear the old map and reset everything to 0
    REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
    REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
    XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
 
    DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
 
    StairRoom = INT(RND * Rooms) + 1
    FOR i = 1 TO Rooms
        DO
            RoomSize = INT(RND * 9) + 2
            RoomX = INT(RND * (XLimit - RoomSize))
            RoomY = INT(RND * (YLimit - RoomSize))
            'test for positioning
            good = -1 'it's good starting out
            FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                    IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
            NEXT X, Y
        LOOP UNTIL good
        FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
                MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
        NEXT X, Y
        RoomCenterX(i) = RoomX + .5 * RoomSize
        RoomCenterY(i) = RoomY + .5 * RoomSize
        IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
            Hero.X = RoomX + INT(RND * RoomSize)
            Hero.Y = RoomY + INT(RND * RoomSize)
            MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
        END IF
        IF i = StairRoom THEN 'place the stairs in one of the random rooms
            DO 'But lets not place the stairs directly on top of the hero to begin with
                StairX = RoomX + INT(RND * RoomSize)
                StairY = RoomY + INT(RND * RoomSize)
            LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
            MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
        END IF
    NEXT
    FOR i = 1 TO Rooms - 1
        StartX = RoomCenterX(i): StartY = RoomCenterY(i)
        EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
        DO UNTIL StartX = EndX AND StartY = EndY
            CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
            Meander = 10
            IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
                    Ychange = 0
                ELSE
                    XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
                    Ychange = 0
                END IF
            ELSE
                IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
                    Ychange = SGN(EndY - StartY)
                    XChange = 0
                ELSE
                    Ychange = INT(RND * 3) - 1
                    XChange = 0
                END IF
            END IF
            StartX = StartX + XChange
            StartY = StartY + Ychange
            IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
            IF StartY < 0 THEN StartY = 0
            IF StartX > XH THEN StartX = XH
            IF StartY > YH THEN StartY = YH
            IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
        LOOP
    NEXT
    PathFind
    EncounterLimit = INT(RND * 6) + 5
    FOR i = 1 TO EncounterLimit
        Encounter(i).Type = 0 'type 0 is a monster
        Encounter(i).Index = RandomMonster
        Encounter(i).Active = -1
        M = Encounter(i).Index
        Encounter(i).Life = INT(RND * Monster(M).Life.High - Monster(M).Life.Low + 1) + Monster(M).Life.Low
        valid = -1: EndlessLoopExit = 0
        DO
            EndlessLoopExit = EndlessLoopExit + 1
            Encounter(i).X = INT(RND * XLimit + 1)
            Encounter(i).Y = INT(RND * YLimit + 1)
            IF MapArray(Encounter(i).X, Encounter(i).Y) AND 32 THEN valid = 0 'the spot where we're wanting to place our monster is invalid.  (Another monster or the hero is probably there.)
            IF EndlessLoopExit = 1000 THEN EXIT DO 'if we can't place the monster in a room after 1000 tries, just place it wherever and call it a "wandering monster".
            'Of course, "wandering monsters" may end up inside a wall, in which case they simply become "lost monsters" and do nothing to affect the level.  It's the same as if they never existed at all.
            'BUT, we *should* generally be able to place a monster after 1000 tries.  This segment is just in the off-chance that the Random Number Gods are out to get us and to prevent any chance for an endless loop.
        LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
        MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
    NEXT
    LootLimit = 0 'no loot on the map at this time.  Too bad for joo!
END SUB
 
SUB PathFind
    $CHECKING:OFF
    STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
    DIM pass AS _UNSIGNED _BYTE
    m = _MEM(Distance()): m1 = _MEM(Temp())
    _MEMFILL m1, m1.OFFSET, m1.SIZE, 255 AS _UNSIGNED _BYTE 'flush distance with 255 values until we see how far things actually are from the hero
    _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
    Temp(Hero.X, Hero.Y) = 0
    pass = 0
    DO
        changed = 0
        y = 0
        DO
            x = 0
            DO
                IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
                    IF x < XH THEN
                        IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF x > 0 THEN
                        IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y < YH THEN
                        IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                    IF y > 0 THEN
                        IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
                    END IF
                END IF
                x = x + 1
            LOOP UNTIL x > XH
            y = y + 1
        LOOP UNTIL y > YH
        _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
        pass = pass + 1
    LOOP UNTIL changed = 0 OR pass = 255 'if we're more than 255 steps from the hero, we don't need to know where the hell we're at.  We're off the map as far as the hero is concerned!
    Distance(Hero.X, Hero.Y) = 0
    $CHECKING:ON
END SUB
 
FUNCTION RandomMonster
    SELECT CASE Level 'the level we're on
        CASE 1 TO 3: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
        CASE ELSE: MC = 3 'since there's only 3 whole monsters in our monster database at the moment, don't expect to find a ton of them to choose from yet!
    END SELECT
    RandomMonster = INT(RND * MC) + 1
END SUB
 
 
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
'# SUBroutines and FUNCTIONs below #'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
    u = UBOUND(TextHandles)
    Handle = WhichHandle
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    Where = TextHandles(Handle).VerticalAlignment
    How = TextHandles(Handle).Justification
    UpdatePrintPosition = TextHandles(Handle).UpdateMethod
    PlaceText Handle, Where, How, What, UpdatePrintPosition
END SUB
 
 
SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
    'WhichHandle is the handle which designates which text area we want to use
    'Where is where we want it to go in that text area
    '  -- Online prints the text to the current print position line in that text area.
    '  -- CenterLine centers the text to the center of that text area.
    '  -- any other value will print to that line positon in that particular box.
    'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
    'What is the text that we want to print in our text area
    'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
 
    DIM FG AS _UNSIGNED LONG, BG AS _UNSIGNED LONG
    FG = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
    D = _DEST: S = _SOURCE
    OldFont = _FONT
 
    u = UBOUND(TextHandles)
    Handle = WhichHandle
 
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).HideFrame THEN
        _DEST TextHandles(Handle).SavedBackground
        _SOURCE TextHandles(Handle).SavedBackground
    END IF
    _FONT TextHandles(Handle).Font
    fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
    IF _FONTWIDTH = 0 THEN
        FOR i = 1 TO 255
            IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
        NEXT
    ELSE
        fw = _FONTWIDTH
    END IF
 
    h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
 
    SELECT CASE Where
        CASE BottomLine
            y = h \ fh
        CASE OnLine
            y = TextHandles(Handle).Ypos
            IF y = 0 THEN y = 1
        CASE CenterLine
            linesused = 0
            tpw = pw: tw = w: tWhat$ = What
            DO UNTIL tpw <= tw
                textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
                text$ = RTRIM$(LEFT$(tWhat$, textallowed))
                linesused = linesused + 1
                tWhat$ = MID$(tWhat$, textallowed + 1)
                tpw = _PRINTWIDTH(tWhat$)
            LOOP
            linesused = linesused + 1
            py = (h - linesused * fh) \ 2
            y = py \ fh + 1
            IF y < 1 THEN y = 1
        CASE ELSE
            y = Where
    END SELECT
 
    'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
    blend = _BLEND
    _DONTBLEND
 
    DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
        'first let's get a temp image handle for the existing area of the screen.
        x1 = TextHandles(Handle).x1 + 2
        y1 = TextHandles(Handle).y1 + 2
        x2 = TextHandles(Handle).x1 + w
        y2 = TextHandles(Handle).y1 + h
        nh = y2 - y1 + 1 - fh
        nw = x2 - x1 + 1
        tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
        _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
        DrawTextArea Handle
        _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
        y = y - 1
    LOOP
 
    IF blend THEN _BLEND
 
    COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
 
    SELECT CASE How
        CASE LeftJustify
            x = 0
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE CenterJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = (w - _PRINTWIDTH(text$)) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
            ELSE
                x = (w - pw) \ 2
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE RightJustify
            IF pw > w THEN
                textallowed = WordBreak(LEFT$(What, w \ fw))
                text$ = RTRIM$(LEFT$(What, textallowed))
                x = w - _PRINTWIDTH(text$)
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
            ELSE
                x = w - pw
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
        CASE NoJustify
            x = TextHandles(Handle).Xpos
            firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
            IF LEN(What) > firstlinelimit THEN
                textallowed = WordBreak(LEFT$(What, firstlinelimit))
                text$ = RTRIM$(LEFT$(What, textallowed))
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
                PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
            ELSE
                _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
                finished = -1
            END IF
    END SELECT
    IF finished THEN
        SELECT CASE TextHandles(Handle).UpdateMethod
            CASE NoUpdate 'We don't update the position at all.
            CASE DoUpdate
                TextHandles(Handle).Xpos = x + pw
                TextHandles(Handle).Ypos = y
            CASE NewLine
                TextHandles(Handle).Ypos = y + 1
                TextHandles(Handle).Xpos = 1
        END SELECT
        _FONT OldFont
        _DEST D: _SOURCE S
        COLOR FG, BG
    END IF
END SUB
 
SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
END SUB
 
 
SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE TextHandles(Handle).Font
        CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
        CASE IS > 1
            'we have the font already in use
            'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
            _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
    END SELECT
 
    temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
    IF temp > 1 THEN
        TextHandles(Handle).Font = temp
    ELSE
        TextHandles(Handle).Font = 16 'default to font 16, in case
    END IF
 
END SUB
 
SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).TextColor = Foreground
    TextHandles(Handle).TextBackgroundColor = Background
END SUB
 
 
SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).UpdateMethod = Method
END SUB
 
 
SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF X < 1 AND X > -4 THEN
        TextHandles(Handle).Justification = X
    ELSE
        TextHandles(Handle).Xpos = X
    END IF
END SUB
 
SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    SELECT CASE Y
        CASE BottomLine
            TextHandles(Handle).VerticalAlignment = -2
        CASE CenterLine
            TextHandles(Handle).VerticalAlignment = -1
        CASE ELSE
            TextHandles(Handle).VerticalAlignment = 0
    END SELECT
    IF Y < 1 THEN EXIT SUB
    TextHandles(Handle).Ypos = Y
END SUB
 
 
FUNCTION GetPrintPositionY (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionY = TextHandles(Handle).Ypos
END FUNCTION
 
FUNCTION GetPrintPositionX (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    GetPrintPositionX = TextHandles(Handle).Xpos
END FUNCTION
 
 
 
FUNCTION WordBreak (text$)
    CONST Breaks = " ;,.?!-"
    FOR i = LEN(text$) TO 0 STEP -1
        IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
        loopcount = loopcount + 1
    NEXT
    IF i = 0 THEN i = LEN(text$)
    WordBreak = i
END FUNCTION
 
 
 
SUB ClearTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).SavedBackground THEN
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
    END IF
    DrawTextArea Handle
END SUB
 
 
 
SUB DrawTextArea (Handle AS INTEGER)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    w = TextHandles(Handle).w
    h = TextHandles(Handle).h
    x1 = TextHandles(Handle).ScreenX
    y1 = TextHandles(Handle).ScreenY
    x2 = x1 + w - 1
    y2 = y1 + h - 1
 
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
    LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
END SUB
 
 
 
SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    TextHandles(Handle).FrameColor = FrameColor
    TextHandles(Handle).BackColor = BackColor
END SUB
 
 
 
FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
    x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
    x2 = tx2: y2 = ty2
    IF x1 > x2 THEN SWAP x1, x2
    IF y1 > y2 THEN SWAP y1, y2
    w = x2 - x1 + 1
    h = y2 - y1 + 1
    IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
    'Error checking for if the user sends coordinates which are off the screen
    IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
    IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
 
    u = UBOUND(TextHandles)
    FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
        IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
    NEXT
    IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
        Handle = u + 1
        REDIM _PRESERVE TextHandles(Handle) AS TextArea
    END IF
    TextHandles(Handle).x1 = x1
    TextHandles(Handle).y1 = y1
    TextHandles(Handle).w = w: TextHandles(Handle).h = h
    TextHandles(Handle).InUse = True
    TextHandles(Handle).Xpos = 0
    TextHandles(Handle).Ypos = 1
    TextHandles(Handle).UpdateMethod = NewLine
    TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
    TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
 
    IF SaveBackground THEN
        imagehandle = _NEWIMAGE(w, h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        TextHandles(Handle).SavedBackground = imagehandle
    END IF
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    TextHandles(Handle).Font = 16 'default to font 16
    NewTextArea% = Handle
END FUNCTION
 
SUB FreeTextArea (Handle AS INTEGER)
    IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
        IF TextHandles(Handle).InUse THEN
            TextHandles(Handle).InUse = False
            IF TextHandles(Handle).SavedBackground THEN
                IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
                    w = TextHandles(Handle).w
                    h = TextHandles(Handle).h
                    x1 = TextHandles(Handle).ScreenX
                    y1 = TextHandles(Handle).ScreenY
                    x2 = x1 + w - 1
                    y2 = y1 + h - 1
                    blend = _BLEND
                    _DONTBLEND
                    _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
                    IF blend THEN _BLEND
                END IF
                'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
                _FREEIMAGE TextHandles(Handle).SavedBackground
            END IF
        ELSE
            ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
        END IF
    ELSE
        ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
    END IF
END SUB
 
SUB HideFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
        TextHandles(Handle).HideFrame = -1
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        IF TextHandles(Handle).SavedBackground THEN
            blend = _BLEND
            _DONTBLEND
            _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
            _FREEIMAGE TextHandles(Handle).SavedBackground
            IF blend THEN _BLEND
        END IF
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
        TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
    END IF
END SUB
 
SUB RestoreFrame (Handle AS INTEGER)
    IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
        TextHandles(Handle).HideFrame = 0
        w = TextHandles(Handle).w
        h = TextHandles(Handle).h
        x1 = TextHandles(Handle).ScreenX
        y1 = TextHandles(Handle).ScreenY
        x2 = x1 + w - 1
        y2 = y1 + h - 1
        imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
        blend = _BLEND
        _DONTBLEND
        _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
        _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
        _FREEIMAGE TextHandles(Handle).SavedBackground
        IF blend THEN _BLEND
        TextHandles(Handle).SavedBackground = imagehandle
        TextHandles(Handle).x1 = x1 'When the frames are restored, we need to recalculate our print position
        TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
    END IF
END SUB
 
SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
    'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
    u = UBOUND(TextHandles)
    IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
    IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
    HideFrame Handle
    TextHandles(Handle).ScreenX = x1
    TextHandles(Handle).ScreenY = y1
    RestoreFrame Handle
END SUB

And why was picking up the food so hard?

I dunno! It just was!!

Actually, it's just a complicated little set of game expansion at work. We don't just pick up the food that creatures drop now -- the game also generates various degrees of food for us. A rat doesn't just drop "rat meat" now; it can drop "Sickly Rat Meat", "Good Rat Meat", or "Tasty Rat Meat". (Along with a few other varieties.)

And, if we've never eaten the exact meat in question, the game only identifies it as "unknown rat meat" for us, so we're left wondering, "Should I eat this to appease my hunger, or will it be bad for me?"

Of course, once we've identified the food, it'll always be identified for us, so the longer our hero lives, the more correct information the game shares with us -- allowing us to experience "growing smarter" over time....

Now that we actually have hunger (which we've had, but ignored for ages), and we now have monsters dropping a source of food, the next step is to actually implement the ability to EAT some food! And then.... Then I can actually make hunger do something and kill lazy players who just want to sit and heal to full health after each and every fight. MuHaHaHaHa!

And after that, I suppose it'll be time to work on adding other type loots into the game for players to find and interact with. ;)

Title: Re: Rogue-Like (work in progress)
Post by: madscijr on November 23, 2021, 02:14:10 pm

Quote from: SMcNeill on September 16, 2019, 02:45:28 am

And we can now start picking up the food that the monsters drop! (Which was actually one of the most complicated little additions to the game engine which I've worked on so far!)

I'd be intereseted in seeing this run, but it is throwing an error:

Unhandled Error #258
Line: 268 (in main module)
Invalid handle
Continue?
[Yes] [No]

I'm currently running QB64 2.0.0 - should I be using a different version?
Any other ideas?
Thanks...

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on November 23, 2021, 02:20:23 pm

Quote from: madscijr on November 23, 2021, 02:14:10 pm

I'd be intereseted in seeing this run, but it is throwing an error:

Unhandled Error #258
Line: 268 (in main module)
Invalid handle
Continue?
[Yes] [No]

I'm currently running QB64 2.0.0 - should I be using a different version?
Any other ideas?
Thanks...

No idea. Line 268 in the main module is a blank line. I can't fathom why it'd toss an error.

Title: Re: Rogue-Like (work in progress)
Post by: Cobalt on November 23, 2021, 06:26:13 pm

Quote from: madscijr on November 23, 2021, 02:14:10 pm

I'd be intereseted in seeing this run, but it is throwing an error:

Unhandled Error #258
Line: 268 (in main module)
Invalid handle
Continue?
[Yes] [No]

I'm currently running QB64 2.0.0 - should I be using a different version?
Any other ideas?
Thanks...

be sure you get the 7z file in a previous post. you might be missing the PNG file.

Title: Re: Rogue-Like (work in progress)
Post by: xra7en on November 23, 2021, 07:45:54 pm

definitely following this:
rogue games have been my passion back in the day, thanks for reviving it

same unhandled error all over :-)

Title: Re: Rogue-Like (work in progress)
Post by: Cobalt on November 23, 2021, 09:08:33 pm

Quote from: xra7en on November 23, 2021, 07:45:54 pm

same unhandled error all over :-)

so the error is coming up for you as well?

That is odd, runs fine for me. You do have the TTF and PNG files right?

Title: Re: Rogue-Like (work in progress)
Post by: SMcNeill on November 23, 2021, 10:02:21 pm

There's only 2 files which need to be in the same folder as the BAS program -- Sprites.png and courbd.ttf (and the font file is only needed if you're not a Windows user as QB64 will find it automatically for you with windows).

You might want to check to see if the OUTPUT EXE TO SOURCE FOLDER option is checked in the IDE for you, or not, as it can make a difference if you're compiling from the "Rogue Like" folder which the zip file extracted everything into.

Title: Re: Rogue-Like (work in progress)
Post by: madscijr on November 23, 2021, 11:19:55 pm

Quote from: SMcNeill on November 23, 2021, 10:02:21 pm

There's only 2 files which need to be in the same folder as the BAS program -- Sprites.png and courbd.ttf (and the font file is only needed if you're not a Windows user as QB64 will find it automatically for you with windows).

You might want to check to see if the OUTPUT EXE TO SOURCE FOLDER option is checked in the IDE for you, or not, as it can make a difference if you're compiling from the "Rogue Like" folder which the zip file extracted everything into.

Thanks for your reply - I'll check all that when I'm back at my PC & let you all know what works..,

Title: Re: Rogue-Like (work in progress)
Post by: madscijr on November 24, 2021, 12:52:06 pm

Quote from: SMcNeill on November 23, 2021, 10:02:21 pm

There's only 2 files which need to be in the same folder as the BAS program -- Sprites.png and courbd.ttf (and the font file is only needed if you're not a Windows user as QB64 will find it automatically for you with windows).

You might want to check to see if the OUTPUT EXE TO SOURCE FOLDER option is checked in the IDE for you, or not, as it can make a difference if you're compiling from the "Rogue Like" folder which the zip file extracted everything into.

It turns out I didn't have the "courbd.ttf" and "Sprites.png" files,
and the "OUTPUT EXE TO SOURCE FOLDER" option was not selected.
I changed the option and downloaded 'Rogue Like.7z"
(instead of using the code from the forum post)
and it works like a charm. Thank you!

This is a very neat implementation of the game so far -
thanks for sharing it.

PS Are there any instructions?
Here's what I determined from reading the code:

Code: QB64: [Select]

KEY         ACTION
up          move north
down        move south
left        move west
right       move east
space       skip turn
<           climb ladder
+           turn lantern up
=           turn lantern up
-           turn lantern down
_           turn lantern down
SHIFT+up    increase scale
SHIFT+down  decrease scale
SHIFT+left  decrease font size
SHIFT+right increase font size

FYI I tried playing it and got to a ladder, and when I pressed "<" the game seemed to lock up
(I waited about a minute and nothing happened so I killed it.)

PPS Some suggestions for future versions

pressing "?" shows help
keys for diagonal movement (I can do that myself, but just saying)
burn lamp fuel faster/slower if you turn the lamp up/down
line-of-sight algorithm (so player can't see through walls)
missile weapons (bow & arrow, sling, etc.) for ranged combat
a level editor (for the option to play user-created dungeons instead of randomly created ones)
hidden passageways

PPS As a guide for anyone who wants to try adding features, here are the commands listed in the the original Rogue manual on myabandonware.com
https://dl2.myabandonware.com:8443/f/p1z/Rogue_Manual_DOS_EN.pdf (https://dl2.myabandonware.com:8443/f/p1z/Rogue_Manual_DOS_EN.pdf)

Code: QB64: [Select]

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ROGUE COMMANDS REFERENCE CARD
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
The following is a complete list of all the commands used in the ROGUE program.
Certain commands have several keys which perform the same function:
 
-------------------------------------------------------------------------------
MOVEMENT/FIGHTING
-------------------------------------------------------------------------------
KEY(S)        COMMAND(S)
, h           Moves you left one space.
H             Moves you left until you run into a wall or door.
f             Moves you left until you are near an object.
, j           Moves you down one space.
J             Moves you down until you run into a wall or door.
f             Moves you down until you are near an object.
, k           Moves you up one space.
K             Moves you up until you run into a wall or door.
f             Moves you up until you are near an object.
, l           Moves you right one space.
L             Moves you right until you run into a wall or door.
f             Moves you right until you run into an object.
Home, y       Moves you diagonally, up and to the left.
Y             Moves you diagonally, up and to the left until you run into a wall or door.
f Home        Moves you diagonally, up and to the left until you are near an object.
End, b        Moves you diagonally, down and to the left.
B             Moves you diagonally, down and to the left until you run into a wall or door.
f End         Moves you diagonally, down and to the left until you are near an object.
PgUp, u       Moves you diagonally, up and to the right. 
U             Moves you diagonally, up and to the right until you run into a wall or door.
f PgUp        Moves you diagonally, up and to the right until you are near an object.
PgDn, n       Moves you diagonally, down and to the right.
N             Moves you diagonally, down and to the right until you run into a wall or door.
f PgDn        Moves you diagonally, down and to the right until you are near an object.
 
NOTE: The above commands are also used for fighting monsters.
 
KEY(S)        COMMAND(S)
s, Del        Search for hidden traps and secret doors in area adjacent to you.
f             Find something. When followed by a direction, this will allow you to move continuously until you run into a wall or door.
g             Go over. Allows you to step on an item without picking it up. Used as a prefix before a direction key.
>, Ins        When standing on a staircase, this allows you to go down the staircase, deeper into the dungeon, to the next level.
<             When standing on a staircase, this allows you to go up the staircase, out of the dungeon, to the next level.
^, F8         Identifies the trap type. (You will have to give the direction of the trap.)
SCROLL LOCK   Fast Play Mode. When engaged, you move through the rooms and passageways continuously until you run into a door, monster, or other object. Also stops any count currently being performed.
                          
-------------------------------------------------------------------------------
USING OBJECTS/FIGHTING
-------------------------------------------------------------------------------
KEY(S)        COMMAND(S)
c, F5         Renames an object which you have not yet identified.
d             Drop an object. To take something out of your pack and leave it on the dungeon floor.
e             Eat food. Takes food out of your pack to eat.
P             Put a ring on your hand. 
q             Quaff (drink) one of the potions you are carrying.
r             Read one of the scrolls in your pack.
R             Remove a ring you are wearing and put it back into your pack.
t, +          Throw an object (i.e. arrow, dagger). (This command is followed by a direction.)
T             Take off the armor you are currently wearing.
w             Wield a new weapon.
W             Wear a different piece of armor.
z, –          Zap a monster with a wand or staff. (This command is followed by a direction.)
 
-------------------------------------------------------------------------------
GENERAL (Function Keys)
-------------------------------------------------------------------------------
KEY(S)        COMMAND(S)
F1, ?         Lists all the Commands (Help).
F2, /         Lists all the symbols used in the game.
F3, a         Repeat the last command given.
F4, Ctrl r    Repeat message.
F5, c         Rename object.
F6, D         List items that have been discovered.
F7, i         Inventory of all items in your pack.
F8, ^         Identify type of trap. (This command is followed by a direction.)
F9 Any key.   (Alt F9 defines this key to any command you wish to use.)
F10, !        Clears the screen, and starts up a fake DOS. Hitting any function key or typing rogue will put you back in the game. (This can be used when playing Rogue at work when you shouldn't be!)
Ctrl t        Terse message mode.
Q             Quit and exit from ROGUE.
S             Save the current game 
v             Prints the current version number.
Esc           Cancels a command before you execute it.
.             Allows you to rest and heal (regain hit points).
0-9           Number keys preceding a command allow you to repeat the command that number of times.
 

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SMcNeill on September 07, 2019, 09:26:57 am