Author Topic: Rogue-Like (work in progress)  (Read 10063 times)

0 Members and 1 Guest are viewing this topic.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #15 on: September 12, 2019, 01:49:35 am »
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]
  1. DEFLNG A-Z 'default to long instead of single
  2. TYPE TextArea
  3.     InUse AS INTEGER
  4.     x1 AS LONG 'left
  5.     y1 AS LONG 'top
  6.     w AS LONG 'width
  7.     h AS LONG 'height
  8.     FrameColor AS _UNSIGNED LONG
  9.     BackColor AS _UNSIGNED LONG
  10.     Xpos AS INTEGER
  11.     Ypos AS INTEGER
  12.     VerticalAlignment AS INTEGER
  13.     Justification AS INTEGER
  14.     UpdateMethod AS INTEGER
  15.     TextColor AS _UNSIGNED LONG
  16.     TextBackgroundColor AS _UNSIGNED LONG
  17.     SavedBackground AS INTEGER
  18.     HideFrame AS INTEGER
  19.     ScreenX AS INTEGER
  20.     ScreenY AS INTEGER
  21.  
  22. REDIM SHARED TextHandles(0) AS TextArea
  23.  
  24. CONST True = -1, False = 0
  25. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  26. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  27. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  28. '********************************************************
  29. '* Text Frames before this line
  30. '********************************************************
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37. _CONSOLE ON 'for debugging purposes while making/testing things
  38.  
  39. TYPE Damage_Type
  40.     Low AS INTEGER
  41.     High AS INTEGER
  42.  
  43. TYPE Light_Type
  44.     Name AS STRING * 20
  45.     Reach AS _UNSIGNED _BYTE
  46.     Left AS _UNSIGNED _BYTE
  47.  
  48. TYPE Weapon_Type
  49.     Name AS STRING * 20
  50.     Reach AS _UNSIGNED _BYTE
  51.     Damage AS Damage_Type
  52.     HitBonus AS _UNSIGNED _BYTE
  53.     DamageBonus AS _UNSIGNED _BYTE
  54.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  55.  
  56. TYPE Armor_Type
  57.     Name AS STRING * 20
  58.     PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
  59.     DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
  60.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  61.  
  62. TYPE Hero_Type
  63.     Name AS STRING * 20
  64.     Life AS Damage_Type
  65.     Level AS _UNSIGNED _BYTE
  66.     EXP_Earned AS LONG
  67.     EXP_Needed AS LONG
  68.     Light AS Light_Type
  69.     Weapon1 AS Weapon_Type
  70.     Weapon2 AS Weapon_Type
  71.     Armor AS Armor_Type
  72.  
  73. TYPE Map_Identifer_TYPE
  74.     Symbol AS _UNSIGNED _BYTE
  75.  
  76. TYPE Monster_TYPE
  77.     Name AS STRING * 20
  78.     Life AS Damage_Type
  79.     Level AS INTEGER
  80.     ExpBonus AS INTEGER
  81.     Sight AS INTEGER
  82.     Hearing AS INTEGER
  83.     Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
  84.     Weapon1 AS Weapon_Type
  85.     Weapon2 AS Weapon_Type
  86.     Armor AS Armor_Type
  87.     ID AS Map_Identifer_TYPE
  88.  
  89. TYPE Encounter_TYPE
  90.     Active AS INTEGER
  91.     X AS INTEGER
  92.     Y AS INTEGER
  93.     M AS INTEGER
  94.     Life AS INTEGER
  95.  
  96. REDIM SHARED Monster(100) AS Monster_TYPE
  97. REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
  98.  
  99. DIM SHARED Hero AS Hero_Type
  100. DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
  101. DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
  102. DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
  103. DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG
  104. DIM SHARED TextFont
  105.  
  106. WorkScreen = _NEWIMAGE(800, 600, 32)
  107. DisplayScreen = _NEWIMAGE(800, 700, 32)
  108. SCREEN DisplayScreen
  109. Scale = 1
  110.  
  111. REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
  112. '1 map is illuminated
  113. '2 map is uncovered
  114. '4 map is a wall
  115. '8 map is a pathway
  116. '16 map is a stairway
  117. '32 map is simply blocked (perhaps with a monster?)
  118. '64 map is secret (can not be uncovered)
  119.  
  120. REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
  121.  
  122.  
  123.  
  124.  
  125.  
  126. Init
  127. CreateMap 99, 74, 10
  128.  
  129.     DrawMap
  130.     DisplayCharacter
  131.     _DISPLAY
  132.     GetInput
  133.     MonstersTurn
  134.     CheckForHeroGrowth
  135.  
  136. SUB Init
  137.     Hero.Name = "Steve The Tester!"
  138.     Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
  139.     Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
  140.     Hero.Light.Name = "Magic Candle"
  141.     Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
  142.     Hero.Weapon1.Name = "Bare Fist"
  143.     Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
  144.     Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
  145.     Hero.Weapon1.Left = -1 'your fist is indestructible!
  146.     Hero.Weapon2.Name = "Magic Candle"
  147.     Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
  148.     Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
  149.     Hero.Weapon2.Left = 0 'you can't attack with a candle
  150.     Hero.Armor.Name = "Naked"
  151.     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!
  152.  
  153.     PrintArea = NewTextArea(230, 601, 799, 699, False)
  154.     ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  155.     DrawTextArea PrintArea
  156.     SetPrintPositionX PrintArea, CenterJustify
  157.     SetPrintUpdate PrintArea, NewLine
  158.     PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
  159.     PrintOut PrintArea, "created by STEVE!"
  160.     PrintOut PrintArea, ""
  161.     SetPrintPositionX PrintArea, LeftJustify
  162.  
  163. SUB CheckForHeroGrowth
  164.     IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
  165.         BEEP
  166.         CLS
  167.         PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
  168.         _DELAY 5
  169.         SYSTEM
  170.     END IF
  171.  
  172.  
  173. SUB DisplayCharacter
  174.     LINE (0, 601)-(229, 799), &HFF000000, BF
  175.     COLOR &HFFFFFFFF, 0
  176.     _PRINTSTRING (0, 605), "HERO : " + Hero.Name
  177.     _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
  178.     _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
  179.     _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
  180.  
  181.     _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
  182.     _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
  183.     _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
  184.     _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
  185.  
  186. SUB GetInput
  187.     DO
  188.         k = _KEYHIT: valid = -1
  189.         SELECT CASE k
  190.             CASE 18432 'up
  191.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  192.                     Scale = Scale + .1
  193.                     IF Scale > 4 THEN Scale = 4
  194.                 ELSE
  195.                     IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
  196.                 END IF
  197.             CASE 19200: 'left
  198.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  199.                     Scale = Scale - .1
  200.                     IF Scale < 1 THEN Scale = 1
  201.                 ELSE
  202.                     IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
  203.                 END IF
  204.             CASE 20480: 'down
  205.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  206.                     Scale = Scale - .1
  207.                     IF Scale < 1 THEN Scale = 1
  208.                 ELSE
  209.                     IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
  210.                 END IF
  211.             CASE 19712: 'right
  212.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  213.                     Scale = Scale + .1
  214.                     IF Scale > 4 THEN Scale = 4
  215.                 ELSE
  216.                     IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
  217.                 END IF
  218.             CASE 32 'space to just wait and skip a turn
  219.             CASE 60 ' "<" key
  220.                 IF MapArray(Hero.X, Hero.Y) AND 16 THEN
  221.                     Level = Level + 1
  222.                     CreateMap 99, 74, 10
  223.                     PathFind
  224.                 END IF
  225.             CASE ASC("+"), ASC("=")
  226.                 IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
  227.             CASE ASC("-"), ASC("_")
  228.                 IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
  229.             CASE ELSE
  230.                 valid = 0 'it's a key press which we don't recognize.  Ignore it
  231.         END SELECT
  232.         _LIMIT 60
  233.     LOOP UNTIL k AND valid
  234.     _KEYCLEAR 'one keystroke at a time
  235.  
  236. SUB Box (X, Y, Wide, High, Caption AS STRING, Kolor AS _UNSIGNED LONG)
  237.     LINE (X, Y)-STEP(Wide, High), Kolor, BF
  238.     LINE (X, Y)-STEP(Wide, High), &HFFFFFFFF, B
  239.     pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
  240.     _PRINTSTRING (X + (Wide - pw) \ 2, Y + (High - ph) \ 2), Caption
  241.  
  242.  
  243. SUB MoveHero (MoveX, MoveY)
  244.     TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
  245.     IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
  246.         IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
  247.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
  248.             IF MoveX THEN Hero.X = Hero.X + MoveX
  249.             IF MoveY THEN Hero.Y = Hero.Y + MoveY
  250.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
  251.             PathFind
  252.         ELSE
  253.             '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!
  254.             FOR i = 1 TO EncounterLimit
  255.                 IF Encounter(i).Active THEN 'Check for active/alive monsters only
  256.                     MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  257.                     IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
  258.                         Swing 0, i, 1 'swing with the right hand
  259.                     END IF
  260.                 END IF
  261.             NEXT
  262.         END IF
  263.     END IF
  264.  
  265. SUB Swing (Who, AtWhom, HandUsed)
  266.     M = Encounter(AtWhom).M
  267.     BaseChancetohit = 10 'base 10 chance to hit
  268.     IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
  269.         IF Hero.Weapon1.Reach > 0 THEN 'it's a weapon and not an utility object being held.
  270.             Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
  271.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  272.             totalroll = 0
  273.             DO
  274.                 roll = INT(RND * 20) + 1
  275.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  276.                 IF roll = 20 THEN totalroll = totalroll + 20
  277.                 totalroll = totalroll + roll
  278.             LOOP UNTIL roll <> 1 AND roll <> 20
  279.             damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
  280.             damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
  281.             out$ = _TRIM$(Hero.Name)
  282.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  283.                 SetTextColor PrintArea, &HFFF000F0, 0
  284.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  285.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  286.                 Hero.Life.Low = Hero.Life.Low - damage
  287.             ELSEIF totalroll < Chancetohit THEN
  288.                 SetTextColor PrintArea, &HFFF0F000, 0
  289.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  290.             ELSEIF totalroll > Chancetohit + 20 THEN
  291.                 SetTextColor PrintArea, &HFF00FF00, 0
  292.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  293.                 damage = damage * (totalroll \ 20 + 1)
  294.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  295.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  296.             ELSEIF totalroll >= Chancetohit THEN
  297.                 SetTextColor PrintArea, &HFF00FF00, 0
  298.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  299.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
  300.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  301.             END IF
  302.             PrintOut PrintArea, out$
  303.         END IF
  304.         IF Hero.Weapon2.Reach > 0 THEN 'it's a weapon and not an utility object being held.
  305.             Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
  306.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  307.             totalroll = 0
  308.             DO
  309.                 roll = INT(RND * 20) + 1
  310.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  311.                 IF roll = 20 THEN totalroll = totalroll + 20
  312.                 totalroll = totalroll + roll
  313.             LOOP UNTIL roll <> 1 AND roll <> 20
  314.             damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
  315.             damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
  316.             out$ = _TRIM$(Hero.Name)
  317.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  318.                 SetTextColor PrintArea, &HFFF000F0, 0
  319.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  320.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  321.                 damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
  322.                 Hero.Life.Low = Hero.Life.Low - damage
  323.             ELSEIF totalroll < Chancetohit THEN
  324.                 SetTextColor PrintArea, &HFFF0F000, 0
  325.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  326.             ELSEIF totalroll > Chancetohit + 20 THEN
  327.                 SetTextColor PrintArea, &HFF00FF00, 0
  328.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  329.                 damage = damage * (totalroll \ 20 + 1)
  330.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  331.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  332.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  333.             ELSEIF totalroll >= Chancetohit THEN
  334.                 SetTextColor PrintArea, &HFF00FF00, 0
  335.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  336.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
  337.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  338.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  339.             END IF
  340.             PrintOut PrintArea, out$
  341.         END IF
  342.  
  343.         IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
  344.             SetTextColor PrintArea, &HFFFF0000, 0
  345.             out$ = _TRIM$(Monster(M).Name) + " died!"
  346.             PrintOut PrintArea, out$
  347.             Encounter(AtWhom).Active = 0
  348.             Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
  349.             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!
  350.  
  351.             RedSet = 128: 'GreenSet = 128: BlueSet = 128
  352.             IF Monster(M).ID.Symbol = 63 THEN 'it's a first time kill!
  353.                 TempArea = NewTextArea(200, 100, 600, 500, True)
  354.                 ColorTextArea TempArea, _RGB32(255, 255, 255), _RGB32(128, 128, 128)
  355.                 DrawTextArea TempArea
  356.                 SetPrintPositionX TempArea, CenterJustify
  357.                 SetPrintUpdate TempArea, NewLine
  358.                 SetTextColor TempArea, &HFFFFFFFF, 0
  359.                 out$ = "CONGRATULATIONS!  You just killed " + _TRIM$(Monster(M).Name) + " for the first time!"
  360.                 PrintOut TempArea, out$
  361.                 DO
  362.                     SetTextColor TempArea, _RGB32(RedSet, GreenSet, BlueSet), 0
  363.                     COLOR _RGB32(RedSet, GreenSet, BlueSet), 0
  364.                     FOR y = 0 TO 15
  365.                         FOR x = 0 TO 15
  366.                             Box x * 16 + 275, y * 16 + 150, 16, 16, CHR$(y * 16 + x), _RGB32(200, 200, 200)
  367.                         NEXT
  368.                     NEXT
  369.                     Box 275, 425, 256, 20, "", _RGB32(200, 200, 200)
  370.                     Box 275, 425, RedSet, 20, "", _RGB32(255, 0, 0)
  371.                     Box 275, 450, 256, 20, "", _RGB32(200, 200, 200)
  372.                     Box 275, 450, GreenSet, 20, "", _RGB32(0, 256, 0)
  373.                     Box 275, 475, 256, 20, "", _RGB32(200, 200, 200)
  374.                     Box 275, 475, BlueSet, 20, "", _RGB32(0, 0, 256)
  375.                     _DISPLAY
  376.                     WHILE _MOUSEINPUT: WEND
  377.                     IF _MOUSEBUTTON(1) THEN
  378.                         IF _MOUSEX > 250 AND _MOUSEX < 556 THEN 'we're clicked at the right mouse coordinate
  379.                             SELECT CASE _MOUSEY
  380.                                 CASE 425 TO 445
  381.                                     RedSet = _MOUSEX - 275
  382.                                     IF RedSet < 0 THEN RedSet = 0
  383.                                     IF RedSet > 255 THEN RedSet = 255
  384.                                 CASE 450 TO 470
  385.                                     GreenSet = _MOUSEX - 275
  386.                                     IF GreenSet < 0 THEN GreenSet = 0
  387.                                     IF GreenSet > 255 THEN GreenSet = 255
  388.                                 CASE 475 TO 495
  389.                                     BlueSet = _MOUSEX - 275
  390.                                     IF BlueSet < 0 THEN BlueSet = 0
  391.                                     IF BlueSet > 255 THEN BlueSet = 255
  392.                             END SELECT
  393.                         END IF
  394.                     END IF
  395.                     _LIMIT 60
  396.                 LOOP
  397.  
  398.             END IF
  399.         END IF
  400.     ELSE 'it's a monster attacking
  401.  
  402.     END IF
  403.  
  404.  
  405. FUNCTION MoveMonster (Monster, MoveX, MoveY)
  406.     MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
  407.     D = Distance(MX, MY) 'distance from monster to the hero
  408.     E = Encounter(i).M 'the actual monster in question
  409.  
  410.     IF D > Distance(MX + MoveX, MY + MoveY) THEN
  411.         IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
  412.             MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
  413.             Encounter(Monster).X = Encounter(Monster).X + MoveX
  414.             Encounter(Monster).Y = Encounter(Monster).Y + MoveY
  415.             MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
  416.             MoveMonster = -1
  417.         END IF
  418.     END IF
  419.  
  420.  
  421.  
  422. SUB MonstersTurn
  423.     FOR i = 1 TO EncounterLimit
  424.         IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
  425.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  426.             D = Distance(MX, MY) 'distance from monster to the hero
  427.             E = Encounter(i).M 'the actual monster in question
  428.             IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
  429.  
  430.                 attack = 0
  431.                 IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
  432.                     'insert attack code here
  433.  
  434.                     _TITLE "ATTACK!"
  435.                     _CONTINUE
  436.                 END IF
  437.                 IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
  438.                     'insert attack code here
  439.                     _CONTINUE
  440.                 END IF
  441.  
  442.                 IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
  443.                     IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
  444.                         IF D > Distance(MX - 1, MY) THEN
  445.                             IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
  446.                         END IF
  447.                     END IF
  448.                     IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
  449.                         IF D > Distance(MX, MY - 1) THEN
  450.                             IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
  451.                         END IF
  452.                     END IF
  453.                     IF MX < XH THEN 'check to see if moving right moves us towards the hero.
  454.                         IF D > Distance(MX + 1, MY) THEN
  455.                             IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
  456.                         END IF
  457.                     END IF
  458.                     IF MY < YH THEN 'check to see if moving down moves us towards the hero.
  459.                         IF D > Distance(MX, MY + 1) THEN
  460.                             IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
  461.                         END IF
  462.                     END IF
  463.                 END IF
  464.             END IF
  465.         END IF
  466.  
  467.     NEXT
  468.  
  469.  
  470.  
  471.  
  472. SUB DrawMap
  473.     _DEST WorkScreen
  474.     _FONT 8
  475.     LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
  476.     FOR Y = 0 TO YH
  477.         FOR X = 0 TO XH
  478.             IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
  479.                 IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
  480.             END IF
  481.             IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
  482.                 IF MapArray(X, Y) AND 4 THEN 'it's a visible room
  483.                     COLOR &HFF000000, 0
  484.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
  485.                 END IF
  486.                 IF MapArray(X, Y) AND 8 THEN 'it's a visible path
  487.                     COLOR &HFF000000, &HFF777777
  488.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
  489.                 END IF
  490.                 IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
  491.                     COLOR &HFF00FF00, &HFFFFFF00
  492.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
  493.                 END IF
  494.             END IF
  495.             'note: highlighting for the light should come AFTER the map is drawn
  496.             IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
  497.                 COLOR &H40FFFF00, 0
  498.                 _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
  499.                 MapArray(X, Y) = MapArray(X, Y) - 1
  500.                 FOR i = 1 TO EncounterLimit
  501.                     IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
  502.                         E = Encounter(i).M
  503.                         COLOR Monster(E).ID.Color
  504.                         _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(Monster(E).ID.Symbol)
  505.                     END IF
  506.                 NEXT
  507.  
  508.             END IF
  509.         NEXT
  510.     NEXT
  511.     COLOR &HFFFFFF00, 0 'Yellow Hero
  512.     _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
  513.     XOffset## = 400 / Scale
  514.     YOffset## = 300 / Scale
  515.     CenterX = Hero.X * 8 'convert hero coordinate to grid coordinate
  516.     CenterY = Hero.Y * 8
  517.     _DEST DisplayScreen
  518.     LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
  519.     _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
  520.  
  521.  
  522.  
  523.  
  524.  
  525. SUB CreateMap (XLimit, YLimit, Rooms)
  526.     ERASE MapArray 'clear the old map and reset everything to 0
  527.     REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
  528.     REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
  529.     REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
  530.     XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
  531.  
  532.     DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
  533.  
  534.     FOR i = 1 TO Rooms
  535.         DO
  536.             RoomSize = INT(RND * 9) + 2
  537.             RoomX = INT(RND * (XLimit - RoomSize))
  538.             RoomY = INT(RND * (YLimit - RoomSize))
  539.             'test for positioning
  540.             good = -1 'it's good starting out
  541.             FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  542.                     IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
  543.             NEXT X, Y
  544.         LOOP UNTIL good
  545.         FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  546.                 MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
  547.         NEXT X, Y
  548.         RoomCenterX(i) = RoomX + .5 * RoomSize
  549.         RoomCenterY(i) = RoomY + .5 * RoomSize
  550.     NEXT
  551.     FOR i = 1 TO Rooms - 1
  552.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  553.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  554.         DO UNTIL StartX = EndX AND StartY = EndY
  555.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  556.             Meander = 10
  557.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  558.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  559.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  560.                     Ychange = 0
  561.                 ELSE
  562.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  563.                     Ychange = 0
  564.                 END IF
  565.             ELSE
  566.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  567.                     Ychange = SGN(EndY - StartY)
  568.                     XChange = 0
  569.                 ELSE
  570.                     Ychange = INT(RND * 3) - 1
  571.                     XChange = 0
  572.                 END IF
  573.             END IF
  574.             StartX = StartX + XChange
  575.             StartY = StartY + Ychange
  576.             IF StartX < 0 THEN StartX = 0
  577.             IF StartY < 0 THEN StartY = 0
  578.             IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
  579.             IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
  580.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
  581.         LOOP
  582.     NEXT
  583.     DO
  584.         Hero.X = INT(RND * XLimit + 1)
  585.         Hero.Y = INT(RND * YLimit + 1)
  586.     LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
  587.     MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
  588.     DO
  589.         X = INT(RND * XLimit + 1)
  590.         Y = INT(RND * YLimit + 1)
  591.     LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
  592.     MapArray(X, Y) = MapArray(X, Y) OR 16
  593.     PathFind
  594.     EncounterLimit = INT(RND * 6) + 5
  595.     FOR i = 1 TO EncounterLimit
  596.         Encounter(i).M = RandomMonster
  597.         Encounter(i).Active = -1
  598.         Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
  599.         valid = -1
  600.         DO
  601.             Encounter(i).X = INT(RND * XLimit + 1)
  602.             Encounter(i).Y = INT(RND * YLimit + 1)
  603.             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.)
  604.         LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
  605.         MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
  606.     NEXT
  607.  
  608. SUB PathFind
  609.     STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
  610.     DIM pass AS _UNSIGNED _BYTE
  611.     m = _MEM(Distance()): m1 = _MEM(Temp())
  612.     _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
  613.     _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
  614.     Temp(Hero.X, Hero.Y) = 0
  615.     pass = 0
  616.     DO
  617.         changed = 0
  618.         y = 0
  619.         DO
  620.             x = 0
  621.             DO
  622.                 IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
  623.                     IF x < XH THEN
  624.                         IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  625.                     END IF
  626.                     IF x > 0 THEN
  627.                         IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  628.                     END IF
  629.                     IF y < YH THEN
  630.                         IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  631.                     END IF
  632.                     IF y > 0 THEN
  633.                         IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  634.                     END IF
  635.                 END IF
  636.                 x = x + 1
  637.             LOOP UNTIL x > XH
  638.             y = y + 1
  639.         LOOP UNTIL y > YH
  640.         _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
  641.         pass = pass + 1
  642.     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!
  643.     Distance(Hero.X, Hero.Y) = 0
  644.  
  645. FUNCTION RandomMonster
  646.     'Shared variable level tells us what level of the dungeon we're on.
  647.     STATIC MC, DS 'monster count and data set
  648.     IF NOT DS THEN
  649.         DS = -1
  650.         Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
  651.         Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
  652.         Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
  653.         Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
  654.         'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
  655.         'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
  656.         'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
  657.         'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
  658.         'Monster(1).Armor.Name = ""
  659.         'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
  660.  
  661.         Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
  662.         Monster(2).Level = 1: Monster(2).ExpBonus = 0
  663.         Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
  664.         Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
  665.         Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
  666.         Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
  667.         Monster(3).Level = 1: Monster(3).ExpBonus = 0
  668.         Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
  669.         Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
  670.         Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
  671.         FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
  672.             Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
  673.         NEXT
  674.     END IF
  675.     SELECT CASE Level 'the starting level
  676.         CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
  677.     END SELECT
  678.     RandomMonster = INT(RND * MC) + 1
  679.  
  680.  
  681. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  682. '# SUBroutines and FUNCTIONs below #'
  683. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  684. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  685.     u = UBOUND(TextHandles)
  686.     Handle = WhichHandle
  687.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  688.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  689.     Where = TextHandles(Handle).VerticalAlignment
  690.     How = TextHandles(Handle).Justification
  691.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  692.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  693.  
  694.  
  695. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  696.     'WhichHandle is the handle which designates which text area we want to use
  697.     'Where is where we want it to go in that text area
  698.     '  -- Online prints the text to the current print position line in that text area.
  699.     '  -- CenterLine centers the text to the center of that text area.
  700.     '  -- any other value will print to that line positon in that particular box.
  701.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  702.     'What is the text that we want to print in our text area
  703.     '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).
  704.  
  705.     D = _DEST: S = _SOURCE
  706.  
  707.  
  708.     u = UBOUND(TextHandles)
  709.     fh = _FONTHEIGHT
  710.     pw = _PRINTWIDTH(What)
  711.     Handle = WhichHandle
  712.  
  713.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  714.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  715.     IF TextHandles(Handle).HideFrame THEN
  716.         _DEST TextHandles(Handle).SavedBackground
  717.         _SOURCE TextHandles(Handle).SavedBackground
  718.     END IF
  719.     h = TextHandles(Handle).h - 4
  720.     w = TextHandles(Handle).w - 4
  721.  
  722.     SELECT CASE Where
  723.         CASE BottomLine
  724.             y = h \ fh
  725.         CASE OnLine
  726.             y = TextHandles(Handle).Ypos
  727.             IF y = 0 THEN y = 1
  728.         CASE CenterLine
  729.             linesused = 0
  730.             tpw = pw: tw = w: tWhat$ = What
  731.             DO UNTIL tpw <= tw
  732.                 textallowed = WordBreak(LEFT$(tWhat$, w \ _FONTWIDTH))
  733.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  734.                 linesused = linesused + 1
  735.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  736.                 tpw = _PRINTWIDTH(tWhat$)
  737.             LOOP
  738.             linesused = linesused + 1
  739.             py = (h - linesused * fh) \ 2
  740.             y = py \ fh + 1
  741.             IF y < 1 THEN y = 1
  742.         CASE ELSE
  743.             y = Where
  744.     END SELECT
  745.  
  746.     IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  747.     blend = _BLEND
  748.     DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  749.         'first let's get a temp image handle for the existing area of the screen.
  750.         x1 = TextHandles(Handle).x1 + 2
  751.         y1 = TextHandles(Handle).y1 + 2
  752.         x2 = TextHandles(Handle).x1 + w
  753.         y2 = TextHandles(Handle).y1 + h
  754.         nh = y2 - y1 + 1 - fh
  755.         nw = x2 - x1 + 1
  756.         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.
  757.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  758.         DrawTextArea Handle
  759.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  760.         y = y - 1
  761.     LOOP
  762.     IF blend THEN _BLEND
  763.  
  764.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  765.  
  766.     SELECT CASE How
  767.         CASE LeftJustify
  768.             x = 0
  769.             IF pw > w THEN
  770.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  771.                 text$ = RTRIM$(LEFT$(What, textallowed))
  772.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  773.                 PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
  774.             ELSE
  775.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  776.                 finished = -1
  777.             END IF
  778.         CASE CenterJustify
  779.             IF pw > w THEN
  780.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  781.                 text$ = RTRIM$(LEFT$(What, textallowed))
  782.                 x = (w - _PRINTWIDTH(text$)) \ 2
  783.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  784.                 PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  785.             ELSE
  786.                 x = (w - pw) \ 2
  787.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  788.                 finished = -1
  789.             END IF
  790.         CASE RightJustify
  791.             IF pw > w THEN
  792.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  793.                 text$ = RTRIM$(LEFT$(What, textallowed))
  794.                 x = w - _PRINTWIDTH(text$)
  795.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  796.                 PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
  797.             ELSE
  798.                 x = w - pw
  799.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  800.                 finished = -1
  801.             END IF
  802.         CASE NoJustify
  803.             x = TextHandles(Handle).Xpos
  804.             firstlinelimit = (w - x) \ _FONTWIDTH 'the limit of characters on the first line
  805.             IF LEN(What) > firstlinelimit THEN
  806.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  807.                 text$ = RTRIM$(LEFT$(What, textallowed))
  808.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  809.                 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
  810.             ELSE
  811.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  812.                 finished = -1
  813.             END IF
  814.     END SELECT
  815.  
  816.     IF finished THEN
  817.         SELECT CASE TextHandles(Handle).UpdateMethod
  818.             CASE NoUpdate 'We don't update the position at all.
  819.             CASE DoUpdate
  820.                 TextHandles(Handle).Xpos = x + pw
  821.                 TextHandles(Handle).Ypos = y
  822.             CASE NewLine
  823.                 TextHandles(Handle).Ypos = y + 1
  824.                 TextHandles(Handle).Xpos = 1
  825.         END SELECT
  826.         _DEST D: _SOURCE S
  827.         COLOR FG, BG
  828.     END IF
  829.  
  830. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  831.     u = UBOUND(TextHandles)
  832.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  833.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  834.     TextHandles(Handle).TextColor = Foreground
  835.  
  836.  
  837. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  838.     u = UBOUND(TextHandles)
  839.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  840.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  841.     TextHandles(Handle).TextBackgroundColor = Background
  842.  
  843.  
  844.  
  845. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  846.     u = UBOUND(TextHandles)
  847.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  848.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  849.     TextHandles(Handle).TextColor = Foreground
  850.     TextHandles(Handle).TextBackgroundColor = Background
  851.  
  852.  
  853. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  854.     u = UBOUND(TextHandles)
  855.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  856.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  857.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  858.     TextHandles(Handle).UpdateMethod = Method
  859.  
  860.  
  861. SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
  862.     u = UBOUND(TextHandles)
  863.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  864.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  865.     SELECT CASE Y
  866.         CASE BottomLine
  867.             TextHandles(Handle).VerticalAlignment = -2
  868.         CASE CenterLine
  869.             TextHandles(Handle).VerticalAlignment = -1
  870.         CASE ELSE
  871.             TextHandles(Handle).VerticalAlignment = 0
  872.     END SELECT
  873.     IF X < 1 AND X > -4 THEN
  874.         TextHandles(Handle).Justification = X
  875.     ELSE
  876.         TextHandles(Handle).Xpos = X
  877.     END IF
  878.     IF Y < 1 THEN EXIT SUB
  879.     TextHandles(Handle).Ypos = Y
  880.  
  881. SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
  882.     u = UBOUND(TextHandles)
  883.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  884.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  885.     IF X < 1 AND X > -4 THEN
  886.         TextHandles(Handle).Justification = X
  887.     ELSE
  888.         TextHandles(Handle).Xpos = X
  889.     END IF
  890.  
  891. SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
  892.     u = UBOUND(TextHandles)
  893.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  894.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  895.     SELECT CASE Y
  896.         CASE BottomLine
  897.             TextHandles(Handle).VerticalAlignment = -2
  898.         CASE CenterLine
  899.             TextHandles(Handle).VerticalAlignment = -1
  900.         CASE ELSE
  901.             TextHandles(Handle).VerticalAlignment = 0
  902.     END SELECT
  903.     IF Y < 1 THEN EXIT SUB
  904.     TextHandles(Handle).Ypos = Y
  905.  
  906.  
  907. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  908.     u = UBOUND(TextHandles)
  909.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  910.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  911.     GetPrintPositionY = TextHandles(Handle).Ypos
  912.  
  913. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  914.     u = UBOUND(TextHandles)
  915.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  916.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  917.     GetPrintPositionX = TextHandles(Handle).Xpos
  918.  
  919.  
  920.  
  921. FUNCTION WordBreak (text$)
  922.     CONST Breaks = " ;,.?!-"
  923.     FOR i = LEN(text$) TO 0 STEP -1
  924.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  925.         loopcount = loopcount + 1
  926.     NEXT
  927.     IF i = 0 THEN i = LEN(text$)
  928.     WordBreak = i
  929.  
  930.  
  931.  
  932. SUB ClearTextArea (Handle AS INTEGER)
  933.     u = UBOUND(TextHandles)
  934.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  935.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  936.     IF TextHandles(Handle).SavedBackground THEN
  937.         w = TextHandles(Handle).w
  938.         h = TextHandles(Handle).h
  939.         x1 = TextHandles(Handle).ScreenX
  940.         y1 = TextHandles(Handle).ScreenY
  941.         x2 = x1 + w - 1
  942.         y2 = y1 + h - 1
  943.         blend = _BLEND
  944.         _DONTBLEND
  945.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  946.         IF blend THEN _BLEND
  947.     END IF
  948.     DrawTextArea Handle
  949.  
  950.  
  951.  
  952. SUB DrawTextArea (Handle AS INTEGER)
  953.     u = UBOUND(TextHandles)
  954.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  955.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  956.     w = TextHandles(Handle).w
  957.     h = TextHandles(Handle).h
  958.     x1 = TextHandles(Handle).ScreenX
  959.     y1 = TextHandles(Handle).ScreenY
  960.     x2 = x1 + w - 1
  961.     y2 = y1 + h - 1
  962.  
  963.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  964.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  965.  
  966.  
  967.  
  968. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  969.     u = UBOUND(TextHandles)
  970.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  971.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  972.     TextHandles(Handle).FrameColor = FrameColor
  973.     TextHandles(Handle).BackColor = BackColor
  974.  
  975.  
  976.  
  977. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  978.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  979.     x2 = tx2: y2 = ty2
  980.     IF x1 > x2 THEN SWAP x1, x2
  981.     IF y1 > y2 THEN SWAP y1, y2
  982.     w = x2 - x1 + 1
  983.     h = y2 - y1 + 1
  984.     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
  985.     'Error checking for if the user sends coordinates which are off the screen
  986.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  987.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  988.  
  989.     u = UBOUND(TextHandles)
  990.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  991.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  992.     NEXT
  993.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  994.         Handle = u + 1
  995.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  996.     END IF
  997.     TextHandles(Handle).x1 = x1
  998.     TextHandles(Handle).y1 = y1
  999.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  1000.     TextHandles(Handle).InUse = True
  1001.     TextHandles(Handle).Xpos = 0
  1002.     TextHandles(Handle).Ypos = 1
  1003.     TextHandles(Handle).UpdateMethod = NewLine
  1004.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  1005.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  1006.  
  1007.     IF SaveBackground THEN
  1008.         imagehandle = _NEWIMAGE(w, h, 32)
  1009.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1010.         TextHandles(Handle).SavedBackground = imagehandle
  1011.     END IF
  1012.     TextHandles(Handle).ScreenX = x1
  1013.     TextHandles(Handle).ScreenY = y1
  1014.  
  1015.     NewTextArea% = Handle
  1016.  
  1017. SUB FreeTextArea (Handle AS INTEGER)
  1018.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  1019.         IF TextHandles(Handle).InUse THEN
  1020.             TextHandles(Handle).InUse = False
  1021.             IF TextHandles(Handle).SavedBackground THEN
  1022.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  1023.                     w = TextHandles(Handle).w
  1024.                     h = TextHandles(Handle).h
  1025.                     x1 = TextHandles(Handle).ScreenX
  1026.                     y1 = TextHandles(Handle).ScreenY
  1027.                     x2 = x1 + w - 1
  1028.                     y2 = y1 + h - 1
  1029.                     blend = _BLEND
  1030.                     _DONTBLEND
  1031.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1032.                     IF blend THEN _BLEND
  1033.                 END IF
  1034.                 '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.
  1035.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  1036.             END IF
  1037.         ELSE
  1038.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  1039.         END IF
  1040.     ELSE
  1041.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  1042.     END IF
  1043.  
  1044. SUB HideFrame (Handle AS INTEGER)
  1045.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  1046.         TextHandles(Handle).HideFrame = -1
  1047.         w = TextHandles(Handle).w
  1048.         h = TextHandles(Handle).h
  1049.         x1 = TextHandles(Handle).ScreenX
  1050.         y1 = TextHandles(Handle).ScreenY
  1051.         x2 = x1 + w - 1
  1052.         y2 = y1 + h - 1
  1053.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1054.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1055.         IF TextHandles(Handle).SavedBackground THEN
  1056.             blend = _BLEND
  1057.             _DONTBLEND
  1058.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1059.             _FREEIMAGE TextHandles(Handle).SavedBackground
  1060.             IF blend THEN _BLEND
  1061.         END IF
  1062.         TextHandles(Handle).SavedBackground = imagehandle
  1063.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  1064.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  1065.     END IF
  1066.  
  1067. SUB RestoreFrame (Handle AS INTEGER)
  1068.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  1069.         TextHandles(Handle).HideFrame = 0
  1070.         w = TextHandles(Handle).w
  1071.         h = TextHandles(Handle).h
  1072.         x1 = TextHandles(Handle).ScreenX
  1073.         y1 = TextHandles(Handle).ScreenY
  1074.         x2 = x1 + w - 1
  1075.         y2 = y1 + h - 1
  1076.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1077.         blend = _BLEND
  1078.         _DONTBLEND
  1079.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1080.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  1081.         _FREEIMAGE TextHandles(Handle).SavedBackground
  1082.         IF blend THEN _BLEND
  1083.         TextHandles(Handle).SavedBackground = imagehandle
  1084.         TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
  1085.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  1086.     END IF
  1087.  
  1088. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  1089.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  1090.     u = UBOUND(TextHandles)
  1091.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1092.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1093.     HideFrame Handle
  1094.     TextHandles(Handle).ScreenX = x1
  1095.     TextHandles(Handle).ScreenY = y1
  1096.     RestoreFrame Handle
  1097.  

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...)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rogue-Like (work in progress)
« Reply #16 on: September 12, 2019, 10:22:07 am »
oops! I killed a rat just by wandering around sorry Mr Rat ;-)
Wow killed rat, now what(QM).PNG
* Wow killed rat, now what(QM).PNG (Filesize: 29.7 KB, Dimensions: 804x730, Views: 191)

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #17 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]
  1. DEFLNG A-Z 'default to long instead of single
  2. TYPE TextArea
  3.     InUse AS INTEGER
  4.     x1 AS LONG 'left
  5.     y1 AS LONG 'top
  6.     w AS LONG 'width
  7.     h AS LONG 'height
  8.     FrameColor AS _UNSIGNED LONG
  9.     BackColor AS _UNSIGNED LONG
  10.     Xpos AS INTEGER
  11.     Ypos AS INTEGER
  12.     VerticalAlignment AS INTEGER
  13.     Justification AS INTEGER
  14.     UpdateMethod AS INTEGER
  15.     TextColor AS _UNSIGNED LONG
  16.     TextBackgroundColor AS _UNSIGNED LONG
  17.     SavedBackground AS INTEGER
  18.     HideFrame AS INTEGER
  19.     ScreenX AS INTEGER
  20.     ScreenY AS INTEGER
  21.     Font AS LONG 'NEW! Change fonts for each independent font area
  22.  
  23. REDIM SHARED TextHandles(0) AS TextArea
  24.  
  25. CONST True = -1, False = 0
  26. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  27. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  28. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  29. '********************************************************
  30. '* Text Frames before this line
  31. '********************************************************
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38. _CONSOLE ON 'for debugging purposes while making/testing things
  39.  
  40. TYPE Damage_Type
  41.     Low AS INTEGER
  42.     High AS INTEGER
  43.  
  44. TYPE Light_Type
  45.     Name AS STRING * 20
  46.     Reach AS _UNSIGNED _BYTE
  47.     Left AS _UNSIGNED _BYTE
  48.  
  49. TYPE Weapon_Type
  50.     Name AS STRING * 20
  51.     Reach AS _UNSIGNED _BYTE
  52.     Damage AS Damage_Type
  53.     HitBonus AS _UNSIGNED _BYTE
  54.     DamageBonus AS _UNSIGNED _BYTE
  55.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  56.  
  57. TYPE Armor_Type
  58.     Name AS STRING * 20
  59.     PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
  60.     DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
  61.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  62.  
  63. TYPE Hero_Type
  64.     Name AS STRING * 20
  65.     Life AS Damage_Type
  66.     Level AS _UNSIGNED _BYTE
  67.     EXP_Earned AS LONG
  68.     EXP_Needed AS LONG
  69.     Light AS Light_Type
  70.     Weapon1 AS Weapon_Type
  71.     Weapon2 AS Weapon_Type
  72.     Armor AS Armor_Type
  73.  
  74. TYPE Map_Identifer_TYPE
  75.     Symbol AS _UNSIGNED _BYTE
  76.  
  77. TYPE Monster_TYPE
  78.     Name AS STRING * 20
  79.     Life AS Damage_Type
  80.     Level AS INTEGER
  81.     ExpBonus AS INTEGER
  82.     Sight AS INTEGER
  83.     Hearing AS INTEGER
  84.     Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
  85.     Weapon1 AS Weapon_Type
  86.     Weapon2 AS Weapon_Type
  87.     Armor AS Armor_Type
  88.     ID AS Map_Identifer_TYPE
  89.  
  90. TYPE Encounter_TYPE
  91.     Active AS INTEGER
  92.     X AS INTEGER
  93.     Y AS INTEGER
  94.     M AS INTEGER
  95.     Life AS INTEGER
  96.  
  97. REDIM SHARED Monster(100) AS Monster_TYPE
  98. REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
  99.  
  100. DIM SHARED Hero AS Hero_Type
  101. DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
  102. DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
  103. DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
  104. DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG
  105. DIM SHARED TextFont
  106.  
  107. WorkScreen = _NEWIMAGE(800, 600, 32)
  108. DisplayScreen = _NEWIMAGE(800, 700, 32)
  109. SCREEN DisplayScreen
  110. Scale = 1
  111.  
  112. REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
  113. '1 map is illuminated
  114. '2 map is uncovered
  115. '4 map is a wall
  116. '8 map is a pathway
  117. '16 map is a stairway
  118. '32 map is simply blocked (perhaps with a monster?)
  119. '64 map is secret (can not be uncovered)
  120.  
  121. REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
  122.  
  123.  
  124.  
  125.  
  126.  
  127. Init
  128. CreateMap 99, 74, 10
  129.  
  130.     DrawMap
  131.     DisplayCharacter
  132.     _DISPLAY
  133.     GetInput
  134.     MonstersTurn
  135.     CheckForHeroGrowth
  136.  
  137. SUB Init
  138.     Hero.Name = "Steve The Tester!"
  139.     Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
  140.     Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
  141.     Hero.Light.Name = "Magic Candle"
  142.     Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
  143.     Hero.Weapon1.Name = "Bare Fist"
  144.     Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
  145.     Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
  146.     Hero.Weapon1.Left = -1 'your fist is indestructible!
  147.     Hero.Weapon2.Name = "Magic Candle"
  148.     Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
  149.     Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
  150.     Hero.Weapon2.Left = 0 'you can't attack with a candle
  151.     Hero.Armor.Name = "Naked"
  152.     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!
  153.  
  154.     PrintArea = NewTextArea(230, 601, 799, 699, False)
  155.     ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  156.     SetTextFont PrintArea, "courbd.ttf", 24
  157.     DrawTextArea PrintArea
  158.     SetPrintPositionX PrintArea, CenterJustify
  159.     SetPrintUpdate PrintArea, NewLine
  160.     PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
  161.     SetTextFont PrintArea, "courbd.ttf", 18
  162.     PrintOut PrintArea, "created by STEVE!"
  163.     PrintOut PrintArea, ""
  164.     SetPrintPositionX PrintArea, LeftJustify
  165.     TextFont = 18
  166.  
  167. SUB CheckForHeroGrowth
  168.     IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
  169.         BEEP
  170.         CLS
  171.         PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
  172.         _DELAY 5
  173.         SYSTEM
  174.     END IF
  175.  
  176.  
  177. SUB DisplayCharacter
  178.     LINE (0, 601)-(229, 799), &HFF000000, BF
  179.     COLOR &HFFFFFFFF, 0
  180.     _PRINTSTRING (0, 605), "HERO : " + Hero.Name
  181.     _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
  182.     _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
  183.     _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
  184.  
  185.     _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
  186.     _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
  187.     _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
  188.     _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
  189.  
  190. SUB GetInput
  191.     DO
  192.         k = _KEYHIT: valid = -1
  193.         SELECT CASE k
  194.             CASE 18432 'up
  195.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  196.                     Scale = Scale + .1
  197.                     IF Scale > 4 THEN Scale = 4
  198.                 ELSE
  199.                     IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
  200.                 END IF
  201.             CASE 19200: 'left
  202.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  203.                     TextFont = TextFont - 1
  204.                     IF TextFont < 8 THEN TextFont = 8
  205.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  206.                     ClearTextArea PrintArea
  207.                     SetPrintPosition PrintArea, 1, 1
  208.                     PrintOut PrintArea, "Font Size Changed"
  209.                 ELSE
  210.                     IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
  211.                 END IF
  212.             CASE 20480: 'down
  213.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  214.                     Scale = Scale - .1
  215.                     IF Scale < 1 THEN Scale = 1
  216.                 ELSE
  217.                     IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
  218.                 END IF
  219.             CASE 19712: 'right
  220.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  221.                     TextFont = TextFont + 1
  222.                     IF TextFont > 48 THEN TextFont = 48
  223.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  224.                     ClearTextArea PrintArea
  225.                     SetPrintPosition PrintArea, 1, 1
  226.                     PrintOut PrintArea, "Font Size Changed"
  227.                 ELSE
  228.                     IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
  229.                 END IF
  230.             CASE 32 'space to just wait and skip a turn
  231.             CASE 60 ' "<" key
  232.                 IF MapArray(Hero.X, Hero.Y) AND 16 THEN
  233.                     Level = Level + 1
  234.                     CreateMap 99, 74, 10
  235.                     PathFind
  236.                 END IF
  237.             CASE ASC("+"), ASC("=")
  238.                 IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
  239.             CASE ASC("-"), ASC("_")
  240.                 IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
  241.             CASE ELSE
  242.                 valid = 0 'it's a key press which we don't recognize.  Ignore it
  243.         END SELECT
  244.         _LIMIT 60
  245.     LOOP UNTIL k AND valid
  246.     _KEYCLEAR 'one keystroke at a time
  247.  
  248. SUB Box (X, Y, Wide, High, Caption AS STRING, Kolor AS _UNSIGNED LONG)
  249.     LINE (X, Y)-STEP(Wide, High), Kolor, BF
  250.     LINE (X, Y)-STEP(Wide, High), &HFFFFFFFF, B
  251.     pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
  252.     _PRINTSTRING (X + (Wide - pw) \ 2, Y + (High - ph) \ 2), Caption
  253.  
  254.  
  255. SUB MoveHero (MoveX, MoveY)
  256.     TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
  257.     IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
  258.         IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
  259.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
  260.             IF MoveX THEN Hero.X = Hero.X + MoveX
  261.             IF MoveY THEN Hero.Y = Hero.Y + MoveY
  262.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
  263.             PathFind
  264.         ELSE
  265.             '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!
  266.             FOR i = 1 TO EncounterLimit
  267.                 IF Encounter(i).Active THEN 'Check for active/alive monsters only
  268.                     MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  269.                     IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
  270.                         Swing 0, i, 1 'swing with the right hand
  271.                     END IF
  272.                 END IF
  273.             NEXT
  274.         END IF
  275.     END IF
  276.  
  277. SUB Swing (Who, AtWhom, HandUsed)
  278.     M = Encounter(AtWhom).M
  279.     BaseChancetohit = 10 'base 10 chance to hit
  280.     IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
  281.         IF Hero.Weapon1.Reach > 0 THEN 'it's a weapon and not an utility object being held.
  282.             Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
  283.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  284.             totalroll = 0
  285.             DO
  286.                 roll = INT(RND * 20) + 1
  287.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  288.                 IF roll = 20 THEN totalroll = totalroll + 20
  289.                 totalroll = totalroll + roll
  290.             LOOP UNTIL roll <> 1 AND roll <> 20
  291.             damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
  292.             damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
  293.             out$ = _TRIM$(Hero.Name)
  294.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  295.                 SetTextColor PrintArea, &HFFF000F0, 0
  296.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  297.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  298.                 Hero.Life.Low = Hero.Life.Low - damage
  299.             ELSEIF totalroll < Chancetohit THEN
  300.                 SetTextColor PrintArea, &HFFF0F000, 0
  301.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  302.             ELSEIF totalroll > Chancetohit + 20 THEN
  303.                 SetTextColor PrintArea, &HFF00FF00, 0
  304.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  305.                 damage = damage * (totalroll \ 20 + 1)
  306.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  307.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  308.             ELSEIF totalroll >= Chancetohit THEN
  309.                 SetTextColor PrintArea, &HFF00FF00, 0
  310.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  311.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
  312.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  313.             END IF
  314.             PrintOut PrintArea, out$
  315.         END IF
  316.         IF Hero.Weapon2.Reach > 0 THEN 'it's a weapon and not an utility object being held.
  317.             Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
  318.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  319.             totalroll = 0
  320.             DO
  321.                 roll = INT(RND * 20) + 1
  322.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  323.                 IF roll = 20 THEN totalroll = totalroll + 20
  324.                 totalroll = totalroll + roll
  325.             LOOP UNTIL roll <> 1 AND roll <> 20
  326.             damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
  327.             damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
  328.             out$ = _TRIM$(Hero.Name)
  329.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  330.                 SetTextColor PrintArea, &HFFF000F0, 0
  331.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  332.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  333.                 damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
  334.                 Hero.Life.Low = Hero.Life.Low - damage
  335.             ELSEIF totalroll < Chancetohit THEN
  336.                 SetTextColor PrintArea, &HFFF0F000, 0
  337.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  338.             ELSEIF totalroll > Chancetohit + 20 THEN
  339.                 SetTextColor PrintArea, &HFF00FF00, 0
  340.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  341.                 damage = damage * (totalroll \ 20 + 1)
  342.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  343.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  344.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  345.             ELSEIF totalroll >= Chancetohit THEN
  346.                 SetTextColor PrintArea, &HFF00FF00, 0
  347.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  348.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
  349.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  350.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  351.             END IF
  352.             PrintOut PrintArea, out$
  353.         END IF
  354.  
  355.         IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
  356.             SetTextColor PrintArea, &HFFFF0000, 0
  357.             out$ = _TRIM$(Monster(M).Name) + " died!"
  358.             PrintOut PrintArea, out$
  359.             Encounter(AtWhom).Active = 0
  360.             Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
  361.             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!
  362.  
  363.             RedSet = 128: 'GreenSet = 128: BlueSet = 128
  364.             IF Monster(M).ID.Symbol = 63 THEN 'it's a first time kill!
  365.                 TempArea = NewTextArea(200, 100, 600, 500, True)
  366.                 ColorTextArea TempArea, _RGB32(255, 255, 255), _RGB32(128, 128, 128)
  367.                 DrawTextArea TempArea
  368.                 SetPrintPositionX TempArea, CenterJustify
  369.                 SetPrintUpdate TempArea, NewLine
  370.                 SetTextColor TempArea, &HFFFFFFFF, 0
  371.                 out$ = "CONGRATULATIONS!  You just killed " + _TRIM$(Monster(M).Name) + " for the first time!"
  372.                 PrintOut TempArea, out$
  373.                 DO
  374.                     SetTextColor TempArea, _RGB32(RedSet, GreenSet, BlueSet), 0
  375.                     COLOR _RGB32(RedSet, GreenSet, BlueSet), 0
  376.                     FOR y = 0 TO 15
  377.                         FOR x = 0 TO 15
  378.                             Box x * 16 + 275, y * 16 + 150, 16, 16, CHR$(y * 16 + x), _RGB32(200, 200, 200)
  379.                         NEXT
  380.                     NEXT
  381.                     Box 275, 425, 256, 20, "", _RGB32(200, 200, 200)
  382.                     Box 275, 425, RedSet, 20, "", _RGB32(255, 0, 0)
  383.                     Box 275, 450, 256, 20, "", _RGB32(200, 200, 200)
  384.                     Box 275, 450, GreenSet, 20, "", _RGB32(0, 256, 0)
  385.                     Box 275, 475, 256, 20, "", _RGB32(200, 200, 200)
  386.                     Box 275, 475, BlueSet, 20, "", _RGB32(0, 0, 256)
  387.                     _DISPLAY
  388.                     WHILE _MOUSEINPUT: WEND
  389.                     IF _MOUSEBUTTON(1) THEN
  390.                         IF _MOUSEX > 250 AND _MOUSEX < 556 THEN 'we're clicked at the right mouse coordinate
  391.                             SELECT CASE _MOUSEY
  392.                                 CASE 425 TO 445
  393.                                     RedSet = _MOUSEX - 275
  394.                                     IF RedSet < 0 THEN RedSet = 0
  395.                                     IF RedSet > 255 THEN RedSet = 255
  396.                                 CASE 450 TO 470
  397.                                     GreenSet = _MOUSEX - 275
  398.                                     IF GreenSet < 0 THEN GreenSet = 0
  399.                                     IF GreenSet > 255 THEN GreenSet = 255
  400.                                 CASE 475 TO 495
  401.                                     BlueSet = _MOUSEX - 275
  402.                                     IF BlueSet < 0 THEN BlueSet = 0
  403.                                     IF BlueSet > 255 THEN BlueSet = 255
  404.                             END SELECT
  405.                         END IF
  406.                     END IF
  407.                     _LIMIT 60
  408.                 LOOP
  409.  
  410.             END IF
  411.         END IF
  412.     ELSE 'it's a monster attacking
  413.  
  414.     END IF
  415.  
  416.  
  417. FUNCTION MoveMonster (Monster, MoveX, MoveY)
  418.     MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
  419.     D = Distance(MX, MY) 'distance from monster to the hero
  420.     E = Encounter(i).M 'the actual monster in question
  421.  
  422.     IF D > Distance(MX + MoveX, MY + MoveY) THEN
  423.         IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
  424.             MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
  425.             Encounter(Monster).X = Encounter(Monster).X + MoveX
  426.             Encounter(Monster).Y = Encounter(Monster).Y + MoveY
  427.             MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
  428.             MoveMonster = -1
  429.         END IF
  430.     END IF
  431.  
  432.  
  433.  
  434. SUB MonstersTurn
  435.     FOR i = 1 TO EncounterLimit
  436.         IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
  437.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  438.             D = Distance(MX, MY) 'distance from monster to the hero
  439.             E = Encounter(i).M 'the actual monster in question
  440.             IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
  441.  
  442.                 attack = 0
  443.                 IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
  444.                     'insert attack code here
  445.  
  446.                     _TITLE "ATTACK!"
  447.                     _CONTINUE
  448.                 END IF
  449.                 IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
  450.                     'insert attack code here
  451.                     _CONTINUE
  452.                 END IF
  453.  
  454.                 IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
  455.                     IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
  456.                         IF D > Distance(MX - 1, MY) THEN
  457.                             IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
  458.                         END IF
  459.                     END IF
  460.                     IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
  461.                         IF D > Distance(MX, MY - 1) THEN
  462.                             IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
  463.                         END IF
  464.                     END IF
  465.                     IF MX < XH THEN 'check to see if moving right moves us towards the hero.
  466.                         IF D > Distance(MX + 1, MY) THEN
  467.                             IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
  468.                         END IF
  469.                     END IF
  470.                     IF MY < YH THEN 'check to see if moving down moves us towards the hero.
  471.                         IF D > Distance(MX, MY + 1) THEN
  472.                             IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
  473.                         END IF
  474.                     END IF
  475.                 END IF
  476.             END IF
  477.         END IF
  478.  
  479.     NEXT
  480.  
  481.  
  482.  
  483.  
  484. SUB DrawMap
  485.     _DEST WorkScreen
  486.     _FONT 8
  487.     LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
  488.     FOR Y = 0 TO YH
  489.         FOR X = 0 TO XH
  490.             IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
  491.                 IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
  492.             END IF
  493.             IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
  494.                 IF MapArray(X, Y) AND 4 THEN 'it's a visible room
  495.                     COLOR &HFF000000, 0
  496.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
  497.                 END IF
  498.                 IF MapArray(X, Y) AND 8 THEN 'it's a visible path
  499.                     COLOR &HFF000000, &HFF777777
  500.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
  501.                 END IF
  502.                 IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
  503.                     COLOR &HFF00FF00, &HFFFFFF00
  504.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
  505.                 END IF
  506.             END IF
  507.             'note: highlighting for the light should come AFTER the map is drawn
  508.             IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
  509.                 COLOR &H40FFFF00, 0
  510.                 _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
  511.                 MapArray(X, Y) = MapArray(X, Y) - 1
  512.                 FOR i = 1 TO EncounterLimit
  513.                     IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
  514.                         E = Encounter(i).M
  515.                         COLOR Monster(E).ID.Color
  516.                         _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(Monster(E).ID.Symbol)
  517.                     END IF
  518.                 NEXT
  519.  
  520.             END IF
  521.         NEXT
  522.     NEXT
  523.     COLOR &HFFFFFF00, 0 'Yellow Hero
  524.     _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
  525.     XOffset## = 400 / Scale
  526.     YOffset## = 300 / Scale
  527.     CenterX = Hero.X * 8 'convert hero coordinate to grid coordinate
  528.     CenterY = Hero.Y * 8
  529.     _DEST DisplayScreen
  530.     LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
  531.     _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
  532.  
  533.  
  534.  
  535.  
  536.  
  537. SUB CreateMap (XLimit, YLimit, Rooms)
  538.     ERASE MapArray 'clear the old map and reset everything to 0
  539.     REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
  540.     REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
  541.     REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
  542.     XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
  543.  
  544.     DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
  545.  
  546.     FOR i = 1 TO Rooms
  547.         DO
  548.             RoomSize = INT(RND * 9) + 2
  549.             RoomX = INT(RND * (XLimit - RoomSize))
  550.             RoomY = INT(RND * (YLimit - RoomSize))
  551.             'test for positioning
  552.             good = -1 'it's good starting out
  553.             FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  554.                     IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
  555.             NEXT X, Y
  556.         LOOP UNTIL good
  557.         FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  558.                 MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
  559.         NEXT X, Y
  560.         RoomCenterX(i) = RoomX + .5 * RoomSize
  561.         RoomCenterY(i) = RoomY + .5 * RoomSize
  562.     NEXT
  563.     FOR i = 1 TO Rooms - 1
  564.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  565.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  566.         DO UNTIL StartX = EndX AND StartY = EndY
  567.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  568.             Meander = 10
  569.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  570.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  571.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  572.                     Ychange = 0
  573.                 ELSE
  574.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  575.                     Ychange = 0
  576.                 END IF
  577.             ELSE
  578.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  579.                     Ychange = SGN(EndY - StartY)
  580.                     XChange = 0
  581.                 ELSE
  582.                     Ychange = INT(RND * 3) - 1
  583.                     XChange = 0
  584.                 END IF
  585.             END IF
  586.             StartX = StartX + XChange
  587.             StartY = StartY + Ychange
  588.             IF StartX < 0 THEN StartX = 0
  589.             IF StartY < 0 THEN StartY = 0
  590.             IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
  591.             IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
  592.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
  593.         LOOP
  594.     NEXT
  595.     DO
  596.         Hero.X = INT(RND * XLimit + 1)
  597.         Hero.Y = INT(RND * YLimit + 1)
  598.     LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
  599.     MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
  600.     DO
  601.         X = INT(RND * XLimit + 1)
  602.         Y = INT(RND * YLimit + 1)
  603.     LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
  604.     MapArray(X, Y) = MapArray(X, Y) OR 16
  605.     PathFind
  606.     EncounterLimit = INT(RND * 6) + 5
  607.     FOR i = 1 TO EncounterLimit
  608.         Encounter(i).M = RandomMonster
  609.         Encounter(i).Active = -1
  610.         Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
  611.         valid = -1
  612.         DO
  613.             Encounter(i).X = INT(RND * XLimit + 1)
  614.             Encounter(i).Y = INT(RND * YLimit + 1)
  615.             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.)
  616.         LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
  617.         MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
  618.     NEXT
  619.  
  620. SUB PathFind
  621.     STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
  622.     DIM pass AS _UNSIGNED _BYTE
  623.     m = _MEM(Distance()): m1 = _MEM(Temp())
  624.     _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
  625.     _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
  626.     Temp(Hero.X, Hero.Y) = 0
  627.     pass = 0
  628.     DO
  629.         changed = 0
  630.         y = 0
  631.         DO
  632.             x = 0
  633.             DO
  634.                 IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
  635.                     IF x < XH THEN
  636.                         IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  637.                     END IF
  638.                     IF x > 0 THEN
  639.                         IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  640.                     END IF
  641.                     IF y < YH THEN
  642.                         IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  643.                     END IF
  644.                     IF y > 0 THEN
  645.                         IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  646.                     END IF
  647.                 END IF
  648.                 x = x + 1
  649.             LOOP UNTIL x > XH
  650.             y = y + 1
  651.         LOOP UNTIL y > YH
  652.         _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
  653.         pass = pass + 1
  654.     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!
  655.     Distance(Hero.X, Hero.Y) = 0
  656.  
  657. FUNCTION RandomMonster
  658.     'Shared variable level tells us what level of the dungeon we're on.
  659.     STATIC MC, DS 'monster count and data set
  660.     IF NOT DS THEN
  661.         DS = -1
  662.         Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
  663.         Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
  664.         Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
  665.         Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
  666.         'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
  667.         'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
  668.         'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
  669.         'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
  670.         'Monster(1).Armor.Name = ""
  671.         'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
  672.  
  673.         Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
  674.         Monster(2).Level = 1: Monster(2).ExpBonus = 0
  675.         Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
  676.         Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
  677.         Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
  678.         Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
  679.         Monster(3).Level = 1: Monster(3).ExpBonus = 0
  680.         Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
  681.         Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
  682.         Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
  683.         FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
  684.             Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
  685.         NEXT
  686.     END IF
  687.     SELECT CASE Level 'the starting level
  688.         CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
  689.     END SELECT
  690.     RandomMonster = INT(RND * MC) + 1
  691.  
  692.  
  693. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  694. '# SUBroutines and FUNCTIONs below #'
  695. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  696. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  697.     u = UBOUND(TextHandles)
  698.     Handle = WhichHandle
  699.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  700.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  701.     Where = TextHandles(Handle).VerticalAlignment
  702.     How = TextHandles(Handle).Justification
  703.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  704.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  705.  
  706.  
  707. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  708.     'WhichHandle is the handle which designates which text area we want to use
  709.     'Where is where we want it to go in that text area
  710.     '  -- Online prints the text to the current print position line in that text area.
  711.     '  -- CenterLine centers the text to the center of that text area.
  712.     '  -- any other value will print to that line positon in that particular box.
  713.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  714.     'What is the text that we want to print in our text area
  715.     '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).
  716.  
  717.     D = _DEST: S = _SOURCE
  718.     F = _FONT
  719.  
  720.     u = UBOUND(TextHandles)
  721.     Handle = WhichHandle
  722.  
  723.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  724.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  725.     IF TextHandles(Handle).HideFrame THEN
  726.         _DEST TextHandles(Handle).SavedBackground
  727.         _SOURCE TextHandles(Handle).SavedBackground
  728.     END IF
  729.     _FONT TextHandles(Handle).Font
  730.     fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
  731.     h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
  732.  
  733.     SELECT CASE Where
  734.         CASE BottomLine
  735.             y = h \ fh
  736.         CASE OnLine
  737.             y = TextHandles(Handle).Ypos
  738.             IF y = 0 THEN y = 1
  739.         CASE CenterLine
  740.             linesused = 0
  741.             tpw = pw: tw = w: tWhat$ = What
  742.             DO UNTIL tpw <= tw
  743.                 textallowed = WordBreak(LEFT$(tWhat$, w \ _FONTWIDTH))
  744.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  745.                 linesused = linesused + 1
  746.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  747.                 tpw = _PRINTWIDTH(tWhat$)
  748.             LOOP
  749.             linesused = linesused + 1
  750.             py = (h - linesused * fh) \ 2
  751.             y = py \ fh + 1
  752.             IF y < 1 THEN y = 1
  753.         CASE ELSE
  754.             y = Where
  755.     END SELECT
  756.  
  757.     IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  758.     blend = _BLEND
  759.     DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  760.         'first let's get a temp image handle for the existing area of the screen.
  761.         x1 = TextHandles(Handle).x1 + 2
  762.         y1 = TextHandles(Handle).y1 + 2
  763.         x2 = TextHandles(Handle).x1 + w
  764.         y2 = TextHandles(Handle).y1 + h
  765.         nh = y2 - y1 + 1 - fh
  766.         nw = x2 - x1 + 1
  767.         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.
  768.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  769.         DrawTextArea Handle
  770.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  771.         y = y - 1
  772.     LOOP
  773.     IF blend THEN _BLEND
  774.  
  775.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  776.  
  777.     SELECT CASE How
  778.         CASE LeftJustify
  779.             x = 0
  780.             IF pw > w THEN
  781.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  782.                 text$ = RTRIM$(LEFT$(What, textallowed))
  783.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  784.                 PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
  785.             ELSE
  786.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  787.                 finished = -1
  788.             END IF
  789.         CASE CenterJustify
  790.             IF pw > w THEN
  791.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  792.                 text$ = RTRIM$(LEFT$(What, textallowed))
  793.                 x = (w - _PRINTWIDTH(text$)) \ 2
  794.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  795.                 PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  796.             ELSE
  797.                 x = (w - pw) \ 2
  798.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  799.                 finished = -1
  800.             END IF
  801.         CASE RightJustify
  802.             IF pw > w THEN
  803.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  804.                 text$ = RTRIM$(LEFT$(What, textallowed))
  805.                 x = w - _PRINTWIDTH(text$)
  806.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  807.                 PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
  808.             ELSE
  809.                 x = w - pw
  810.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  811.                 finished = -1
  812.             END IF
  813.         CASE NoJustify
  814.             x = TextHandles(Handle).Xpos
  815.             firstlinelimit = (w - x) \ _FONTWIDTH 'the limit of characters on the first line
  816.             IF LEN(What) > firstlinelimit THEN
  817.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  818.                 text$ = RTRIM$(LEFT$(What, textallowed))
  819.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  820.                 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
  821.             ELSE
  822.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  823.                 finished = -1
  824.             END IF
  825.     END SELECT
  826.  
  827.     IF finished THEN
  828.         SELECT CASE TextHandles(Handle).UpdateMethod
  829.             CASE NoUpdate 'We don't update the position at all.
  830.             CASE DoUpdate
  831.                 TextHandles(Handle).Xpos = x + pw
  832.                 TextHandles(Handle).Ypos = y
  833.             CASE NewLine
  834.                 TextHandles(Handle).Ypos = y + 1
  835.                 TextHandles(Handle).Xpos = 1
  836.         END SELECT
  837.         _FONT F
  838.         _DEST D: _SOURCE S
  839.         COLOR FG, BG
  840.     END IF
  841.  
  842. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  843.     u = UBOUND(TextHandles)
  844.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  845.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  846.     TextHandles(Handle).TextColor = Foreground
  847.  
  848.  
  849. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  850.     u = UBOUND(TextHandles)
  851.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  852.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  853.     TextHandles(Handle).TextBackgroundColor = Background
  854.  
  855. SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
  856.     u = UBOUND(TextHandles)
  857.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  858.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  859.     SELECT CASE TextHandles(Handle).Font
  860.         CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
  861.         CASE IS > 1
  862.             'we have the font already in use
  863.             'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
  864.             _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
  865.     END SELECT
  866.  
  867.     temp = _LOADFONT(FontName, FontSize, "monospace")
  868.     IF temp > 1 THEN
  869.         TextHandles(Handle).Font = temp
  870.     ELSE
  871.         TextHandles(Handle).Font = 16 'default to font 16, in case
  872.     END IF
  873.  
  874.  
  875. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  876.     u = UBOUND(TextHandles)
  877.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  878.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  879.     TextHandles(Handle).TextColor = Foreground
  880.     TextHandles(Handle).TextBackgroundColor = Background
  881.  
  882.  
  883. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  884.     u = UBOUND(TextHandles)
  885.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  886.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  887.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  888.     TextHandles(Handle).UpdateMethod = Method
  889.  
  890.  
  891. SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
  892.     u = UBOUND(TextHandles)
  893.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  894.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  895.     SELECT CASE Y
  896.         CASE BottomLine
  897.             TextHandles(Handle).VerticalAlignment = -2
  898.         CASE CenterLine
  899.             TextHandles(Handle).VerticalAlignment = -1
  900.         CASE ELSE
  901.             TextHandles(Handle).VerticalAlignment = 0
  902.     END SELECT
  903.     IF X < 1 AND X > -4 THEN
  904.         TextHandles(Handle).Justification = X
  905.     ELSE
  906.         TextHandles(Handle).Xpos = X
  907.     END IF
  908.     IF Y < 1 THEN EXIT SUB
  909.     TextHandles(Handle).Ypos = Y
  910.  
  911. SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
  912.     u = UBOUND(TextHandles)
  913.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  914.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  915.     IF X < 1 AND X > -4 THEN
  916.         TextHandles(Handle).Justification = X
  917.     ELSE
  918.         TextHandles(Handle).Xpos = X
  919.     END IF
  920.  
  921. SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
  922.     u = UBOUND(TextHandles)
  923.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  924.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  925.     SELECT CASE Y
  926.         CASE BottomLine
  927.             TextHandles(Handle).VerticalAlignment = -2
  928.         CASE CenterLine
  929.             TextHandles(Handle).VerticalAlignment = -1
  930.         CASE ELSE
  931.             TextHandles(Handle).VerticalAlignment = 0
  932.     END SELECT
  933.     IF Y < 1 THEN EXIT SUB
  934.     TextHandles(Handle).Ypos = Y
  935.  
  936.  
  937. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  938.     u = UBOUND(TextHandles)
  939.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  940.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  941.     GetPrintPositionY = TextHandles(Handle).Ypos
  942.  
  943. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  944.     u = UBOUND(TextHandles)
  945.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  946.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  947.     GetPrintPositionX = TextHandles(Handle).Xpos
  948.  
  949.  
  950.  
  951. FUNCTION WordBreak (text$)
  952.     CONST Breaks = " ;,.?!-"
  953.     FOR i = LEN(text$) TO 0 STEP -1
  954.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  955.         loopcount = loopcount + 1
  956.     NEXT
  957.     IF i = 0 THEN i = LEN(text$)
  958.     WordBreak = i
  959.  
  960.  
  961.  
  962. SUB ClearTextArea (Handle AS INTEGER)
  963.     u = UBOUND(TextHandles)
  964.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  965.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  966.     IF TextHandles(Handle).SavedBackground THEN
  967.         w = TextHandles(Handle).w
  968.         h = TextHandles(Handle).h
  969.         x1 = TextHandles(Handle).ScreenX
  970.         y1 = TextHandles(Handle).ScreenY
  971.         x2 = x1 + w - 1
  972.         y2 = y1 + h - 1
  973.         blend = _BLEND
  974.         _DONTBLEND
  975.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  976.         IF blend THEN _BLEND
  977.     END IF
  978.     DrawTextArea Handle
  979.  
  980.  
  981.  
  982. SUB DrawTextArea (Handle AS INTEGER)
  983.     u = UBOUND(TextHandles)
  984.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  985.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  986.     w = TextHandles(Handle).w
  987.     h = TextHandles(Handle).h
  988.     x1 = TextHandles(Handle).ScreenX
  989.     y1 = TextHandles(Handle).ScreenY
  990.     x2 = x1 + w - 1
  991.     y2 = y1 + h - 1
  992.  
  993.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  994.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  995.  
  996.  
  997.  
  998. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  999.     u = UBOUND(TextHandles)
  1000.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1001.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1002.     TextHandles(Handle).FrameColor = FrameColor
  1003.     TextHandles(Handle).BackColor = BackColor
  1004.  
  1005.  
  1006.  
  1007. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  1008.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  1009.     x2 = tx2: y2 = ty2
  1010.     IF x1 > x2 THEN SWAP x1, x2
  1011.     IF y1 > y2 THEN SWAP y1, y2
  1012.     w = x2 - x1 + 1
  1013.     h = y2 - y1 + 1
  1014.     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
  1015.     'Error checking for if the user sends coordinates which are off the screen
  1016.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  1017.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  1018.  
  1019.     u = UBOUND(TextHandles)
  1020.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  1021.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  1022.     NEXT
  1023.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  1024.         Handle = u + 1
  1025.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  1026.     END IF
  1027.     TextHandles(Handle).x1 = x1
  1028.     TextHandles(Handle).y1 = y1
  1029.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  1030.     TextHandles(Handle).InUse = True
  1031.     TextHandles(Handle).Xpos = 0
  1032.     TextHandles(Handle).Ypos = 1
  1033.     TextHandles(Handle).UpdateMethod = NewLine
  1034.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  1035.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  1036.  
  1037.     IF SaveBackground THEN
  1038.         imagehandle = _NEWIMAGE(w, h, 32)
  1039.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1040.         TextHandles(Handle).SavedBackground = imagehandle
  1041.     END IF
  1042.     TextHandles(Handle).ScreenX = x1
  1043.     TextHandles(Handle).ScreenY = y1
  1044.     TextHandles(Handle).Font = 16 'default to font 16
  1045.     NewTextArea% = Handle
  1046.  
  1047. SUB FreeTextArea (Handle AS INTEGER)
  1048.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  1049.         IF TextHandles(Handle).InUse THEN
  1050.             TextHandles(Handle).InUse = False
  1051.             IF TextHandles(Handle).SavedBackground THEN
  1052.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  1053.                     w = TextHandles(Handle).w
  1054.                     h = TextHandles(Handle).h
  1055.                     x1 = TextHandles(Handle).ScreenX
  1056.                     y1 = TextHandles(Handle).ScreenY
  1057.                     x2 = x1 + w - 1
  1058.                     y2 = y1 + h - 1
  1059.                     blend = _BLEND
  1060.                     _DONTBLEND
  1061.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1062.                     IF blend THEN _BLEND
  1063.                 END IF
  1064.                 '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.
  1065.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  1066.             END IF
  1067.         ELSE
  1068.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  1069.         END IF
  1070.     ELSE
  1071.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  1072.     END IF
  1073.  
  1074. SUB HideFrame (Handle AS INTEGER)
  1075.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  1076.         TextHandles(Handle).HideFrame = -1
  1077.         w = TextHandles(Handle).w
  1078.         h = TextHandles(Handle).h
  1079.         x1 = TextHandles(Handle).ScreenX
  1080.         y1 = TextHandles(Handle).ScreenY
  1081.         x2 = x1 + w - 1
  1082.         y2 = y1 + h - 1
  1083.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1084.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1085.         IF TextHandles(Handle).SavedBackground THEN
  1086.             blend = _BLEND
  1087.             _DONTBLEND
  1088.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1089.             _FREEIMAGE TextHandles(Handle).SavedBackground
  1090.             IF blend THEN _BLEND
  1091.         END IF
  1092.         TextHandles(Handle).SavedBackground = imagehandle
  1093.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  1094.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  1095.     END IF
  1096.  
  1097. SUB RestoreFrame (Handle AS INTEGER)
  1098.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  1099.         TextHandles(Handle).HideFrame = 0
  1100.         w = TextHandles(Handle).w
  1101.         h = TextHandles(Handle).h
  1102.         x1 = TextHandles(Handle).ScreenX
  1103.         y1 = TextHandles(Handle).ScreenY
  1104.         x2 = x1 + w - 1
  1105.         y2 = y1 + h - 1
  1106.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1107.         blend = _BLEND
  1108.         _DONTBLEND
  1109.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1110.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  1111.         _FREEIMAGE TextHandles(Handle).SavedBackground
  1112.         IF blend THEN _BLEND
  1113.         TextHandles(Handle).SavedBackground = imagehandle
  1114.         TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
  1115.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  1116.     END IF
  1117.  
  1118. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  1119.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  1120.     u = UBOUND(TextHandles)
  1121.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1122.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1123.     HideFrame Handle
  1124.     TextHandles(Handle).ScreenX = x1
  1125.     TextHandles(Handle).ScreenY = y1
  1126.     RestoreFrame Handle

(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
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rogue-Like (work in progress)
« Reply #18 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).
« Last Edit: September 12, 2019, 10:33:33 am by bplus »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #19 on: September 12, 2019, 10:44:27 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. :)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #20 on: September 12, 2019, 12:41:48 pm »
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]
  1. DEFLNG A-Z 'default to long instead of single
  2. TYPE TextArea
  3.     InUse AS INTEGER
  4.     x1 AS LONG 'left
  5.     y1 AS LONG 'top
  6.     w AS LONG 'width
  7.     h AS LONG 'height
  8.     FrameColor AS _UNSIGNED LONG
  9.     BackColor AS _UNSIGNED LONG
  10.     Xpos AS INTEGER
  11.     Ypos AS INTEGER
  12.     VerticalAlignment AS INTEGER
  13.     Justification AS INTEGER
  14.     UpdateMethod AS INTEGER
  15.     TextColor AS _UNSIGNED LONG
  16.     TextBackgroundColor AS _UNSIGNED LONG
  17.     SavedBackground AS INTEGER
  18.     HideFrame AS INTEGER
  19.     ScreenX AS INTEGER
  20.     ScreenY AS INTEGER
  21.     Font AS LONG 'NEW! Change fonts for each independent font area
  22.  
  23. REDIM SHARED TextHandles(0) AS TextArea
  24.  
  25. CONST True = -1, False = 0
  26. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  27. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  28. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  29. '********************************************************
  30. '* Text Frames before this line
  31. '********************************************************
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38. _CONSOLE ON 'for debugging purposes while making/testing things
  39.  
  40. TYPE Damage_Type
  41.     Low AS INTEGER
  42.     High AS INTEGER
  43.  
  44. TYPE Light_Type
  45.     Name AS STRING * 20
  46.     Reach AS _UNSIGNED _BYTE
  47.     Left AS _UNSIGNED _BYTE
  48.  
  49. TYPE Weapon_Type
  50.     Name AS STRING * 20
  51.     Reach AS _UNSIGNED _BYTE
  52.     Damage AS Damage_Type
  53.     HitBonus AS _UNSIGNED _BYTE
  54.     DamageBonus AS _UNSIGNED _BYTE
  55.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  56.  
  57. TYPE Armor_Type
  58.     Name AS STRING * 20
  59.     PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
  60.     DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
  61.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  62.  
  63. TYPE Hero_Type
  64.     Name AS STRING * 20
  65.     Life AS Damage_Type
  66.     Level AS _UNSIGNED _BYTE
  67.     EXP_Earned AS LONG
  68.     EXP_Needed AS LONG
  69.     Light AS Light_Type
  70.     Weapon1 AS Weapon_Type
  71.     Weapon2 AS Weapon_Type
  72.     Armor AS Armor_Type
  73.  
  74. TYPE Map_Identifer_TYPE
  75.     Symbol AS _UNSIGNED _BYTE
  76.  
  77. TYPE Monster_TYPE
  78.     Name AS STRING * 20
  79.     Life AS Damage_Type
  80.     Level AS INTEGER
  81.     ExpBonus AS INTEGER
  82.     Sight AS INTEGER
  83.     Hearing AS INTEGER
  84.     Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
  85.     Weapon1 AS Weapon_Type
  86.     Weapon2 AS Weapon_Type
  87.     Armor AS Armor_Type
  88.     ID AS Map_Identifer_TYPE
  89.  
  90. TYPE Encounter_TYPE
  91.     Active AS INTEGER
  92.     X AS INTEGER
  93.     Y AS INTEGER
  94.     M AS INTEGER
  95.     Life AS INTEGER
  96.  
  97. REDIM SHARED Monster(100) AS Monster_TYPE
  98. REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
  99.  
  100. DIM SHARED Hero AS Hero_Type
  101. DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
  102. DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
  103. DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
  104. DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG
  105. DIM SHARED TextFont
  106.  
  107. WorkScreen = _NEWIMAGE(800, 600, 32)
  108. DisplayScreen = _NEWIMAGE(800, 700, 32)
  109. SCREEN DisplayScreen
  110. Scale = 1
  111.  
  112. REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
  113. '1 map is illuminated
  114. '2 map is uncovered
  115. '4 map is a wall
  116. '8 map is a pathway
  117. '16 map is a stairway
  118. '32 map is simply blocked (perhaps with a monster?)
  119. '64 map is secret (can not be uncovered)
  120.  
  121. REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
  122.  
  123.  
  124.  
  125. ON ERROR GOTO errorhandler
  126.  
  127. GOTO skiperrorhandler
  128. errorhandler:
  129.  
  130. PRINT ERR; "Error on "; _ERRORLINE
  131. _DEST DisplayScreen
  132. skiperrorhandler:
  133.  
  134. Init
  135. CreateMap 99, 74, 10
  136.  
  137.     DrawMap
  138.     DisplayCharacter
  139.     _DISPLAY
  140.     GetInput
  141.     MonstersTurn
  142.     CheckForHeroGrowth
  143.  
  144. SUB Init
  145.     Hero.Name = "Steve The Tester!"
  146.     Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
  147.     Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
  148.     Hero.Light.Name = "Magic Candle"
  149.     Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
  150.     Hero.Weapon1.Name = "Bare Fist"
  151.     Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
  152.     Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
  153.     Hero.Weapon1.Left = -1 'your fist is indestructible!
  154.     Hero.Weapon2.Name = "Magic Candle"
  155.     Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
  156.     Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
  157.     Hero.Weapon2.Left = 0 'you can't attack with a candle
  158.     Hero.Armor.Name = "Naked"
  159.     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!
  160.  
  161.     PrintArea = NewTextArea(230, 601, 799, 699, False)
  162.     ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  163.     SetTextFont PrintArea, "courbd.ttf", 24
  164.     DrawTextArea PrintArea
  165.     SetPrintPositionX PrintArea, CenterJustify
  166.     SetPrintUpdate PrintArea, NewLine
  167.     PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
  168.     SetTextFont PrintArea, "courbd.ttf", 18
  169.     PrintOut PrintArea, "created by STEVE!"
  170.     PrintOut PrintArea, ""
  171.     SetPrintPositionX PrintArea, LeftJustify
  172.     SetTextFont PrintArea, "courbd.ttf", 14
  173.     TextFont = 14
  174.  
  175. SUB CheckForHeroGrowth
  176.     IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
  177.         BEEP
  178.         CLS
  179.         PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
  180.         _DELAY 5
  181.         SYSTEM
  182.     END IF
  183.  
  184.  
  185. SUB DisplayCharacter
  186.     LINE (0, 601)-(229, 799), &HFF000000, BF
  187.     COLOR &HFFFFFFFF, 0
  188.     _PRINTSTRING (0, 605), "HERO : " + Hero.Name
  189.     _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
  190.     _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
  191.     _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
  192.  
  193.     _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
  194.     _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
  195.     _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
  196.     _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
  197.  
  198. SUB GetInput
  199.     DO
  200.         k = _KEYHIT: valid = -1
  201.         SELECT CASE k
  202.             CASE 18432 'up
  203.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  204.                     Scale = Scale + .1
  205.                     IF Scale > 4 THEN Scale = 4
  206.                 ELSE
  207.                     IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
  208.                 END IF
  209.             CASE 19200: 'left
  210.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  211.                     TextFont = TextFont - 1
  212.                     IF TextFont < 8 THEN TextFont = 8
  213.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  214.                     ClearTextArea PrintArea
  215.                     SetPrintPosition PrintArea, 1, 1
  216.                     PrintOut PrintArea, "Font Size Changed"
  217.                 ELSE
  218.                     IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
  219.                 END IF
  220.             CASE 20480: 'down
  221.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  222.                     Scale = Scale - .1
  223.                     IF Scale < 1 THEN Scale = 1
  224.                 ELSE
  225.                     IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
  226.                 END IF
  227.             CASE 19712: 'right
  228.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  229.                     TextFont = TextFont + 1
  230.                     IF TextFont > 48 THEN TextFont = 48
  231.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  232.                     ClearTextArea PrintArea
  233.                     SetPrintPosition PrintArea, 1, 1
  234.                     PrintOut PrintArea, "Font Size Changed"
  235.                 ELSE
  236.                     IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
  237.                 END IF
  238.             CASE 32 'space to just wait and skip a turn
  239.             CASE 60 ' "<" key
  240.                 IF MapArray(Hero.X, Hero.Y) AND 16 THEN
  241.                     Level = Level + 1
  242.                     CreateMap 99, 74, 10
  243.                     PathFind
  244.                 END IF
  245.             CASE ASC("+"), ASC("=")
  246.                 IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
  247.             CASE ASC("-"), ASC("_")
  248.                 IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
  249.             CASE ELSE
  250.                 valid = 0 'it's a key press which we don't recognize.  Ignore it
  251.         END SELECT
  252.         _LIMIT 60
  253.     LOOP UNTIL k AND valid
  254.     _KEYCLEAR 'one keystroke at a time
  255.  
  256. SUB Box (X, Y, Wide, High, Caption AS STRING, Kolor AS _UNSIGNED LONG)
  257.     LINE (X, Y)-STEP(Wide, High), Kolor, BF
  258.     LINE (X, Y)-STEP(Wide, High), &HFFFFFFFF, B
  259.     pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
  260.     _PRINTSTRING (X + (Wide - pw) \ 2, Y + (High - ph) \ 2), Caption
  261.  
  262.  
  263. SUB MoveHero (MoveX, MoveY)
  264.     TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
  265.     IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
  266.         IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
  267.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
  268.             IF MoveX THEN Hero.X = Hero.X + MoveX
  269.             IF MoveY THEN Hero.Y = Hero.Y + MoveY
  270.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
  271.             PathFind
  272.         ELSE
  273.             '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!
  274.  
  275.             FOR i = 1 TO EncounterLimit
  276.                 IF Encounter(i).Active THEN 'Check for active/alive monsters only
  277.                     MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  278.                     IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
  279.                         Swing 0, i 'hero swings at the monster
  280.                     END IF
  281.                 END IF
  282.             NEXT
  283.         END IF
  284.     END IF
  285.  
  286. SUB Swing (Who, AtWhom)
  287.     M = Encounter(AtWhom).M
  288.     BaseChancetohit = 10 'base 10 chance to hit
  289.  
  290.     IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
  291.         IF Hero.Weapon1.Reach > 0 THEN 'it's a weapon and not an utility object being held.
  292.             Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
  293.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  294.             totalroll = 0
  295.             DO
  296.                 roll = INT(RND * 20) + 1
  297.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  298.                 IF roll = 20 THEN totalroll = totalroll + 20
  299.                 totalroll = totalroll + roll
  300.             LOOP UNTIL roll <> 1 AND roll <> 20
  301.             damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
  302.             damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
  303.             out$ = _TRIM$(Hero.Name)
  304.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  305.                 SetTextColor PrintArea, &HFFF000F0, 0
  306.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  307.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  308.                 Hero.Life.Low = Hero.Life.Low - damage
  309.             ELSEIF totalroll < Chancetohit THEN
  310.                 SetTextColor PrintArea, &HFFF0F000, 0
  311.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  312.             ELSEIF totalroll > Chancetohit + 20 THEN
  313.                 SetTextColor PrintArea, &HFF00FF00, 0
  314.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  315.                 damage = damage * (totalroll / 20 + 1)
  316.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  317.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  318.             ELSEIF totalroll >= Chancetohit THEN
  319.                 SetTextColor PrintArea, &HFF00FF00, 0
  320.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  321.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
  322.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  323.             END IF
  324.             PrintOut PrintArea, out$
  325.         END IF
  326.         IF Hero.Weapon2.Reach > 0 THEN 'it's a weapon and not an utility object being held.
  327.             Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
  328.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  329.             totalroll = 0
  330.             DO
  331.                 roll = INT(RND * 20) + 1
  332.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  333.                 IF roll = 20 THEN totalroll = totalroll + 20
  334.                 totalroll = totalroll + roll
  335.             LOOP UNTIL roll <> 1 AND roll <> 20
  336.             damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
  337.             damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
  338.             out$ = _TRIM$(Hero.Name)
  339.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  340.                 SetTextColor PrintArea, &HFFF000F0, 0
  341.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  342.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  343.                 damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
  344.                 Hero.Life.Low = Hero.Life.Low - damage
  345.             ELSEIF totalroll < Chancetohit THEN
  346.                 SetTextColor PrintArea, &HFFF0F000, 0
  347.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  348.             ELSEIF totalroll > Chancetohit + 20 THEN
  349.                 SetTextColor PrintArea, &HFF00FF00, 0
  350.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  351.                 damage = damage * (totalroll / 20 + 1)
  352.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  353.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  354.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  355.             ELSEIF totalroll >= Chancetohit THEN
  356.                 SetTextColor PrintArea, &HFF00FF00, 0
  357.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  358.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
  359.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  360.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  361.             END IF
  362.             PrintOut PrintArea, out$
  363.         END IF
  364.  
  365.         IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
  366.             SetTextColor PrintArea, &HFFFF0000, 0
  367.             out$ = _TRIM$(Monster(M).Name) + " died!"
  368.             PrintOut PrintArea, out$
  369.             Encounter(AtWhom).Active = 0
  370.             Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
  371.             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!
  372.             IF Monster(M).ID.Symbol = 63 THEN 'it's a first time kill!
  373.                 DIM ub AS _UNSIGNED _BYTE, ul AS _UNSIGNED LONG
  374.                 SetSymbol ub, ul, "CONGRATULATIONS!  You just killed " + _TRIM$(Monster(M).Name) + " for the first time!"
  375.  
  376.             END IF
  377.         END IF
  378.     ELSE 'it's a monster attacking
  379.  
  380.     END IF
  381.  
  382.  
  383. SUB SetSymbol (ReturnSymbol AS _UNSIGNED _BYTE, ReturnColor AS _UNSIGNED LONG, out$)
  384.     'Make certain that the routine that calls this one uses the same variable types so we can pass values back and forth
  385.     RedSet = 128: 'GreenSet = 128: BlueSet = 128
  386.  
  387.     TempArea = NewTextArea(200, 100, 600, 500, True)
  388.     ColorTextArea TempArea, _RGB32(255, 255, 255), _RGB32(128, 128, 128)
  389.     DrawTextArea TempArea
  390.     SetPrintPositionX TempArea, CenterJustify
  391.     SetPrintUpdate TempArea, NewLine
  392.     SetTextColor TempArea, &HFFFFFFFF, 0
  393.     PrintOut TempArea, out$
  394.     SetTextFont TempArea, "courbd.ttf", 8
  395.     DO
  396.         SetTextColor TempArea, _RGB32(RedSet, GreenSet, BlueSet), 0
  397.         COLOR _RGB32(RedSet, GreenSet, BlueSet), 0
  398.         FOR y = 0 TO 15
  399.             FOR x = 0 TO 15
  400.                 Box x * 16 + 275, y * 16 + 150, 16, 16, CHR$(y * 16 + x), _RGB32(200, 200, 200)
  401.             NEXT
  402.         NEXT
  403.         Box 275, 425, 256, 20, "", _RGB32(200, 200, 200)
  404.         Box 275, 425, RedSet, 20, "", _RGB32(255, 0, 0)
  405.         Box 275, 450, 256, 20, "", _RGB32(200, 200, 200)
  406.         Box 275, 450, GreenSet, 20, "", _RGB32(0, 256, 0)
  407.         Box 275, 475, 256, 20, "", _RGB32(200, 200, 200)
  408.         Box 275, 475, BlueSet, 20, "", _RGB32(0, 0, 256)
  409.         _DISPLAY
  410.         WHILE _MOUSEINPUT: WEND
  411.         IF _MOUSEBUTTON(1) THEN
  412.             IF _MOUSEX > 250 AND _MOUSEX < 556 THEN 'we're clicked at the right mouse coordinate
  413.                 SELECT CASE _MOUSEY
  414.                     CASE 425 TO 445
  415.                         RedSet = _MOUSEX - 275
  416.                         IF RedSet < 0 THEN RedSet = 0
  417.                         IF RedSet > 255 THEN RedSet = 255
  418.                     CASE 450 TO 470
  419.                         GreenSet = _MOUSEX - 275
  420.                         IF GreenSet < 0 THEN GreenSet = 0
  421.                         IF GreenSet > 255 THEN GreenSet = 255
  422.                     CASE 475 TO 495
  423.                         BlueSet = _MOUSEX - 275
  424.                         IF BlueSet < 0 THEN BlueSet = 0
  425.                         IF BlueSet > 255 THEN BlueSet = 255
  426.                 END SELECT
  427.             END IF
  428.         END IF
  429.         _LIMIT 60
  430.     LOOP
  431.  
  432.  
  433.  
  434.  
  435. FUNCTION MoveMonster (Monster, MoveX, MoveY)
  436.     MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
  437.     D = Distance(MX, MY) 'distance from monster to the hero
  438.     E = Encounter(i).M 'the actual monster in question
  439.  
  440.     IF D > Distance(MX + MoveX, MY + MoveY) THEN
  441.         IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
  442.             MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
  443.             Encounter(Monster).X = Encounter(Monster).X + MoveX
  444.             Encounter(Monster).Y = Encounter(Monster).Y + MoveY
  445.             MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
  446.             MoveMonster = -1
  447.         END IF
  448.     END IF
  449.  
  450.  
  451.  
  452. SUB MonstersTurn
  453.     FOR i = 1 TO EncounterLimit
  454.         IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
  455.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  456.             D = Distance(MX, MY) 'distance from monster to the hero
  457.             E = Encounter(i).M 'the actual monster in question
  458.             IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
  459.  
  460.                 attack = 0
  461.                 IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
  462.                     'insert attack code here
  463.  
  464.                     _TITLE "ATTACK!"
  465.                     _CONTINUE
  466.                 END IF
  467.                 IF D <= Monster(E).Weapon2.Reach THEN 'we're in reach for the monster to attack with their off hand.
  468.                     'insert attack code here
  469.                     _CONTINUE
  470.                 END IF
  471.  
  472.                 IF attack = 0 THEN 'if the monster didn't attack, it can now move towards the hero.
  473.                     IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
  474.                         IF D > Distance(MX - 1, MY) THEN
  475.                             IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
  476.                         END IF
  477.                     END IF
  478.                     IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
  479.                         IF D > Distance(MX, MY - 1) THEN
  480.                             IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
  481.                         END IF
  482.                     END IF
  483.                     IF MX < XH THEN 'check to see if moving right moves us towards the hero.
  484.                         IF D > Distance(MX + 1, MY) THEN
  485.                             IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
  486.                         END IF
  487.                     END IF
  488.                     IF MY < YH THEN 'check to see if moving down moves us towards the hero.
  489.                         IF D > Distance(MX, MY + 1) THEN
  490.                             IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
  491.                         END IF
  492.                     END IF
  493.                 END IF
  494.             END IF
  495.         END IF
  496.  
  497.     NEXT
  498.  
  499.  
  500.  
  501.  
  502. SUB DrawMap
  503.     _DEST WorkScreen
  504.     _FONT 8
  505.     LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
  506.     FOR Y = 0 TO YH
  507.         FOR X = 0 TO XH
  508.             IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
  509.                 IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
  510.             END IF
  511.             IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
  512.                 IF MapArray(X, Y) AND 4 THEN 'it's a visible room
  513.                     COLOR &HFF000000, 0
  514.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
  515.                 END IF
  516.                 IF MapArray(X, Y) AND 8 THEN 'it's a visible path
  517.                     COLOR &HFF000000, &HFF777777
  518.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), "."
  519.                 END IF
  520.                 IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
  521.                     COLOR &HFF00FF00, &HFFFFFF00
  522.                     _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(240)
  523.                 END IF
  524.             END IF
  525.             'note: highlighting for the light should come AFTER the map is drawn
  526.             IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
  527.                 COLOR &H40FFFF00, 0
  528.                 _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(219)
  529.                 MapArray(X, Y) = MapArray(X, Y) - 1
  530.                 FOR i = 1 TO EncounterLimit
  531.                     IF X = Encounter(i).X AND Y = Encounter(i).Y AND Encounter(i).Active = -1 THEN
  532.                         E = Encounter(i).M
  533.                         COLOR Monster(E).ID.Color
  534.                         _PRINTSTRING (X * _FONTWIDTH, Y * _FONTHEIGHT), CHR$(Monster(E).ID.Symbol)
  535.                     END IF
  536.                 NEXT
  537.  
  538.             END IF
  539.         NEXT
  540.     NEXT
  541.     COLOR &HFFFFFF00, 0 'Yellow Hero
  542.     _PRINTSTRING (Hero.X * _FONTWIDTH, Hero.Y * _FONTHEIGHT), CHR$(1)
  543.     XOffset## = 400 / Scale
  544.     YOffset## = 300 / Scale
  545.     CenterX = Hero.X * 8 'convert hero coordinate to grid coordinate
  546.     CenterY = Hero.Y * 8
  547.     _DEST DisplayScreen
  548.     LINE (0, 0)-(800, 600), &HFF0000FF, BF 'clear the map
  549.     _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
  550.  
  551.  
  552.  
  553.  
  554.  
  555. SUB CreateMap (XLimit, YLimit, Rooms)
  556.     ERASE MapArray 'clear the old map and reset everything to 0
  557.     REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
  558.     REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
  559.     REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
  560.     XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
  561.  
  562.     DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
  563.  
  564.     FOR i = 1 TO Rooms
  565.         DO
  566.             RoomSize = INT(RND * 9) + 2
  567.             RoomX = INT(RND * (XLimit - RoomSize))
  568.             RoomY = INT(RND * (YLimit - RoomSize))
  569.             'test for positioning
  570.             good = -1 'it's good starting out
  571.             FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  572.                     IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
  573.             NEXT X, Y
  574.         LOOP UNTIL good
  575.         FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  576.                 MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
  577.         NEXT X, Y
  578.         RoomCenterX(i) = RoomX + .5 * RoomSize
  579.         RoomCenterY(i) = RoomY + .5 * RoomSize
  580.     NEXT
  581.     FOR i = 1 TO Rooms - 1
  582.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  583.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  584.         DO UNTIL StartX = EndX AND StartY = EndY
  585.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  586.             Meander = 10
  587.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  588.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  589.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  590.                     Ychange = 0
  591.                 ELSE
  592.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  593.                     Ychange = 0
  594.                 END IF
  595.             ELSE
  596.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  597.                     Ychange = SGN(EndY - StartY)
  598.                     XChange = 0
  599.                 ELSE
  600.                     Ychange = INT(RND * 3) - 1
  601.                     XChange = 0
  602.                 END IF
  603.             END IF
  604.             StartX = StartX + XChange
  605.             StartY = StartY + Ychange
  606.             IF StartX < 0 THEN StartX = 0
  607.             IF StartY < 0 THEN StartY = 0
  608.             IF StartX > UBOUND(MapArray, 1) THEN StartX = UBOUND(MapArray, 1)
  609.             IF StartY > UBOUND(MapArray, 2) THEN StartY = UBOUND(MapArray, 2)
  610.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8
  611.         LOOP
  612.     NEXT
  613.     DO
  614.         Hero.X = INT(RND * XLimit + 1)
  615.         Hero.Y = INT(RND * YLimit + 1)
  616.     LOOP UNTIL MapArray(Hero.X, Hero.Y) AND 4 'place the hero randomly, until they're in a room somewhere
  617.     MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
  618.     DO
  619.         X = INT(RND * XLimit + 1)
  620.         Y = INT(RND * YLimit + 1)
  621.     LOOP UNTIL MapArray(X, Y) AND 4 'get a random spot in a room, for the stairs to the next level
  622.     MapArray(X, Y) = MapArray(X, Y) OR 16
  623.     PathFind
  624.     EncounterLimit = INT(RND * 6) + 5
  625.     FOR i = 1 TO EncounterLimit
  626.         Encounter(i).M = RandomMonster
  627.         Encounter(i).Active = -1
  628.         Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
  629.         valid = -1
  630.         DO
  631.             Encounter(i).X = INT(RND * XLimit + 1)
  632.             Encounter(i).Y = INT(RND * YLimit + 1)
  633.             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.)
  634.         LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
  635.         MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
  636.     NEXT
  637.  
  638. SUB PathFind
  639.     STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
  640.     DIM pass AS _UNSIGNED _BYTE
  641.     m = _MEM(Distance()): m1 = _MEM(Temp())
  642.     _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
  643.     _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
  644.     Temp(Hero.X, Hero.Y) = 0
  645.     pass = 0
  646.     DO
  647.         changed = 0
  648.         y = 0
  649.         DO
  650.             x = 0
  651.             DO
  652.                 IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
  653.                     IF x < XH THEN
  654.                         IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  655.                     END IF
  656.                     IF x > 0 THEN
  657.                         IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  658.                     END IF
  659.                     IF y < YH THEN
  660.                         IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  661.                     END IF
  662.                     IF y > 0 THEN
  663.                         IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  664.                     END IF
  665.                 END IF
  666.                 x = x + 1
  667.             LOOP UNTIL x > XH
  668.             y = y + 1
  669.         LOOP UNTIL y > YH
  670.         _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
  671.         pass = pass + 1
  672.     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!
  673.     Distance(Hero.X, Hero.Y) = 0
  674.  
  675. FUNCTION RandomMonster
  676.     'Shared variable level tells us what level of the dungeon we're on.
  677.     STATIC MC, DS 'monster count and data set
  678.     IF NOT DS THEN
  679.         DS = -1
  680.         Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
  681.         Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
  682.         Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
  683.         Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
  684.         'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
  685.         'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
  686.         'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
  687.         'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
  688.         'Monster(1).Armor.Name = ""
  689.         'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
  690.  
  691.         Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
  692.         Monster(2).Level = 1: Monster(2).ExpBonus = 0
  693.         Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
  694.         Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
  695.         Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
  696.         Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
  697.         Monster(3).Level = 1: Monster(3).ExpBonus = 0
  698.         Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
  699.         Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
  700.         Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
  701.         FOR i = 1 TO UBOUND(Monster) 'All monsters first appear as a red question mark on the screen, until battled.
  702.             Monster(i).ID.Symbol = 63: Monster(i).ID.Color = &HFFFF0000
  703.         NEXT
  704.     END IF
  705.     SELECT CASE Level 'the starting level
  706.         CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
  707.     END SELECT
  708.     RandomMonster = INT(RND * MC) + 1
  709.  
  710.  
  711. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  712. '# SUBroutines and FUNCTIONs below #'
  713. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  714. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  715.     u = UBOUND(TextHandles)
  716.     Handle = WhichHandle
  717.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  718.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  719.     Where = TextHandles(Handle).VerticalAlignment
  720.     How = TextHandles(Handle).Justification
  721.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  722.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  723.  
  724.  
  725. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  726.     'WhichHandle is the handle which designates which text area we want to use
  727.     'Where is where we want it to go in that text area
  728.     '  -- Online prints the text to the current print position line in that text area.
  729.     '  -- CenterLine centers the text to the center of that text area.
  730.     '  -- any other value will print to that line positon in that particular box.
  731.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  732.     'What is the text that we want to print in our text area
  733.     '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).
  734.  
  735.     D = _DEST: S = _SOURCE
  736.     OldFont = _FONT
  737.  
  738.     u = UBOUND(TextHandles)
  739.     Handle = WhichHandle
  740.  
  741.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  742.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  743.     IF TextHandles(Handle).HideFrame THEN
  744.         _DEST TextHandles(Handle).SavedBackground
  745.         _SOURCE TextHandles(Handle).SavedBackground
  746.     END IF
  747.     _FONT TextHandles(Handle).Font
  748.     fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
  749.     IF _FONTWIDTH = 0 THEN
  750.         FOR i = 1 TO 255
  751.             IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
  752.         NEXT
  753.     ELSE
  754.         fw = _FONTWIDTH
  755.     END IF
  756.  
  757.     h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
  758.  
  759.     SELECT CASE Where
  760.         CASE BottomLine
  761.             y = h \ fh
  762.         CASE OnLine
  763.             y = TextHandles(Handle).Ypos
  764.             IF y = 0 THEN y = 1
  765.         CASE CenterLine
  766.             linesused = 0
  767.             tpw = pw: tw = w: tWhat$ = What
  768.             DO UNTIL tpw <= tw
  769.                 textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
  770.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  771.                 linesused = linesused + 1
  772.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  773.                 tpw = _PRINTWIDTH(tWhat$)
  774.             LOOP
  775.             linesused = linesused + 1
  776.             py = (h - linesused * fh) \ 2
  777.             y = py \ fh + 1
  778.             IF y < 1 THEN y = 1
  779.         CASE ELSE
  780.             y = Where
  781.     END SELECT
  782.  
  783.     'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  784.     blend = _BLEND
  785.  
  786.     DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  787.         'first let's get a temp image handle for the existing area of the screen.
  788.         x1 = TextHandles(Handle).x1 + 2
  789.         y1 = TextHandles(Handle).y1 + 2
  790.         x2 = TextHandles(Handle).x1 + w
  791.         y2 = TextHandles(Handle).y1 + h
  792.         nh = y2 - y1 + 1 - fh
  793.         nw = x2 - x1 + 1
  794.         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.
  795.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  796.         DrawTextArea Handle
  797.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  798.         y = y - 1
  799.     LOOP
  800.  
  801.     IF blend THEN _BLEND
  802.  
  803.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  804.  
  805.     SELECT CASE How
  806.         CASE LeftJustify
  807.             x = 0
  808.             IF pw > w THEN
  809.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  810.                 text$ = RTRIM$(LEFT$(What, textallowed))
  811.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  812.                 PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
  813.             ELSE
  814.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  815.                 finished = -1
  816.             END IF
  817.         CASE CenterJustify
  818.             IF pw > w THEN
  819.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  820.                 text$ = RTRIM$(LEFT$(What, textallowed))
  821.                 x = (w - _PRINTWIDTH(text$)) \ 2
  822.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  823.                 PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  824.             ELSE
  825.                 x = (w - pw) \ 2
  826.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  827.                 finished = -1
  828.             END IF
  829.         CASE RightJustify
  830.             IF pw > w THEN
  831.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  832.                 text$ = RTRIM$(LEFT$(What, textallowed))
  833.                 x = w - _PRINTWIDTH(text$)
  834.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  835.                 PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
  836.             ELSE
  837.                 x = w - pw
  838.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  839.                 finished = -1
  840.             END IF
  841.         CASE NoJustify
  842.             x = TextHandles(Handle).Xpos
  843.             firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
  844.             IF LEN(What) > firstlinelimit THEN
  845.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  846.                 text$ = RTRIM$(LEFT$(What, textallowed))
  847.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  848.                 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
  849.             ELSE
  850.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  851.                 finished = -1
  852.             END IF
  853.     END SELECT
  854.     IF finished THEN
  855.         SELECT CASE TextHandles(Handle).UpdateMethod
  856.             CASE NoUpdate 'We don't update the position at all.
  857.             CASE DoUpdate
  858.                 TextHandles(Handle).Xpos = x + pw
  859.                 TextHandles(Handle).Ypos = y
  860.             CASE NewLine
  861.                 TextHandles(Handle).Ypos = y + 1
  862.                 TextHandles(Handle).Xpos = 1
  863.         END SELECT
  864.         _FONT OldFont
  865.         _DEST D: _SOURCE S
  866.         COLOR FG, BG
  867.     END IF
  868.  
  869. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  870.     u = UBOUND(TextHandles)
  871.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  872.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  873.     TextHandles(Handle).TextColor = Foreground
  874.  
  875.  
  876. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  877.     u = UBOUND(TextHandles)
  878.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  879.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  880.     TextHandles(Handle).TextBackgroundColor = Background
  881.  
  882. SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
  883.     u = UBOUND(TextHandles)
  884.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  885.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  886.     SELECT CASE TextHandles(Handle).Font
  887.         CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
  888.         CASE IS > 1
  889.             'we have the font already in use
  890.             'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
  891.             _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
  892.     END SELECT
  893.  
  894.     temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
  895.     IF temp > 1 THEN
  896.         TextHandles(Handle).Font = temp
  897.     ELSE
  898.         TextHandles(Handle).Font = 16 'default to font 16, in case
  899.     END IF
  900.  
  901.  
  902. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  903.     u = UBOUND(TextHandles)
  904.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  905.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  906.     TextHandles(Handle).TextColor = Foreground
  907.     TextHandles(Handle).TextBackgroundColor = Background
  908.  
  909.  
  910. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  911.     u = UBOUND(TextHandles)
  912.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  913.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  914.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  915.     TextHandles(Handle).UpdateMethod = Method
  916.  
  917.  
  918. SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
  919.     u = UBOUND(TextHandles)
  920.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  921.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  922.     SELECT CASE Y
  923.         CASE BottomLine
  924.             TextHandles(Handle).VerticalAlignment = -2
  925.         CASE CenterLine
  926.             TextHandles(Handle).VerticalAlignment = -1
  927.         CASE ELSE
  928.             TextHandles(Handle).VerticalAlignment = 0
  929.     END SELECT
  930.     IF X < 1 AND X > -4 THEN
  931.         TextHandles(Handle).Justification = X
  932.     ELSE
  933.         TextHandles(Handle).Xpos = X
  934.     END IF
  935.     IF Y < 1 THEN EXIT SUB
  936.     TextHandles(Handle).Ypos = Y
  937.  
  938. SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
  939.     u = UBOUND(TextHandles)
  940.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  941.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  942.     IF X < 1 AND X > -4 THEN
  943.         TextHandles(Handle).Justification = X
  944.     ELSE
  945.         TextHandles(Handle).Xpos = X
  946.     END IF
  947.  
  948. SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
  949.     u = UBOUND(TextHandles)
  950.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  951.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  952.     SELECT CASE Y
  953.         CASE BottomLine
  954.             TextHandles(Handle).VerticalAlignment = -2
  955.         CASE CenterLine
  956.             TextHandles(Handle).VerticalAlignment = -1
  957.         CASE ELSE
  958.             TextHandles(Handle).VerticalAlignment = 0
  959.     END SELECT
  960.     IF Y < 1 THEN EXIT SUB
  961.     TextHandles(Handle).Ypos = Y
  962.  
  963.  
  964. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  965.     u = UBOUND(TextHandles)
  966.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  967.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  968.     GetPrintPositionY = TextHandles(Handle).Ypos
  969.  
  970. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  971.     u = UBOUND(TextHandles)
  972.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  973.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  974.     GetPrintPositionX = TextHandles(Handle).Xpos
  975.  
  976.  
  977.  
  978. FUNCTION WordBreak (text$)
  979.     CONST Breaks = " ;,.?!-"
  980.     FOR i = LEN(text$) TO 0 STEP -1
  981.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  982.         loopcount = loopcount + 1
  983.     NEXT
  984.     IF i = 0 THEN i = LEN(text$)
  985.     WordBreak = i
  986.  
  987.  
  988.  
  989. SUB ClearTextArea (Handle AS INTEGER)
  990.     u = UBOUND(TextHandles)
  991.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  992.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  993.     IF TextHandles(Handle).SavedBackground THEN
  994.         w = TextHandles(Handle).w
  995.         h = TextHandles(Handle).h
  996.         x1 = TextHandles(Handle).ScreenX
  997.         y1 = TextHandles(Handle).ScreenY
  998.         x2 = x1 + w - 1
  999.         y2 = y1 + h - 1
  1000.         blend = _BLEND
  1001.         _DONTBLEND
  1002.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1003.         IF blend THEN _BLEND
  1004.     END IF
  1005.     DrawTextArea Handle
  1006.  
  1007.  
  1008.  
  1009. SUB DrawTextArea (Handle AS INTEGER)
  1010.     u = UBOUND(TextHandles)
  1011.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1012.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1013.     w = TextHandles(Handle).w
  1014.     h = TextHandles(Handle).h
  1015.     x1 = TextHandles(Handle).ScreenX
  1016.     y1 = TextHandles(Handle).ScreenY
  1017.     x2 = x1 + w - 1
  1018.     y2 = y1 + h - 1
  1019.  
  1020.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  1021.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  1022.  
  1023.  
  1024.  
  1025. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  1026.     u = UBOUND(TextHandles)
  1027.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1028.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1029.     TextHandles(Handle).FrameColor = FrameColor
  1030.     TextHandles(Handle).BackColor = BackColor
  1031.  
  1032.  
  1033.  
  1034. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  1035.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  1036.     x2 = tx2: y2 = ty2
  1037.     IF x1 > x2 THEN SWAP x1, x2
  1038.     IF y1 > y2 THEN SWAP y1, y2
  1039.     w = x2 - x1 + 1
  1040.     h = y2 - y1 + 1
  1041.     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
  1042.     'Error checking for if the user sends coordinates which are off the screen
  1043.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  1044.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  1045.  
  1046.     u = UBOUND(TextHandles)
  1047.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  1048.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  1049.     NEXT
  1050.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  1051.         Handle = u + 1
  1052.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  1053.     END IF
  1054.     TextHandles(Handle).x1 = x1
  1055.     TextHandles(Handle).y1 = y1
  1056.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  1057.     TextHandles(Handle).InUse = True
  1058.     TextHandles(Handle).Xpos = 0
  1059.     TextHandles(Handle).Ypos = 1
  1060.     TextHandles(Handle).UpdateMethod = NewLine
  1061.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  1062.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  1063.  
  1064.     IF SaveBackground THEN
  1065.         imagehandle = _NEWIMAGE(w, h, 32)
  1066.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1067.         TextHandles(Handle).SavedBackground = imagehandle
  1068.     END IF
  1069.     TextHandles(Handle).ScreenX = x1
  1070.     TextHandles(Handle).ScreenY = y1
  1071.     TextHandles(Handle).Font = 16 'default to font 16
  1072.     NewTextArea% = Handle
  1073.  
  1074. SUB FreeTextArea (Handle AS INTEGER)
  1075.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  1076.         IF TextHandles(Handle).InUse THEN
  1077.             TextHandles(Handle).InUse = False
  1078.             IF TextHandles(Handle).SavedBackground THEN
  1079.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  1080.                     w = TextHandles(Handle).w
  1081.                     h = TextHandles(Handle).h
  1082.                     x1 = TextHandles(Handle).ScreenX
  1083.                     y1 = TextHandles(Handle).ScreenY
  1084.                     x2 = x1 + w - 1
  1085.                     y2 = y1 + h - 1
  1086.                     blend = _BLEND
  1087.                     _DONTBLEND
  1088.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1089.                     IF blend THEN _BLEND
  1090.                 END IF
  1091.                 '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.
  1092.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  1093.             END IF
  1094.         ELSE
  1095.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  1096.         END IF
  1097.     ELSE
  1098.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  1099.     END IF
  1100.  
  1101. SUB HideFrame (Handle AS INTEGER)
  1102.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  1103.         TextHandles(Handle).HideFrame = -1
  1104.         w = TextHandles(Handle).w
  1105.         h = TextHandles(Handle).h
  1106.         x1 = TextHandles(Handle).ScreenX
  1107.         y1 = TextHandles(Handle).ScreenY
  1108.         x2 = x1 + w - 1
  1109.         y2 = y1 + h - 1
  1110.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1111.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1112.         IF TextHandles(Handle).SavedBackground THEN
  1113.             blend = _BLEND
  1114.             _DONTBLEND
  1115.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1116.             _FREEIMAGE TextHandles(Handle).SavedBackground
  1117.             IF blend THEN _BLEND
  1118.         END IF
  1119.         TextHandles(Handle).SavedBackground = imagehandle
  1120.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  1121.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  1122.     END IF
  1123.  
  1124. SUB RestoreFrame (Handle AS INTEGER)
  1125.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  1126.         TextHandles(Handle).HideFrame = 0
  1127.         w = TextHandles(Handle).w
  1128.         h = TextHandles(Handle).h
  1129.         x1 = TextHandles(Handle).ScreenX
  1130.         y1 = TextHandles(Handle).ScreenY
  1131.         x2 = x1 + w - 1
  1132.         y2 = y1 + h - 1
  1133.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1134.         blend = _BLEND
  1135.         _DONTBLEND
  1136.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1137.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  1138.         _FREEIMAGE TextHandles(Handle).SavedBackground
  1139.         IF blend THEN _BLEND
  1140.         TextHandles(Handle).SavedBackground = imagehandle
  1141.         TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
  1142.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  1143.     END IF
  1144.  
  1145. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  1146.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  1147.     u = UBOUND(TextHandles)
  1148.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1149.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1150.     HideFrame Handle
  1151.     TextHandles(Handle).ScreenX = x1
  1152.     TextHandles(Handle).ScreenY = y1
  1153.     RestoreFrame Handle

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?!!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #21 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:
* Rogue Like.7z (Filesize: 1.76 MB, Downloads: 117)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rogue-Like (work in progress)
« Reply #22 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?


Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #23 on: September 13, 2019, 11:16:37 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.  ;)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #24 on: September 13, 2019, 08:46:04 pm »
Code: QB64: [Select]
  1. DEFLNG A-Z 'default to long instead of single
  2. TYPE TextArea
  3.     InUse AS INTEGER
  4.     x1 AS LONG 'left
  5.     y1 AS LONG 'top
  6.     w AS LONG 'width
  7.     h AS LONG 'height
  8.     FrameColor AS _UNSIGNED LONG
  9.     BackColor AS _UNSIGNED LONG
  10.     Xpos AS INTEGER
  11.     Ypos AS INTEGER
  12.     VerticalAlignment AS INTEGER
  13.     Justification AS INTEGER
  14.     UpdateMethod AS INTEGER
  15.     TextColor AS _UNSIGNED LONG
  16.     TextBackgroundColor AS _UNSIGNED LONG
  17.     SavedBackground AS INTEGER
  18.     HideFrame AS INTEGER
  19.     ScreenX AS INTEGER
  20.     ScreenY AS INTEGER
  21.     Font AS LONG 'NEW! Change fonts for each independent font area
  22.  
  23. REDIM SHARED TextHandles(0) AS TextArea
  24.  
  25. CONST True = -1, False = 0
  26. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  27. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  28. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  29. '********************************************************
  30. '* Text Frames before this line
  31. '********************************************************
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38. _CONSOLE ON 'for debugging purposes while making/testing things
  39.  
  40. TYPE Damage_Type
  41.     Low AS INTEGER
  42.     High AS INTEGER
  43.  
  44. TYPE Light_Type
  45.     Name AS STRING * 20
  46.     Reach AS _UNSIGNED _BYTE
  47.     Left AS _UNSIGNED _BYTE
  48.  
  49. TYPE Weapon_Type
  50.     Name AS STRING * 20
  51.     Reach AS _UNSIGNED _BYTE
  52.     Damage AS Damage_Type
  53.     HitBonus AS _UNSIGNED _BYTE
  54.     DamageBonus AS _UNSIGNED _BYTE
  55.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  56.  
  57. TYPE Armor_Type
  58.     Name AS STRING * 20
  59.     PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
  60.     DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
  61.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  62.  
  63. TYPE Hero_Type
  64.     Name AS STRING * 20
  65.     Life AS Damage_Type
  66.     Level AS _UNSIGNED _BYTE
  67.     EXP_Earned AS LONG
  68.     EXP_Needed AS LONG
  69.     Light AS Light_Type
  70.     Weapon1 AS Weapon_Type
  71.     Weapon2 AS Weapon_Type
  72.     Armor AS Armor_Type
  73.     HealingRate AS _UNSIGNED _BYTE
  74.  
  75. TYPE Monster_TYPE
  76.     Name AS STRING * 20
  77.     Life AS Damage_Type
  78.     Level AS INTEGER
  79.     ExpBonus AS INTEGER
  80.     Sight AS INTEGER
  81.     Hearing AS INTEGER
  82.     Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
  83.     Weapon1 AS Weapon_Type
  84.     Weapon2 AS Weapon_Type
  85.     Armor AS Armor_Type
  86.     Found AS INTEGER
  87.     IconX AS LONG
  88.     IconY AS LONG
  89.  
  90. TYPE Encounter_TYPE
  91.     Active AS INTEGER
  92.     X AS INTEGER
  93.     Y AS INTEGER
  94.     M AS INTEGER
  95.     Life AS INTEGER
  96.  
  97. REDIM SHARED Monster(100) AS Monster_TYPE
  98. REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
  99.  
  100. DIM SHARED Hero AS Hero_Type
  101. DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
  102. DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
  103. DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
  104. DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG
  105. DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
  106.  
  107. WorkScreen = _NEWIMAGE(3200, 2400, 32)
  108. DisplayScreen = _NEWIMAGE(800, 700, 32)
  109. SCREEN DisplayScreen
  110. Scale = 2
  111.  
  112. REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
  113. '1 map is illuminated
  114. '2 map is uncovered
  115. '4 map is a wall
  116. '8 map is a pathway
  117. '16 map is a stairway
  118. '32 map is simply blocked (perhaps with a monster?)
  119. '64 map is secret (can not be uncovered)
  120.  
  121. REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
  122.  
  123.  
  124.  
  125. ON ERROR GOTO errorhandler
  126.  
  127. GOTO skiperrorhandler
  128. errorhandler:
  129.  
  130. PRINT ERR; "Error on "; _ERRORLINE
  131. _DEST DisplayScreen
  132. skiperrorhandler:
  133.  
  134. Init
  135. CreateMap 99, 74, 10
  136.  
  137.     DrawMap
  138.     DisplayCharacter
  139.     _DISPLAY
  140.     GetInput
  141.     MonstersTurn
  142.     CheckForHeroGrowth
  143.  
  144. SUB Init
  145.     Hero.Name = "Steve The Tester!"
  146.     Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
  147.     Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
  148.     Hero.Light.Name = "Magic Candle"
  149.     Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
  150.     Hero.Weapon1.Name = "Bare Fist"
  151.     Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
  152.     Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
  153.     Hero.Weapon1.Left = -1 'your fist is indestructible!
  154.     Hero.Weapon2.Name = "Magic Candle"
  155.     Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
  156.     Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
  157.     Hero.Weapon2.Left = 0 'you can't attack with a candle
  158.     Hero.Armor.Name = "Naked"
  159.     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!
  160.     Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
  161.  
  162.     PrintArea = NewTextArea(230, 601, 799, 699, False)
  163.     ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  164.     SetTextFont PrintArea, "courbd.ttf", 24
  165.     DrawTextArea PrintArea
  166.     SetPrintPositionX PrintArea, CenterJustify
  167.     SetPrintUpdate PrintArea, NewLine
  168.     PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
  169.     SetTextFont PrintArea, "courbd.ttf", 18
  170.     PrintOut PrintArea, "created by STEVE!"
  171.     PrintOut PrintArea, ""
  172.     SetPrintPositionX PrintArea, LeftJustify
  173.     SetTextFont PrintArea, "courbd.ttf", 12
  174.     TextFont = 12
  175.  
  176. SUB CheckForHeroGrowth
  177.     IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
  178.         CLS
  179.         PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
  180.         _DISPLAY
  181.         BEEP
  182.         _DELAY 5
  183.         SYSTEM
  184.     END IF
  185.     IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
  186.         IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
  187.     END IF
  188.  
  189.  
  190. SUB DisplayCharacter
  191.     LINE (0, 601)-(229, 799), &HFF000000, BF
  192.     COLOR &HFFFFFFFF, 0
  193.     _PRINTSTRING (0, 605), "HERO : " + Hero.Name
  194.     _PRINTSTRING (0, 613), "LEVEL:" + STR$(Hero.Level)
  195.     _PRINTSTRING (0, 621), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
  196.     _PRINTSTRING (0, 637), "LIFE :" + STR$(Hero.Life.Low) + " (" + _TRIM$(STR$(Hero.Life.High)) + ")"
  197.  
  198.     _PRINTSTRING (0, 653), "HAND1: " + Hero.Weapon1.Name
  199.     _PRINTSTRING (0, 661), "HAND2: " + Hero.Weapon2.Name
  200.     _PRINTSTRING (0, 669), "ARMOR: " + Hero.Armor.Name
  201.     _PRINTSTRING (0, 685), "LIGHT: " + Hero.Light.Name
  202.  
  203. SUB GetInput
  204.     DO
  205.         k = _KEYHIT: valid = -1
  206.         SELECT CASE k
  207.             CASE 18432 'up
  208.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  209.                     SELECT CASE Scale
  210.                         CASE 1.5: Scale = 2 'It's as small as we go
  211.                         CASE 2: Scale = 3
  212.                         CASE 3: Scale = 4
  213.                         CASE 4: Scale = 6
  214.                         CASE 6: Scale = 8
  215.                         CASE 8: Scale = 12
  216.                     END SELECT
  217.                 ELSE
  218.                     IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
  219.                 END IF
  220.             CASE 19200: 'left
  221.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  222.                     TextFont = TextFont - 1
  223.                     IF TextFont < 8 THEN TextFont = 8
  224.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  225.                     ClearTextArea PrintArea
  226.                     SetPrintPosition PrintArea, 1, 1
  227.                     PrintOut PrintArea, "Font Size Changed"
  228.                 ELSE
  229.                     IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
  230.                 END IF
  231.             CASE 20480: 'down
  232.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  233.                     SELECT CASE Scale
  234.                         CASE 2: Scale = 1.5 'It's as small as we go
  235.                         CASE 3: Scale = 2
  236.                         CASE 4: Scale = 3
  237.                         CASE 6: Scale = 4
  238.                         CASE 8: Scale = 6
  239.                         CASE 12: Scale = 8
  240.                     END SELECT
  241.                 ELSE
  242.                     IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
  243.                 END IF
  244.             CASE 19712: 'right
  245.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  246.                     TextFont = TextFont + 1
  247.                     IF TextFont > 48 THEN TextFont = 48
  248.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  249.                     ClearTextArea PrintArea
  250.                     SetPrintPosition PrintArea, 1, 1
  251.                     PrintOut PrintArea, "Font Size Changed"
  252.                 ELSE
  253.                     IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
  254.                 END IF
  255.             CASE 32 'space to just wait and skip a turn
  256.             CASE 60 ' "<" key
  257.                 IF MapArray(Hero.X, Hero.Y) AND 16 THEN
  258.                     Level = Level + 1
  259.                     CreateMap 99, 74, 10
  260.                     PathFind
  261.                 END IF
  262.             CASE ASC("+"), ASC("=")
  263.                 IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
  264.             CASE ASC("-"), ASC("_")
  265.                 IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
  266.             CASE ELSE
  267.                 valid = 0 'it's a key press which we don't recognize.  Ignore it
  268.         END SELECT
  269.         _LIMIT 60
  270.     LOOP UNTIL k AND valid
  271.     _KEYCLEAR 'one keystroke at a time
  272.     StepsTaken = StepsTaken + 1
  273.  
  274. SUB Box (X, Y, Wide, High, Caption AS STRING, Kolor AS _UNSIGNED LONG)
  275.     LINE (X, Y)-STEP(Wide, High), Kolor, BF
  276.     LINE (X, Y)-STEP(Wide, High), &HFFFFFFFF, B
  277.     pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
  278.     _PRINTSTRING (X + (Wide - pw) \ 2, Y + (High - ph) \ 2), Caption
  279.  
  280.  
  281. SUB MoveHero (MoveX, MoveY)
  282.     TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
  283.     IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
  284.         IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
  285.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
  286.             IF MoveX THEN Hero.X = Hero.X + MoveX
  287.             IF MoveY THEN Hero.Y = Hero.Y + MoveY
  288.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
  289.             PathFind
  290.         ELSE
  291.             '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!
  292.             FOR i = 1 TO EncounterLimit
  293.                 IF Encounter(i).Active THEN 'Check for active/alive monsters only
  294.                     MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  295.                     IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
  296.                         Swing 0, i 'hero swings at the monster
  297.                     END IF
  298.                 END IF
  299.             NEXT
  300.         END IF
  301.     END IF
  302.  
  303. SUB Swing (Who, AtWhom)
  304.  
  305.     BaseChancetohit = 10 'base 10 chance to hit
  306.     IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
  307.         M = Encounter(AtWhom).M
  308.         IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  309.             Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
  310.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  311.             totalroll = 0
  312.             DO
  313.                 roll = INT(RND * 20) + 1
  314.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  315.                 IF roll = 20 THEN totalroll = totalroll + 20
  316.                 totalroll = totalroll + roll
  317.             LOOP UNTIL roll <> 1 AND roll <> 20
  318.             damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
  319.             damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
  320.             out$ = _TRIM$(Hero.Name)
  321.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  322.                 SetTextColor PrintArea, &HFFF000F0, 0
  323.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  324.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  325.                 Hero.Life.Low = Hero.Life.Low - damage
  326.             ELSEIF totalroll < Chancetohit THEN
  327.                 SetTextColor PrintArea, &HFFF0F000, 0
  328.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  329.             ELSEIF totalroll > Chancetohit + 20 THEN
  330.                 SetTextColor PrintArea, &HFF00FF00, 0
  331.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  332.                 damage = damage * (totalroll / 20 + 1)
  333.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  334.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  335.             ELSEIF totalroll >= Chancetohit THEN
  336.                 SetTextColor PrintArea, &HFF00FF00, 0
  337.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  338.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
  339.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  340.             END IF
  341.         ELSEIF Hero.Weapon1.Reach > 0 THEN
  342.             SetTextColor PrintArea, &HFFF000F0, 0
  343.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
  344.         ELSE
  345.             out$ = ""
  346.         END IF
  347.         IF out$ <> "" THEN PrintOut PrintArea, out$
  348.         IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  349.             Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
  350.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  351.             totalroll = 0
  352.             DO
  353.                 roll = INT(RND * 20) + 1
  354.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  355.                 IF roll = 20 THEN totalroll = totalroll + 20
  356.                 totalroll = totalroll + roll
  357.             LOOP UNTIL roll <> 1 AND roll <> 20
  358.             damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
  359.             damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
  360.             out$ = _TRIM$(Hero.Name)
  361.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  362.                 SetTextColor PrintArea, &HFFF000F0, 0
  363.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  364.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  365.                 damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
  366.                 Hero.Life.Low = Hero.Life.Low - damage
  367.             ELSEIF totalroll < Chancetohit THEN
  368.                 SetTextColor PrintArea, &HFFF0F000, 0
  369.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  370.             ELSEIF totalroll > Chancetohit + 20 THEN
  371.                 SetTextColor PrintArea, &HFF00FF00, 0
  372.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  373.                 damage = damage * (totalroll / 20 + 1)
  374.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  375.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  376.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  377.             ELSEIF totalroll >= Chancetohit THEN
  378.                 SetTextColor PrintArea, &HFF00FF00, 0
  379.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  380.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
  381.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  382.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  383.             END IF
  384.         ELSEIF Hero.Weapon2.Reach > 0 THEN
  385.             SetTextColor PrintArea, &HFFF000F0, 0
  386.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
  387.         ELSE
  388.             out$ = ""
  389.         END IF
  390.         IF out$ <> "" THEN PrintOut PrintArea, out$
  391.         IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
  392.             SetTextColor PrintArea, &HFFFF0000, 0
  393.             out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
  394.             PrintOut PrintArea, out$
  395.             Encounter(AtWhom).Active = 0
  396.             Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
  397.             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!
  398.             IF Monster(M).Found = 0 THEN
  399.                 Monster(M).Found = -1 'it's a first time kill!
  400.                 SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
  401.                 out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
  402.                 PrintOut PrintArea, out$
  403.             END IF
  404.         END IF
  405.     ELSE 'it's a monster attacking
  406.         M = Encounter(Who).M
  407.         IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
  408.             Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
  409.             Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
  410.             totalroll = 0
  411.             DO
  412.                 roll = INT(RND * 20) + 1
  413.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  414.                 IF roll = 20 THEN totalroll = totalroll + 20
  415.                 totalroll = totalroll + roll
  416.             LOOP UNTIL roll <> 1 AND roll <> 20
  417.             damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
  418.             damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
  419.             out$ = _TRIM$(Monster(M).Name)
  420.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  421.                 SetTextColor PrintArea, &HFFF000F0, 0
  422.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  423.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  424.                 Monster(M).Life.Low = Monster(M).Life.Low - damage
  425.             ELSEIF totalroll < Chancetohit THEN
  426.                 SetTextColor PrintArea, &HFFF0F000, 0
  427.                 out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  428.             ELSEIF totalroll > Chancetohit + 20 THEN
  429.                 SetTextColor PrintArea, &HFF00FFFF, 0
  430.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
  431.                 damage = damage * (totalroll / 20 + 1)
  432.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  433.                 Hero.Life.Low = Hero.Life.Low - damage
  434.             ELSEIF totalroll >= Chancetohit THEN
  435.                 SetTextColor PrintArea, &HFF00FFFF, 0
  436.                 out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
  437.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
  438.                 Hero.Life.Low = Hero.Life.Low - damage
  439.             END IF
  440.         ELSEIF Monster(M).Weapon1.Reach > 0 THEN
  441.             SetTextColor PrintArea, &HFFF000F0, 0
  442.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
  443.         ELSE
  444.             out$ = ""
  445.         END IF
  446.         IF out$ <> "" THEN PrintOut PrintArea, out$
  447.     END IF
  448.  
  449.  
  450. FUNCTION MoveMonster (Monster, MoveX, MoveY)
  451.     MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
  452.     D = Distance(MX, MY) 'distance from monster to the hero
  453.     E = Encounter(i).M 'the actual monster in question
  454.  
  455.     IF D > Distance(MX + MoveX, MY + MoveY) THEN
  456.         IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
  457.             MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
  458.             Encounter(Monster).X = Encounter(Monster).X + MoveX
  459.             Encounter(Monster).Y = Encounter(Monster).Y + MoveY
  460.             MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
  461.             MoveMonster = -1
  462.         END IF
  463.     END IF
  464.  
  465.  
  466.  
  467. SUB MonstersTurn
  468.     FOR i = 1 TO EncounterLimit
  469.         IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
  470.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  471.             D = Distance(MX, MY) 'distance from monster to the hero
  472.             E = Encounter(i).M 'the actual monster in question
  473.             IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
  474.  
  475.                 attack = 0
  476.                 IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
  477.                     'insert attack code here
  478.                     Swing i, 0
  479.                     _CONTINUE
  480.                 END IF
  481.  
  482.                 'if the monster didn't attack, it can now move towards the hero.
  483.                 IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
  484.                     IF D > Distance(MX - 1, MY) THEN
  485.                         IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
  486.                     END IF
  487.                 END IF
  488.                 IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
  489.                     IF D > Distance(MX, MY - 1) THEN
  490.                         IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
  491.                     END IF
  492.                 END IF
  493.                 IF MX < XH THEN 'check to see if moving right moves us towards the hero.
  494.                     IF D > Distance(MX + 1, MY) THEN
  495.                         IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
  496.                     END IF
  497.                 END IF
  498.                 IF MY < YH THEN 'check to see if moving down moves us towards the hero.
  499.                     IF D > Distance(MX, MY + 1) THEN
  500.                         IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
  501.                     END IF
  502.                 END IF
  503.             END IF
  504.         END IF
  505.  
  506.     NEXT
  507.  
  508.  
  509.  
  510.  
  511. SUB DrawMap
  512.     STATIC Icons AS LONG
  513.     IF Icons = 0 THEN
  514.         temp = _NEWIMAGE(480, 480, 32)
  515.         _DEST temp: _CONTROLCHR OFF
  516.         COLOR &HFFFFFF00, 0 'Yellow Hero
  517.         _PRINTSTRING (0, 0), CHR$(1) 'the hero
  518.         COLOR &HFFFF0000, 0 'Red Question Mark
  519.         _PRINTSTRING (16, 0), "?" 'a question mark
  520.         Icons = _LOADIMAGE("Sprites.png", 32)
  521.         _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  522.         _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  523.         '        SCREEN Icons: DO: SLEEP: LOOP
  524.     END IF
  525.     _DEST WorkScreen
  526.     CLS
  527.     'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
  528.     FOR Y = 0 TO YH
  529.         FOR X = 0 TO XH
  530.             IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
  531.                 IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
  532.             END IF
  533.             IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
  534.                 IF MapArray(X, Y) AND 4 THEN 'it's a visible room
  535.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
  536.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
  537.                 END IF
  538.                 IF MapArray(X, Y) AND 8 THEN 'it's a visible path
  539.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
  540.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
  541.                 END IF
  542.                 IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
  543.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
  544.                 END IF
  545.             END IF
  546.             'note: highlighting for the light should come AFTER the map is drawn
  547.             IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
  548.                 LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
  549.                 MapArray(X, Y) = MapArray(X, Y) - 1
  550.                 FOR I = 1 TO EncounterLimit
  551.                     IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
  552.                         E = Encounter(I).M
  553.                         IF Monster(E).Found THEN
  554.                             _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
  555.                         ELSE
  556.                             _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
  557.                         END IF
  558.                     END IF
  559.                 NEXT
  560.  
  561.             END IF
  562.         NEXT
  563.     NEXT
  564.     COLOR &HFFFFFF00, 0 'Yellow Hero
  565.     _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
  566.     XOffset## = 1600 / Scale
  567.     YOffset## = 1200 / Scale
  568.     CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
  569.     CenterY = Hero.Y * 32
  570.     _DEST DisplayScreen
  571.     LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
  572.     _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
  573.  
  574.  
  575.  
  576.  
  577.  
  578. SUB CreateMap (XLimit, YLimit, Rooms)
  579.     ERASE MapArray 'clear the old map and reset everything to 0
  580.     REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
  581.     REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
  582.     REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
  583.     XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
  584.  
  585.     DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
  586.  
  587.     StairRoom = INT(RND * Rooms) + 1
  588.     FOR i = 1 TO Rooms
  589.         DO
  590.             RoomSize = INT(RND * 9) + 2
  591.             RoomX = INT(RND * (XLimit - RoomSize))
  592.             RoomY = INT(RND * (YLimit - RoomSize))
  593.             'test for positioning
  594.             good = -1 'it's good starting out
  595.             FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  596.                     IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
  597.             NEXT X, Y
  598.         LOOP UNTIL good
  599.         FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  600.                 MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
  601.         NEXT X, Y
  602.         RoomCenterX(i) = RoomX + .5 * RoomSize
  603.         RoomCenterY(i) = RoomY + .5 * RoomSize
  604.         IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
  605.             Hero.X = RoomX + INT(RND * RoomSize)
  606.             Hero.Y = RoomY + INT(RND * RoomSize)
  607.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
  608.         END IF
  609.         IF i = StairRoom THEN 'place the stairs in one of the random rooms
  610.             DO 'But lets not place the stairs directly on top of the hero to begin with
  611.                 StairX = RoomX + INT(RND * RoomSize)
  612.                 StairY = RoomY + INT(RND * RoomSize)
  613.             LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
  614.             MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
  615.         END IF
  616.     NEXT
  617.     FOR i = 1 TO Rooms - 1
  618.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  619.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  620.         DO UNTIL StartX = EndX AND StartY = EndY
  621.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  622.             Meander = 10
  623.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  624.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  625.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  626.                     Ychange = 0
  627.                 ELSE
  628.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  629.                     Ychange = 0
  630.                 END IF
  631.             ELSE
  632.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  633.                     Ychange = SGN(EndY - StartY)
  634.                     XChange = 0
  635.                 ELSE
  636.                     Ychange = INT(RND * 3) - 1
  637.                     XChange = 0
  638.                 END IF
  639.             END IF
  640.             StartX = StartX + XChange
  641.             StartY = StartY + Ychange
  642.             IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
  643.             IF StartY < 0 THEN StartY = 0
  644.             IF StartX > XH THEN StartX = XH
  645.             IF StartY > YH THEN StartY = YH
  646.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
  647.         LOOP
  648.     NEXT
  649.     PathFind
  650.     EncounterLimit = INT(RND * 6) + 5
  651.     FOR i = 1 TO EncounterLimit
  652.         Encounter(i).M = RandomMonster
  653.         Encounter(i).Active = -1
  654.         Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
  655.         valid = -1: EndlessLoopExit = 0
  656.         DO
  657.             EndlessLoopExit = EndlessLoopExit + 1
  658.             Encounter(i).X = INT(RND * XLimit + 1)
  659.             Encounter(i).Y = INT(RND * YLimit + 1)
  660.             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.)
  661.             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".
  662.             '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.
  663.             '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.
  664.         LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
  665.         MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
  666.     NEXT
  667.  
  668. SUB PathFind
  669.     STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
  670.     DIM pass AS _UNSIGNED _BYTE
  671.     m = _MEM(Distance()): m1 = _MEM(Temp())
  672.     _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
  673.     _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
  674.     Temp(Hero.X, Hero.Y) = 0
  675.     pass = 0
  676.     DO
  677.         changed = 0
  678.         y = 0
  679.         DO
  680.             x = 0
  681.             DO
  682.                 IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
  683.                     IF x < XH THEN
  684.                         IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  685.                     END IF
  686.                     IF x > 0 THEN
  687.                         IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  688.                     END IF
  689.                     IF y < YH THEN
  690.                         IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  691.                     END IF
  692.                     IF y > 0 THEN
  693.                         IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  694.                     END IF
  695.                 END IF
  696.                 x = x + 1
  697.             LOOP UNTIL x > XH
  698.             y = y + 1
  699.         LOOP UNTIL y > YH
  700.         _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
  701.         pass = pass + 1
  702.     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!
  703.     Distance(Hero.X, Hero.Y) = 0
  704.  
  705. FUNCTION RandomMonster
  706.     'Shared variable level tells us what level of the dungeon we're on.
  707.     STATIC MC, DS 'monster count and data set
  708.     IF NOT DS THEN
  709.         DS = -1
  710.         Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
  711.         Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
  712.         Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
  713.         Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
  714.         Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
  715.         'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
  716.         'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
  717.         'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
  718.         'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
  719.         'Monster(1).Armor.Name = ""
  720.         'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
  721.  
  722.         Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
  723.         Monster(2).Level = 1: Monster(2).ExpBonus = 0
  724.         Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
  725.         Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
  726.         Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
  727.         Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
  728.         Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
  729.         Monster(3).Level = 1: Monster(3).ExpBonus = 0
  730.         Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
  731.         Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
  732.         Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
  733.         Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
  734.     END IF
  735.     SELECT CASE Level 'the starting level
  736.         CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
  737.     END SELECT
  738.     RandomMonster = INT(RND * MC) + 1
  739.  
  740.  
  741. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  742. '# SUBroutines and FUNCTIONs below #'
  743. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  744. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  745.     u = UBOUND(TextHandles)
  746.     Handle = WhichHandle
  747.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  748.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  749.     Where = TextHandles(Handle).VerticalAlignment
  750.     How = TextHandles(Handle).Justification
  751.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  752.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  753.  
  754.  
  755. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  756.     'WhichHandle is the handle which designates which text area we want to use
  757.     'Where is where we want it to go in that text area
  758.     '  -- Online prints the text to the current print position line in that text area.
  759.     '  -- CenterLine centers the text to the center of that text area.
  760.     '  -- any other value will print to that line positon in that particular box.
  761.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  762.     'What is the text that we want to print in our text area
  763.     '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).
  764.  
  765.     D = _DEST: S = _SOURCE
  766.     OldFont = _FONT
  767.  
  768.     u = UBOUND(TextHandles)
  769.     Handle = WhichHandle
  770.  
  771.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  772.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  773.     IF TextHandles(Handle).HideFrame THEN
  774.         _DEST TextHandles(Handle).SavedBackground
  775.         _SOURCE TextHandles(Handle).SavedBackground
  776.     END IF
  777.     _FONT TextHandles(Handle).Font
  778.     fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
  779.     IF _FONTWIDTH = 0 THEN
  780.         FOR i = 1 TO 255
  781.             IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
  782.         NEXT
  783.     ELSE
  784.         fw = _FONTWIDTH
  785.     END IF
  786.  
  787.     h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
  788.  
  789.     SELECT CASE Where
  790.         CASE BottomLine
  791.             y = h \ fh
  792.         CASE OnLine
  793.             y = TextHandles(Handle).Ypos
  794.             IF y = 0 THEN y = 1
  795.         CASE CenterLine
  796.             linesused = 0
  797.             tpw = pw: tw = w: tWhat$ = What
  798.             DO UNTIL tpw <= tw
  799.                 textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
  800.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  801.                 linesused = linesused + 1
  802.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  803.                 tpw = _PRINTWIDTH(tWhat$)
  804.             LOOP
  805.             linesused = linesused + 1
  806.             py = (h - linesused * fh) \ 2
  807.             y = py \ fh + 1
  808.             IF y < 1 THEN y = 1
  809.         CASE ELSE
  810.             y = Where
  811.     END SELECT
  812.  
  813.     'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  814.     blend = _BLEND
  815.  
  816.     DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  817.         'first let's get a temp image handle for the existing area of the screen.
  818.         x1 = TextHandles(Handle).x1 + 2
  819.         y1 = TextHandles(Handle).y1 + 2
  820.         x2 = TextHandles(Handle).x1 + w
  821.         y2 = TextHandles(Handle).y1 + h
  822.         nh = y2 - y1 + 1 - fh
  823.         nw = x2 - x1 + 1
  824.         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.
  825.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  826.         DrawTextArea Handle
  827.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  828.         y = y - 1
  829.     LOOP
  830.  
  831.     IF blend THEN _BLEND
  832.  
  833.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  834.  
  835.     SELECT CASE How
  836.         CASE LeftJustify
  837.             x = 0
  838.             IF pw > w THEN
  839.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  840.                 text$ = RTRIM$(LEFT$(What, textallowed))
  841.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  842.                 PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
  843.             ELSE
  844.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  845.                 finished = -1
  846.             END IF
  847.         CASE CenterJustify
  848.             IF pw > w THEN
  849.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  850.                 text$ = RTRIM$(LEFT$(What, textallowed))
  851.                 x = (w - _PRINTWIDTH(text$)) \ 2
  852.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  853.                 PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  854.             ELSE
  855.                 x = (w - pw) \ 2
  856.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  857.                 finished = -1
  858.             END IF
  859.         CASE RightJustify
  860.             IF pw > w THEN
  861.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  862.                 text$ = RTRIM$(LEFT$(What, textallowed))
  863.                 x = w - _PRINTWIDTH(text$)
  864.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  865.                 PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
  866.             ELSE
  867.                 x = w - pw
  868.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  869.                 finished = -1
  870.             END IF
  871.         CASE NoJustify
  872.             x = TextHandles(Handle).Xpos
  873.             firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
  874.             IF LEN(What) > firstlinelimit THEN
  875.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  876.                 text$ = RTRIM$(LEFT$(What, textallowed))
  877.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  878.                 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
  879.             ELSE
  880.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  881.                 finished = -1
  882.             END IF
  883.     END SELECT
  884.     IF finished THEN
  885.         SELECT CASE TextHandles(Handle).UpdateMethod
  886.             CASE NoUpdate 'We don't update the position at all.
  887.             CASE DoUpdate
  888.                 TextHandles(Handle).Xpos = x + pw
  889.                 TextHandles(Handle).Ypos = y
  890.             CASE NewLine
  891.                 TextHandles(Handle).Ypos = y + 1
  892.                 TextHandles(Handle).Xpos = 1
  893.         END SELECT
  894.         _FONT OldFont
  895.         _DEST D: _SOURCE S
  896.         COLOR FG, BG
  897.     END IF
  898.  
  899. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  900.     u = UBOUND(TextHandles)
  901.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  902.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  903.     TextHandles(Handle).TextColor = Foreground
  904.  
  905.  
  906. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  907.     u = UBOUND(TextHandles)
  908.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  909.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  910.     TextHandles(Handle).TextBackgroundColor = Background
  911.  
  912. SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
  913.     u = UBOUND(TextHandles)
  914.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  915.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  916.     SELECT CASE TextHandles(Handle).Font
  917.         CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
  918.         CASE IS > 1
  919.             'we have the font already in use
  920.             'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
  921.             _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
  922.     END SELECT
  923.  
  924.     temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
  925.     IF temp > 1 THEN
  926.         TextHandles(Handle).Font = temp
  927.     ELSE
  928.         TextHandles(Handle).Font = 16 'default to font 16, in case
  929.     END IF
  930.  
  931.  
  932. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  933.     u = UBOUND(TextHandles)
  934.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  935.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  936.     TextHandles(Handle).TextColor = Foreground
  937.     TextHandles(Handle).TextBackgroundColor = Background
  938.  
  939.  
  940. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  941.     u = UBOUND(TextHandles)
  942.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  943.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  944.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  945.     TextHandles(Handle).UpdateMethod = Method
  946.  
  947.  
  948. SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
  949.     u = UBOUND(TextHandles)
  950.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  951.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  952.     SELECT CASE Y
  953.         CASE BottomLine
  954.             TextHandles(Handle).VerticalAlignment = -2
  955.         CASE CenterLine
  956.             TextHandles(Handle).VerticalAlignment = -1
  957.         CASE ELSE
  958.             TextHandles(Handle).VerticalAlignment = 0
  959.     END SELECT
  960.     IF X < 1 AND X > -4 THEN
  961.         TextHandles(Handle).Justification = X
  962.     ELSE
  963.         TextHandles(Handle).Xpos = X
  964.     END IF
  965.     IF Y < 1 THEN EXIT SUB
  966.     TextHandles(Handle).Ypos = Y
  967.  
  968. SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
  969.     u = UBOUND(TextHandles)
  970.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  971.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  972.     IF X < 1 AND X > -4 THEN
  973.         TextHandles(Handle).Justification = X
  974.     ELSE
  975.         TextHandles(Handle).Xpos = X
  976.     END IF
  977.  
  978. SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
  979.     u = UBOUND(TextHandles)
  980.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  981.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  982.     SELECT CASE Y
  983.         CASE BottomLine
  984.             TextHandles(Handle).VerticalAlignment = -2
  985.         CASE CenterLine
  986.             TextHandles(Handle).VerticalAlignment = -1
  987.         CASE ELSE
  988.             TextHandles(Handle).VerticalAlignment = 0
  989.     END SELECT
  990.     IF Y < 1 THEN EXIT SUB
  991.     TextHandles(Handle).Ypos = Y
  992.  
  993.  
  994. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  995.     u = UBOUND(TextHandles)
  996.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  997.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  998.     GetPrintPositionY = TextHandles(Handle).Ypos
  999.  
  1000. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  1001.     u = UBOUND(TextHandles)
  1002.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1003.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1004.     GetPrintPositionX = TextHandles(Handle).Xpos
  1005.  
  1006.  
  1007.  
  1008. FUNCTION WordBreak (text$)
  1009.     CONST Breaks = " ;,.?!-"
  1010.     FOR i = LEN(text$) TO 0 STEP -1
  1011.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  1012.         loopcount = loopcount + 1
  1013.     NEXT
  1014.     IF i = 0 THEN i = LEN(text$)
  1015.     WordBreak = i
  1016.  
  1017.  
  1018.  
  1019. SUB ClearTextArea (Handle AS INTEGER)
  1020.     u = UBOUND(TextHandles)
  1021.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1022.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1023.     IF TextHandles(Handle).SavedBackground THEN
  1024.         w = TextHandles(Handle).w
  1025.         h = TextHandles(Handle).h
  1026.         x1 = TextHandles(Handle).ScreenX
  1027.         y1 = TextHandles(Handle).ScreenY
  1028.         x2 = x1 + w - 1
  1029.         y2 = y1 + h - 1
  1030.         blend = _BLEND
  1031.         _DONTBLEND
  1032.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1033.         IF blend THEN _BLEND
  1034.     END IF
  1035.     DrawTextArea Handle
  1036.  
  1037.  
  1038.  
  1039. SUB DrawTextArea (Handle AS INTEGER)
  1040.     u = UBOUND(TextHandles)
  1041.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1042.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1043.     w = TextHandles(Handle).w
  1044.     h = TextHandles(Handle).h
  1045.     x1 = TextHandles(Handle).ScreenX
  1046.     y1 = TextHandles(Handle).ScreenY
  1047.     x2 = x1 + w - 1
  1048.     y2 = y1 + h - 1
  1049.  
  1050.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  1051.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  1052.  
  1053.  
  1054.  
  1055. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  1056.     u = UBOUND(TextHandles)
  1057.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1058.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1059.     TextHandles(Handle).FrameColor = FrameColor
  1060.     TextHandles(Handle).BackColor = BackColor
  1061.  
  1062.  
  1063.  
  1064. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  1065.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  1066.     x2 = tx2: y2 = ty2
  1067.     IF x1 > x2 THEN SWAP x1, x2
  1068.     IF y1 > y2 THEN SWAP y1, y2
  1069.     w = x2 - x1 + 1
  1070.     h = y2 - y1 + 1
  1071.     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
  1072.     'Error checking for if the user sends coordinates which are off the screen
  1073.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  1074.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  1075.  
  1076.     u = UBOUND(TextHandles)
  1077.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  1078.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  1079.     NEXT
  1080.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  1081.         Handle = u + 1
  1082.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  1083.     END IF
  1084.     TextHandles(Handle).x1 = x1
  1085.     TextHandles(Handle).y1 = y1
  1086.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  1087.     TextHandles(Handle).InUse = True
  1088.     TextHandles(Handle).Xpos = 0
  1089.     TextHandles(Handle).Ypos = 1
  1090.     TextHandles(Handle).UpdateMethod = NewLine
  1091.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  1092.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  1093.  
  1094.     IF SaveBackground THEN
  1095.         imagehandle = _NEWIMAGE(w, h, 32)
  1096.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1097.         TextHandles(Handle).SavedBackground = imagehandle
  1098.     END IF
  1099.     TextHandles(Handle).ScreenX = x1
  1100.     TextHandles(Handle).ScreenY = y1
  1101.     TextHandles(Handle).Font = 16 'default to font 16
  1102.     NewTextArea% = Handle
  1103.  
  1104. SUB FreeTextArea (Handle AS INTEGER)
  1105.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  1106.         IF TextHandles(Handle).InUse THEN
  1107.             TextHandles(Handle).InUse = False
  1108.             IF TextHandles(Handle).SavedBackground THEN
  1109.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  1110.                     w = TextHandles(Handle).w
  1111.                     h = TextHandles(Handle).h
  1112.                     x1 = TextHandles(Handle).ScreenX
  1113.                     y1 = TextHandles(Handle).ScreenY
  1114.                     x2 = x1 + w - 1
  1115.                     y2 = y1 + h - 1
  1116.                     blend = _BLEND
  1117.                     _DONTBLEND
  1118.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1119.                     IF blend THEN _BLEND
  1120.                 END IF
  1121.                 '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.
  1122.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  1123.             END IF
  1124.         ELSE
  1125.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  1126.         END IF
  1127.     ELSE
  1128.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  1129.     END IF
  1130.  
  1131. SUB HideFrame (Handle AS INTEGER)
  1132.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  1133.         TextHandles(Handle).HideFrame = -1
  1134.         w = TextHandles(Handle).w
  1135.         h = TextHandles(Handle).h
  1136.         x1 = TextHandles(Handle).ScreenX
  1137.         y1 = TextHandles(Handle).ScreenY
  1138.         x2 = x1 + w - 1
  1139.         y2 = y1 + h - 1
  1140.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1141.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1142.         IF TextHandles(Handle).SavedBackground THEN
  1143.             blend = _BLEND
  1144.             _DONTBLEND
  1145.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1146.             _FREEIMAGE TextHandles(Handle).SavedBackground
  1147.             IF blend THEN _BLEND
  1148.         END IF
  1149.         TextHandles(Handle).SavedBackground = imagehandle
  1150.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  1151.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  1152.     END IF
  1153.  
  1154. SUB RestoreFrame (Handle AS INTEGER)
  1155.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  1156.         TextHandles(Handle).HideFrame = 0
  1157.         w = TextHandles(Handle).w
  1158.         h = TextHandles(Handle).h
  1159.         x1 = TextHandles(Handle).ScreenX
  1160.         y1 = TextHandles(Handle).ScreenY
  1161.         x2 = x1 + w - 1
  1162.         y2 = y1 + h - 1
  1163.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1164.         blend = _BLEND
  1165.         _DONTBLEND
  1166.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1167.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  1168.         _FREEIMAGE TextHandles(Handle).SavedBackground
  1169.         IF blend THEN _BLEND
  1170.         TextHandles(Handle).SavedBackground = imagehandle
  1171.         TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
  1172.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  1173.     END IF
  1174.  
  1175. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  1176.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  1177.     u = UBOUND(TextHandles)
  1178.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1179.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1180.     HideFrame Handle
  1181.     TextHandles(Handle).ScreenX = x1
  1182.     TextHandles(Handle).ScreenY = y1
  1183.     RestoreFrame Handle
  1184.  

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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #25 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]
  1. DEFLNG A-Z 'default to long instead of single
  2. TYPE TextArea
  3.     InUse AS INTEGER
  4.     x1 AS LONG 'left
  5.     y1 AS LONG 'top
  6.     w AS LONG 'width
  7.     h AS LONG 'height
  8.     FrameColor AS _UNSIGNED LONG
  9.     BackColor AS _UNSIGNED LONG
  10.     Xpos AS INTEGER
  11.     Ypos AS INTEGER
  12.     VerticalAlignment AS INTEGER
  13.     Justification AS INTEGER
  14.     UpdateMethod AS INTEGER
  15.     TextColor AS _UNSIGNED LONG
  16.     TextBackgroundColor AS _UNSIGNED LONG
  17.     SavedBackground AS INTEGER
  18.     HideFrame AS INTEGER
  19.     ScreenX AS INTEGER
  20.     ScreenY AS INTEGER
  21.     Font AS LONG 'NEW! Change fonts for each independent font area
  22.  
  23. REDIM SHARED TextHandles(0) AS TextArea
  24.  
  25. CONST True = -1, False = 0
  26. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  27. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  28. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  29. '********************************************************
  30. '* Text Frames before this line
  31. '********************************************************
  32.  
  33.  
  34.  
  35.  
  36.  
  37. _CONSOLE ON 'for debugging purposes while making/testing things
  38.  
  39. TYPE Damage_Type
  40.     Low AS INTEGER
  41.     High AS INTEGER
  42.  
  43. TYPE Light_Type
  44.     Name AS STRING * 20
  45.     Reach AS _UNSIGNED _BYTE
  46.     Left AS _UNSIGNED _BYTE
  47.  
  48. TYPE Weapon_Type
  49.     Name AS STRING * 20
  50.     Reach AS _UNSIGNED _BYTE
  51.     Damage AS Damage_Type
  52.     HitBonus AS _UNSIGNED _BYTE
  53.     DamageBonus AS _UNSIGNED _BYTE
  54.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  55.  
  56. TYPE Armor_Type
  57.     Name AS STRING * 20
  58.     PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
  59.     DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
  60.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  61.  
  62. TYPE Hero_Type
  63.     Name AS STRING * 20
  64.     Life AS Damage_Type
  65.     Mana AS Damage_Type
  66.     Level AS _UNSIGNED _BYTE
  67.     EXP_Earned AS LONG
  68.     EXP_Needed AS LONG
  69.     Light AS Light_Type
  70.     Weapon1 AS Weapon_Type
  71.     Weapon2 AS Weapon_Type
  72.     Armor AS Armor_Type
  73.     HealingRate AS _UNSIGNED _BYTE
  74.     Hunger AS SINGLE
  75.     HungerRate AS SINGLE
  76.  
  77. TYPE Monster_TYPE
  78.     Name AS STRING * 20
  79.     Life AS Damage_Type
  80.     Level AS INTEGER
  81.     ExpBonus AS INTEGER
  82.     Sight AS INTEGER
  83.     Hearing AS INTEGER
  84.     Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
  85.     Weapon1 AS Weapon_Type
  86.     Weapon2 AS Weapon_Type
  87.     Armor AS Armor_Type
  88.     Found AS INTEGER
  89.     IconX AS LONG
  90.     IconY AS LONG
  91.  
  92. TYPE Encounter_TYPE
  93.     Active AS INTEGER
  94.     X AS INTEGER
  95.     Y AS INTEGER
  96.     M AS INTEGER
  97.     Life AS INTEGER
  98.  
  99. REDIM SHARED Monster(100) AS Monster_TYPE
  100. REDIM SHARED Encounter(100) AS Encounter_TYPE, EncounterLimit AS INTEGER
  101.  
  102. DIM SHARED Hero AS Hero_Type
  103. DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
  104. DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
  105. DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
  106. DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG, Icons AS LONG
  107. DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
  108.  
  109. WorkScreen = _NEWIMAGE(3200, 2400, 32)
  110. DisplayScreen = _NEWIMAGE(800, 700, 32)
  111. SCREEN DisplayScreen
  112. Scale = 2
  113.  
  114. REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
  115. '1 map is illuminated
  116. '2 map is uncovered
  117. '4 map is a wall
  118. '8 map is a pathway
  119. '16 map is a stairway
  120. '32 map is simply blocked (perhaps with a monster?)
  121. '64 map is secret (can not be uncovered)
  122.  
  123. REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
  124.  
  125.  
  126.  
  127. ON ERROR GOTO errorhandler
  128.  
  129. GOTO skiperrorhandler
  130. errorhandler:
  131.  
  132. PRINT ERR; "Error on "; _ERRORLINE
  133. _DEST DisplayScreen
  134. skiperrorhandler:
  135.  
  136. Init
  137. CreateMap 99, 74, 10
  138.  
  139.     DrawMap
  140.     DisplayCharacter
  141.     _DISPLAY
  142.     GetInput
  143.     MonstersTurn
  144.     CheckForHeroGrowth
  145.  
  146. SUB Init
  147.     D = _DEST
  148.     Hero.Name = "Steve The Tester!"
  149.     Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
  150.     Hero.Mana.Low = 10: Hero.Mana.High = 10
  151.     Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
  152.     Hero.Light.Name = "Magic Candle"
  153.     Hero.Light.Reach = 2: Hero.Light.Left = -1 'infinite
  154.     Hero.Weapon1.Name = "Bare Fist"
  155.     Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
  156.     Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
  157.     Hero.Weapon1.Left = -1 'your fist is indestructible!
  158.     Hero.Weapon2.Name = "Magic Candle"
  159.     Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
  160.     Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
  161.     Hero.Weapon2.Left = 0 'you can't attack with a candle
  162.     Hero.Armor.Name = "Naked"
  163.     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!
  164.     Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
  165.     Hero.HungerRate = 0.1 'Let's start heros out with a full belly and a low hunger growth rate
  166.  
  167.     PrintArea = NewTextArea(230, 601, 799, 699, False)
  168.     ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  169.     SetTextFont PrintArea, "courbd.ttf", 24
  170.     DrawTextArea PrintArea
  171.     SetPrintPositionX PrintArea, CenterJustify
  172.     SetPrintUpdate PrintArea, NewLine
  173.     PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
  174.     SetTextFont PrintArea, "courbd.ttf", 18
  175.     PrintOut PrintArea, "created by STEVE!"
  176.     PrintOut PrintArea, ""
  177.     SetPrintPositionX PrintArea, LeftJustify
  178.     SetTextFont PrintArea, "courbd.ttf", 12
  179.     TextFont = 12
  180.  
  181.  
  182.  
  183.     temp = _NEWIMAGE(480, 480, 32)
  184.     _DEST temp: _CONTROLCHR OFF
  185.     COLOR &HFFFFFF00, 0 'Yellow Hero
  186.     _PRINTSTRING (0, 0), CHR$(1) 'the hero
  187.     COLOR &HFFFF0000, 0 'Red Question Mark
  188.     _PRINTSTRING (16, 0), "?" 'a question mark
  189.     Icons = _LOADIMAGE("Sprites.png", 32)
  190.     _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  191.     _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  192.     '        SCREEN Icons: DO: SLEEP: LOOP
  193.  
  194.  
  195.     _DEST D
  196.  
  197. SUB CheckForHeroGrowth
  198.     IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
  199.         CLS
  200.         PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
  201.         _DISPLAY
  202.         BEEP
  203.         _DELAY 5
  204.         SYSTEM
  205.     END IF
  206.     IF Hero.EXP_Earned >= Hero.EXP_Needed THEN 'let's check to see if the hero has leveled up
  207.         PrintOut PrintArea, "Congratulations!  You have gained a level!"
  208.         DO
  209.             r = INT(RND * 6) + 1
  210.             lifegained = lifegained + r
  211.         LOOP UNTIL r <> 6
  212.         Hero.Life.Low = Hero.Life.Low + r
  213.         Hero.Life.High = Hero.Life.High + r
  214.         Hero.EXP_Earned = 0
  215.         Hero.Level = Hero.Level + 1
  216.         Hero.EXP_Needed = Hero.EXP_Needed + Hero.Level + 1
  217.     END IF
  218.     IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
  219.         IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
  220.     END IF
  221.     Hero.Hunger = Hero.Hunger + Hero.HungerRate
  222.  
  223.  
  224.  
  225. SUB DisplayCharacter
  226.     LINE (0, 601)-(229, 799), &HFF000000, BF
  227.     COLOR -1, 0
  228.  
  229.     Box 0, 601, 229, 62, 0, 0, "", Silver, 0
  230.     Box 0, 601, 229, 12, Black, 0, _TRIM$(Hero.Name), Silver, 0
  231.     Box 0, 626, 229 * Hero.Life.Low / Hero.Life.High, 12, 0, 0, "", Red, Black
  232.     Box 0, 639, 229 * Hero.Mana.Low / Hero.Mana.High, 12, 0, 0, "", Blue, Black
  233.     Box 0, 652, 229 * Hero.EXP_Earned / Hero.EXP_Needed, 12, 0, 0, "", Green, Black
  234.     _PRINTSTRING (10, 616), "LEVEL:" + STR$(Hero.Level)
  235.     _PRINTSTRING (10, 629), "LIFE :" + STR$(Hero.Life.Low) + " / " + _TRIM$(STR$(Hero.Life.High))
  236.     _PRINTSTRING (10, 642), "MANA :" + STR$(Hero.Mana.Low) + " / " + _TRIM$(STR$(Hero.Mana.High))
  237.     _PRINTSTRING (10, 655), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
  238.  
  239.     FOR i = 0 TO 5 'six boxes for information : left hand, right hand, armor, and 3 more for later....
  240.         Box 36 * i + 8, 665, 34, 34, 0, 0, "", Black, Silver
  241.     NEXT
  242.     FOR i = 0 TO 1
  243.         IF i = 0 THEN WeaponName$ = _TRIM$(Hero.Weapon1.Name) ELSE WeaponName$ = _TRIM$(Hero.Weapon2.Name)
  244.  
  245.         SELECT CASE WeaponName$
  246.             CASE "Bare Fist": X = 2 * 32: Y = 47 * 32
  247.             CASE "Magic Candle": X = 52 * 32: Y = 42 * 32
  248.             CASE ELSE: X = -100: Y = -100
  249.         END SELECT
  250.         _PUTIMAGE (9 + 36 * i, 666)-STEP(32, 32), Icons, DisplayScreen, (X, Y)-STEP(32, 32)
  251.     NEXT
  252.     SELECT CASE _TRIM$(Hero.Armor.Name)
  253.         CASE "Naked": X = 46 * 32: Y = 42 * 32
  254.         CASE ELSE: X = -100: Y = -100
  255.     END SELECT
  256.     _PUTIMAGE (81, 666)-STEP(32, 32), Icons, DisplayScreen, (X, Y)-STEP(32, 32)
  257.  
  258.  
  259. SUB GetInput
  260.     DO
  261.         k = _KEYHIT: valid = -1
  262.         SELECT CASE k
  263.             CASE 18432 'up
  264.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  265.                     SELECT CASE Scale
  266.                         CASE 1.5: Scale = 2 'It's as small as we go
  267.                         CASE 2: Scale = 3
  268.                         CASE 3: Scale = 4
  269.                         CASE 4: Scale = 6
  270.                         CASE 6: Scale = 8
  271.                         CASE 8: Scale = 12
  272.                     END SELECT
  273.                 ELSE
  274.                     IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
  275.                 END IF
  276.             CASE 19200: 'left
  277.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  278.                     TextFont = TextFont - 1
  279.                     IF TextFont < 8 THEN TextFont = 8
  280.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  281.                     ClearTextArea PrintArea
  282.                     SetPrintPosition PrintArea, 1, 1
  283.                     PrintOut PrintArea, "Font Size Changed"
  284.                 ELSE
  285.                     IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
  286.                 END IF
  287.             CASE 20480: 'down
  288.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  289.                     SELECT CASE Scale
  290.                         CASE 2: Scale = 1.5 'It's as small as we go
  291.                         CASE 3: Scale = 2
  292.                         CASE 4: Scale = 3
  293.                         CASE 6: Scale = 4
  294.                         CASE 8: Scale = 6
  295.                         CASE 12: Scale = 8
  296.                     END SELECT
  297.                 ELSE
  298.                     IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
  299.                 END IF
  300.             CASE 19712: 'right
  301.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  302.                     TextFont = TextFont + 1
  303.                     IF TextFont > 48 THEN TextFont = 48
  304.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  305.                     ClearTextArea PrintArea
  306.                     SetPrintPosition PrintArea, 1, 1
  307.                     PrintOut PrintArea, "Font Size Changed"
  308.                 ELSE
  309.                     IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
  310.                 END IF
  311.             CASE 32 'space to just wait and skip a turn
  312.             CASE 60 ' "<" key
  313.                 IF MapArray(Hero.X, Hero.Y) AND 16 THEN
  314.                     Level = Level + 1
  315.                     CreateMap 99, 74, 10
  316.                     PathFind
  317.                 END IF
  318.             CASE ASC("+"), ASC("=")
  319.                 IF Hero.Light.Reach < 25 THEN Hero.Light.Reach = Hero.Light.Reach + 1
  320.             CASE ASC("-"), ASC("_")
  321.                 IF Hero.Light.Reach > 1 THEN Hero.Light.Reach = Hero.Light.Reach - 1
  322.             CASE ELSE
  323.                 valid = 0 'it's a key press which we don't recognize.  Ignore it
  324.         END SELECT
  325.         _LIMIT 60
  326.     LOOP UNTIL k AND valid
  327.     _KEYCLEAR 'one keystroke at a time
  328.     StepsTaken = StepsTaken + 1
  329.  
  330. SUB Box (X, Y, Wide, High, FontColor as _unsigned long, _
  331.          FontBackGround as _unsigned long, Caption AS STRING, Kolor AS _UNSIGNED LONG, BackGround AS _UNSIGNED LONG)
  332.     COLOR FontColor, FontBackGround
  333.     LINE (X, Y)-STEP(Wide, High), Kolor, BF
  334.     LINE (X, Y)-STEP(Wide, High), BackGround, B
  335.     pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
  336.     _PRINTSTRING (X + (Wide - pw + 1) \ 2, Y + (High - ph + 1) \ 2), Caption
  337.     COLOR DC, BG
  338.  
  339.  
  340. SUB MoveHero (MoveX, MoveY)
  341.     TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
  342.     IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
  343.         IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
  344.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
  345.             IF MoveX THEN Hero.X = Hero.X + MoveX
  346.             IF MoveY THEN Hero.Y = Hero.Y + MoveY
  347.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
  348.             PathFind
  349.         ELSE
  350.             '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!
  351.             FOR i = 1 TO EncounterLimit
  352.                 IF Encounter(i).Active THEN 'Check for active/alive monsters only
  353.                     MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  354.                     IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
  355.                         Swing 0, i 'hero swings at the monster
  356.                     END IF
  357.                 END IF
  358.             NEXT
  359.         END IF
  360.     END IF
  361.  
  362. SUB Swing (Who, AtWhom)
  363.  
  364.     BaseChancetohit = 10 'base 10 chance to hit
  365.     IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
  366.         M = Encounter(AtWhom).M
  367.         IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  368.             Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
  369.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  370.             totalroll = 0
  371.             DO
  372.                 roll = INT(RND * 20) + 1
  373.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  374.                 IF roll = 20 THEN totalroll = totalroll + 20
  375.                 totalroll = totalroll + roll
  376.             LOOP UNTIL roll <> 1 AND roll <> 20
  377.             damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
  378.             damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
  379.             out$ = _TRIM$(Hero.Name)
  380.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  381.                 SetTextColor PrintArea, &HFFF000F0, 0
  382.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  383.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  384.                 Hero.Life.Low = Hero.Life.Low - damage
  385.             ELSEIF totalroll < Chancetohit THEN
  386.                 SetTextColor PrintArea, &HFFF0F000, 0
  387.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  388.             ELSEIF totalroll > Chancetohit + 20 THEN
  389.                 SetTextColor PrintArea, &HFF00FF00, 0
  390.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  391.                 damage = damage * (totalroll / 20 + 1)
  392.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  393.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  394.             ELSEIF totalroll >= Chancetohit THEN
  395.                 SetTextColor PrintArea, &HFF00FF00, 0
  396.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  397.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
  398.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  399.             END IF
  400.         ELSEIF Hero.Weapon1.Reach > 0 THEN
  401.             SetTextColor PrintArea, &HFFF000F0, 0
  402.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
  403.         ELSE
  404.             out$ = ""
  405.         END IF
  406.         IF out$ <> "" THEN PrintOut PrintArea, out$
  407.         IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  408.             Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
  409.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  410.             totalroll = 0
  411.             DO
  412.                 roll = INT(RND * 20) + 1
  413.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  414.                 IF roll = 20 THEN totalroll = totalroll + 20
  415.                 totalroll = totalroll + roll
  416.             LOOP UNTIL roll <> 1 AND roll <> 20
  417.             damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
  418.             damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
  419.             out$ = _TRIM$(Hero.Name)
  420.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  421.                 SetTextColor PrintArea, &HFFF000F0, 0
  422.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  423.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  424.                 damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
  425.                 Hero.Life.Low = Hero.Life.Low - damage
  426.             ELSEIF totalroll < Chancetohit THEN
  427.                 SetTextColor PrintArea, &HFFF0F000, 0
  428.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  429.             ELSEIF totalroll > Chancetohit + 20 THEN
  430.                 SetTextColor PrintArea, &HFF00FF00, 0
  431.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  432.                 damage = damage * (totalroll / 20 + 1)
  433.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  434.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  435.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  436.             ELSEIF totalroll >= Chancetohit THEN
  437.                 SetTextColor PrintArea, &HFF00FF00, 0
  438.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  439.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
  440.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  441.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  442.             END IF
  443.         ELSEIF Hero.Weapon2.Reach > 0 THEN
  444.             SetTextColor PrintArea, &HFFF000F0, 0
  445.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
  446.         ELSE
  447.             out$ = ""
  448.         END IF
  449.         IF out$ <> "" THEN PrintOut PrintArea, out$
  450.         IF Encounter(AtWhom).Life <= 0 THEN 'the monster died!
  451.             SetTextColor PrintArea, &HFFFF0000, 0
  452.             out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
  453.             PrintOut PrintArea, out$
  454.             Encounter(AtWhom).Active = 0
  455.             Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
  456.             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!
  457.             IF Monster(M).Found = 0 THEN
  458.                 Monster(M).Found = -1 'it's a first time kill!
  459.                 SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
  460.                 out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
  461.                 PrintOut PrintArea, out$
  462.             END IF
  463.         END IF
  464.     ELSE 'it's a monster attacking
  465.         M = Encounter(Who).M
  466.         IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
  467.             Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
  468.             Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
  469.             totalroll = 0
  470.             DO
  471.                 roll = INT(RND * 20) + 1
  472.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  473.                 IF roll = 20 THEN totalroll = totalroll + 20
  474.                 totalroll = totalroll + roll
  475.             LOOP UNTIL roll <> 1 AND roll <> 20
  476.             damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
  477.             damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
  478.             out$ = _TRIM$(Monster(M).Name)
  479.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  480.                 SetTextColor PrintArea, &HFFF000F0, 0
  481.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  482.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  483.                 Monster(M).Life.Low = Monster(M).Life.Low - damage
  484.             ELSEIF totalroll < Chancetohit THEN
  485.                 SetTextColor PrintArea, &HFFF0F000, 0
  486.                 out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  487.             ELSEIF totalroll > Chancetohit + 20 THEN
  488.                 SetTextColor PrintArea, &HFF00FFFF, 0
  489.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
  490.                 damage = damage * (totalroll / 20 + 1)
  491.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  492.                 Hero.Life.Low = Hero.Life.Low - damage
  493.             ELSEIF totalroll >= Chancetohit THEN
  494.                 SetTextColor PrintArea, &HFF00FFFF, 0
  495.                 out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
  496.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
  497.                 Hero.Life.Low = Hero.Life.Low - damage
  498.             END IF
  499.         ELSEIF Monster(M).Weapon1.Reach > 0 THEN
  500.             SetTextColor PrintArea, &HFFF000F0, 0
  501.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
  502.         ELSE
  503.             out$ = ""
  504.         END IF
  505.         IF out$ <> "" THEN PrintOut PrintArea, out$
  506.     END IF
  507.  
  508.  
  509. FUNCTION MoveMonster (Monster, MoveX, MoveY)
  510.     MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
  511.     D = Distance(MX, MY) 'distance from monster to the hero
  512.     E = Encounter(i).M 'the actual monster in question
  513.  
  514.     IF D > Distance(MX + MoveX, MY + MoveY) THEN
  515.         IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
  516.             MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
  517.             Encounter(Monster).X = Encounter(Monster).X + MoveX
  518.             Encounter(Monster).Y = Encounter(Monster).Y + MoveY
  519.             MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
  520.             MoveMonster = -1
  521.         END IF
  522.     END IF
  523.  
  524.  
  525.  
  526. SUB MonstersTurn
  527.     FOR i = 1 TO EncounterLimit
  528.         IF Encounter(i).Active THEN 'Only if the monster is still alive and active do we need to actually do anything else.
  529.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  530.             D = Distance(MX, MY) 'distance from monster to the hero
  531.             E = Encounter(i).M 'the actual monster in question
  532.             IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
  533.  
  534.                 attack = 0
  535.                 IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
  536.                     'insert attack code here
  537.                     Swing i, 0
  538.                     _CONTINUE
  539.                 END IF
  540.  
  541.                 'if the monster didn't attack, it can now move towards the hero.
  542.                 IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
  543.                     IF D > Distance(MX - 1, MY) THEN
  544.                         IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
  545.                     END IF
  546.                 END IF
  547.                 IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
  548.                     IF D > Distance(MX, MY - 1) THEN
  549.                         IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
  550.                     END IF
  551.                 END IF
  552.                 IF MX < XH THEN 'check to see if moving right moves us towards the hero.
  553.                     IF D > Distance(MX + 1, MY) THEN
  554.                         IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
  555.                     END IF
  556.                 END IF
  557.                 IF MY < YH THEN 'check to see if moving down moves us towards the hero.
  558.                     IF D > Distance(MX, MY + 1) THEN
  559.                         IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
  560.                     END IF
  561.                 END IF
  562.             END IF
  563.         END IF
  564.  
  565.     NEXT
  566.  
  567.  
  568.  
  569.  
  570. SUB DrawMap
  571.     _DEST WorkScreen
  572.     CLS
  573.     'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
  574.     FOR Y = 0 TO YH
  575.         FOR X = 0 TO XH
  576.             IF Distance(X, Y) <= Hero.Light.Reach THEN 'It's close enough to check for illumination
  577.                 IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
  578.             END IF
  579.             IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
  580.                 IF MapArray(X, Y) AND 4 THEN 'it's a visible room
  581.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
  582.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
  583.                 END IF
  584.                 IF MapArray(X, Y) AND 8 THEN 'it's a visible path
  585.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
  586.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
  587.                 END IF
  588.                 IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
  589.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
  590.                 END IF
  591.             END IF
  592.             'note: highlighting for the light should come AFTER the map is drawn
  593.             IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
  594.                 LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
  595.                 MapArray(X, Y) = MapArray(X, Y) - 1
  596.                 FOR I = 1 TO EncounterLimit
  597.                     IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
  598.                         E = Encounter(I).M
  599.                         IF Monster(E).Found THEN
  600.                             _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
  601.                         ELSE
  602.                             _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
  603.                         END IF
  604.                     END IF
  605.                 NEXT
  606.  
  607.             END IF
  608.         NEXT
  609.     NEXT
  610.     COLOR &HFFFFFF00, 0 'Yellow Hero
  611.     _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
  612.     XOffset## = 1600 / Scale
  613.     YOffset## = 1200 / Scale
  614.     CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
  615.     CenterY = Hero.Y * 32
  616.     _DEST DisplayScreen
  617.     LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
  618.     _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
  619.  
  620.  
  621.  
  622.  
  623.  
  624. SUB CreateMap (XLimit, YLimit, Rooms)
  625.     ERASE MapArray 'clear the old map and reset everything to 0
  626.     REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
  627.     REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
  628.     REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
  629.     XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
  630.  
  631.     DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
  632.  
  633.     StairRoom = INT(RND * Rooms) + 1
  634.     FOR i = 1 TO Rooms
  635.         DO
  636.             RoomSize = INT(RND * 9) + 2
  637.             RoomX = INT(RND * (XLimit - RoomSize))
  638.             RoomY = INT(RND * (YLimit - RoomSize))
  639.             'test for positioning
  640.             good = -1 'it's good starting out
  641.             FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  642.                     IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
  643.             NEXT X, Y
  644.         LOOP UNTIL good
  645.         FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  646.                 MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
  647.         NEXT X, Y
  648.         RoomCenterX(i) = RoomX + .5 * RoomSize
  649.         RoomCenterY(i) = RoomY + .5 * RoomSize
  650.         IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
  651.             Hero.X = RoomX + INT(RND * RoomSize)
  652.             Hero.Y = RoomY + INT(RND * RoomSize)
  653.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
  654.         END IF
  655.         IF i = StairRoom THEN 'place the stairs in one of the random rooms
  656.             DO 'But lets not place the stairs directly on top of the hero to begin with
  657.                 StairX = RoomX + INT(RND * RoomSize)
  658.                 StairY = RoomY + INT(RND * RoomSize)
  659.             LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
  660.             MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
  661.         END IF
  662.     NEXT
  663.     FOR i = 1 TO Rooms - 1
  664.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  665.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  666.         DO UNTIL StartX = EndX AND StartY = EndY
  667.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  668.             Meander = 10
  669.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  670.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  671.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  672.                     Ychange = 0
  673.                 ELSE
  674.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  675.                     Ychange = 0
  676.                 END IF
  677.             ELSE
  678.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  679.                     Ychange = SGN(EndY - StartY)
  680.                     XChange = 0
  681.                 ELSE
  682.                     Ychange = INT(RND * 3) - 1
  683.                     XChange = 0
  684.                 END IF
  685.             END IF
  686.             StartX = StartX + XChange
  687.             StartY = StartY + Ychange
  688.             IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
  689.             IF StartY < 0 THEN StartY = 0
  690.             IF StartX > XH THEN StartX = XH
  691.             IF StartY > YH THEN StartY = YH
  692.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
  693.         LOOP
  694.     NEXT
  695.     PathFind
  696.     EncounterLimit = INT(RND * 6) + 5
  697.     FOR i = 1 TO EncounterLimit
  698.         Encounter(i).M = RandomMonster
  699.         Encounter(i).Active = -1
  700.         Encounter(i).Life = INT(RND * Monster(Encounter(i).M).Life.High - Monster(Encounter(i).M).Life.Low + 1) + Monster(Encounter(i).M).Life.Low
  701.         valid = -1: EndlessLoopExit = 0
  702.         DO
  703.             EndlessLoopExit = EndlessLoopExit + 1
  704.             Encounter(i).X = INT(RND * XLimit + 1)
  705.             Encounter(i).Y = INT(RND * YLimit + 1)
  706.             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.)
  707.             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".
  708.             '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.
  709.             '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.
  710.         LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
  711.         MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
  712.     NEXT
  713.  
  714. SUB PathFind
  715.     STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
  716.     DIM pass AS _UNSIGNED _BYTE
  717.     m = _MEM(Distance()): m1 = _MEM(Temp())
  718.     _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
  719.     _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
  720.     Temp(Hero.X, Hero.Y) = 0
  721.     pass = 0
  722.     DO
  723.         changed = 0
  724.         y = 0
  725.         DO
  726.             x = 0
  727.             DO
  728.                 IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
  729.                     IF x < XH THEN
  730.                         IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  731.                     END IF
  732.                     IF x > 0 THEN
  733.                         IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  734.                     END IF
  735.                     IF y < YH THEN
  736.                         IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  737.                     END IF
  738.                     IF y > 0 THEN
  739.                         IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  740.                     END IF
  741.                 END IF
  742.                 x = x + 1
  743.             LOOP UNTIL x > XH
  744.             y = y + 1
  745.         LOOP UNTIL y > YH
  746.         _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
  747.         pass = pass + 1
  748.     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!
  749.     Distance(Hero.X, Hero.Y) = 0
  750.  
  751. FUNCTION RandomMonster
  752.     'Shared variable level tells us what level of the dungeon we're on.
  753.     STATIC MC, DS 'monster count and data set
  754.     IF NOT DS THEN
  755.         DS = -1
  756.         Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
  757.         Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
  758.         Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
  759.         Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
  760.         Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
  761.         'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
  762.         'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
  763.         'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
  764.         'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
  765.         'Monster(1).Armor.Name = ""
  766.         'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
  767.  
  768.         Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
  769.         Monster(2).Level = 1: Monster(2).ExpBonus = 0
  770.         Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
  771.         Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
  772.         Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
  773.         Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
  774.         Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
  775.         Monster(3).Level = 1: Monster(3).ExpBonus = 0
  776.         Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
  777.         Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
  778.         Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
  779.         Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
  780.     END IF
  781.     SELECT CASE Level 'the starting level
  782.         CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
  783.     END SELECT
  784.     RandomMonster = INT(RND * MC) + 1
  785.  
  786.  
  787. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  788. '# SUBroutines and FUNCTIONs below #'
  789. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  790. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  791.     u = UBOUND(TextHandles)
  792.     Handle = WhichHandle
  793.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  794.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  795.     Where = TextHandles(Handle).VerticalAlignment
  796.     How = TextHandles(Handle).Justification
  797.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  798.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  799.  
  800.  
  801. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  802.     'WhichHandle is the handle which designates which text area we want to use
  803.     'Where is where we want it to go in that text area
  804.     '  -- Online prints the text to the current print position line in that text area.
  805.     '  -- CenterLine centers the text to the center of that text area.
  806.     '  -- any other value will print to that line positon in that particular box.
  807.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  808.     'What is the text that we want to print in our text area
  809.     '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).
  810.  
  811.     D = _DEST: S = _SOURCE
  812.     OldFont = _FONT
  813.  
  814.     u = UBOUND(TextHandles)
  815.     Handle = WhichHandle
  816.  
  817.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  818.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  819.     IF TextHandles(Handle).HideFrame THEN
  820.         _DEST TextHandles(Handle).SavedBackground
  821.         _SOURCE TextHandles(Handle).SavedBackground
  822.     END IF
  823.     _FONT TextHandles(Handle).Font
  824.     fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
  825.     IF _FONTWIDTH = 0 THEN
  826.         FOR i = 1 TO 255
  827.             IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
  828.         NEXT
  829.     ELSE
  830.         fw = _FONTWIDTH
  831.     END IF
  832.  
  833.     h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
  834.  
  835.     SELECT CASE Where
  836.         CASE BottomLine
  837.             y = h \ fh
  838.         CASE OnLine
  839.             y = TextHandles(Handle).Ypos
  840.             IF y = 0 THEN y = 1
  841.         CASE CenterLine
  842.             linesused = 0
  843.             tpw = pw: tw = w: tWhat$ = What
  844.             DO UNTIL tpw <= tw
  845.                 textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
  846.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  847.                 linesused = linesused + 1
  848.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  849.                 tpw = _PRINTWIDTH(tWhat$)
  850.             LOOP
  851.             linesused = linesused + 1
  852.             py = (h - linesused * fh) \ 2
  853.             y = py \ fh + 1
  854.             IF y < 1 THEN y = 1
  855.         CASE ELSE
  856.             y = Where
  857.     END SELECT
  858.  
  859.     'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  860.     blend = _BLEND
  861.  
  862.     DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  863.         'first let's get a temp image handle for the existing area of the screen.
  864.         x1 = TextHandles(Handle).x1 + 2
  865.         y1 = TextHandles(Handle).y1 + 2
  866.         x2 = TextHandles(Handle).x1 + w
  867.         y2 = TextHandles(Handle).y1 + h
  868.         nh = y2 - y1 + 1 - fh
  869.         nw = x2 - x1 + 1
  870.         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.
  871.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  872.         DrawTextArea Handle
  873.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  874.         y = y - 1
  875.     LOOP
  876.  
  877.     IF blend THEN _BLEND
  878.  
  879.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  880.  
  881.     SELECT CASE How
  882.         CASE LeftJustify
  883.             x = 0
  884.             IF pw > w THEN
  885.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  886.                 text$ = RTRIM$(LEFT$(What, textallowed))
  887.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  888.                 PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
  889.             ELSE
  890.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  891.                 finished = -1
  892.             END IF
  893.         CASE CenterJustify
  894.             IF pw > w THEN
  895.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  896.                 text$ = RTRIM$(LEFT$(What, textallowed))
  897.                 x = (w - _PRINTWIDTH(text$)) \ 2
  898.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  899.                 PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  900.             ELSE
  901.                 x = (w - pw) \ 2
  902.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  903.                 finished = -1
  904.             END IF
  905.         CASE RightJustify
  906.             IF pw > w THEN
  907.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  908.                 text$ = RTRIM$(LEFT$(What, textallowed))
  909.                 x = w - _PRINTWIDTH(text$)
  910.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  911.                 PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
  912.             ELSE
  913.                 x = w - pw
  914.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  915.                 finished = -1
  916.             END IF
  917.         CASE NoJustify
  918.             x = TextHandles(Handle).Xpos
  919.             firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
  920.             IF LEN(What) > firstlinelimit THEN
  921.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  922.                 text$ = RTRIM$(LEFT$(What, textallowed))
  923.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  924.                 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
  925.             ELSE
  926.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  927.                 finished = -1
  928.             END IF
  929.     END SELECT
  930.     IF finished THEN
  931.         SELECT CASE TextHandles(Handle).UpdateMethod
  932.             CASE NoUpdate 'We don't update the position at all.
  933.             CASE DoUpdate
  934.                 TextHandles(Handle).Xpos = x + pw
  935.                 TextHandles(Handle).Ypos = y
  936.             CASE NewLine
  937.                 TextHandles(Handle).Ypos = y + 1
  938.                 TextHandles(Handle).Xpos = 1
  939.         END SELECT
  940.         _FONT OldFont
  941.         _DEST D: _SOURCE S
  942.         COLOR FG, BG
  943.     END IF
  944.  
  945. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  946.     u = UBOUND(TextHandles)
  947.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  948.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  949.     TextHandles(Handle).TextColor = Foreground
  950.  
  951.  
  952. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  953.     u = UBOUND(TextHandles)
  954.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  955.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  956.     TextHandles(Handle).TextBackgroundColor = Background
  957.  
  958. SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
  959.     u = UBOUND(TextHandles)
  960.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  961.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  962.     SELECT CASE TextHandles(Handle).Font
  963.         CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
  964.         CASE IS > 1
  965.             'we have the font already in use
  966.             'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
  967.             _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
  968.     END SELECT
  969.  
  970.     temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
  971.     IF temp > 1 THEN
  972.         TextHandles(Handle).Font = temp
  973.     ELSE
  974.         TextHandles(Handle).Font = 16 'default to font 16, in case
  975.     END IF
  976.  
  977.  
  978. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  979.     u = UBOUND(TextHandles)
  980.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  981.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  982.     TextHandles(Handle).TextColor = Foreground
  983.     TextHandles(Handle).TextBackgroundColor = Background
  984.  
  985.  
  986. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  987.     u = UBOUND(TextHandles)
  988.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  989.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  990.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  991.     TextHandles(Handle).UpdateMethod = Method
  992.  
  993.  
  994. SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
  995.     u = UBOUND(TextHandles)
  996.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  997.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  998.     SELECT CASE Y
  999.         CASE BottomLine
  1000.             TextHandles(Handle).VerticalAlignment = -2
  1001.         CASE CenterLine
  1002.             TextHandles(Handle).VerticalAlignment = -1
  1003.         CASE ELSE
  1004.             TextHandles(Handle).VerticalAlignment = 0
  1005.     END SELECT
  1006.     IF X < 1 AND X > -4 THEN
  1007.         TextHandles(Handle).Justification = X
  1008.     ELSE
  1009.         TextHandles(Handle).Xpos = X
  1010.     END IF
  1011.     IF Y < 1 THEN EXIT SUB
  1012.     TextHandles(Handle).Ypos = Y
  1013.  
  1014. SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
  1015.     u = UBOUND(TextHandles)
  1016.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1017.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1018.     IF X < 1 AND X > -4 THEN
  1019.         TextHandles(Handle).Justification = X
  1020.     ELSE
  1021.         TextHandles(Handle).Xpos = X
  1022.     END IF
  1023.  
  1024. SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
  1025.     u = UBOUND(TextHandles)
  1026.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1027.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1028.     SELECT CASE Y
  1029.         CASE BottomLine
  1030.             TextHandles(Handle).VerticalAlignment = -2
  1031.         CASE CenterLine
  1032.             TextHandles(Handle).VerticalAlignment = -1
  1033.         CASE ELSE
  1034.             TextHandles(Handle).VerticalAlignment = 0
  1035.     END SELECT
  1036.     IF Y < 1 THEN EXIT SUB
  1037.     TextHandles(Handle).Ypos = Y
  1038.  
  1039.  
  1040. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  1041.     u = UBOUND(TextHandles)
  1042.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1043.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1044.     GetPrintPositionY = TextHandles(Handle).Ypos
  1045.  
  1046. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  1047.     u = UBOUND(TextHandles)
  1048.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1049.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1050.     GetPrintPositionX = TextHandles(Handle).Xpos
  1051.  
  1052.  
  1053.  
  1054. FUNCTION WordBreak (text$)
  1055.     CONST Breaks = " ;,.?!-"
  1056.     FOR i = LEN(text$) TO 0 STEP -1
  1057.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  1058.         loopcount = loopcount + 1
  1059.     NEXT
  1060.     IF i = 0 THEN i = LEN(text$)
  1061.     WordBreak = i
  1062.  
  1063.  
  1064.  
  1065. SUB ClearTextArea (Handle AS INTEGER)
  1066.     u = UBOUND(TextHandles)
  1067.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1068.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1069.     IF TextHandles(Handle).SavedBackground THEN
  1070.         w = TextHandles(Handle).w
  1071.         h = TextHandles(Handle).h
  1072.         x1 = TextHandles(Handle).ScreenX
  1073.         y1 = TextHandles(Handle).ScreenY
  1074.         x2 = x1 + w - 1
  1075.         y2 = y1 + h - 1
  1076.         blend = _BLEND
  1077.         _DONTBLEND
  1078.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1079.         IF blend THEN _BLEND
  1080.     END IF
  1081.     DrawTextArea Handle
  1082.  
  1083.  
  1084.  
  1085. SUB DrawTextArea (Handle AS INTEGER)
  1086.     u = UBOUND(TextHandles)
  1087.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1088.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1089.     w = TextHandles(Handle).w
  1090.     h = TextHandles(Handle).h
  1091.     x1 = TextHandles(Handle).ScreenX
  1092.     y1 = TextHandles(Handle).ScreenY
  1093.     x2 = x1 + w - 1
  1094.     y2 = y1 + h - 1
  1095.  
  1096.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  1097.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  1098.  
  1099.  
  1100.  
  1101. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  1102.     u = UBOUND(TextHandles)
  1103.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1104.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1105.     TextHandles(Handle).FrameColor = FrameColor
  1106.     TextHandles(Handle).BackColor = BackColor
  1107.  
  1108.  
  1109.  
  1110. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  1111.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  1112.     x2 = tx2: y2 = ty2
  1113.     IF x1 > x2 THEN SWAP x1, x2
  1114.     IF y1 > y2 THEN SWAP y1, y2
  1115.     w = x2 - x1 + 1
  1116.     h = y2 - y1 + 1
  1117.     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
  1118.     'Error checking for if the user sends coordinates which are off the screen
  1119.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  1120.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  1121.  
  1122.     u = UBOUND(TextHandles)
  1123.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  1124.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  1125.     NEXT
  1126.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  1127.         Handle = u + 1
  1128.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  1129.     END IF
  1130.     TextHandles(Handle).x1 = x1
  1131.     TextHandles(Handle).y1 = y1
  1132.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  1133.     TextHandles(Handle).InUse = True
  1134.     TextHandles(Handle).Xpos = 0
  1135.     TextHandles(Handle).Ypos = 1
  1136.     TextHandles(Handle).UpdateMethod = NewLine
  1137.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  1138.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  1139.  
  1140.     IF SaveBackground THEN
  1141.         imagehandle = _NEWIMAGE(w, h, 32)
  1142.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1143.         TextHandles(Handle).SavedBackground = imagehandle
  1144.     END IF
  1145.     TextHandles(Handle).ScreenX = x1
  1146.     TextHandles(Handle).ScreenY = y1
  1147.     TextHandles(Handle).Font = 16 'default to font 16
  1148.     NewTextArea% = Handle
  1149.  
  1150. SUB FreeTextArea (Handle AS INTEGER)
  1151.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  1152.         IF TextHandles(Handle).InUse THEN
  1153.             TextHandles(Handle).InUse = False
  1154.             IF TextHandles(Handle).SavedBackground THEN
  1155.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  1156.                     w = TextHandles(Handle).w
  1157.                     h = TextHandles(Handle).h
  1158.                     x1 = TextHandles(Handle).ScreenX
  1159.                     y1 = TextHandles(Handle).ScreenY
  1160.                     x2 = x1 + w - 1
  1161.                     y2 = y1 + h - 1
  1162.                     blend = _BLEND
  1163.                     _DONTBLEND
  1164.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1165.                     IF blend THEN _BLEND
  1166.                 END IF
  1167.                 '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.
  1168.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  1169.             END IF
  1170.         ELSE
  1171.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  1172.         END IF
  1173.     ELSE
  1174.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  1175.     END IF
  1176.  
  1177. SUB HideFrame (Handle AS INTEGER)
  1178.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  1179.         TextHandles(Handle).HideFrame = -1
  1180.         w = TextHandles(Handle).w
  1181.         h = TextHandles(Handle).h
  1182.         x1 = TextHandles(Handle).ScreenX
  1183.         y1 = TextHandles(Handle).ScreenY
  1184.         x2 = x1 + w - 1
  1185.         y2 = y1 + h - 1
  1186.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1187.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1188.         IF TextHandles(Handle).SavedBackground THEN
  1189.             blend = _BLEND
  1190.             _DONTBLEND
  1191.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1192.             _FREEIMAGE TextHandles(Handle).SavedBackground
  1193.             IF blend THEN _BLEND
  1194.         END IF
  1195.         TextHandles(Handle).SavedBackground = imagehandle
  1196.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  1197.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  1198.     END IF
  1199.  
  1200. SUB RestoreFrame (Handle AS INTEGER)
  1201.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  1202.         TextHandles(Handle).HideFrame = 0
  1203.         w = TextHandles(Handle).w
  1204.         h = TextHandles(Handle).h
  1205.         x1 = TextHandles(Handle).ScreenX
  1206.         y1 = TextHandles(Handle).ScreenY
  1207.         x2 = x1 + w - 1
  1208.         y2 = y1 + h - 1
  1209.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1210.         blend = _BLEND
  1211.         _DONTBLEND
  1212.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1213.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  1214.         _FREEIMAGE TextHandles(Handle).SavedBackground
  1215.         IF blend THEN _BLEND
  1216.         TextHandles(Handle).SavedBackground = imagehandle
  1217.         TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
  1218.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  1219.     END IF
  1220.  
  1221. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  1222.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  1223.     u = UBOUND(TextHandles)
  1224.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1225.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1226.     HideFrame Handle
  1227.     TextHandles(Handle).ScreenX = x1
  1228.     TextHandles(Handle).ScreenY = y1
  1229.     RestoreFrame Handle
Screenshot.jpg
* Screenshot.jpg (Filesize: 69.24 KB, Dimensions: 806x729, Views: 152)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #26 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]
  1. DEFLNG A-Z 'default to long instead of single
  2. TYPE TextArea
  3.     InUse AS INTEGER
  4.     x1 AS LONG 'left
  5.     y1 AS LONG 'top
  6.     w AS LONG 'width
  7.     h AS LONG 'height
  8.     FrameColor AS _UNSIGNED LONG
  9.     BackColor AS _UNSIGNED LONG
  10.     Xpos AS INTEGER
  11.     Ypos AS INTEGER
  12.     VerticalAlignment AS INTEGER
  13.     Justification AS INTEGER
  14.     UpdateMethod AS INTEGER
  15.     TextColor AS _UNSIGNED LONG
  16.     TextBackgroundColor AS _UNSIGNED LONG
  17.     SavedBackground AS INTEGER
  18.     HideFrame AS INTEGER
  19.     ScreenX AS INTEGER
  20.     ScreenY AS INTEGER
  21.     Font AS LONG 'NEW! Change fonts for each independent font area
  22.  
  23. REDIM SHARED TextHandles(0) AS TextArea
  24.  
  25. CONST True = -1, False = 0
  26. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  27. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  28. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  29. '********************************************************
  30. '* Text Frames before this line
  31. '********************************************************
  32.  
  33.  
  34.  
  35.  
  36.  
  37. _CONSOLE ON 'for debugging purposes while making/testing things
  38.  
  39. TYPE Damage_Type
  40.     Low AS INTEGER
  41.     High AS INTEGER
  42.  
  43. TYPE Light_Type
  44.     Reach AS _UNSIGNED _BYTE
  45.     Left AS _UNSIGNED _BYTE
  46.  
  47. TYPE Weapon_Type
  48.     Name AS STRING * 20
  49.     Reach AS _UNSIGNED _BYTE
  50.     Damage AS Damage_Type
  51.     HitBonus AS _UNSIGNED _BYTE
  52.     DamageBonus AS _UNSIGNED _BYTE
  53.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  54.     IconX AS LONG
  55.     IconY AS LONG
  56.     Light AS Light_Type
  57.  
  58. TYPE Armor_Type
  59.     Name AS STRING * 20
  60.     PD AS _UNSIGNED _BYTE 'Passive Defense (dodge)
  61.     DR AS _UNSIGNED _BYTE 'Damage Resistance (absorption)
  62.     Left AS _UNSIGNED _BYTE 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  63.     IconX AS LONG
  64.     IconY AS LONG
  65.  
  66. TYPE Food_Type
  67.     Name AS STRING * 20
  68.     HungerFill AS SINGLE 'how much said food fills one's stomach
  69.     HungerRate AS SINGLE 'how fast it digests before we get hunry again
  70.     IconX AS LONG
  71.     IconY AS LONG
  72.  
  73.  
  74. TYPE Hero_Type
  75.     Name AS STRING * 20
  76.     Life AS Damage_Type
  77.     Mana AS Damage_Type
  78.     Level AS _UNSIGNED _BYTE
  79.     EXP_Earned AS LONG
  80.     EXP_Needed AS LONG
  81.     Light AS Light_Type
  82.     Weapon1 AS Weapon_Type
  83.     Weapon2 AS Weapon_Type
  84.     Armor AS Armor_Type
  85.     HealingRate AS _UNSIGNED _BYTE
  86.     Hunger AS SINGLE
  87.     HungerRate AS SINGLE
  88.  
  89. TYPE Treasure_TYPE
  90.     Chance AS SINGLE
  91.     Type AS _UNSIGNED _BYTE '1 weapon, 2 armor, 3 food, 4 item
  92.     Index AS INTEGER 'the number of the type... Weapon(0) = "Bare Fist", so tyoe = 1, index = 0.
  93.  
  94. TYPE Monster_TYPE
  95.     Name AS STRING * 20
  96.     Life AS Damage_Type
  97.     Level AS INTEGER
  98.     ExpBonus AS INTEGER
  99.     Sight AS INTEGER
  100.     Hearing AS INTEGER
  101.     Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
  102.     Weapon1 AS Weapon_Type
  103.     Weapon2 AS Weapon_Type
  104.     Armor AS Armor_Type
  105.     Found AS INTEGER
  106.     IconX AS LONG
  107.     IconY AS LONG
  108.     Loot1 AS Treasure_TYPE
  109.     Loot2 AS Treasure_TYPE
  110.     loot3 AS Treasure_TYPE
  111.  
  112. TYPE Encounter_TYPE
  113.     Active AS INTEGER
  114.     X AS INTEGER
  115.     Y AS INTEGER
  116.     Type AS INTEGER '0 monster, 1 weapon, 2 armor, 3 food, 4 item
  117.     Index AS INTEGER
  118.     Life AS INTEGER
  119.  
  120. REDIM SHARED Monster(100) AS Monster_TYPE
  121. REDIM SHARED Encounter(1000) AS Encounter_TYPE, EncounterLimit AS INTEGER
  122.  
  123. '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.
  124. REDIM SHARED Weapon(100) AS Weapon_Type
  125. REDIM SHARED Armor(100) AS Armor_Type
  126. REDIM SHARED Food(100) AS Food_Type
  127.  
  128. DIM SHARED Hero AS Hero_Type
  129. DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
  130. DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
  131. DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
  132. DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG, Icons AS LONG
  133. DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
  134.  
  135. WorkScreen = _NEWIMAGE(3200, 2400, 32)
  136. DisplayScreen = _NEWIMAGE(800, 700, 32)
  137. SCREEN DisplayScreen
  138. Scale = 2
  139.  
  140. REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
  141. '1 map is illuminated
  142. '2 map is uncovered
  143. '4 map is a wall
  144. '8 map is a pathway
  145. '16 map is a stairway
  146. '32 map is simply blocked (perhaps with a monster?)
  147. '64 map is secret (can not be uncovered)
  148. '128 is an item on the ground
  149.  
  150. REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
  151.  
  152.  
  153.  
  154. ON ERROR GOTO errorhandler
  155.  
  156. GOTO skiperrorhandler
  157. errorhandler:
  158.  
  159. PRINT ERR; "Error on "; _ERRORLINE
  160. _DEST DisplayScreen
  161. skiperrorhandler:
  162.  
  163. Init
  164. CreateMap 99, 74, 10
  165.     DrawMap
  166.     DisplayCharacter
  167.     _DISPLAY
  168.     GetInput
  169.     MonstersTurn
  170.     CheckForHeroGrowth
  171.  
  172. SUB Init
  173.     D = _DEST
  174.     Hero.Name = "Steve The Tester!"
  175.     Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
  176.     Hero.Mana.Low = 10: Hero.Mana.High = 10
  177.     Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
  178.     Hero.Weapon1.Name = "Bare Fist"
  179.     Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
  180.     Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
  181.     Hero.Weapon1.Left = -1 'your fist is indestructible!
  182.     Hero.Weapon1.IconX = 2 * 32: Hero.Weapon1.IconY = 47 * 32
  183.     Hero.Weapon2.Name = "Magic Candle"
  184.     Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
  185.     Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
  186.     Hero.Weapon2.Left = 0 'you can't attack with a candle
  187.     Hero.Weapon2.IconX = 52 * 32: Hero.Weapon2.IconY = 42 * 32
  188.     Hero.Weapon2.Light.Reach = 2: Hero.Weapon2.Light.Left = -1 'infinite
  189.     Hero.Armor.Name = "Naked"
  190.     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!
  191.     Hero.Armor.IconX = 46 * 32: Hero.Armor.IconY = 42 * 32
  192.     Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
  193.     Hero.HungerRate = 0.1 'Let's start heros out with a full belly and a low hunger growth rate
  194.  
  195.     PrintArea = NewTextArea(230, 601, 799, 699, False)
  196.     ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  197.     SetTextFont PrintArea, "courbd.ttf", 24
  198.     DrawTextArea PrintArea
  199.     SetPrintPositionX PrintArea, CenterJustify
  200.     SetPrintUpdate PrintArea, NewLine
  201.     PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
  202.     SetTextFont PrintArea, "courbd.ttf", 18
  203.     PrintOut PrintArea, "created by STEVE!"
  204.     PrintOut PrintArea, ""
  205.     SetPrintPositionX PrintArea, LeftJustify
  206.     SetTextFont PrintArea, "courbd.ttf", 12
  207.     TextFont = 12
  208.  
  209.     temp = _NEWIMAGE(480, 480, 32)
  210.     _DEST temp: _CONTROLCHR OFF
  211.     COLOR &HFFFFFF00, 0 'Yellow Hero
  212.     _PRINTSTRING (0, 0), CHR$(1) 'the hero
  213.     COLOR &HFFFF0000, 0 'Red Question Mark
  214.     _PRINTSTRING (16, 0), "?" 'a question mark
  215.     Icons = _LOADIMAGE("Sprites.png", 32)
  216.     _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  217.     _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  218.     '        SCREEN Icons: DO: SLEEP: LOOP
  219.     _DEST D
  220.  
  221.     'Init some basic weapons which we can find
  222.  
  223.     'These first two should always be available for us to use/enjoy.
  224.     Weapon(0).Name = "Bare Fist"
  225.     Weapon(0).Reach = 1: Weapon(0).Damage.Low = 1: Weapon(0).Damage.High = 2
  226.     Weapon(0).HitBonus = 0: Weapon(0).DamageBonus = 0
  227.     Weapon(0).Left = -1 'your fist is indestructible!
  228.     Weapon(0).IconX = 2 * 32: Weapon(0).IconY = 47 * 32
  229.     Weapon(0).Light.Reach = 0: Weapon(0).Light.Left = 0
  230.     Weapon(1).Name = "Magic Candle"
  231.     Weapon(1).Reach = 0: Weapon(1).Damage.Low = 0: Weapon(1).Damage.High = 0
  232.     Weapon(1).HitBonus = 0: Weapon(1).DamageBonus = 0
  233.     Weapon(1).Left = 0 'you can't attack with a candle
  234.     Weapon(1).IconX = 52 * 32: Weapon(1).IconY = 42 * 32
  235.     Weapon(1).Light.Reach = 2: Weapon(1).Light.Left = -1 'infinite
  236.  
  237.     Armor(0).Name = "Naked"
  238.     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!
  239.     Armor(0).IconX = 46 * 32: Armor(0).IconY = 42 * 32
  240.  
  241.     Food(1).Name = "Bat Meat"
  242.     Food(1).HungerFill = 10: Food(1).HungerRate = .1
  243.     Food(1).IconX = 36 * 32: Food(1).IconY = 23 * 32
  244.  
  245.     Food(2).Name = "Rat Meat"
  246.     Food(2).HungerFill = 10: Food(2).HungerRate = .1
  247.     Food(2).IconX = 36 * 32: Food(2).IconY = 23 * 32
  248.  
  249.     Food(3).Name = "Snake Meat"
  250.     Food(3).HungerFill = 10: Food(3).HungerRate = .1
  251.     Food(3).IconX = 36 * 32: Food(3).IconY = 23 * 32
  252.  
  253.     InitMonsters
  254.  
  255. SUB InitMonsters
  256.  
  257.     Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
  258.     Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
  259.     Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
  260.     Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
  261.     Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
  262.     Monster(1).Loot1.Chance = 95: Monster(1).Loot1.Type = 3: Monster(1).Loot1.Index = 1
  263.     'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
  264.     'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
  265.     'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
  266.     'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
  267.     'Monster(1).Armor.Name = ""
  268.     'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
  269.     Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
  270.     Monster(2).Level = 1: Monster(2).ExpBonus = 0
  271.     Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
  272.     Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
  273.     Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
  274.     Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
  275.     Monster(2).Loot1.Chance = 25: Monster(2).Loot1.Type = 3: Monster(2).Loot1.Index = 2
  276.     Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
  277.     Monster(3).Level = 1: Monster(3).ExpBonus = 0
  278.     Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
  279.     Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
  280.     Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
  281.     Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
  282.     Monster(3).Loot1.Chance = 25: Monster(3).Loot1.Type = 3: Monster(3).Loot1.Index = 3
  283.  
  284.  
  285. SUB CheckForHeroGrowth
  286.     IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
  287.         CLS
  288.         PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
  289.         _DISPLAY
  290.         BEEP
  291.         _DELAY 5
  292.         SYSTEM
  293.     END IF
  294.     IF Hero.EXP_Earned >= Hero.EXP_Needed THEN 'let's check to see if the hero has leveled up
  295.         PrintOut PrintArea, "Congratulations!  You have gained a level!"
  296.         DO
  297.             r = INT(RND * 6) + 1
  298.             lifegained = lifegained + r
  299.         LOOP UNTIL r <> 6
  300.         Hero.Life.Low = Hero.Life.Low + r
  301.         Hero.Life.High = Hero.Life.High + r
  302.         Hero.EXP_Earned = 0
  303.         Hero.Level = Hero.Level + 1
  304.         Hero.EXP_Needed = Hero.EXP_Needed + Hero.Level + 1
  305.     END IF
  306.     IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
  307.         IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
  308.     END IF
  309.     Hero.Hunger = Hero.Hunger + Hero.HungerRate
  310.     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
  311.     IF Hero.Weapon2.Light.Left > -1 THEN Hero.Weapon2.Light.Left = Hero.Weapon2.Light.Left - 1
  312.  
  313.  
  314.  
  315. SUB DisplayCharacter
  316.     LINE (0, 601)-(229, 799), &HFF000000, BF
  317.     COLOR -1, 0
  318.     Box 0, 601, 229, 62, 0, 0, "", Silver, 0
  319.     Box 0, 601, 229, 12, Black, 0, _TRIM$(Hero.Name), Silver, 0
  320.     Box 0, 626, 229 * Hero.Life.Low / Hero.Life.High, 12, 0, 0, "", Red, Black
  321.     Box 0, 639, 229 * Hero.Mana.Low / Hero.Mana.High, 12, 0, 0, "", Blue, Black
  322.     Box 0, 652, 229 * Hero.EXP_Earned / Hero.EXP_Needed, 12, 0, 0, "", Green, Black
  323.     _PRINTSTRING (10, 616), "LEVEL:" + STR$(Hero.Level)
  324.     _PRINTSTRING (10, 629), "LIFE :" + STR$(Hero.Life.Low) + " / " + _TRIM$(STR$(Hero.Life.High))
  325.     _PRINTSTRING (10, 642), "MANA :" + STR$(Hero.Mana.Low) + " / " + _TRIM$(STR$(Hero.Mana.High))
  326.     _PRINTSTRING (10, 655), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
  327.     FOR i = 0 TO 5 'six boxes for information : left hand, right hand, armor, and 3 more for later....
  328.         Box 36 * i + 8, 665, 34, 34, 0, 0, "", Black, Silver
  329.     NEXT
  330.     _PUTIMAGE (9, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon1.IconX, Hero.Weapon1.IconY)-STEP(32, 32)
  331.     _PUTIMAGE (45, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon2.IconX, Hero.Weapon2.IconY)-STEP(32, 32)
  332.     _PUTIMAGE (81, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Armor.IconX, Hero.Armor.IconY)-STEP(32, 32)
  333.  
  334. SUB GetInput
  335.     DO
  336.         k = _KEYHIT: valid = -1
  337.         SELECT CASE k
  338.             CASE 18432 'up
  339.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  340.                     SELECT CASE Scale
  341.                         CASE 1.5: Scale = 2 'It's as small as we go
  342.                         CASE 2: Scale = 3
  343.                         CASE 3: Scale = 4
  344.                         CASE 4: Scale = 6
  345.                         CASE 6: Scale = 8
  346.                         CASE 8: Scale = 12
  347.                     END SELECT
  348.                 ELSE
  349.                     IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
  350.                 END IF
  351.             CASE 19200: 'left
  352.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  353.                     TextFont = TextFont - 1
  354.                     IF TextFont < 8 THEN TextFont = 8
  355.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  356.                     ClearTextArea PrintArea
  357.                     SetPrintPosition PrintArea, 1, 1
  358.                     PrintOut PrintArea, "Font Size Changed"
  359.                 ELSE
  360.                     IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
  361.                 END IF
  362.             CASE 20480: 'down
  363.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  364.                     SELECT CASE Scale
  365.                         CASE 2: Scale = 1.5 'It's as small as we go
  366.                         CASE 3: Scale = 2
  367.                         CASE 4: Scale = 3
  368.                         CASE 6: Scale = 4
  369.                         CASE 8: Scale = 6
  370.                         CASE 12: Scale = 8
  371.                     END SELECT
  372.                 ELSE
  373.                     IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
  374.                 END IF
  375.             CASE 19712: 'right
  376.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  377.                     TextFont = TextFont + 1
  378.                     IF TextFont > 48 THEN TextFont = 48
  379.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  380.                     ClearTextArea PrintArea
  381.                     SetPrintPosition PrintArea, 1, 1
  382.                     PrintOut PrintArea, "Font Size Changed"
  383.                 ELSE
  384.                     IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
  385.                 END IF
  386.             CASE 32 'space to just wait and skip a turn
  387.             CASE 60 ' "<" key
  388.                 IF MapArray(Hero.X, Hero.Y) AND 16 THEN
  389.                     Level = Level + 1
  390.                     CreateMap 99, 74, 10
  391.                     PathFind
  392.                 END IF
  393.             CASE ASC("+"), ASC("=")
  394.                 IF Hero.Weapon2.Light.Reach < 25 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach + 1
  395.             CASE ASC("-"), ASC("_")
  396.                 IF Hero.Weapon2.Light.Reach > -1 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach - 1
  397.             CASE ELSE
  398.                 valid = 0 'it's a key press which we don't recognize.  Ignore it
  399.         END SELECT
  400.         _LIMIT 60
  401.     LOOP UNTIL k AND valid
  402.     _KEYCLEAR 'one keystroke at a time
  403.     StepsTaken = StepsTaken + 1
  404.  
  405. SUB Box (X, Y, Wide, High, FontColor as _unsigned long, _
  406.          FontBackGround as _unsigned long, Caption AS STRING, Kolor AS _UNSIGNED LONG, BackGround AS _UNSIGNED LONG)
  407.     COLOR FontColor, FontBackGround
  408.     LINE (X, Y)-STEP(Wide, High), Kolor, BF
  409.     LINE (X, Y)-STEP(Wide, High), BackGround, B
  410.     pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
  411.     _PRINTSTRING (X + (Wide - pw + 1) \ 2, Y + (High - ph + 1) \ 2), Caption
  412.     COLOR DC, BG
  413.  
  414.  
  415. SUB MoveHero (MoveX, MoveY)
  416.     TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
  417.     IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
  418.         IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
  419.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
  420.             IF MoveX THEN Hero.X = Hero.X + MoveX
  421.             IF MoveY THEN Hero.Y = Hero.Y + MoveY
  422.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
  423.             PathFind
  424.         ELSE
  425.             '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!
  426.             FOR i = 1 TO EncounterLimit
  427.                 IF Encounter(i).Active THEN 'Check for active/alive monsters only
  428.                     MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  429.                     IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
  430.                         Swing 0, i 'hero swings at the monster
  431.                     END IF
  432.                 END IF
  433.             NEXT
  434.         END IF
  435.     END IF
  436.  
  437. SUB Swing (Who, AtWhom)
  438.  
  439.     BaseChancetohit = 10 'base 10 chance to hit
  440.     IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
  441.         M = Encounter(AtWhom).Index
  442.         IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  443.             Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
  444.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  445.             totalroll = 0
  446.             DO
  447.                 roll = INT(RND * 20) + 1
  448.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  449.                 IF roll = 20 THEN totalroll = totalroll + 20
  450.                 totalroll = totalroll + roll
  451.             LOOP UNTIL roll <> 1 AND roll <> 20
  452.             damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
  453.             damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
  454.             out$ = _TRIM$(Hero.Name)
  455.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  456.                 SetTextColor PrintArea, &HFFF000F0, 0
  457.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  458.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  459.                 Hero.Life.Low = Hero.Life.Low - damage
  460.             ELSEIF totalroll < Chancetohit THEN
  461.                 SetTextColor PrintArea, &HFFF0F000, 0
  462.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  463.             ELSEIF totalroll > Chancetohit + 20 THEN
  464.                 SetTextColor PrintArea, &HFF00FF00, 0
  465.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  466.                 damage = damage * (totalroll / 20 + 1)
  467.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  468.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  469.             ELSEIF totalroll >= Chancetohit THEN
  470.                 SetTextColor PrintArea, &HFF00FF00, 0
  471.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  472.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
  473.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  474.             END IF
  475.         ELSEIF Hero.Weapon1.Reach > 0 THEN
  476.             SetTextColor PrintArea, &HFFF000F0, 0
  477.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
  478.         ELSE
  479.             out$ = ""
  480.         END IF
  481.         IF out$ <> "" THEN PrintOut PrintArea, out$
  482.         IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  483.             Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
  484.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  485.             totalroll = 0
  486.             DO
  487.                 roll = INT(RND * 20) + 1
  488.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  489.                 IF roll = 20 THEN totalroll = totalroll + 20
  490.                 totalroll = totalroll + roll
  491.             LOOP UNTIL roll <> 1 AND roll <> 20
  492.             damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
  493.             damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
  494.             out$ = _TRIM$(Hero.Name)
  495.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  496.                 SetTextColor PrintArea, &HFFF000F0, 0
  497.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  498.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  499.                 damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
  500.                 Hero.Life.Low = Hero.Life.Low - damage
  501.             ELSEIF totalroll < Chancetohit THEN
  502.                 SetTextColor PrintArea, &HFFF0F000, 0
  503.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  504.             ELSEIF totalroll > Chancetohit + 20 THEN
  505.                 SetTextColor PrintArea, &HFF00FF00, 0
  506.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  507.                 damage = damage * (totalroll / 20 + 1)
  508.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  509.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  510.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  511.             ELSEIF totalroll >= Chancetohit THEN
  512.                 SetTextColor PrintArea, &HFF00FF00, 0
  513.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  514.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
  515.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  516.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  517.             END IF
  518.         ELSEIF Hero.Weapon2.Reach > 0 THEN
  519.             SetTextColor PrintArea, &HFFF000F0, 0
  520.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
  521.         ELSE
  522.             out$ = ""
  523.         END IF
  524.         IF out$ <> "" THEN PrintOut PrintArea, out$
  525.         IF Encounter(AtWhom).Life <= 0 THEN MonsterDied (AtWhom) 'the monster died!
  526.     ELSE 'it's a monster attacking
  527.         M = Encounter(Who).Index
  528.         IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
  529.             Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
  530.             Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
  531.             totalroll = 0
  532.             DO
  533.                 roll = INT(RND * 20) + 1
  534.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  535.                 IF roll = 20 THEN totalroll = totalroll + 20
  536.                 totalroll = totalroll + roll
  537.             LOOP UNTIL roll <> 1 AND roll <> 20
  538.             damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
  539.             damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
  540.             out$ = _TRIM$(Monster(M).Name)
  541.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  542.                 SetTextColor PrintArea, &HFFF000F0, 0
  543.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  544.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  545.                 Monster(M).Life.Low = Monster(M).Life.Low - damage
  546.             ELSEIF totalroll < Chancetohit THEN
  547.                 SetTextColor PrintArea, &HFFF0F000, 0
  548.                 out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  549.             ELSEIF totalroll > Chancetohit + 20 THEN
  550.                 SetTextColor PrintArea, &HFF00FFFF, 0
  551.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
  552.                 damage = damage * (totalroll / 20 + 1)
  553.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  554.                 Hero.Life.Low = Hero.Life.Low - damage
  555.             ELSEIF totalroll >= Chancetohit THEN
  556.                 SetTextColor PrintArea, &HFF00FFFF, 0
  557.                 out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
  558.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
  559.                 Hero.Life.Low = Hero.Life.Low - damage
  560.             END IF
  561.         ELSEIF Monster(M).Weapon1.Reach > 0 THEN
  562.             SetTextColor PrintArea, &HFFF000F0, 0
  563.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
  564.         ELSE
  565.             out$ = ""
  566.         END IF
  567.         IF out$ <> "" THEN PrintOut PrintArea, out$
  568.     END IF
  569.  
  570. SUB MonsterDied (Who)
  571.     M = Encounter(Who).Index
  572.     SetTextColor PrintArea, &HFFFF0000, 0
  573.     out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
  574.     PrintOut PrintArea, out$
  575.     Encounter(Who).Active = 0
  576.     Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
  577.     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!
  578.     IF Monster(M).Found = 0 THEN
  579.         Monster(M).Found = -1 'it's a first time kill!
  580.         SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
  581.         out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
  582.         PrintOut PrintArea, out$
  583.     END IF
  584.  
  585.     'monster loot!!
  586.     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.
  587.     'if the player starts dumping items onto the ground, we could concievably fill the screen with tons of loots.
  588.     R# = RND * 100
  589.     IF R# < Monster(M).Loot1.Chance THEN
  590.         GOSUB addloot
  591.         Encounter(E).Type = Monster(M).Loot1.Type
  592.         Encounter(E).Index = Monster(M).Loot1.Index
  593.     ELSEIF R# < Monster(M).Loot2.Chance THEN
  594.         GOSUB addloot
  595.     ELSEIF R# < Monster(M).loot3.Chance THEN
  596.         GOSUB addloot
  597.     END IF
  598.  
  599.     EXIT SUB
  600.  
  601.     addloot: 'a small sub proceedure to reduce copy/paste code
  602.     EncounterLimit = EncounterLimit + 1
  603.     E = EncounterLimit 'just for ease of typing below
  604.     Encounter(E).Active = -1
  605.     Encounter(E).X = Encounter(Who).X
  606.     Encounter(E).Y = Encounter(Who).Y
  607.     PrintOut PrintArea, _TRIM$(Monster(M).Name) + " left something behind."
  608.     RETURN
  609.  
  610.  
  611. FUNCTION MoveMonster (Monster, MoveX, MoveY)
  612.     MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
  613.     D = Distance(MX, MY) 'distance from monster to the hero
  614.     E = Encounter(i).Index 'the actual monster in question
  615.     IF D > Distance(MX + MoveX, MY + MoveY) THEN
  616.         IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
  617.             MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
  618.             Encounter(Monster).X = Encounter(Monster).X + MoveX
  619.             Encounter(Monster).Y = Encounter(Monster).Y + MoveY
  620.             MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
  621.             MoveMonster = -1
  622.         END IF
  623.     END IF
  624.  
  625.  
  626.  
  627. SUB MonstersTurn
  628.     FOR i = 1 TO EncounterLimit
  629.         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.
  630.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  631.             D = Distance(MX, MY) 'distance from monster to the hero
  632.             E = Encounter(i).Index 'the actual monster in question
  633.             IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
  634.                 attack = 0
  635.                 IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
  636.                     'insert attack code here
  637.                     Swing i, 0
  638.                     _CONTINUE
  639.                 END IF
  640.                 'if the monster didn't attack, it can now move towards the hero.
  641.                 IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
  642.                     IF D > Distance(MX - 1, MY) THEN
  643.                         IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
  644.                     END IF
  645.                 END IF
  646.                 IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
  647.                     IF D > Distance(MX, MY - 1) THEN
  648.                         IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
  649.                     END IF
  650.                 END IF
  651.                 IF MX < XH THEN 'check to see if moving right moves us towards the hero.
  652.                     IF D > Distance(MX + 1, MY) THEN
  653.                         IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
  654.                     END IF
  655.                 END IF
  656.                 IF MY < YH THEN 'check to see if moving down moves us towards the hero.
  657.                     IF D > Distance(MX, MY + 1) THEN
  658.                         IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
  659.                     END IF
  660.                 END IF
  661.             END IF
  662.         END IF
  663.  
  664.     NEXT
  665.  
  666.  
  667.  
  668.  
  669. SUB DrawMap
  670.     _DEST WorkScreen
  671.     CLS
  672.     'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
  673.     IF Hero.Weapon1.Light.Reach > Hero.Weapon2.Light.Reach THEN LightReach = Hero.Weapon1.Light.Reach ELSE LightReach = Hero.Weapon2.Light.Reach
  674.     FOR Y = 0 TO YH
  675.         FOR X = 0 TO XH
  676.             IF Distance(X, Y) <= LightReach THEN 'It's close enough to check for illumination
  677.                 IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
  678.             END IF
  679.             IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
  680.                 IF MapArray(X, Y) AND 4 THEN 'it's a visible room
  681.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
  682.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
  683.                 END IF
  684.                 IF MapArray(X, Y) AND 8 THEN 'it's a visible path
  685.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
  686.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
  687.                 END IF
  688.                 IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
  689.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
  690.                 END IF
  691.             END IF
  692.             'note: highlighting for the light should come AFTER the map is drawn
  693.             IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
  694.                 LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
  695.                 MapArray(X, Y) = MapArray(X, Y) - 1
  696.                 FOR I = 1 TO EncounterLimit
  697.                     IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
  698.                         E = Encounter(I).Index
  699.                         T = Encounter(I).Type
  700.                         SELECT CASE T
  701.                             CASE 0 'it's a monster
  702.                                 IF Monster(E).Found THEN
  703.                                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
  704.                                 ELSE
  705.                                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
  706.                                 END IF
  707.                             CASE 1 'weapon
  708.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Weapon(E).IconX, Weapon(E).IconY)-STEP(31, 31)
  709.                             CASE 2 'armor
  710.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Armor(E).IconX, Armor(E).IconY)-STEP(31, 31)
  711.                             CASE 3 'food
  712.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Food(E).IconX, Food(E).IconY)-STEP(31, 31)
  713.                             CASE 4 'item
  714.                         END SELECT
  715.                     END IF
  716.                 NEXT
  717.  
  718.             END IF
  719.         NEXT
  720.     NEXT
  721.     COLOR &HFFFFFF00, 0 'Yellow Hero
  722.     _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
  723.     XOffset## = 1600 / Scale
  724.     YOffset## = 1200 / Scale
  725.     CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
  726.     CenterY = Hero.Y * 32
  727.     _DEST DisplayScreen
  728.     LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
  729.     _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
  730.  
  731.  
  732.  
  733.  
  734.  
  735. SUB CreateMap (XLimit, YLimit, Rooms)
  736.     ERASE MapArray 'clear the old map and reset everything to 0
  737.     REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
  738.     REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
  739.     REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
  740.     XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
  741.  
  742.     DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
  743.  
  744.     StairRoom = INT(RND * Rooms) + 1
  745.     FOR i = 1 TO Rooms
  746.         DO
  747.             RoomSize = INT(RND * 9) + 2
  748.             RoomX = INT(RND * (XLimit - RoomSize))
  749.             RoomY = INT(RND * (YLimit - RoomSize))
  750.             'test for positioning
  751.             good = -1 'it's good starting out
  752.             FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  753.                     IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
  754.             NEXT X, Y
  755.         LOOP UNTIL good
  756.         FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  757.                 MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
  758.         NEXT X, Y
  759.         RoomCenterX(i) = RoomX + .5 * RoomSize
  760.         RoomCenterY(i) = RoomY + .5 * RoomSize
  761.         IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
  762.             Hero.X = RoomX + INT(RND * RoomSize)
  763.             Hero.Y = RoomY + INT(RND * RoomSize)
  764.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
  765.         END IF
  766.         IF i = StairRoom THEN 'place the stairs in one of the random rooms
  767.             DO 'But lets not place the stairs directly on top of the hero to begin with
  768.                 StairX = RoomX + INT(RND * RoomSize)
  769.                 StairY = RoomY + INT(RND * RoomSize)
  770.             LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
  771.             MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
  772.         END IF
  773.     NEXT
  774.     FOR i = 1 TO Rooms - 1
  775.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  776.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  777.         DO UNTIL StartX = EndX AND StartY = EndY
  778.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  779.             Meander = 10
  780.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  781.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  782.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  783.                     Ychange = 0
  784.                 ELSE
  785.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  786.                     Ychange = 0
  787.                 END IF
  788.             ELSE
  789.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  790.                     Ychange = SGN(EndY - StartY)
  791.                     XChange = 0
  792.                 ELSE
  793.                     Ychange = INT(RND * 3) - 1
  794.                     XChange = 0
  795.                 END IF
  796.             END IF
  797.             StartX = StartX + XChange
  798.             StartY = StartY + Ychange
  799.             IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
  800.             IF StartY < 0 THEN StartY = 0
  801.             IF StartX > XH THEN StartX = XH
  802.             IF StartY > YH THEN StartY = YH
  803.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
  804.         LOOP
  805.     NEXT
  806.     PathFind
  807.     EncounterLimit = INT(RND * 6) + 5
  808.     FOR i = 1 TO EncounterLimit
  809.         Encounter(i).Type = 0 'type 0 is a monster
  810.         Encounter(i).Index = RandomMonster
  811.         Encounter(i).Active = -1
  812.         M = Encounter(i).Index
  813.         Encounter(i).Life = INT(RND * Monster(M).Life.High - Monster(M).Life.Low + 1) + Monster(M).Life.Low
  814.         valid = -1: EndlessLoopExit = 0
  815.         DO
  816.             EndlessLoopExit = EndlessLoopExit + 1
  817.             Encounter(i).X = INT(RND * XLimit + 1)
  818.             Encounter(i).Y = INT(RND * YLimit + 1)
  819.             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.)
  820.             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".
  821.             '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.
  822.             '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.
  823.         LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
  824.         MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
  825.     NEXT
  826.     LootLimit = 0 'no loot on the map at this time.  Too bad for joo!
  827.  
  828. SUB PathFind
  829.     STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
  830.     DIM pass AS _UNSIGNED _BYTE
  831.     m = _MEM(Distance()): m1 = _MEM(Temp())
  832.     _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
  833.     _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
  834.     Temp(Hero.X, Hero.Y) = 0
  835.     pass = 0
  836.     DO
  837.         changed = 0
  838.         y = 0
  839.         DO
  840.             x = 0
  841.             DO
  842.                 IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
  843.                     IF x < XH THEN
  844.                         IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  845.                     END IF
  846.                     IF x > 0 THEN
  847.                         IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  848.                     END IF
  849.                     IF y < YH THEN
  850.                         IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  851.                     END IF
  852.                     IF y > 0 THEN
  853.                         IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  854.                     END IF
  855.                 END IF
  856.                 x = x + 1
  857.             LOOP UNTIL x > XH
  858.             y = y + 1
  859.         LOOP UNTIL y > YH
  860.         _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
  861.         pass = pass + 1
  862.     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!
  863.     Distance(Hero.X, Hero.Y) = 0
  864.  
  865. FUNCTION RandomMonster
  866.     STATIC MC 'monster count
  867.     SELECT CASE Level 'the starting level
  868.         CASE 1: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
  869.     END SELECT
  870.     RandomMonster = INT(RND * MC) + 1
  871.  
  872.  
  873. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  874. '# SUBroutines and FUNCTIONs below #'
  875. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  876. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  877.     u = UBOUND(TextHandles)
  878.     Handle = WhichHandle
  879.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  880.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  881.     Where = TextHandles(Handle).VerticalAlignment
  882.     How = TextHandles(Handle).Justification
  883.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  884.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  885.  
  886.  
  887. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  888.     'WhichHandle is the handle which designates which text area we want to use
  889.     'Where is where we want it to go in that text area
  890.     '  -- Online prints the text to the current print position line in that text area.
  891.     '  -- CenterLine centers the text to the center of that text area.
  892.     '  -- any other value will print to that line positon in that particular box.
  893.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  894.     'What is the text that we want to print in our text area
  895.     '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).
  896.  
  897.     D = _DEST: S = _SOURCE
  898.     OldFont = _FONT
  899.  
  900.     u = UBOUND(TextHandles)
  901.     Handle = WhichHandle
  902.  
  903.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  904.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  905.     IF TextHandles(Handle).HideFrame THEN
  906.         _DEST TextHandles(Handle).SavedBackground
  907.         _SOURCE TextHandles(Handle).SavedBackground
  908.     END IF
  909.     _FONT TextHandles(Handle).Font
  910.     fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
  911.     IF _FONTWIDTH = 0 THEN
  912.         FOR i = 1 TO 255
  913.             IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
  914.         NEXT
  915.     ELSE
  916.         fw = _FONTWIDTH
  917.     END IF
  918.  
  919.     h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
  920.  
  921.     SELECT CASE Where
  922.         CASE BottomLine
  923.             y = h \ fh
  924.         CASE OnLine
  925.             y = TextHandles(Handle).Ypos
  926.             IF y = 0 THEN y = 1
  927.         CASE CenterLine
  928.             linesused = 0
  929.             tpw = pw: tw = w: tWhat$ = What
  930.             DO UNTIL tpw <= tw
  931.                 textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
  932.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  933.                 linesused = linesused + 1
  934.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  935.                 tpw = _PRINTWIDTH(tWhat$)
  936.             LOOP
  937.             linesused = linesused + 1
  938.             py = (h - linesused * fh) \ 2
  939.             y = py \ fh + 1
  940.             IF y < 1 THEN y = 1
  941.         CASE ELSE
  942.             y = Where
  943.     END SELECT
  944.  
  945.     'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  946.     blend = _BLEND
  947.  
  948.     DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  949.         'first let's get a temp image handle for the existing area of the screen.
  950.         x1 = TextHandles(Handle).x1 + 2
  951.         y1 = TextHandles(Handle).y1 + 2
  952.         x2 = TextHandles(Handle).x1 + w
  953.         y2 = TextHandles(Handle).y1 + h
  954.         nh = y2 - y1 + 1 - fh
  955.         nw = x2 - x1 + 1
  956.         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.
  957.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  958.         DrawTextArea Handle
  959.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  960.         y = y - 1
  961.     LOOP
  962.  
  963.     IF blend THEN _BLEND
  964.  
  965.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  966.  
  967.     SELECT CASE How
  968.         CASE LeftJustify
  969.             x = 0
  970.             IF pw > w THEN
  971.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  972.                 text$ = RTRIM$(LEFT$(What, textallowed))
  973.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  974.                 PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
  975.             ELSE
  976.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  977.                 finished = -1
  978.             END IF
  979.         CASE CenterJustify
  980.             IF pw > w THEN
  981.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  982.                 text$ = RTRIM$(LEFT$(What, textallowed))
  983.                 x = (w - _PRINTWIDTH(text$)) \ 2
  984.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  985.                 PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  986.             ELSE
  987.                 x = (w - pw) \ 2
  988.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  989.                 finished = -1
  990.             END IF
  991.         CASE RightJustify
  992.             IF pw > w THEN
  993.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  994.                 text$ = RTRIM$(LEFT$(What, textallowed))
  995.                 x = w - _PRINTWIDTH(text$)
  996.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  997.                 PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
  998.             ELSE
  999.                 x = w - pw
  1000.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1001.                 finished = -1
  1002.             END IF
  1003.         CASE NoJustify
  1004.             x = TextHandles(Handle).Xpos
  1005.             firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
  1006.             IF LEN(What) > firstlinelimit THEN
  1007.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  1008.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1009.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1010.                 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
  1011.             ELSE
  1012.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1013.                 finished = -1
  1014.             END IF
  1015.     END SELECT
  1016.     IF finished THEN
  1017.         SELECT CASE TextHandles(Handle).UpdateMethod
  1018.             CASE NoUpdate 'We don't update the position at all.
  1019.             CASE DoUpdate
  1020.                 TextHandles(Handle).Xpos = x + pw
  1021.                 TextHandles(Handle).Ypos = y
  1022.             CASE NewLine
  1023.                 TextHandles(Handle).Ypos = y + 1
  1024.                 TextHandles(Handle).Xpos = 1
  1025.         END SELECT
  1026.         _FONT OldFont
  1027.         _DEST D: _SOURCE S
  1028.         COLOR FG, BG
  1029.     END IF
  1030.  
  1031. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  1032.     u = UBOUND(TextHandles)
  1033.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1034.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1035.     TextHandles(Handle).TextColor = Foreground
  1036.  
  1037.  
  1038. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  1039.     u = UBOUND(TextHandles)
  1040.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1041.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1042.     TextHandles(Handle).TextBackgroundColor = Background
  1043.  
  1044. SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
  1045.     u = UBOUND(TextHandles)
  1046.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1047.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1048.     SELECT CASE TextHandles(Handle).Font
  1049.         CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
  1050.         CASE IS > 1
  1051.             'we have the font already in use
  1052.             'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
  1053.             _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
  1054.     END SELECT
  1055.  
  1056.     temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
  1057.     IF temp > 1 THEN
  1058.         TextHandles(Handle).Font = temp
  1059.     ELSE
  1060.         TextHandles(Handle).Font = 16 'default to font 16, in case
  1061.     END IF
  1062.  
  1063.  
  1064. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  1065.     u = UBOUND(TextHandles)
  1066.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1067.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1068.     TextHandles(Handle).TextColor = Foreground
  1069.     TextHandles(Handle).TextBackgroundColor = Background
  1070.  
  1071.  
  1072. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  1073.     u = UBOUND(TextHandles)
  1074.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1075.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1076.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  1077.     TextHandles(Handle).UpdateMethod = Method
  1078.  
  1079.  
  1080. SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
  1081.     u = UBOUND(TextHandles)
  1082.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1083.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1084.     SELECT CASE Y
  1085.         CASE BottomLine
  1086.             TextHandles(Handle).VerticalAlignment = -2
  1087.         CASE CenterLine
  1088.             TextHandles(Handle).VerticalAlignment = -1
  1089.         CASE ELSE
  1090.             TextHandles(Handle).VerticalAlignment = 0
  1091.     END SELECT
  1092.     IF X < 1 AND X > -4 THEN
  1093.         TextHandles(Handle).Justification = X
  1094.     ELSE
  1095.         TextHandles(Handle).Xpos = X
  1096.     END IF
  1097.     IF Y < 1 THEN EXIT SUB
  1098.     TextHandles(Handle).Ypos = Y
  1099.  
  1100. SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
  1101.     u = UBOUND(TextHandles)
  1102.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1103.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1104.     IF X < 1 AND X > -4 THEN
  1105.         TextHandles(Handle).Justification = X
  1106.     ELSE
  1107.         TextHandles(Handle).Xpos = X
  1108.     END IF
  1109.  
  1110. SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
  1111.     u = UBOUND(TextHandles)
  1112.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1113.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1114.     SELECT CASE Y
  1115.         CASE BottomLine
  1116.             TextHandles(Handle).VerticalAlignment = -2
  1117.         CASE CenterLine
  1118.             TextHandles(Handle).VerticalAlignment = -1
  1119.         CASE ELSE
  1120.             TextHandles(Handle).VerticalAlignment = 0
  1121.     END SELECT
  1122.     IF Y < 1 THEN EXIT SUB
  1123.     TextHandles(Handle).Ypos = Y
  1124.  
  1125.  
  1126. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  1127.     u = UBOUND(TextHandles)
  1128.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1129.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1130.     GetPrintPositionY = TextHandles(Handle).Ypos
  1131.  
  1132. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  1133.     u = UBOUND(TextHandles)
  1134.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1135.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1136.     GetPrintPositionX = TextHandles(Handle).Xpos
  1137.  
  1138.  
  1139.  
  1140. FUNCTION WordBreak (text$)
  1141.     CONST Breaks = " ;,.?!-"
  1142.     FOR i = LEN(text$) TO 0 STEP -1
  1143.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  1144.         loopcount = loopcount + 1
  1145.     NEXT
  1146.     IF i = 0 THEN i = LEN(text$)
  1147.     WordBreak = i
  1148.  
  1149.  
  1150.  
  1151. SUB ClearTextArea (Handle AS INTEGER)
  1152.     u = UBOUND(TextHandles)
  1153.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1154.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1155.     IF TextHandles(Handle).SavedBackground THEN
  1156.         w = TextHandles(Handle).w
  1157.         h = TextHandles(Handle).h
  1158.         x1 = TextHandles(Handle).ScreenX
  1159.         y1 = TextHandles(Handle).ScreenY
  1160.         x2 = x1 + w - 1
  1161.         y2 = y1 + h - 1
  1162.         blend = _BLEND
  1163.         _DONTBLEND
  1164.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1165.         IF blend THEN _BLEND
  1166.     END IF
  1167.     DrawTextArea Handle
  1168.  
  1169.  
  1170.  
  1171. SUB DrawTextArea (Handle AS INTEGER)
  1172.     u = UBOUND(TextHandles)
  1173.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1174.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1175.     w = TextHandles(Handle).w
  1176.     h = TextHandles(Handle).h
  1177.     x1 = TextHandles(Handle).ScreenX
  1178.     y1 = TextHandles(Handle).ScreenY
  1179.     x2 = x1 + w - 1
  1180.     y2 = y1 + h - 1
  1181.  
  1182.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  1183.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  1184.  
  1185.  
  1186.  
  1187. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  1188.     u = UBOUND(TextHandles)
  1189.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1190.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1191.     TextHandles(Handle).FrameColor = FrameColor
  1192.     TextHandles(Handle).BackColor = BackColor
  1193.  
  1194.  
  1195.  
  1196. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  1197.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  1198.     x2 = tx2: y2 = ty2
  1199.     IF x1 > x2 THEN SWAP x1, x2
  1200.     IF y1 > y2 THEN SWAP y1, y2
  1201.     w = x2 - x1 + 1
  1202.     h = y2 - y1 + 1
  1203.     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
  1204.     'Error checking for if the user sends coordinates which are off the screen
  1205.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  1206.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  1207.  
  1208.     u = UBOUND(TextHandles)
  1209.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  1210.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  1211.     NEXT
  1212.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  1213.         Handle = u + 1
  1214.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  1215.     END IF
  1216.     TextHandles(Handle).x1 = x1
  1217.     TextHandles(Handle).y1 = y1
  1218.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  1219.     TextHandles(Handle).InUse = True
  1220.     TextHandles(Handle).Xpos = 0
  1221.     TextHandles(Handle).Ypos = 1
  1222.     TextHandles(Handle).UpdateMethod = NewLine
  1223.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  1224.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  1225.  
  1226.     IF SaveBackground THEN
  1227.         imagehandle = _NEWIMAGE(w, h, 32)
  1228.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1229.         TextHandles(Handle).SavedBackground = imagehandle
  1230.     END IF
  1231.     TextHandles(Handle).ScreenX = x1
  1232.     TextHandles(Handle).ScreenY = y1
  1233.     TextHandles(Handle).Font = 16 'default to font 16
  1234.     NewTextArea% = Handle
  1235.  
  1236. SUB FreeTextArea (Handle AS INTEGER)
  1237.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  1238.         IF TextHandles(Handle).InUse THEN
  1239.             TextHandles(Handle).InUse = False
  1240.             IF TextHandles(Handle).SavedBackground THEN
  1241.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  1242.                     w = TextHandles(Handle).w
  1243.                     h = TextHandles(Handle).h
  1244.                     x1 = TextHandles(Handle).ScreenX
  1245.                     y1 = TextHandles(Handle).ScreenY
  1246.                     x2 = x1 + w - 1
  1247.                     y2 = y1 + h - 1
  1248.                     blend = _BLEND
  1249.                     _DONTBLEND
  1250.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1251.                     IF blend THEN _BLEND
  1252.                 END IF
  1253.                 '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.
  1254.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  1255.             END IF
  1256.         ELSE
  1257.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  1258.         END IF
  1259.     ELSE
  1260.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  1261.     END IF
  1262.  
  1263. SUB HideFrame (Handle AS INTEGER)
  1264.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  1265.         TextHandles(Handle).HideFrame = -1
  1266.         w = TextHandles(Handle).w
  1267.         h = TextHandles(Handle).h
  1268.         x1 = TextHandles(Handle).ScreenX
  1269.         y1 = TextHandles(Handle).ScreenY
  1270.         x2 = x1 + w - 1
  1271.         y2 = y1 + h - 1
  1272.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1273.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1274.         IF TextHandles(Handle).SavedBackground THEN
  1275.             blend = _BLEND
  1276.             _DONTBLEND
  1277.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1278.             _FREEIMAGE TextHandles(Handle).SavedBackground
  1279.             IF blend THEN _BLEND
  1280.         END IF
  1281.         TextHandles(Handle).SavedBackground = imagehandle
  1282.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  1283.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  1284.     END IF
  1285.  
  1286. SUB RestoreFrame (Handle AS INTEGER)
  1287.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  1288.         TextHandles(Handle).HideFrame = 0
  1289.         w = TextHandles(Handle).w
  1290.         h = TextHandles(Handle).h
  1291.         x1 = TextHandles(Handle).ScreenX
  1292.         y1 = TextHandles(Handle).ScreenY
  1293.         x2 = x1 + w - 1
  1294.         y2 = y1 + h - 1
  1295.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1296.         blend = _BLEND
  1297.         _DONTBLEND
  1298.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1299.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  1300.         _FREEIMAGE TextHandles(Handle).SavedBackground
  1301.         IF blend THEN _BLEND
  1302.         TextHandles(Handle).SavedBackground = imagehandle
  1303.         TextHandles(Handle).x1 = x1 'When the frames are restored, we need to recalculate our print position
  1304.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  1305.     END IF
  1306.  
  1307. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  1308.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  1309.     u = UBOUND(TextHandles)
  1310.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1311.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1312.     HideFrame Handle
  1313.     TextHandles(Handle).ScreenX = x1
  1314.     TextHandles(Handle).ScreenY = y1
  1315.     RestoreFrame Handle
  1316.  

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
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #27 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]
  1. DEFLNG A-Z 'default to long instead of single
  2. TYPE TextArea
  3.     InUse AS INTEGER
  4.     x1 AS LONG 'left
  5.     y1 AS LONG 'top
  6.     w AS LONG 'width
  7.     h AS LONG 'height
  8.     FrameColor AS _UNSIGNED LONG
  9.     BackColor AS _UNSIGNED LONG
  10.     Xpos AS INTEGER
  11.     Ypos AS INTEGER
  12.     VerticalAlignment AS INTEGER
  13.     Justification AS INTEGER
  14.     UpdateMethod AS INTEGER
  15.     TextColor AS _UNSIGNED LONG
  16.     TextBackgroundColor AS _UNSIGNED LONG
  17.     SavedBackground AS INTEGER
  18.     HideFrame AS INTEGER
  19.     ScreenX AS INTEGER
  20.     ScreenY AS INTEGER
  21.     Font AS LONG 'NEW! Change fonts for each independent font area
  22.  
  23. REDIM SHARED TextHandles(0) AS TextArea
  24.  
  25. CONST True = -1, False = 0
  26. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  27. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  28. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  29. '********************************************************
  30. '* Text Frames before this line
  31. '********************************************************
  32.  
  33.  
  34.  
  35.  
  36.  
  37. _CONSOLE ON 'for debugging purposes while making/testing things
  38.  
  39. TYPE Damage_Type
  40.     Low AS INTEGER
  41.     High AS INTEGER
  42.  
  43. TYPE Light_Type
  44.     Reach AS INTEGER
  45.     Left AS INTEGER
  46.  
  47. TYPE Weapon_Type
  48.     Identified AS _UNSIGNED _BYTE
  49.     Name AS STRING * 20
  50.     DisplayedName AS STRING * 20
  51.     Reach AS INTEGER
  52.     Damage AS Damage_Type
  53.     HitBonus AS INTEGER
  54.     DamageBonus AS INTEGER
  55.     Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  56.     IconX AS LONG
  57.     IconY AS LONG
  58.     Light AS Light_Type
  59.  
  60. TYPE Armor_Type
  61.     Identified AS _UNSIGNED _BYTE
  62.     Name AS STRING * 20
  63.     DisplayedName AS STRING * 20
  64.     PD AS INTEGER 'Passive Defense (dodge)
  65.     DR AS INTEGER 'Damage Resistance (absorption)
  66.     Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  67.     IconX AS LONG
  68.     IconY AS LONG
  69.  
  70. TYPE Food_Type
  71.     Identified AS _UNSIGNED _BYTE
  72.     Name AS STRING * 20
  73.     DisplayedName AS STRING * 20
  74.     HungerFill AS SINGLE 'how much said food fills one's stomach
  75.     HungerRate AS SINGLE 'how fast it digests before we get hunry again
  76.     IconX AS LONG
  77.     IconY AS LONG
  78.  
  79.  
  80. TYPE Hero_Type
  81.     Name AS STRING * 20
  82.     Life AS Damage_Type
  83.     Mana AS Damage_Type
  84.     Level AS _UNSIGNED _BYTE
  85.     EXP_Earned AS LONG
  86.     EXP_Needed AS LONG
  87.     Light AS Light_Type
  88.     Weapon1 AS Weapon_Type
  89.     Weapon2 AS Weapon_Type
  90.     Armor AS Armor_Type
  91.     HealingRate AS INTEGER 'number of turns before the hero heals a point
  92.     Hunger AS SINGLE
  93.     HungerRate AS SINGLE
  94.  
  95. TYPE Treasure_TYPE
  96.     Chance AS SINGLE
  97.     Type AS _UNSIGNED _BYTE '1 weapon, 2 armor, 3 food, 4 item
  98.     Index AS INTEGER 'the number of the type... Weapon(0) = "Bare Fist", so tyoe = 1, index = 0.
  99.  
  100. TYPE Monster_TYPE
  101.     Name AS STRING * 20
  102.     Life AS Damage_Type
  103.     Level AS INTEGER
  104.     ExpBonus AS INTEGER
  105.     Sight AS INTEGER
  106.     Hearing AS INTEGER
  107.     Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
  108.     Weapon1 AS Weapon_Type
  109.     Weapon2 AS Weapon_Type
  110.     Armor AS Armor_Type
  111.     Found AS INTEGER
  112.     IconX AS LONG
  113.     IconY AS LONG
  114.     Loot1 AS Treasure_TYPE
  115.     Loot2 AS Treasure_TYPE
  116.     loot3 AS Treasure_TYPE
  117.  
  118. TYPE Encounter_TYPE
  119.     Active AS INTEGER
  120.     X AS INTEGER
  121.     Y AS INTEGER
  122.     Type AS INTEGER '0 monster, 1 weapon, 2 armor, 3 food, 4 item
  123.     Index AS INTEGER
  124.     Life AS INTEGER
  125.  
  126. TYPE Inventory_Type
  127.     Weapon AS Weapon_Type
  128.     Armor AS Armor_Type
  129.     Food AS Food_Type
  130.     'Item as item_type 'to come later, once general items get added
  131.  
  132.  
  133. REDIM SHARED Monster(100) AS Monster_TYPE
  134. REDIM SHARED Encounter(1000) AS Encounter_TYPE, EncounterLimit AS INTEGER
  135.  
  136. '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.
  137. REDIM SHARED Weapon(100) AS Weapon_Type
  138. REDIM SHARED Armor(100) AS Armor_Type
  139. REDIM SHARED Food(100) AS Food_Type
  140.  
  141. DIM SHARED Hero AS Hero_Type
  142. REDIM SHARED Inventory(103) AS Inventory_Type '103 slots each to carry weapons/armor/food/items
  143. 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.
  144. DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
  145. DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
  146. DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
  147. DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG, Icons AS LONG
  148. DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
  149.  
  150. WorkScreen = _NEWIMAGE(3200, 2400, 32)
  151. DisplayScreen = _NEWIMAGE(800, 700, 32)
  152. SCREEN DisplayScreen
  153. Scale = 2
  154.  
  155. REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
  156. '1 map is illuminated
  157. '2 map is uncovered
  158. '4 map is a wall
  159. '8 map is a pathway
  160. '16 map is a stairway
  161. '32 map is simply blocked (perhaps with a monster?)
  162. '64 map is secret (can not be uncovered)
  163.  
  164. REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
  165.  
  166.  
  167. Init
  168. CreateMap 99, 74, 10
  169.     DrawMap
  170.     DisplayCharacter
  171.     _DISPLAY
  172.     GetInput
  173.     MonstersTurn
  174.     CheckForHeroGrowth
  175.  
  176. SUB Init
  177.     D = _DEST
  178.     Hero.Name = "Steve The Tester!"
  179.     Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
  180.     Hero.Mana.Low = 10: Hero.Mana.High = 10
  181.     Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
  182.     Hero.Weapon1.Name = "Bare Fist"
  183.     Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
  184.     Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
  185.     Hero.Weapon1.Left = -1 'your fist is indestructible!
  186.     Hero.Weapon1.IconX = 2 * 32: Hero.Weapon1.IconY = 47 * 32
  187.     Hero.Weapon2.Name = "Magic Candle"
  188.     Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
  189.     Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
  190.     Hero.Weapon2.Left = 0 'you can't attack with a candle
  191.     Hero.Weapon2.IconX = 52 * 32: Hero.Weapon2.IconY = 42 * 32
  192.     Hero.Weapon2.Light.Reach = 2: Hero.Weapon2.Light.Left = -1 'infinite
  193.     Hero.Armor.Name = "Naked"
  194.     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!
  195.     Hero.Armor.IconX = 46 * 32: Hero.Armor.IconY = 42 * 32
  196.     Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
  197.     Hero.HungerRate = 0.1 'Let's start heros out with a full belly and a low hunger growth rate
  198.  
  199.     PrintArea = NewTextArea(230, 601, 799, 699, False)
  200.     ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  201.     SetTextFont PrintArea, "courbd.ttf", 24
  202.     DrawTextArea PrintArea
  203.     SetPrintPositionX PrintArea, CenterJustify
  204.     SetPrintUpdate PrintArea, NewLine
  205.     PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
  206.     SetTextFont PrintArea, "courbd.ttf", 18
  207.     PrintOut PrintArea, "created by STEVE!"
  208.     PrintOut PrintArea, ""
  209.     SetPrintPositionX PrintArea, LeftJustify
  210.     SetTextFont PrintArea, "courbd.ttf", 12
  211.     TextFont = 12
  212.  
  213.     temp = _NEWIMAGE(480, 480, 32)
  214.     _DEST temp: _CONTROLCHR OFF
  215.     COLOR &HFFFFFF00, 0 'Yellow Hero
  216.     _PRINTSTRING (0, 0), CHR$(1) 'the hero
  217.     COLOR &HFFFF0000, 0 'Red Question Mark
  218.     _PRINTSTRING (16, 0), "?" 'a question mark
  219.     Icons = _LOADIMAGE("Sprites.png", 32)
  220.     _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  221.     _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  222.     '        SCREEN Icons: DO: SLEEP: LOOP
  223.     _DEST D
  224.  
  225.     'Init some basic weapons which we can find
  226.  
  227.     'These first two should always be available for us to use/enjoy.
  228.     Weapon(0).Name = "Bare Fist"
  229.     Weapon(0).Reach = 1: Weapon(0).Damage.Low = 1: Weapon(0).Damage.High = 2
  230.     Weapon(0).HitBonus = 0: Weapon(0).DamageBonus = 0
  231.     Weapon(0).Left = -1 'your fist is indestructible!
  232.     Weapon(0).IconX = 2 * 32: Weapon(0).IconY = 47 * 32
  233.     Weapon(0).Light.Reach = 0: Weapon(0).Light.Left = 0
  234.     Weapon(1).Name = "Magic Candle"
  235.     Weapon(1).Reach = 0: Weapon(1).Damage.Low = 0: Weapon(1).Damage.High = 0
  236.     Weapon(1).HitBonus = 0: Weapon(1).DamageBonus = 0
  237.     Weapon(1).Left = 0 'you can't attack with a candle
  238.     Weapon(1).IconX = 52 * 32: Weapon(1).IconY = 42 * 32
  239.     Weapon(1).Light.Reach = 2: Weapon(1).Light.Left = -1 'infinite
  240.  
  241.     Armor(0).Name = "Naked"
  242.     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!
  243.     Armor(0).IconX = 46 * 32: Armor(0).IconY = 42 * 32
  244.  
  245.     Food(1).Name = "Bat Meat"
  246.     Food(1).HungerFill = 10: Food(1).HungerRate = .1
  247.     Food(1).IconX = 36 * 32: Food(1).IconY = 23 * 32
  248.  
  249.     Food(2).Name = "Rat Meat"
  250.     Food(2).HungerFill = 10: Food(2).HungerRate = .1
  251.     Food(2).IconX = 36 * 32: Food(2).IconY = 23 * 32
  252.  
  253.     Food(3).Name = "Snake Meat"
  254.     Food(3).HungerFill = 10: Food(3).HungerRate = .1
  255.     Food(3).IconX = 36 * 32: Food(3).IconY = 23 * 32
  256.  
  257.     WeaponsOwned = 2
  258.     Inventory(0).Weapon.Identified = -1
  259.     Inventory(0).Weapon.Name = "Bare Fist"
  260.     Inventory(0).Weapon.Reach = 1: Inventory(0).Weapon.Damage.Low = 1: Inventory(0).Weapon.Damage.High = 2
  261.     Inventory(0).Weapon.HitBonus = 0: Inventory(0).Weapon.DamageBonus = 0
  262.     Inventory(0).Weapon.Left = -1 'your fist is indestructible!
  263.     Inventory(0).Weapon.IconX = 2 * 32: Inventory(0).Weapon.IconY = 47 * 32
  264.     Inventory(0).Weapon.Light.Reach = 0: Inventory(0).Weapon.Light.Left = -1
  265.     Inventory(1).Weapon.Identified = -1
  266.     Inventory(1).Weapon.Name = "Magic Candle"
  267.     Inventory(1).Weapon.Reach = 0: Inventory(1).Weapon.Damage.Low = 0: Inventory(1).Weapon.Damage.High = 0
  268.     Inventory(1).Weapon.HitBonus = 0: Inventory(1).Weapon.DamageBonus = 0
  269.     Inventory(1).Weapon.Left = -1 'magic candle is indestructible
  270.     Inventory(1).Weapon.IconX = 52 * 32: Inventory(1).Weapon.IconY = 42 * 32
  271.     Inventory(1).Weapon.Light.Reach = 2: Inventory(1).Weapon.Light.Left = -1 'infinite
  272.  
  273.     ArmorOwnded = 1
  274.     Inventory(0).Armor.Identified = -1
  275.     Inventory(0).Armor.Name = "Naked"
  276.     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!
  277.     Inventory(0).Armor.IconX = 46 * 32: Inventory(0).Armor.IconY = 42 * 32
  278.  
  279.     InitMonsters
  280.  
  281. SUB InitMonsters
  282.  
  283.     Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
  284.     Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
  285.     Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
  286.     Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
  287.     Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
  288.     Monster(1).Loot1.Chance = 95: Monster(1).Loot1.Type = 3: Monster(1).Loot1.Index = 1
  289.     'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
  290.     'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
  291.     'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
  292.     'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
  293.     'Monster(1).Armor.Name = ""
  294.     'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
  295.     Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
  296.     Monster(2).Level = 1: Monster(2).ExpBonus = 0
  297.     Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
  298.     Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
  299.     Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
  300.     Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
  301.     Monster(2).Loot1.Chance = 25: Monster(2).Loot1.Type = 3: Monster(2).Loot1.Index = 2
  302.     Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
  303.     Monster(3).Level = 1: Monster(3).ExpBonus = 0
  304.     Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
  305.     Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
  306.     Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
  307.     Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
  308.     Monster(3).Loot1.Chance = 25: Monster(3).Loot1.Type = 3: Monster(3).Loot1.Index = 3
  309.  
  310.  
  311. SUB CheckForHeroGrowth
  312.     IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
  313.         CLS
  314.         PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
  315.         _DISPLAY
  316.         BEEP
  317.         _DELAY 5
  318.         SYSTEM
  319.     END IF
  320.     IF Hero.EXP_Earned >= Hero.EXP_Needed THEN 'let's check to see if the hero has leveled up
  321.         PrintOut PrintArea, "Congratulations!  You have gained a level!"
  322.         DO
  323.             r = INT(RND * 6) + 1
  324.             lifegained = lifegained + r
  325.         LOOP UNTIL r <> 6
  326.         Hero.Life.Low = Hero.Life.Low + r
  327.         Hero.Life.High = Hero.Life.High + r
  328.         Hero.EXP_Earned = 0
  329.         Hero.Level = Hero.Level + 1
  330.         Hero.EXP_Needed = Hero.EXP_Needed + Hero.Level + 1
  331.     END IF
  332.     IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
  333.         IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
  334.     END IF
  335.     Hero.Hunger = Hero.Hunger + Hero.HungerRate
  336.     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
  337.     IF Hero.Weapon2.Light.Left > -1 THEN Hero.Weapon2.Light.Left = Hero.Weapon2.Light.Left - 1
  338.  
  339.  
  340.  
  341. SUB DisplayCharacter
  342.     LINE (0, 601)-(229, 799), &HFF000000, BF
  343.     COLOR -1, 0
  344.     Box 0, 601, 229, 62, 0, 0, "", Silver, 0
  345.     Box 0, 601, 229, 12, Black, 0, _TRIM$(Hero.Name), Silver, 0
  346.     Box 0, 626, 229 * Hero.Life.Low / Hero.Life.High, 12, 0, 0, "", Red, Black
  347.     Box 0, 639, 229 * Hero.Mana.Low / Hero.Mana.High, 12, 0, 0, "", Blue, Black
  348.     Box 0, 652, 229 * Hero.EXP_Earned / Hero.EXP_Needed, 12, 0, 0, "", Green, Black
  349.     _PRINTSTRING (10, 616), "LEVEL:" + STR$(Hero.Level)
  350.     _PRINTSTRING (10, 629), "LIFE :" + STR$(Hero.Life.Low) + " / " + _TRIM$(STR$(Hero.Life.High))
  351.     _PRINTSTRING (10, 642), "MANA :" + STR$(Hero.Mana.Low) + " / " + _TRIM$(STR$(Hero.Mana.High))
  352.     _PRINTSTRING (10, 655), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
  353.     FOR i = 0 TO 5 'six boxes for information : left hand, right hand, armor, and 3 more for later....
  354.         Box 36 * i + 8, 665, 34, 34, 0, 0, "", Black, Silver
  355.     NEXT
  356.     _PUTIMAGE (9, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon1.IconX, Hero.Weapon1.IconY)-STEP(32, 32)
  357.     _PUTIMAGE (45, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon2.IconX, Hero.Weapon2.IconY)-STEP(32, 32)
  358.     _PUTIMAGE (81, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Armor.IconX, Hero.Armor.IconY)-STEP(32, 32)
  359.  
  360. SUB ManageInventory
  361.     STATIC Header AS LONG, MainFont AS LONG, ItemNameFont AS LONG
  362.     STATIC Selection AS INTEGER, Page AS INTEGER, Item AS INTEGER
  363.     PCOPY 0, 1
  364.     D = _DEST: S = _SOURCE
  365.     OldFont = _FONT
  366.     IF Header = 0 THEN Header = _LOADFONT("courbd.ttf", 24, "monospace")
  367.     IF MainFont = 0 THEN MainFont = _LOADFONT("courbd.ttf", 14, "monospace")
  368.     IF ItemNameFont = 0 THEN ItemNameFont = _LOADFONT("courbd.ttf", 18, "monospace")
  369.     IF Selection = 0 THEN Selection = 1 'there's 4 categories which we can choose from (Weapon, Armor, Food, Item)
  370.     'Page = 0 'there's 4 pages of info for each category, from 0 to 3
  371.     'Item = 0 'and there's 26 items on each page, from 0 to 25.
  372.     DO
  373.         _LIMIT 30
  374.         valid = -1
  375.         LINE (50, 50)-STEP(700, 500), SkyBlue, BF 'erase the background
  376.         LINE (300, 106)-(725, 450), LightGray, BF
  377.         _FONT Header
  378.         SELECT CASE Selection 'redraw the selection we're working with
  379.             CASE 1
  380.                 Box 51, 51, 174, 50, Black, 0, "Weapons", SkyBlue, SkyBlue
  381.                 Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
  382.                 Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
  383.                 Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
  384.                 _FONT MainFont
  385.                 FOR i = 26 * Page TO 26 * Page + 25
  386.                     out$ = CHR$(65 + i MOD 26) + ")" + Inventory(i).Weapon.Name
  387.                     _PRINTSTRING (56, 106 + _FONTHEIGHT * (i MOD 26)), out$
  388.                 NEXT
  389.                 S = Item MOD 26
  390.                 Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
  391.                 out$ = CHR$(65 + S) + ")" + Inventory(Item).Weapon.Name
  392.                 _PRINTSTRING (56, 106 + _FONTHEIGHT * S), out$
  393.  
  394.                 COLOR Black, 0
  395.                 _FONT ItemNameFont
  396.                 IF Inventory(Item).Weapon.Identified THEN
  397.                     Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Weapon.Name), 0, 0
  398.                     _FONT 8
  399.                     _PRINTSTRING (305, 145), "Reach  :" + STR$(Inventory(Item).Weapon.Reach)
  400.                     _PRINTSTRING (305, 165), "Min Dmg:" + STR$(Inventory(Item).Weapon.Damage.Low)
  401.                     _PRINTSTRING (305, 175), "Max Dmg:" + STR$(Inventory(Item).Weapon.Damage.High)
  402.                     _PRINTSTRING (305, 185), "Hit Mod:" + STR$(Inventory(Item).Weapon.HitBonus)
  403.                     _PRINTSTRING (305, 195), "Dmg Mod:" + STR$(Inventory(Item).Weapon.DamageBonus)
  404.                     _PRINTSTRING (305, 205), "Light  :" + STR$(Inventory(Item).Weapon.Light.Reach)
  405.                 ELSE
  406.                     Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Weapon.DisplayedName), 0, 0
  407.                     _FONT 8
  408.                     _PRINTSTRING (305, 145), "Reach  : ???"
  409.                     _PRINTSTRING (305, 165), "Min Dmg: ???"
  410.                     _PRINTSTRING (305, 175), "Max Dmg: ???"
  411.                     _PRINTSTRING (305, 185), "Hit Mod: ???"
  412.                     _PRINTSTRING (305, 195), "Dmg Mod: ???"
  413.                     _PRINTSTRING (305, 205), "Light  : ???"
  414.                 END IF
  415.                 out$ = "Cond   : "
  416.                 SELECT CASE Inventory(Item).Weapon.Left 'the durability left on a weapon
  417.                     CASE -1: out$ = out$ + "Ind."
  418.                     CASE 0: out$ = out$ + "Broken"
  419.                     CASE IS < 26: out$ = out$ + "Worn"
  420.                     CASE IS < 50: out$ = out$ + "Used"
  421.                     CASE IS < 75: out$ = out$ + "Good"
  422.                     CASE IS < 90: out$ = out$ + "Mint"
  423.                     CASE ELSE: out$ = out$ + "New"
  424.                 END SELECT
  425.                 _PRINTSTRING (305, 155), out$
  426.                 LINE (422, 134)-STEP(130, 130), Black, BF
  427.                 _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Weapon.IconX, Inventory(Item).Weapon.IconY)-STEP(31, 31)
  428.             CASE 2
  429.                 Box 225, 51, 174, 50, Black, 0, "Armors", SkyBlue, SkyBlue
  430.                 Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
  431.                 Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
  432.                 Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
  433.                 _FONT MainFont
  434.                 FOR i = 0 TO 25
  435.                     out$ = CHR$(65 + i) + ")" + Inventory(i).Armor.Name
  436.                     _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
  437.                 NEXT
  438.                 Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
  439.                 out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Armor.Name
  440.                 _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
  441.  
  442.                 COLOR Black, 0
  443.                 _FONT ItemNameFont
  444.                 IF Inventory(Item).Armor.Identified THEN
  445.                     Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Armor.Name), 0, 0
  446.                     _FONT 8
  447.                     _PRINTSTRING (305, 145), "PD   :" + STR$(Inventory(Item).Armor.PD)
  448.                     _PRINTSTRING (305, 155), "DR   :" + STR$(Inventory(Item).Armor.DR)
  449.                 ELSE
  450.                     Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Armor.DisplayedName), 0, 0
  451.                     _FONT 8
  452.                     _PRINTSTRING (305, 145), "PD   : ???"
  453.                     _PRINTSTRING (305, 155), "DR   : ???"
  454.                 END IF
  455.                 out$ = "Cond : "
  456.                 SELECT CASE Inventory(Item).Armor.Left 'the durability left on armor
  457.                     CASE -1: out$ = out$ + "Ind."
  458.                     CASE 0: out$ = out$ + "Broken"
  459.                     CASE IS < 26: out$ = out$ + "Worn"
  460.                     CASE IS < 50: out$ = out$ + "Used"
  461.                     CASE IS < 75: out$ = out$ + "Good"
  462.                     CASE IS < 90: out$ = out$ + "Mint"
  463.                     CASE ELSE: out$ = out$ + "New"
  464.                 END SELECT
  465.                 _PRINTSTRING (305, 175), out$
  466.                 LINE (422, 134)-STEP(130, 130), Black, BF
  467.                 _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Armor.IconX, Inventory(Item).Armor.IconY)-STEP(31, 31)
  468.             CASE 3
  469.                 Box 400, 51, 174, 50, Black, 0, "Food", SkyBlue, SkyBlue
  470.                 Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
  471.                 Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
  472.                 Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
  473.                 _FONT MainFont
  474.                 FOR i = 0 TO 25
  475.                     out$ = CHR$(65 + i) + ")" + Inventory(i).Food.Name
  476.                     _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
  477.                 NEXT
  478.                 Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
  479.                 out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Food.Name
  480.                 _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
  481.  
  482.                 COLOR Black, 0
  483.                 _FONT ItemNameFont
  484.                 IF Inventory(Item).Food.Identified THEN
  485.                     Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Food.Name), 0, 0
  486.                 ELSE
  487.                     Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Food.DisplayedName), 0, 0
  488.                 END IF
  489.                 LINE (422, 134)-STEP(130, 130), Black, BF
  490.                 _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Food.IconX, Inventory(Item).Food.IconY)-STEP(31, 31)
  491.             CASE 4
  492.                 Box 575, 51, 174, 50, Black, 0, "Items", SkyBlue, SkyBlue
  493.                 Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
  494.                 Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
  495.                 Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
  496.                 _FONT MainFont
  497.                 FOR i = 0 TO 25
  498.                     out$ = CHR$(65 + i) + ")" '+ Inventory(i).Item.Name 'not defined yet
  499.                     _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
  500.                 NEXT
  501.                 Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
  502.                 out$ = CHR$(65 + Item MOD 26) + ")" '+ Inventory(Item).Item.Name
  503.                 _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
  504.         END SELECT
  505.         _FONT MainFont
  506.         Box 55, 485, 95, 50, Black, 0, "Page" + STR$(Page + 1), 0, 0
  507.         Box 170, 485, 95, 50, Black, 0, "(D)rop", LightGray, Black
  508.         Box 285, 485, 95, 50, Black, 0, "(E)quip", LightGray, Black
  509.         Box 410, 485, 95, 50, Black, 0, "(U)se", LightGray, Black
  510.         Box 525, 485, 95, 50, Black, 0, "nothing", LightGray, Black
  511.         Box 640, 485, 95, 50, Black, 0, "(C)lose", LightGray, Black
  512.         k = _KEYHIT
  513.         SELECT CASE k
  514.             CASE 18432 'up
  515.                 Item = Item - 1
  516.                 IF Item < 0 THEN Item = 25
  517.             CASE 19200 'left
  518.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  519.                     Page = Page - 1
  520.                     IF Page < 0 THEN Page = 3
  521.                 ELSE
  522.                     Selection = Selection - 1
  523.                     IF Selection < 1 THEN Selection = 4
  524.                 END IF
  525.             CASE 20480 'down
  526.                 Item = Item + 1
  527.                 IF Item > 25 THEN Item = 0
  528.             CASE 19712 'right
  529.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  530.                     Page = Page + 1
  531.                     IF Page > 3 THEN Page = 0
  532.                 ELSE
  533.                     Selection = Selection + 1
  534.                     IF Selection > 4 THEN Selection = 1
  535.                 END IF
  536.             CASE ASC("C"), ASC("c"), 27
  537.                 EXIT DO
  538.             CASE ELSE
  539.                 valid = 0
  540.         END SELECT
  541.         _DISPLAY
  542.         PCOPY 1, 0
  543.     LOOP
  544.  
  545.     _FONT OldFont
  546.     _DEST D: _SOURCE S
  547.  
  548.  
  549.  
  550.  
  551. SUB GetInput
  552.     DO
  553.         k = _KEYHIT: valid = -1
  554.         SELECT CASE k
  555.             CASE 18432 'up
  556.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  557.                     SELECT CASE Scale
  558.                         CASE 1.5: Scale = 2 'It's as small as we go
  559.                         CASE 2: Scale = 3
  560.                         CASE 3: Scale = 4
  561.                         CASE 4: Scale = 6
  562.                         CASE 6: Scale = 8
  563.                         CASE 8: Scale = 12
  564.                     END SELECT
  565.                 ELSE
  566.                     IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
  567.                 END IF
  568.             CASE 19200: 'left
  569.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  570.                     TextFont = TextFont - 1
  571.                     IF TextFont < 8 THEN TextFont = 8
  572.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  573.                     ClearTextArea PrintArea
  574.                     SetPrintPosition PrintArea, 1, 1
  575.                     PrintOut PrintArea, "Font Size Changed"
  576.                 ELSE
  577.                     IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
  578.                 END IF
  579.             CASE 20480: 'down
  580.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  581.                     SELECT CASE Scale
  582.                         CASE 2: Scale = 1.5 'It's as small as we go
  583.                         CASE 3: Scale = 2
  584.                         CASE 4: Scale = 3
  585.                         CASE 6: Scale = 4
  586.                         CASE 8: Scale = 6
  587.                         CASE 12: Scale = 8
  588.                     END SELECT
  589.                 ELSE
  590.                     IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
  591.                 END IF
  592.             CASE 19712: 'right
  593.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  594.                     TextFont = TextFont + 1
  595.                     IF TextFont > 48 THEN TextFont = 48
  596.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  597.                     ClearTextArea PrintArea
  598.                     SetPrintPosition PrintArea, 1, 1
  599.                     PrintOut PrintArea, "Font Size Changed"
  600.                 ELSE
  601.                     IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
  602.                 END IF
  603.             CASE 32 'space to just wait and skip a turn
  604.             CASE 60 ' "<" key
  605.                 IF MapArray(Hero.X, Hero.Y) AND 16 THEN
  606.                     Level = Level + 1
  607.                     CreateMap 99, 74, 10
  608.                     PathFind
  609.                 END IF
  610.             CASE ASC("I"), ASC("i")
  611.                 ManageInventory
  612.             CASE ASC("+"), ASC("=")
  613.                 IF Hero.Weapon2.Light.Reach < 25 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach + 1
  614.             CASE ASC("-"), ASC("_")
  615.                 IF Hero.Weapon2.Light.Reach > -1 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach - 1
  616.             CASE ELSE
  617.                 valid = 0 'it's a key press which we don't recognize.  Ignore it
  618.         END SELECT
  619.         _LIMIT 60
  620.     LOOP UNTIL k AND valid
  621.     _KEYCLEAR 'one keystroke at a time
  622.     StepsTaken = StepsTaken + 1
  623.  
  624. SUB Box (X, Y, Wide, High, FontColor as _unsigned long, _
  625.          FontBackGround as _unsigned long, Caption AS STRING, Kolor AS _UNSIGNED LONG, BackGround AS _UNSIGNED LONG)
  626.     COLOR FontColor, FontBackGround
  627.     LINE (X, Y)-STEP(Wide, High), Kolor, BF
  628.     LINE (X, Y)-STEP(Wide, High), BackGround, B
  629.     pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
  630.     _PRINTSTRING (X + (Wide - pw + 1) \ 2, Y + (High - ph + 1) \ 2), Caption
  631.     COLOR DC, BG
  632.  
  633.  
  634. SUB MoveHero (MoveX, MoveY)
  635.     TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
  636.     IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
  637.         IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
  638.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
  639.             IF MoveX THEN Hero.X = Hero.X + MoveX
  640.             IF MoveY THEN Hero.Y = Hero.Y + MoveY
  641.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
  642.             PathFind
  643.         ELSE
  644.             '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!
  645.             FOR i = 1 TO EncounterLimit
  646.                 IF Encounter(i).Active THEN 'Check for active/alive monsters only
  647.                     MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  648.                     IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
  649.                         Swing 0, i 'hero swings at the monster
  650.                     END IF
  651.                 END IF
  652.             NEXT
  653.         END IF
  654.     END IF
  655.  
  656. SUB Swing (Who, AtWhom)
  657.  
  658.     BaseChancetohit = 10 'base 10 chance to hit
  659.     IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
  660.         M = Encounter(AtWhom).Index
  661.         IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  662.             Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
  663.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  664.             totalroll = 0
  665.             DO
  666.                 roll = INT(RND * 20) + 1
  667.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  668.                 IF roll = 20 THEN totalroll = totalroll + 20
  669.                 totalroll = totalroll + roll
  670.             LOOP UNTIL roll <> 1 AND roll <> 20
  671.             damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
  672.             damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
  673.             out$ = _TRIM$(Hero.Name)
  674.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  675.                 SetTextColor PrintArea, &HFFF000F0, 0
  676.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  677.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  678.                 Hero.Life.Low = Hero.Life.Low - damage
  679.             ELSEIF totalroll < Chancetohit THEN
  680.                 SetTextColor PrintArea, &HFFF0F000, 0
  681.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  682.             ELSEIF totalroll > Chancetohit + 20 THEN
  683.                 SetTextColor PrintArea, &HFF00FF00, 0
  684.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  685.                 damage = damage * (totalroll / 20 + 1)
  686.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  687.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  688.             ELSEIF totalroll >= Chancetohit THEN
  689.                 SetTextColor PrintArea, &HFF00FF00, 0
  690.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  691.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
  692.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  693.             END IF
  694.         ELSEIF Hero.Weapon1.Reach > 0 THEN
  695.             SetTextColor PrintArea, &HFFF000F0, 0
  696.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
  697.         ELSE
  698.             out$ = ""
  699.         END IF
  700.         IF out$ <> "" THEN PrintOut PrintArea, out$
  701.         IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  702.             Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
  703.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  704.             totalroll = 0
  705.             DO
  706.                 roll = INT(RND * 20) + 1
  707.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  708.                 IF roll = 20 THEN totalroll = totalroll + 20
  709.                 totalroll = totalroll + roll
  710.             LOOP UNTIL roll <> 1 AND roll <> 20
  711.             damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
  712.             damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
  713.             out$ = _TRIM$(Hero.Name)
  714.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  715.                 SetTextColor PrintArea, &HFFF000F0, 0
  716.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  717.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  718.                 damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
  719.                 Hero.Life.Low = Hero.Life.Low - damage
  720.             ELSEIF totalroll < Chancetohit THEN
  721.                 SetTextColor PrintArea, &HFFF0F000, 0
  722.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  723.             ELSEIF totalroll > Chancetohit + 20 THEN
  724.                 SetTextColor PrintArea, &HFF00FF00, 0
  725.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  726.                 damage = damage * (totalroll / 20 + 1)
  727.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  728.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  729.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  730.             ELSEIF totalroll >= Chancetohit THEN
  731.                 SetTextColor PrintArea, &HFF00FF00, 0
  732.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  733.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
  734.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  735.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  736.             END IF
  737.         ELSEIF Hero.Weapon2.Reach > 0 THEN
  738.             SetTextColor PrintArea, &HFFF000F0, 0
  739.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
  740.         ELSE
  741.             out$ = ""
  742.         END IF
  743.         IF out$ <> "" THEN PrintOut PrintArea, out$
  744.         IF Encounter(AtWhom).Life <= 0 THEN MonsterDied (AtWhom) 'the monster died!
  745.     ELSE 'it's a monster attacking
  746.         M = Encounter(Who).Index
  747.         IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
  748.             Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
  749.             Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
  750.             totalroll = 0
  751.             DO
  752.                 roll = INT(RND * 20) + 1
  753.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  754.                 IF roll = 20 THEN totalroll = totalroll + 20
  755.                 totalroll = totalroll + roll
  756.             LOOP UNTIL roll <> 1 AND roll <> 20
  757.             damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
  758.             damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
  759.             out$ = _TRIM$(Monster(M).Name)
  760.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  761.                 SetTextColor PrintArea, &HFFF000F0, 0
  762.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  763.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  764.                 Monster(M).Life.Low = Monster(M).Life.Low - damage
  765.             ELSEIF totalroll < Chancetohit THEN
  766.                 SetTextColor PrintArea, &HFFF0F000, 0
  767.                 out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  768.             ELSEIF totalroll > Chancetohit + 20 THEN
  769.                 SetTextColor PrintArea, &HFF00FFFF, 0
  770.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
  771.                 damage = damage * (totalroll / 20 + 1)
  772.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  773.                 Hero.Life.Low = Hero.Life.Low - damage
  774.             ELSEIF totalroll >= Chancetohit THEN
  775.                 SetTextColor PrintArea, &HFF00FFFF, 0
  776.                 out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
  777.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
  778.                 Hero.Life.Low = Hero.Life.Low - damage
  779.             END IF
  780.         ELSEIF Monster(M).Weapon1.Reach > 0 THEN
  781.             SetTextColor PrintArea, &HFFF000F0, 0
  782.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
  783.         ELSE
  784.             out$ = ""
  785.         END IF
  786.         IF out$ <> "" THEN PrintOut PrintArea, out$
  787.     END IF
  788.  
  789. SUB MonsterDied (Who)
  790.     M = Encounter(Who).Index
  791.     SetTextColor PrintArea, &HFFFF0000, 0
  792.     out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
  793.     PrintOut PrintArea, out$
  794.     Encounter(Who).Active = 0
  795.     Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
  796.     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!
  797.     IF Monster(M).Found = 0 THEN
  798.         Monster(M).Found = -1 'it's a first time kill!
  799.         SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
  800.         out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
  801.         PrintOut PrintArea, out$
  802.     END IF
  803.  
  804.     'monster loot!!
  805.     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.
  806.     'if the player starts dumping items onto the ground, we could concievably fill the screen with tons of loots.
  807.     R# = RND * 100
  808.     IF R# < Monster(M).Loot1.Chance THEN
  809.         GOSUB addloot
  810.         Encounter(E).Type = Monster(M).Loot1.Type
  811.         Encounter(E).Index = Monster(M).Loot1.Index
  812.     ELSEIF R# < Monster(M).Loot2.Chance THEN
  813.         GOSUB addloot
  814.     ELSEIF R# < Monster(M).loot3.Chance THEN
  815.         GOSUB addloot
  816.     END IF
  817.  
  818.     EXIT SUB
  819.  
  820.     addloot: 'a small sub proceedure to reduce copy/paste code
  821.     EncounterLimit = EncounterLimit + 1
  822.     E = EncounterLimit 'just for ease of typing below
  823.     Encounter(E).Active = -1
  824.     Encounter(E).X = Encounter(Who).X
  825.     Encounter(E).Y = Encounter(Who).Y
  826.     PrintOut PrintArea, _TRIM$(Monster(M).Name) + " left something behind."
  827.     RETURN
  828.  
  829.  
  830. FUNCTION MoveMonster (Monster, MoveX, MoveY)
  831.     MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
  832.     D = Distance(MX, MY) 'distance from monster to the hero
  833.     E = Encounter(i).Index 'the actual monster in question
  834.     IF D > Distance(MX + MoveX, MY + MoveY) THEN
  835.         IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
  836.             MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
  837.             Encounter(Monster).X = Encounter(Monster).X + MoveX
  838.             Encounter(Monster).Y = Encounter(Monster).Y + MoveY
  839.             MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
  840.             MoveMonster = -1
  841.         END IF
  842.     END IF
  843.  
  844.  
  845.  
  846. SUB MonstersTurn
  847.     FOR i = 1 TO EncounterLimit
  848.         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.
  849.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  850.             D = Distance(MX, MY) 'distance from monster to the hero
  851.             E = Encounter(i).Index 'the actual monster in question
  852.             IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
  853.                 attack = 0
  854.                 IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
  855.                     'insert attack code here
  856.                     Swing i, 0
  857.                     _CONTINUE
  858.                 END IF
  859.                 'if the monster didn't attack, it can now move towards the hero.
  860.                 IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
  861.                     IF D > Distance(MX - 1, MY) THEN
  862.                         IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
  863.                     END IF
  864.                 END IF
  865.                 IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
  866.                     IF D > Distance(MX, MY - 1) THEN
  867.                         IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
  868.                     END IF
  869.                 END IF
  870.                 IF MX < XH THEN 'check to see if moving right moves us towards the hero.
  871.                     IF D > Distance(MX + 1, MY) THEN
  872.                         IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
  873.                     END IF
  874.                 END IF
  875.                 IF MY < YH THEN 'check to see if moving down moves us towards the hero.
  876.                     IF D > Distance(MX, MY + 1) THEN
  877.                         IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
  878.                     END IF
  879.                 END IF
  880.             END IF
  881.         END IF
  882.     NEXT
  883.  
  884.  
  885.  
  886. SUB DrawMap
  887.     _DEST WorkScreen
  888.     CLS
  889.     'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
  890.     IF Hero.Weapon1.Light.Reach > Hero.Weapon2.Light.Reach THEN LightReach = Hero.Weapon1.Light.Reach ELSE LightReach = Hero.Weapon2.Light.Reach
  891.     FOR Y = 0 TO YH
  892.         FOR X = 0 TO XH
  893.             IF Distance(X, Y) <= LightReach THEN 'It's close enough to check for illumination
  894.                 IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
  895.             END IF
  896.             IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
  897.                 IF MapArray(X, Y) AND 4 THEN 'it's a visible room
  898.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
  899.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
  900.                 END IF
  901.                 IF MapArray(X, Y) AND 8 THEN 'it's a visible path
  902.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
  903.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
  904.                 END IF
  905.                 IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
  906.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
  907.                 END IF
  908.             END IF
  909.             'note: highlighting for the light should come AFTER the map is drawn
  910.             IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
  911.                 LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
  912.                 MapArray(X, Y) = MapArray(X, Y) - 1
  913.                 FOR I = 1 TO EncounterLimit
  914.                     IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
  915.                         E = Encounter(I).Index
  916.                         T = Encounter(I).Type
  917.                         SELECT CASE T
  918.                             CASE 0 'it's a monster
  919.                                 IF Monster(E).Found THEN
  920.                                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
  921.                                 ELSE
  922.                                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
  923.                                 END IF
  924.                             CASE 1 'weapon
  925.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Weapon(E).IconX, Weapon(E).IconY)-STEP(31, 31)
  926.                             CASE 2 'armor
  927.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Armor(E).IconX, Armor(E).IconY)-STEP(31, 31)
  928.                             CASE 3 'food
  929.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Food(E).IconX, Food(E).IconY)-STEP(31, 31)
  930.                             CASE 4 'item
  931.                         END SELECT
  932.                     END IF
  933.                 NEXT
  934.  
  935.             END IF
  936.         NEXT
  937.     NEXT
  938.     COLOR &HFFFFFF00, 0 'Yellow Hero
  939.     _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
  940.     XOffset## = 1600 / Scale
  941.     YOffset## = 1200 / Scale
  942.     CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
  943.     CenterY = Hero.Y * 32
  944.     _DEST DisplayScreen
  945.     LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
  946.     _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
  947.  
  948.  
  949.  
  950.  
  951.  
  952. SUB CreateMap (XLimit, YLimit, Rooms)
  953.     ERASE MapArray 'clear the old map and reset everything to 0
  954.     REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
  955.     REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
  956.     REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
  957.     XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
  958.  
  959.     DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
  960.  
  961.     StairRoom = INT(RND * Rooms) + 1
  962.     FOR i = 1 TO Rooms
  963.         DO
  964.             RoomSize = INT(RND * 9) + 2
  965.             RoomX = INT(RND * (XLimit - RoomSize))
  966.             RoomY = INT(RND * (YLimit - RoomSize))
  967.             'test for positioning
  968.             good = -1 'it's good starting out
  969.             FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  970.                     IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
  971.             NEXT X, Y
  972.         LOOP UNTIL good
  973.         FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  974.                 MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
  975.         NEXT X, Y
  976.         RoomCenterX(i) = RoomX + .5 * RoomSize
  977.         RoomCenterY(i) = RoomY + .5 * RoomSize
  978.         IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
  979.             Hero.X = RoomX + INT(RND * RoomSize)
  980.             Hero.Y = RoomY + INT(RND * RoomSize)
  981.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
  982.         END IF
  983.         IF i = StairRoom THEN 'place the stairs in one of the random rooms
  984.             DO 'But lets not place the stairs directly on top of the hero to begin with
  985.                 StairX = RoomX + INT(RND * RoomSize)
  986.                 StairY = RoomY + INT(RND * RoomSize)
  987.             LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
  988.             MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
  989.         END IF
  990.     NEXT
  991.     FOR i = 1 TO Rooms - 1
  992.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  993.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  994.         DO UNTIL StartX = EndX AND StartY = EndY
  995.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  996.             Meander = 10
  997.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  998.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  999.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  1000.                     Ychange = 0
  1001.                 ELSE
  1002.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  1003.                     Ychange = 0
  1004.                 END IF
  1005.             ELSE
  1006.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  1007.                     Ychange = SGN(EndY - StartY)
  1008.                     XChange = 0
  1009.                 ELSE
  1010.                     Ychange = INT(RND * 3) - 1
  1011.                     XChange = 0
  1012.                 END IF
  1013.             END IF
  1014.             StartX = StartX + XChange
  1015.             StartY = StartY + Ychange
  1016.             IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
  1017.             IF StartY < 0 THEN StartY = 0
  1018.             IF StartX > XH THEN StartX = XH
  1019.             IF StartY > YH THEN StartY = YH
  1020.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
  1021.         LOOP
  1022.     NEXT
  1023.     PathFind
  1024.     EncounterLimit = INT(RND * 6) + 5
  1025.     FOR i = 1 TO EncounterLimit
  1026.         Encounter(i).Type = 0 'type 0 is a monster
  1027.         Encounter(i).Index = RandomMonster
  1028.         Encounter(i).Active = -1
  1029.         M = Encounter(i).Index
  1030.         Encounter(i).Life = INT(RND * Monster(M).Life.High - Monster(M).Life.Low + 1) + Monster(M).Life.Low
  1031.         valid = -1: EndlessLoopExit = 0
  1032.         DO
  1033.             EndlessLoopExit = EndlessLoopExit + 1
  1034.             Encounter(i).X = INT(RND * XLimit + 1)
  1035.             Encounter(i).Y = INT(RND * YLimit + 1)
  1036.             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.)
  1037.             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".
  1038.             '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.
  1039.             '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.
  1040.         LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
  1041.         MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
  1042.     NEXT
  1043.     LootLimit = 0 'no loot on the map at this time.  Too bad for joo!
  1044.  
  1045. SUB PathFind
  1046.     STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
  1047.     DIM pass AS _UNSIGNED _BYTE
  1048.     m = _MEM(Distance()): m1 = _MEM(Temp())
  1049.     _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
  1050.     _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
  1051.     Temp(Hero.X, Hero.Y) = 0
  1052.     pass = 0
  1053.     DO
  1054.         changed = 0
  1055.         y = 0
  1056.         DO
  1057.             x = 0
  1058.             DO
  1059.                 IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
  1060.                     IF x < XH THEN
  1061.                         IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  1062.                     END IF
  1063.                     IF x > 0 THEN
  1064.                         IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  1065.                     END IF
  1066.                     IF y < YH THEN
  1067.                         IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  1068.                     END IF
  1069.                     IF y > 0 THEN
  1070.                         IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  1071.                     END IF
  1072.                 END IF
  1073.                 x = x + 1
  1074.             LOOP UNTIL x > XH
  1075.             y = y + 1
  1076.         LOOP UNTIL y > YH
  1077.         _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
  1078.         pass = pass + 1
  1079.     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!
  1080.     Distance(Hero.X, Hero.Y) = 0
  1081.  
  1082. FUNCTION RandomMonster
  1083.     SELECT CASE Level 'the level we're on
  1084.         CASE 1 TO 3: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
  1085.         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!
  1086.     END SELECT
  1087.     RandomMonster = INT(RND * MC) + 1
  1088.  
  1089.  
  1090. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  1091. '# SUBroutines and FUNCTIONs below #'
  1092. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  1093. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  1094.     u = UBOUND(TextHandles)
  1095.     Handle = WhichHandle
  1096.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1097.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1098.     Where = TextHandles(Handle).VerticalAlignment
  1099.     How = TextHandles(Handle).Justification
  1100.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  1101.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  1102.  
  1103.  
  1104. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  1105.     'WhichHandle is the handle which designates which text area we want to use
  1106.     'Where is where we want it to go in that text area
  1107.     '  -- Online prints the text to the current print position line in that text area.
  1108.     '  -- CenterLine centers the text to the center of that text area.
  1109.     '  -- any other value will print to that line positon in that particular box.
  1110.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  1111.     'What is the text that we want to print in our text area
  1112.     '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).
  1113.  
  1114.     D = _DEST: S = _SOURCE
  1115.     OldFont = _FONT
  1116.  
  1117.     u = UBOUND(TextHandles)
  1118.     Handle = WhichHandle
  1119.  
  1120.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1121.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1122.     IF TextHandles(Handle).HideFrame THEN
  1123.         _DEST TextHandles(Handle).SavedBackground
  1124.         _SOURCE TextHandles(Handle).SavedBackground
  1125.     END IF
  1126.     _FONT TextHandles(Handle).Font
  1127.     fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
  1128.     IF _FONTWIDTH = 0 THEN
  1129.         FOR i = 1 TO 255
  1130.             IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
  1131.         NEXT
  1132.     ELSE
  1133.         fw = _FONTWIDTH
  1134.     END IF
  1135.  
  1136.     h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
  1137.  
  1138.     SELECT CASE Where
  1139.         CASE BottomLine
  1140.             y = h \ fh
  1141.         CASE OnLine
  1142.             y = TextHandles(Handle).Ypos
  1143.             IF y = 0 THEN y = 1
  1144.         CASE CenterLine
  1145.             linesused = 0
  1146.             tpw = pw: tw = w: tWhat$ = What
  1147.             DO UNTIL tpw <= tw
  1148.                 textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
  1149.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  1150.                 linesused = linesused + 1
  1151.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  1152.                 tpw = _PRINTWIDTH(tWhat$)
  1153.             LOOP
  1154.             linesused = linesused + 1
  1155.             py = (h - linesused * fh) \ 2
  1156.             y = py \ fh + 1
  1157.             IF y < 1 THEN y = 1
  1158.         CASE ELSE
  1159.             y = Where
  1160.     END SELECT
  1161.  
  1162.     'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  1163.     blend = _BLEND
  1164.  
  1165.     DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  1166.         'first let's get a temp image handle for the existing area of the screen.
  1167.         x1 = TextHandles(Handle).x1 + 2
  1168.         y1 = TextHandles(Handle).y1 + 2
  1169.         x2 = TextHandles(Handle).x1 + w
  1170.         y2 = TextHandles(Handle).y1 + h
  1171.         nh = y2 - y1 + 1 - fh
  1172.         nw = x2 - x1 + 1
  1173.         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.
  1174.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  1175.         DrawTextArea Handle
  1176.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  1177.         y = y - 1
  1178.     LOOP
  1179.  
  1180.     IF blend THEN _BLEND
  1181.  
  1182.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  1183.  
  1184.     SELECT CASE How
  1185.         CASE LeftJustify
  1186.             x = 0
  1187.             IF pw > w THEN
  1188.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  1189.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1190.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1191.                 PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
  1192.             ELSE
  1193.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1194.                 finished = -1
  1195.             END IF
  1196.         CASE CenterJustify
  1197.             IF pw > w THEN
  1198.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  1199.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1200.                 x = (w - _PRINTWIDTH(text$)) \ 2
  1201.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1202.                 PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  1203.             ELSE
  1204.                 x = (w - pw) \ 2
  1205.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1206.                 finished = -1
  1207.             END IF
  1208.         CASE RightJustify
  1209.             IF pw > w THEN
  1210.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  1211.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1212.                 x = w - _PRINTWIDTH(text$)
  1213.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1214.                 PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
  1215.             ELSE
  1216.                 x = w - pw
  1217.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1218.                 finished = -1
  1219.             END IF
  1220.         CASE NoJustify
  1221.             x = TextHandles(Handle).Xpos
  1222.             firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
  1223.             IF LEN(What) > firstlinelimit THEN
  1224.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  1225.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1226.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1227.                 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
  1228.             ELSE
  1229.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1230.                 finished = -1
  1231.             END IF
  1232.     END SELECT
  1233.     IF finished THEN
  1234.         SELECT CASE TextHandles(Handle).UpdateMethod
  1235.             CASE NoUpdate 'We don't update the position at all.
  1236.             CASE DoUpdate
  1237.                 TextHandles(Handle).Xpos = x + pw
  1238.                 TextHandles(Handle).Ypos = y
  1239.             CASE NewLine
  1240.                 TextHandles(Handle).Ypos = y + 1
  1241.                 TextHandles(Handle).Xpos = 1
  1242.         END SELECT
  1243.         _FONT OldFont
  1244.         _DEST D: _SOURCE S
  1245.         COLOR FG, BG
  1246.     END IF
  1247.  
  1248. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  1249.     u = UBOUND(TextHandles)
  1250.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1251.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1252.     TextHandles(Handle).TextColor = Foreground
  1253.  
  1254.  
  1255. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  1256.     u = UBOUND(TextHandles)
  1257.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1258.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1259.     TextHandles(Handle).TextBackgroundColor = Background
  1260.  
  1261. SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
  1262.     u = UBOUND(TextHandles)
  1263.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1264.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1265.     SELECT CASE TextHandles(Handle).Font
  1266.         CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
  1267.         CASE IS > 1
  1268.             'we have the font already in use
  1269.             'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
  1270.             _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
  1271.     END SELECT
  1272.  
  1273.     temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
  1274.     IF temp > 1 THEN
  1275.         TextHandles(Handle).Font = temp
  1276.     ELSE
  1277.         TextHandles(Handle).Font = 16 'default to font 16, in case
  1278.     END IF
  1279.  
  1280.  
  1281. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  1282.     u = UBOUND(TextHandles)
  1283.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1284.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1285.     TextHandles(Handle).TextColor = Foreground
  1286.     TextHandles(Handle).TextBackgroundColor = Background
  1287.  
  1288.  
  1289. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  1290.     u = UBOUND(TextHandles)
  1291.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1292.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1293.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  1294.     TextHandles(Handle).UpdateMethod = Method
  1295.  
  1296.  
  1297. SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
  1298.     u = UBOUND(TextHandles)
  1299.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1300.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1301.     SELECT CASE Y
  1302.         CASE BottomLine
  1303.             TextHandles(Handle).VerticalAlignment = -2
  1304.         CASE CenterLine
  1305.             TextHandles(Handle).VerticalAlignment = -1
  1306.         CASE ELSE
  1307.             TextHandles(Handle).VerticalAlignment = 0
  1308.     END SELECT
  1309.     IF X < 1 AND X > -4 THEN
  1310.         TextHandles(Handle).Justification = X
  1311.     ELSE
  1312.         TextHandles(Handle).Xpos = X
  1313.     END IF
  1314.     IF Y < 1 THEN EXIT SUB
  1315.     TextHandles(Handle).Ypos = Y
  1316.  
  1317. SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
  1318.     u = UBOUND(TextHandles)
  1319.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1320.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1321.     IF X < 1 AND X > -4 THEN
  1322.         TextHandles(Handle).Justification = X
  1323.     ELSE
  1324.         TextHandles(Handle).Xpos = X
  1325.     END IF
  1326.  
  1327. SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
  1328.     u = UBOUND(TextHandles)
  1329.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1330.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1331.     SELECT CASE Y
  1332.         CASE BottomLine
  1333.             TextHandles(Handle).VerticalAlignment = -2
  1334.         CASE CenterLine
  1335.             TextHandles(Handle).VerticalAlignment = -1
  1336.         CASE ELSE
  1337.             TextHandles(Handle).VerticalAlignment = 0
  1338.     END SELECT
  1339.     IF Y < 1 THEN EXIT SUB
  1340.     TextHandles(Handle).Ypos = Y
  1341.  
  1342.  
  1343. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  1344.     u = UBOUND(TextHandles)
  1345.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1346.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1347.     GetPrintPositionY = TextHandles(Handle).Ypos
  1348.  
  1349. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  1350.     u = UBOUND(TextHandles)
  1351.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1352.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1353.     GetPrintPositionX = TextHandles(Handle).Xpos
  1354.  
  1355.  
  1356.  
  1357. FUNCTION WordBreak (text$)
  1358.     CONST Breaks = " ;,.?!-"
  1359.     FOR i = LEN(text$) TO 0 STEP -1
  1360.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  1361.         loopcount = loopcount + 1
  1362.     NEXT
  1363.     IF i = 0 THEN i = LEN(text$)
  1364.     WordBreak = i
  1365.  
  1366.  
  1367.  
  1368. SUB ClearTextArea (Handle AS INTEGER)
  1369.     u = UBOUND(TextHandles)
  1370.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1371.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1372.     IF TextHandles(Handle).SavedBackground THEN
  1373.         w = TextHandles(Handle).w
  1374.         h = TextHandles(Handle).h
  1375.         x1 = TextHandles(Handle).ScreenX
  1376.         y1 = TextHandles(Handle).ScreenY
  1377.         x2 = x1 + w - 1
  1378.         y2 = y1 + h - 1
  1379.         blend = _BLEND
  1380.         _DONTBLEND
  1381.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1382.         IF blend THEN _BLEND
  1383.     END IF
  1384.     DrawTextArea Handle
  1385.  
  1386.  
  1387.  
  1388. SUB DrawTextArea (Handle AS INTEGER)
  1389.     u = UBOUND(TextHandles)
  1390.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1391.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1392.     w = TextHandles(Handle).w
  1393.     h = TextHandles(Handle).h
  1394.     x1 = TextHandles(Handle).ScreenX
  1395.     y1 = TextHandles(Handle).ScreenY
  1396.     x2 = x1 + w - 1
  1397.     y2 = y1 + h - 1
  1398.  
  1399.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  1400.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  1401.  
  1402.  
  1403.  
  1404. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  1405.     u = UBOUND(TextHandles)
  1406.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1407.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1408.     TextHandles(Handle).FrameColor = FrameColor
  1409.     TextHandles(Handle).BackColor = BackColor
  1410.  
  1411.  
  1412.  
  1413. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  1414.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  1415.     x2 = tx2: y2 = ty2
  1416.     IF x1 > x2 THEN SWAP x1, x2
  1417.     IF y1 > y2 THEN SWAP y1, y2
  1418.     w = x2 - x1 + 1
  1419.     h = y2 - y1 + 1
  1420.     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
  1421.     'Error checking for if the user sends coordinates which are off the screen
  1422.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  1423.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  1424.  
  1425.     u = UBOUND(TextHandles)
  1426.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  1427.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  1428.     NEXT
  1429.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  1430.         Handle = u + 1
  1431.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  1432.     END IF
  1433.     TextHandles(Handle).x1 = x1
  1434.     TextHandles(Handle).y1 = y1
  1435.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  1436.     TextHandles(Handle).InUse = True
  1437.     TextHandles(Handle).Xpos = 0
  1438.     TextHandles(Handle).Ypos = 1
  1439.     TextHandles(Handle).UpdateMethod = NewLine
  1440.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  1441.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  1442.  
  1443.     IF SaveBackground THEN
  1444.         imagehandle = _NEWIMAGE(w, h, 32)
  1445.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1446.         TextHandles(Handle).SavedBackground = imagehandle
  1447.     END IF
  1448.     TextHandles(Handle).ScreenX = x1
  1449.     TextHandles(Handle).ScreenY = y1
  1450.     TextHandles(Handle).Font = 16 'default to font 16
  1451.     NewTextArea% = Handle
  1452.  
  1453. SUB FreeTextArea (Handle AS INTEGER)
  1454.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  1455.         IF TextHandles(Handle).InUse THEN
  1456.             TextHandles(Handle).InUse = False
  1457.             IF TextHandles(Handle).SavedBackground THEN
  1458.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  1459.                     w = TextHandles(Handle).w
  1460.                     h = TextHandles(Handle).h
  1461.                     x1 = TextHandles(Handle).ScreenX
  1462.                     y1 = TextHandles(Handle).ScreenY
  1463.                     x2 = x1 + w - 1
  1464.                     y2 = y1 + h - 1
  1465.                     blend = _BLEND
  1466.                     _DONTBLEND
  1467.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1468.                     IF blend THEN _BLEND
  1469.                 END IF
  1470.                 '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.
  1471.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  1472.             END IF
  1473.         ELSE
  1474.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  1475.         END IF
  1476.     ELSE
  1477.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  1478.     END IF
  1479.  
  1480. SUB HideFrame (Handle AS INTEGER)
  1481.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  1482.         TextHandles(Handle).HideFrame = -1
  1483.         w = TextHandles(Handle).w
  1484.         h = TextHandles(Handle).h
  1485.         x1 = TextHandles(Handle).ScreenX
  1486.         y1 = TextHandles(Handle).ScreenY
  1487.         x2 = x1 + w - 1
  1488.         y2 = y1 + h - 1
  1489.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1490.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1491.         IF TextHandles(Handle).SavedBackground THEN
  1492.             blend = _BLEND
  1493.             _DONTBLEND
  1494.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1495.             _FREEIMAGE TextHandles(Handle).SavedBackground
  1496.             IF blend THEN _BLEND
  1497.         END IF
  1498.         TextHandles(Handle).SavedBackground = imagehandle
  1499.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  1500.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  1501.     END IF
  1502.  
  1503. SUB RestoreFrame (Handle AS INTEGER)
  1504.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  1505.         TextHandles(Handle).HideFrame = 0
  1506.         w = TextHandles(Handle).w
  1507.         h = TextHandles(Handle).h
  1508.         x1 = TextHandles(Handle).ScreenX
  1509.         y1 = TextHandles(Handle).ScreenY
  1510.         x2 = x1 + w - 1
  1511.         y2 = y1 + h - 1
  1512.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1513.         blend = _BLEND
  1514.         _DONTBLEND
  1515.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1516.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  1517.         _FREEIMAGE TextHandles(Handle).SavedBackground
  1518.         IF blend THEN _BLEND
  1519.         TextHandles(Handle).SavedBackground = imagehandle
  1520.         TextHandles(Handle).x1 = x1 'When the frames are restored, we need to recalculate our print position
  1521.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  1522.     END IF
  1523.  
  1524. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  1525.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  1526.     u = UBOUND(TextHandles)
  1527.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1528.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1529.     HideFrame Handle
  1530.     TextHandles(Handle).ScreenX = x1
  1531.     TextHandles(Handle).ScreenY = y1
  1532.     RestoreFrame Handle

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
Inventory Screenshot.jpg
* Inventory Screenshot.jpg (Filesize: 84.51 KB, Dimensions: 806x729, Views: 77)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Rogue-Like (work in progress)
« Reply #28 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]
  1. DEFLNG A-Z 'default to long instead of single
  2. TYPE TextArea
  3.     InUse AS INTEGER
  4.     x1 AS LONG 'left
  5.     y1 AS LONG 'top
  6.     w AS LONG 'width
  7.     h AS LONG 'height
  8.     FrameColor AS _UNSIGNED LONG
  9.     BackColor AS _UNSIGNED LONG
  10.     Xpos AS INTEGER
  11.     Ypos AS INTEGER
  12.     VerticalAlignment AS INTEGER
  13.     Justification AS INTEGER
  14.     UpdateMethod AS INTEGER
  15.     TextColor AS _UNSIGNED LONG
  16.     TextBackgroundColor AS _UNSIGNED LONG
  17.     SavedBackground AS INTEGER
  18.     HideFrame AS INTEGER
  19.     ScreenX AS INTEGER
  20.     ScreenY AS INTEGER
  21.     Font AS LONG 'NEW! Change fonts for each independent font area
  22.  
  23. REDIM SHARED TextHandles(0) AS TextArea
  24.  
  25. CONST True = -1, False = 0
  26. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  27. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  28. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  29. '********************************************************
  30. '* Text Frames before this line
  31. '********************************************************
  32.  
  33.  
  34.  
  35.  
  36.  
  37. _CONSOLE ON 'for debugging purposes while making/testing things
  38.  
  39. TYPE Damage_Type
  40.     Low AS INTEGER
  41.     High AS INTEGER
  42.  
  43. TYPE Light_Type
  44.     Reach AS INTEGER
  45.     Left AS INTEGER
  46.  
  47. TYPE Weapon_Type
  48.     Identified AS _UNSIGNED _BYTE
  49.     Name AS STRING * 20
  50.     DisplayedName AS STRING * 20
  51.     Reach AS INTEGER
  52.     Damage AS Damage_Type
  53.     HitBonus AS INTEGER
  54.     DamageBonus AS INTEGER
  55.     Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  56.     IconX AS LONG
  57.     IconY AS LONG
  58.     Light AS Light_Type
  59.  
  60. TYPE Armor_Type
  61.     Identified AS _UNSIGNED _BYTE
  62.     Name AS STRING * 20
  63.     DisplayedName AS STRING * 20
  64.     PD AS INTEGER 'Passive Defense (dodge)
  65.     DR AS INTEGER 'Damage Resistance (absorption)
  66.     Left AS INTEGER 'life left on the weapon, AKA "durability", but easier and cheaper to spell
  67.     IconX AS LONG
  68.     IconY AS LONG
  69.  
  70. TYPE Food_Type
  71.     Count AS INTEGER 'food is stackable
  72.     Identified AS _UNSIGNED _BYTE
  73.     Name AS STRING * 20
  74.     DisplayedName AS STRING * 20
  75.     HungerFill AS SINGLE 'how much said food fills one's stomach
  76.     HungerRate AS SINGLE 'how fast it digests before we get hunry again
  77.     IconX AS LONG
  78.     IconY AS LONG
  79.  
  80.  
  81. TYPE Hero_Type
  82.     Name AS STRING * 20
  83.     Life AS Damage_Type
  84.     Mana AS Damage_Type
  85.     Level AS _UNSIGNED _BYTE
  86.     EXP_Earned AS LONG
  87.     EXP_Needed AS LONG
  88.     Light AS Light_Type
  89.     Weapon1 AS Weapon_Type
  90.     Weapon2 AS Weapon_Type
  91.     Armor AS Armor_Type
  92.     HealingRate AS INTEGER 'number of turns before the hero heals a point
  93.     Hunger AS SINGLE
  94.     HungerRate AS SINGLE
  95.  
  96. TYPE Treasure_TYPE
  97.     Chance AS SINGLE
  98.     Type AS _UNSIGNED _BYTE '1 weapon, 2 armor, 3 food, 4 item
  99.     Index AS INTEGER 'the number of the type... Weapon(0) = "Bare Fist", so tyoe = 1, index = 0.
  100.  
  101. TYPE Monster_TYPE
  102.     Name AS STRING * 20
  103.     Life AS Damage_Type
  104.     Level AS INTEGER
  105.     ExpBonus AS INTEGER
  106.     Sight AS INTEGER
  107.     Hearing AS INTEGER
  108.     Detection AS INTEGER 'in case it has some sort of magic "sixth sense" to detect characters, not related to sight nor sound.
  109.     Weapon1 AS Weapon_Type
  110.     Weapon2 AS Weapon_Type
  111.     Armor AS Armor_Type
  112.     Found AS INTEGER
  113.     IconX AS LONG
  114.     IconY AS LONG
  115.     Loot1 AS Treasure_TYPE
  116.     Loot2 AS Treasure_TYPE
  117.     loot3 AS Treasure_TYPE
  118.  
  119. TYPE Encounter_TYPE
  120.     Active AS INTEGER
  121.     X AS INTEGER
  122.     Y AS INTEGER
  123.     Type AS INTEGER '0 monster, 1 weapon, 2 armor, 3 food, 4 item
  124.     Index AS INTEGER
  125.     Life AS INTEGER
  126.  
  127. TYPE Inventory_Type
  128.     Weapon AS Weapon_Type
  129.     Armor AS Armor_Type
  130.     Food AS Food_Type
  131.     'Item as item_type 'to come later, once general items get added
  132.  
  133.  
  134. REDIM SHARED Monster(100) AS Monster_TYPE
  135. REDIM SHARED Encounter(1000) AS Encounter_TYPE, EncounterLimit AS INTEGER
  136.  
  137. '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.
  138. REDIM SHARED Weapon(100) AS Weapon_Type
  139. REDIM SHARED Armor(100) AS Armor_Type
  140. REDIM SHARED Food(100) AS Food_Type
  141.  
  142. DIM SHARED Hero AS Hero_Type
  143. REDIM SHARED Inventory(103) AS Inventory_Type '103 slots each to carry weapons/armor/food/items
  144. DIM SHARED WeaponsInGame AS INTEGER, ArmorInGame AS INTEGER, FoodInGame AS INTEGER, ItemsInGame AS INTEGER
  145. 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.
  146. DIM SHARED Level AS _UNSIGNED _BYTE: Level = 1
  147. DIM SHARED XL, XH, YL, YH 'the map X/Y low/high array limits.
  148. DIM SHARED PrintArea AS LONG 'the handle to our text frame print area for game results.
  149. DIM SHARED Scale AS _FLOAT, WorkScreen AS LONG, DisplayScreen AS LONG, Icons AS LONG
  150. DIM SHARED TextFont AS LONG, StepsTaken AS _UNSIGNED _INTEGER64
  151.  
  152. WorkScreen = _NEWIMAGE(3200, 2400, 32)
  153. DisplayScreen = _NEWIMAGE(800, 700, 32)
  154. SCREEN DisplayScreen
  155. Scale = 2
  156.  
  157. REDIM SHARED MapArray(0, 0) AS _UNSIGNED _BYTE
  158. '1 map is illuminated
  159. '2 map is uncovered
  160. '4 map is a wall
  161. '8 map is a pathway
  162. '16 map is a stairway
  163. '32 map is simply blocked (perhaps with a monster?)
  164. '64 map is secret (can not be uncovered)
  165.  
  166. REDIM SHARED Distance(0, 0) AS _UNSIGNED _BYTE
  167.  
  168.  
  169. Init
  170. CreateMap 99, 74, 10
  171.     DrawMap
  172.     DisplayCharacter
  173.     _DISPLAY
  174.     GetInput
  175.     MonstersTurn
  176.     CheckForHeroGrowth
  177.  
  178. SUB Init
  179.     D = _DEST
  180.     Hero.Name = "Steve The Tester!"
  181.     Hero.Life.Low = 10: Hero.Life.High = 10: Hero.Level = 1
  182.     Hero.Mana.Low = 10: Hero.Mana.High = 10
  183.     Hero.EXP_Earned = 0: Hero.EXP_Needed = 2
  184.     Hero.Weapon1.Name = "Bare Fist"
  185.     Hero.Weapon1.Reach = 1: Hero.Weapon1.Damage.Low = 1: Hero.Weapon1.Damage.High = 2
  186.     Hero.Weapon1.HitBonus = 0: Hero.Weapon1.DamageBonus = 0
  187.     Hero.Weapon1.Left = -1 'your fist is indestructible!
  188.     Hero.Weapon1.IconX = 2 * 32: Hero.Weapon1.IconY = 47 * 32
  189.     Hero.Weapon2.Name = "Magic Candle"
  190.     Hero.Weapon2.Reach = 0: Hero.Weapon2.Damage.Low = 0: Hero.Weapon2.Damage.High = 0
  191.     Hero.Weapon2.HitBonus = 0: Hero.Weapon2.DamageBonus = 0
  192.     Hero.Weapon2.Left = 0 'you can't attack with a candle
  193.     Hero.Weapon2.IconX = 52 * 32: Hero.Weapon2.IconY = 42 * 32
  194.     Hero.Weapon2.Light.Reach = 2: Hero.Weapon2.Light.Left = -1 'infinite
  195.     Hero.Armor.Name = "Naked"
  196.     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!
  197.     Hero.Armor.IconX = 46 * 32: Hero.Armor.IconY = 42 * 32
  198.     Hero.HealingRate = 20 'the hero heals 1 point of health for every 20 valid turns naturally
  199.     Hero.HungerRate = 0.1 'Let's start heros out with a full belly and a low hunger growth rate
  200.  
  201.     PrintArea = NewTextArea(230, 601, 799, 699, False)
  202.     ColorTextArea PrintArea, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  203.     SetTextFont PrintArea, "courbd.ttf", 24
  204.     DrawTextArea PrintArea
  205.     SetPrintPositionX PrintArea, CenterJustify
  206.     SetPrintUpdate PrintArea, NewLine
  207.     PrintOut PrintArea, "WELCOME TO (almost) ROGUE"
  208.     SetTextFont PrintArea, "courbd.ttf", 18
  209.     PrintOut PrintArea, "created by STEVE!"
  210.     PrintOut PrintArea, ""
  211.     SetPrintPositionX PrintArea, LeftJustify
  212.     SetTextFont PrintArea, "courbd.ttf", 12
  213.     TextFont = 12
  214.  
  215.     temp = _NEWIMAGE(480, 480, 32)
  216.     _DEST temp: _CONTROLCHR OFF
  217.     COLOR &HFFFFFF00, 0 'Yellow Hero
  218.     _PRINTSTRING (0, 0), CHR$(1) 'the hero
  219.     COLOR &HFFFF0000, 0 'Red Question Mark
  220.     _PRINTSTRING (16, 0), "?" 'a question mark
  221.     Icons = _LOADIMAGE("Sprites.png", 32)
  222.     _PUTIMAGE (2016, 1504)-STEP(32, 32), temp, Icons, (0, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  223.     _PUTIMAGE (1984, 1504)-STEP(32, 32), temp, Icons, (16, 0)-STEP(_FONTWIDTH, _FONTHEIGHT)
  224.     '        SCREEN Icons: DO: SLEEP: LOOP
  225.     _DEST D
  226.  
  227.     'Init some basic weapons which we can find
  228.  
  229.     'These first two should always be available for us to use/enjoy.
  230.     WeaponOwned = 1: ArmorOwned = 1: FoodOwned = 1
  231.     Weapon(0).Name = "Bare Fist": Weapon(0).Identified = -1
  232.     Weapon(0).Reach = 1: Weapon(0).Damage.Low = 1: Weapon(0).Damage.High = 2
  233.     Weapon(0).HitBonus = 0: Weapon(0).DamageBonus = 0
  234.     Weapon(0).Left = -1 'your fist is indestructible!
  235.     Weapon(0).IconX = 2 * 32: Weapon(0).IconY = 47 * 32
  236.     Weapon(0).Light.Reach = 0: Weapon(0).Light.Left = 0
  237.     Weapon(1).Name = "Magic Candle": Weapon(1).Identified = -1
  238.     Weapon(1).Reach = 0: Weapon(1).Damage.Low = 0: Weapon(1).Damage.High = 0
  239.     Weapon(1).HitBonus = 0: Weapon(1).DamageBonus = 0
  240.     Weapon(1).Left = 0 'you can't attack with a candle
  241.     Weapon(1).IconX = 52 * 32: Weapon(1).IconY = 42 * 32
  242.     Weapon(1).Light.Reach = 2: Weapon(1).Light.Left = -1 'infinite
  243.  
  244.     Armor(0).Name = "Naked": Armor(0).Identified = -1
  245.     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!
  246.     Armor(0).IconX = 46 * 32: Armor(0).IconY = 42 * 32
  247.  
  248.     Food(0).Name = "Nothing": Food(0).Identified = -1
  249.     Food(0).HungerFill = 10: Food(0).HungerRate = 0
  250.     Food(0).IconX = 0: Food(0).IconY = 0
  251.  
  252.     Food(1).Name = "Bat Meat"
  253.     Food(1).HungerFill = 10: Food(1).HungerRate = .1
  254.     Food(1).IconX = 36 * 32: Food(1).IconY = 23 * 32
  255.  
  256.     Food(2).Name = "Rat Meat"
  257.     Food(2).HungerFill = 10: Food(2).HungerRate = .1
  258.     Food(2).IconX = 36 * 32: Food(2).IconY = 23 * 32
  259.  
  260.     Food(3).Name = "Snake Meat"
  261.     Food(3).HungerFill = 10: Food(3).HungerRate = .1
  262.     Food(3).IconX = 36 * 32: Food(3).IconY = 23 * 32
  263.  
  264.     WeaponsOwned = 1: ArmorOwnded = 0: FoodOwned = 0 'You start the game with a magic candle and nothing else.
  265.     Inventory(0).Weapon = Weapon(0): Inventory(1).Weapon = Weapon(1)
  266.     Inventory(0).Armor = Armor(0)
  267.     Inventory(0).Food = Food(0)
  268.  
  269.     WeaponsInGame = 1: ArmorInGame = 0: FoodInGame = 3
  270.     InitMonsters
  271.  
  272. SUB InitMonsters
  273.  
  274.     Monster(1).Name = "Bat": Monster(1).Life.Low = 1: Monster(1).Life.High = 4: Monster(1).Level = 1: Monster(1).ExpBonus = 0
  275.     Monster(1).Sight = 2: Monster(1).Hearing = 4: Monster(1).Detection = 0
  276.     Monster(1).Weapon1.Name = "Bite": Monster(1).Weapon1.Reach = 1
  277.     Monster(1).Weapon1.Damage.Low = 1: Monster(1).Weapon1.Damage.High = 2
  278.     Monster(1).IconX = 44 * 32: Monster(1).IconY = 3 * 32 'position 44,3 on the sprite sheet
  279.     Monster(1).Loot1.Chance = 95: Monster(1).Loot1.Type = 3: Monster(1).Loot1.Index = 1
  280.     'Monster(1).Weapon1.HitBonus = 0: Monster(1).Weapon1.DamageBonus = 0: Monster(1).Weapon1.Left = 0
  281.     'Monster(1).Weapon2.Name = "": Monster(1).Weapon2.Reach = 0
  282.     'Monster(1).Weapon2.Damage.Low = 0: Monster(1).Weapon2.Damage.High = 0
  283.     'Monster(1).Weapon2.HitBonus = 0: Monster(1).Weapon2.DamageBonus = 0: Monster(1).Weapon2.Left = 0
  284.     'Monster(1).Armor.Name = ""
  285.     'Monster(1).Armor.PD = 0: Monster(1).Armor.DR = 0: Monster(1).Armor.Left = 0
  286.     Monster(2).Name = "Rat": Monster(2).Life.Low = 1: Monster(2).Life.High = 4
  287.     Monster(2).Level = 1: Monster(2).ExpBonus = 0
  288.     Monster(2).Sight = 2: Monster(2).Hearing = 4: Monster(2).Detection = 0
  289.     Monster(2).Weapon1.Name = "Bite": Monster(2).Weapon1.Reach = 1
  290.     Monster(2).Weapon1.Damage.Low = 1: Monster(2).Weapon1.Damage.High = 2
  291.     Monster(2).IconX = 23 * 32: Monster(2).IconY = 4 * 32 'position 44,3 on the sprite sheet
  292.     Monster(2).Loot1.Chance = 25: Monster(2).Loot1.Type = 3: Monster(2).Loot1.Index = 2
  293.     Monster(3).Name = "Snake": Monster(3).Life.Low = 1: Monster(3).Life.High = 4
  294.     Monster(3).Level = 1: Monster(3).ExpBonus = 0
  295.     Monster(3).Sight = 2: Monster(3).Hearing = 4: Monster(3).Detection = 0
  296.     Monster(3).Weapon1.Name = "Bite": Monster(3).Weapon1.Reach = 1
  297.     Monster(3).Weapon1.Damage.Low = 1: Monster(3).Weapon1.Damage.High = 2
  298.     Monster(3).IconX = 37 * 32: Monster(3).IconY = 4 * 32 'position 44,3 on the sprite sheet
  299.     Monster(3).Loot1.Chance = 25: Monster(3).Loot1.Type = 3: Monster(3).Loot1.Index = 3
  300.  
  301.  
  302. SUB CheckForHeroGrowth
  303.     IF Hero.Life.Low < 1 THEN 'first, let's check to see if we died...
  304.         CLS
  305.         PRINT "YOU DIED!  HAHAHAHA!! (Better ending coming later...)"
  306.         _DISPLAY
  307.         BEEP
  308.         _DELAY 5
  309.         SYSTEM
  310.     END IF
  311.     IF Hero.EXP_Earned >= Hero.EXP_Needed THEN 'let's check to see if the hero has leveled up
  312.         PrintOut PrintArea, "Congratulations!  You have gained a level!"
  313.         DO
  314.             r = INT(RND * 6) + 1
  315.             lifegained = lifegained + r
  316.         LOOP UNTIL r <> 6
  317.         Hero.Life.Low = Hero.Life.Low + r
  318.         Hero.Life.High = Hero.Life.High + r
  319.         Hero.EXP_Earned = 0
  320.         Hero.Level = Hero.Level + 1
  321.         Hero.EXP_Needed = Hero.EXP_Needed + Hero.Level + 1
  322.     END IF
  323.     IF StepsTaken MOD Hero.HealingRate = 0 THEN 'heal the hero naturally over time
  324.         IF Hero.Life.Low < Hero.Life.High THEN Hero.Life.Low = Hero.Life.Low + 1
  325.     END IF
  326.     Hero.Hunger = Hero.Hunger + Hero.HungerRate
  327.     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
  328.     IF Hero.Weapon2.Light.Left > -1 THEN Hero.Weapon2.Light.Left = Hero.Weapon2.Light.Left - 1
  329.  
  330.  
  331.  
  332. SUB DisplayCharacter
  333.     LINE (0, 601)-(229, 799), &HFF000000, BF
  334.     COLOR -1, 0
  335.     Box 0, 601, 229, 62, 0, 0, "", Silver, 0
  336.     Box 0, 601, 229, 12, Black, 0, _TRIM$(Hero.Name), Silver, 0
  337.     Box 0, 626, 229 * Hero.Life.Low / Hero.Life.High, 12, 0, 0, "", Red, Black
  338.     Box 0, 639, 229 * Hero.Mana.Low / Hero.Mana.High, 12, 0, 0, "", Blue, Black
  339.     Box 0, 652, 229 * Hero.EXP_Earned / Hero.EXP_Needed, 12, 0, 0, "", Green, Black
  340.     _PRINTSTRING (10, 616), "LEVEL:" + STR$(Hero.Level)
  341.     _PRINTSTRING (10, 629), "LIFE :" + STR$(Hero.Life.Low) + " / " + _TRIM$(STR$(Hero.Life.High))
  342.     _PRINTSTRING (10, 642), "MANA :" + STR$(Hero.Mana.Low) + " / " + _TRIM$(STR$(Hero.Mana.High))
  343.     _PRINTSTRING (10, 655), "EXP  :" + STR$(Hero.EXP_Earned) + " (" + _TRIM$(STR$(Hero.EXP_Needed)) + ")"
  344.     FOR i = 0 TO 5 'six boxes for information : left hand, right hand, armor, and 3 more for later....
  345.         Box 36 * i + 8, 665, 34, 34, 0, 0, "", Black, Silver
  346.     NEXT
  347.     _PUTIMAGE (9, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon1.IconX, Hero.Weapon1.IconY)-STEP(32, 32)
  348.     _PUTIMAGE (45, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Weapon2.IconX, Hero.Weapon2.IconY)-STEP(32, 32)
  349.     _PUTIMAGE (81, 666)-STEP(32, 32), Icons, DisplayScreen, (Hero.Armor.IconX, Hero.Armor.IconY)-STEP(32, 32)
  350.  
  351. SUB ManageInventory
  352.     STATIC Header AS LONG, MainFont AS LONG, ItemNameFont AS LONG
  353.     STATIC Selection AS INTEGER, Page AS INTEGER, Item AS INTEGER
  354.     PCOPY 0, 1
  355.     D = _DEST: S = _SOURCE
  356.     OldFont = _FONT
  357.     IF Header = 0 THEN Header = _LOADFONT("courbd.ttf", 24, "monospace")
  358.     IF MainFont = 0 THEN MainFont = _LOADFONT("courbd.ttf", 14, "monospace")
  359.     IF ItemNameFont = 0 THEN ItemNameFont = _LOADFONT("courbd.ttf", 18, "monospace")
  360.     IF Selection = 0 THEN Selection = 1 'there's 4 categories which we can choose from (Weapon, Armor, Food, Item)
  361.     'Page = 0 'there's 4 pages of info for each category, from 0 to 3
  362.     'Item = 0 'and there's 26 items on each page, from 0 to 25.
  363.     DO
  364.         _LIMIT 30
  365.         valid = -1
  366.         LINE (50, 50)-STEP(700, 500), SkyBlue, BF 'erase the background
  367.         LINE (300, 106)-(725, 450), LightGray, BF
  368.         _FONT Header
  369.         SELECT CASE Selection 'redraw the selection we're working with
  370.             CASE 1
  371.                 Box 51, 51, 174, 50, Black, 0, "Weapons", SkyBlue, SkyBlue
  372.                 Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
  373.                 Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
  374.                 Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
  375.                 _FONT MainFont
  376.                 FOR i = 26 * Page TO 26 * Page + 25
  377.                     out$ = CHR$(65 + i MOD 26) + ")" + Inventory(i).Weapon.Name
  378.                     _PRINTSTRING (56, 106 + _FONTHEIGHT * (i MOD 26)), out$
  379.                 NEXT
  380.                 S = Item MOD 26
  381.                 Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
  382.                 out$ = CHR$(65 + S) + ")" + Inventory(Item).Weapon.Name
  383.                 _PRINTSTRING (56, 106 + _FONTHEIGHT * S), out$
  384.  
  385.                 COLOR Black, 0
  386.                 _FONT ItemNameFont
  387.                 IF Inventory(Item).Weapon.Identified THEN
  388.                     Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Weapon.Name), 0, 0
  389.                     _FONT 8
  390.                     _PRINTSTRING (305, 145), "Reach  :" + STR$(Inventory(Item).Weapon.Reach)
  391.                     _PRINTSTRING (305, 165), "Min Dmg:" + STR$(Inventory(Item).Weapon.Damage.Low)
  392.                     _PRINTSTRING (305, 175), "Max Dmg:" + STR$(Inventory(Item).Weapon.Damage.High)
  393.                     _PRINTSTRING (305, 185), "Hit Mod:" + STR$(Inventory(Item).Weapon.HitBonus)
  394.                     _PRINTSTRING (305, 195), "Dmg Mod:" + STR$(Inventory(Item).Weapon.DamageBonus)
  395.                     _PRINTSTRING (305, 205), "Light  :" + STR$(Inventory(Item).Weapon.Light.Reach)
  396.                 ELSE
  397.                     Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Weapon.DisplayedName), 0, 0
  398.                     _FONT 8
  399.                     _PRINTSTRING (305, 145), "Reach  : ???"
  400.                     _PRINTSTRING (305, 165), "Min Dmg: ???"
  401.                     _PRINTSTRING (305, 175), "Max Dmg: ???"
  402.                     _PRINTSTRING (305, 185), "Hit Mod: ???"
  403.                     _PRINTSTRING (305, 195), "Dmg Mod: ???"
  404.                     _PRINTSTRING (305, 205), "Light  : ???"
  405.                 END IF
  406.                 out$ = "Cond   : "
  407.                 SELECT CASE Inventory(Item).Weapon.Left 'the durability left on a weapon
  408.                     CASE -1: out$ = out$ + "Ind."
  409.                     CASE 0: out$ = out$ + "Broken"
  410.                     CASE IS < 26: out$ = out$ + "Worn"
  411.                     CASE IS < 50: out$ = out$ + "Used"
  412.                     CASE IS < 75: out$ = out$ + "Good"
  413.                     CASE IS < 90: out$ = out$ + "Mint"
  414.                     CASE ELSE: out$ = out$ + "New"
  415.                 END SELECT
  416.                 _PRINTSTRING (305, 155), out$
  417.                 LINE (422, 134)-STEP(130, 130), Black, BF
  418.                 _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Weapon.IconX, Inventory(Item).Weapon.IconY)-STEP(31, 31)
  419.             CASE 2
  420.                 Box 225, 51, 174, 50, Black, 0, "Armors", SkyBlue, SkyBlue
  421.                 Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
  422.                 Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
  423.                 Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
  424.                 _FONT MainFont
  425.                 FOR i = 0 TO 25
  426.                     out$ = CHR$(65 + i) + ")" + Inventory(i).Armor.Name
  427.                     _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
  428.                 NEXT
  429.                 Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
  430.                 out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Armor.Name
  431.                 _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
  432.  
  433.                 COLOR Black, 0
  434.                 _FONT ItemNameFont
  435.                 IF Inventory(Item).Armor.Identified THEN
  436.                     Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Armor.Name), 0, 0
  437.                     _FONT 8
  438.                     _PRINTSTRING (305, 145), "PD   :" + STR$(Inventory(Item).Armor.PD)
  439.                     _PRINTSTRING (305, 155), "DR   :" + STR$(Inventory(Item).Armor.DR)
  440.                 ELSE
  441.                     Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Armor.DisplayedName), 0, 0
  442.                     _FONT 8
  443.                     _PRINTSTRING (305, 145), "PD   : ???"
  444.                     _PRINTSTRING (305, 155), "DR   : ???"
  445.                 END IF
  446.                 out$ = "Cond : "
  447.                 SELECT CASE Inventory(Item).Armor.Left 'the durability left on armor
  448.                     CASE -1: out$ = out$ + "Ind."
  449.                     CASE 0: out$ = out$ + "Broken"
  450.                     CASE IS < 26: out$ = out$ + "Worn"
  451.                     CASE IS < 50: out$ = out$ + "Used"
  452.                     CASE IS < 75: out$ = out$ + "Good"
  453.                     CASE IS < 90: out$ = out$ + "Mint"
  454.                     CASE ELSE: out$ = out$ + "New"
  455.                 END SELECT
  456.                 _PRINTSTRING (305, 175), out$
  457.                 LINE (422, 134)-STEP(130, 130), Black, BF
  458.                 _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Armor.IconX, Inventory(Item).Armor.IconY)-STEP(31, 31)
  459.             CASE 3
  460.                 Box 400, 51, 174, 50, Black, 0, "Food", SkyBlue, SkyBlue
  461.                 Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
  462.                 Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
  463.                 Box 575, 51, 174, 50, Black, 0, "Items", LightGray, Black
  464.                 _FONT MainFont
  465.                 FOR i = 0 TO 25
  466.                     IF Inventory(i).Food.Identified THEN
  467.                         out$ = CHR$(65 + i MOD 26) + ")" + Inventory(i).Food.Name
  468.                     ELSE
  469.                         out$ = CHR$(65 + i MOD 26) + ")" + Inventory(i).Food.DisplayedName
  470.                     END IF
  471.                     _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
  472.                 NEXT
  473.                 Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
  474.  
  475.                 IF Inventory(Item).Food.Identified THEN
  476.                     out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Food.Name
  477.                 ELSE
  478.                     out$ = CHR$(65 + Item MOD 26) + ")" + Inventory(Item).Food.DisplayedName
  479.                 END IF
  480.                 IF Inventory(Item).Food.Count > 1 THEN out$ = out$ + "(" + _TRIM$(STR$(Inventory(Item).Food.Count)) + ")"
  481.                 _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
  482.  
  483.                 COLOR Black, 0
  484.                 _FONT ItemNameFont
  485.                 IF Inventory(Item).Food.Identified THEN
  486.                     Box 300, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Food.Name), 0, 0
  487.                 ELSE
  488.                     Box 350, 110, 375, 28, Black, 0, _TRIM$(Inventory(Item).Food.DisplayedName), 0, 0
  489.                 END IF
  490.                 LINE (422, 134)-STEP(130, 130), Black, BF
  491.                 _PUTIMAGE (423, 135)-STEP(128, 128), Icons, DisplayScreen, (Inventory(Item).Food.IconX, Inventory(Item).Food.IconY)-STEP(31, 31)
  492.             CASE 4
  493.                 Box 575, 51, 174, 50, Black, 0, "Items", SkyBlue, SkyBlue
  494.                 Box 51, 51, 174, 50, Black, 0, "Weapons", LightGray, Black
  495.                 Box 225, 51, 174, 50, Black, 0, "Armors", LightGray, Black
  496.                 Box 400, 51, 174, 50, Black, 0, "Food", LightGray, Black
  497.                 _FONT MainFont
  498.                 FOR i = 0 TO 25
  499.                     out$ = CHR$(65 + i) + ")" '+ Inventory(i).Item.Name 'not defined yet
  500.                     _PRINTSTRING (56, 106 + _FONTHEIGHT * i), out$
  501.                 NEXT
  502.                 Box 54 + _FONTWIDTH * 2, 106 + _FONTHEIGHT * Item, _FONTWIDTH * 20 + 4, _FONTHEIGHT, 0, 0, "", LightGray, Black
  503.                 out$ = CHR$(65 + Item MOD 26) + ")" '+ Inventory(Item).Item.Name
  504.                 _PRINTSTRING (56, 106 + _FONTHEIGHT * (Item MOD 26)), out$
  505.         END SELECT
  506.         _FONT MainFont
  507.         Box 55, 485, 95, 50, Black, 0, "Page" + STR$(Page + 1), 0, 0
  508.         Box 170, 485, 95, 50, Black, 0, "(D)rop", LightGray, Black
  509.         Box 285, 485, 95, 50, Black, 0, "(E)quip", LightGray, Black
  510.         Box 410, 485, 95, 50, Black, 0, "(U)se", LightGray, Black
  511.         Box 525, 485, 95, 50, Black, 0, "nothing", LightGray, Black
  512.         Box 640, 485, 95, 50, Black, 0, "(C)lose", LightGray, Black
  513.         k = _KEYHIT
  514.         SELECT CASE k
  515.             CASE 18432 'up
  516.                 Item = Item - 1
  517.                 IF Item < 0 THEN Item = 25
  518.             CASE 19200 'left
  519.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  520.                     Page = Page - 1
  521.                     IF Page < 0 THEN Page = 3
  522.                 ELSE
  523.                     Selection = Selection - 1
  524.                     IF Selection < 1 THEN Selection = 4
  525.                 END IF
  526.             CASE 20480 'down
  527.                 Item = Item + 1
  528.                 IF Item > 25 THEN Item = 0
  529.             CASE 19712 'right
  530.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  531.                     Page = Page + 1
  532.                     IF Page > 3 THEN Page = 0
  533.                 ELSE
  534.                     Selection = Selection + 1
  535.                     IF Selection > 4 THEN Selection = 1
  536.                 END IF
  537.             CASE ASC("C"), ASC("c"), 27
  538.                 EXIT DO
  539.             CASE ELSE
  540.                 valid = 0
  541.         END SELECT
  542.         _DISPLAY
  543.         PCOPY 1, 0
  544.     LOOP
  545.  
  546.     _FONT OldFont
  547.     _DEST D: _SOURCE S
  548.  
  549.  
  550.  
  551.  
  552. SUB GetInput
  553.     DO
  554.         k = _KEYHIT: valid = -1
  555.         SELECT CASE k
  556.             CASE 18432 'up
  557.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  558.                     SELECT CASE Scale
  559.                         CASE 1.5: Scale = 2 'It's as small as we go
  560.                         CASE 2: Scale = 3
  561.                         CASE 3: Scale = 4
  562.                         CASE 4: Scale = 6
  563.                         CASE 6: Scale = 8
  564.                         CASE 8: Scale = 12
  565.                     END SELECT
  566.                 ELSE
  567.                     IF Hero.Y > YL THEN MoveHero 0, -1 'if we can move up
  568.                 END IF
  569.             CASE 19200: 'left
  570.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  571.                     TextFont = TextFont - 1
  572.                     IF TextFont < 8 THEN TextFont = 8
  573.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  574.                     ClearTextArea PrintArea
  575.                     SetPrintPosition PrintArea, 1, 1
  576.                     PrintOut PrintArea, "Font Size Changed"
  577.                 ELSE
  578.                     IF Hero.X > XL THEN MoveHero -1, 0 'if we can move left
  579.                 END IF
  580.             CASE 20480: 'down
  581.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  582.                     SELECT CASE Scale
  583.                         CASE 2: Scale = 1.5 'It's as small as we go
  584.                         CASE 3: Scale = 2
  585.                         CASE 4: Scale = 3
  586.                         CASE 6: Scale = 4
  587.                         CASE 8: Scale = 6
  588.                         CASE 12: Scale = 8
  589.                     END SELECT
  590.                 ELSE
  591.                     IF Hero.Y < YH THEN MoveHero 0, 1 'if we can move down
  592.                 END IF
  593.             CASE 19712: 'right
  594.                 IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN 'shift arrow
  595.                     TextFont = TextFont + 1
  596.                     IF TextFont > 48 THEN TextFont = 48
  597.                     SetTextFont PrintArea, "courbd.ttf", TextFont
  598.                     ClearTextArea PrintArea
  599.                     SetPrintPosition PrintArea, 1, 1
  600.                     PrintOut PrintArea, "Font Size Changed"
  601.                 ELSE
  602.                     IF Hero.X < XH THEN MoveHero 1, 0 'if we can move right
  603.                 END IF
  604.             CASE 27 'escape key
  605.                 SYSTEM
  606.             CASE 32 'space to just wait and skip a turn
  607.             CASE 60 ' "<" key
  608.                 IF MapArray(Hero.X, Hero.Y) AND 16 THEN
  609.                     Level = Level + 1
  610.                     CreateMap 99, 74, 10
  611.                     PathFind
  612.                 END IF
  613.             CASE ASC("I"), ASC("i")
  614.                 ManageInventory
  615.             CASE ASC("P"), ASC("p")
  616.                 PickUpSomething
  617.             CASE ASC("+"), ASC("=")
  618.                 IF Hero.Weapon2.Light.Reach < 25 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach + 1
  619.             CASE ASC("-"), ASC("_")
  620.                 IF Hero.Weapon2.Light.Reach > -1 THEN Hero.Weapon2.Light.Reach = Hero.Weapon2.Light.Reach - 1
  621.             CASE ELSE
  622.                 valid = 0 'it's a key press which we don't recognize.  Ignore it
  623.         END SELECT
  624.         _LIMIT 60
  625.     LOOP UNTIL k AND valid
  626.     _KEYCLEAR 'one keystroke at a time
  627.     StepsTaken = StepsTaken + 1
  628.  
  629. SUB Box (X, Y, Wide, High, FontColor as _unsigned long, _
  630.          FontBackGround as _unsigned long, Caption AS STRING, Kolor AS _UNSIGNED LONG, BackGround AS _UNSIGNED LONG)
  631.     COLOR FontColor, FontBackGround
  632.     LINE (X, Y)-STEP(Wide, High), Kolor, BF
  633.     LINE (X, Y)-STEP(Wide, High), BackGround, B
  634.     pw = _PRINTWIDTH(Caption): ph = _FONTHEIGHT
  635.     _PRINTSTRING (X + (Wide - pw + 1) \ 2, Y + (High - ph + 1) \ 2), Caption
  636.     COLOR DC, BG
  637.  
  638.  
  639. SUB MoveHero (MoveX, MoveY)
  640.     TestX = Hero.X + MoveX: TestY = Hero.Y + MoveY
  641.     IF MapArray(TestX, TestY) AND (4 OR 8) THEN 'and it's a room or passageway
  642.         IF (MapArray(TestX, TestY) AND 32) = 0 THEN 'and it's not blocked for some reason
  643.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) AND NOT 32 'unblock where the hero is
  644.             IF MoveX THEN Hero.X = Hero.X + MoveX
  645.             IF MoveY THEN Hero.Y = Hero.Y + MoveY
  646.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'and block where the hero is now that he moved
  647.             PathFind
  648.         ELSE
  649.             '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!
  650.             FOR i = 1 TO EncounterLimit
  651.                 IF Encounter(i).Active THEN 'Check for active/alive monsters only
  652.                     MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  653.                     IF MX = TestX AND MY = TestY THEN 'yep, we found our monster!
  654.                         Swing 0, i 'hero swings at the monster
  655.                     END IF
  656.                 END IF
  657.             NEXT
  658.         END IF
  659.     END IF
  660.  
  661. SUB Swing (Who, AtWhom)
  662.  
  663.     BaseChancetohit = 10 'base 10 chance to hit
  664.     IF Who = 0 THEN 'it's the hero attacking, add his attack bonuses
  665.         M = Encounter(AtWhom).Index
  666.         IF Hero.Weapon1.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  667.             Chancetohit = BaseChancetohit + Hero.Weapon1.HitBonus 'add in the weapon's hit bonus
  668.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  669.             totalroll = 0
  670.             DO
  671.                 roll = INT(RND * 20) + 1
  672.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  673.                 IF roll = 20 THEN totalroll = totalroll + 20
  674.                 totalroll = totalroll + roll
  675.             LOOP UNTIL roll <> 1 AND roll <> 20
  676.             damage = INT(RND * (Hero.Weapon1.Damage.High - Hero.Weapon1.Damage.Low + 1)) + Hero.Weapon1.Damage.Low 'random damage for the hit
  677.             damage = damage + Hero.Weapon1.DamageBonus 'add in the weapon's damage bonus
  678.             out$ = _TRIM$(Hero.Name)
  679.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  680.                 SetTextColor PrintArea, &HFFF000F0, 0
  681.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  682.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  683.                 Hero.Life.Low = Hero.Life.Low - damage
  684.             ELSEIF totalroll < Chancetohit THEN
  685.                 SetTextColor PrintArea, &HFFF0F000, 0
  686.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  687.             ELSEIF totalroll > Chancetohit + 20 THEN
  688.                 SetTextColor PrintArea, &HFF00FF00, 0
  689.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  690.                 damage = damage * (totalroll / 20 + 1)
  691.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "!"
  692.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  693.             ELSEIF totalroll >= Chancetohit THEN
  694.                 SetTextColor PrintArea, &HFF00FF00, 0
  695.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  696.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon1.Name) + "."
  697.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  698.             END IF
  699.         ELSEIF Hero.Weapon1.Reach > 0 THEN
  700.             SetTextColor PrintArea, &HFFF000F0, 0
  701.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon1.Name) + "!"
  702.         ELSE
  703.             out$ = ""
  704.         END IF
  705.         IF out$ <> "" THEN PrintOut PrintArea, out$
  706.         IF Hero.Weapon2.Reach >= Distance(Encounter(AtWhom).X, Encounter(AtWhom).Y) THEN 'it's a weapon and not an utility object being held.
  707.             Chancetohit = BaseChancetohit + Hero.Weapon2.HitBonus 'add in the weapon's hit bonus
  708.             Chancetohit = Chancetohit - Monster(AtWhom).Armor.PD 'subtract the monster's armor/ natural dodge
  709.             totalroll = 0
  710.             DO
  711.                 roll = INT(RND * 20) + 1
  712.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  713.                 IF roll = 20 THEN totalroll = totalroll + 20
  714.                 totalroll = totalroll + roll
  715.             LOOP UNTIL roll <> 1 AND roll <> 20
  716.             damage = INT(RND * (Hero.Weapon2.Damage.High - Hero.Weapon2.Damage.Low + 1)) + Hero.Weapon2.Damage.Low 'random damage for the hit
  717.             damage = damage + Hero.Weapon2.DamageBonus 'add in the weapon's damage bonus
  718.             out$ = _TRIM$(Hero.Name)
  719.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  720.                 SetTextColor PrintArea, &HFFF000F0, 0
  721.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  722.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  723.                 damage = damage - Hero.Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us
  724.                 Hero.Life.Low = Hero.Life.Low - damage
  725.             ELSEIF totalroll < Chancetohit THEN
  726.                 SetTextColor PrintArea, &HFFF0F000, 0
  727.                 out$ = out$ + " missed " + _TRIM$(Monster(M).Name) + ", with " + _TRIM$(Hero.Weapon1.Name) + "!"
  728.             ELSEIF totalroll > Chancetohit + 20 THEN
  729.                 SetTextColor PrintArea, &HFF00FF00, 0
  730.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Monster(M).Name) + " for"
  731.                 damage = damage * (totalroll / 20 + 1)
  732.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "!"
  733.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  734.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  735.             ELSEIF totalroll >= Chancetohit THEN
  736.                 SetTextColor PrintArea, &HFF00FF00, 0
  737.                 out$ = out$ + " hit " + _TRIM$(Monster(M).Name) + " for"
  738.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Hero.Weapon2.Name) + "."
  739.                 damage = damage - Monster(M).Armor.PD: IF damage < 0 THEN damage = 0 'armor absorbs some damage for us"
  740.                 Encounter(AtWhom).Life = Encounter(AtWhom).Life - damage
  741.             END IF
  742.         ELSEIF Hero.Weapon2.Reach > 0 THEN
  743.             SetTextColor PrintArea, &HFFF000F0, 0
  744.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Hero.Weapon2.Name) + "!"
  745.         ELSE
  746.             out$ = ""
  747.         END IF
  748.         IF out$ <> "" THEN PrintOut PrintArea, out$
  749.         IF Encounter(AtWhom).Life <= 0 THEN MonsterDied (AtWhom) 'the monster died!
  750.     ELSE 'it's a monster attacking
  751.         M = Encounter(Who).Index
  752.         IF Monster(M).Weapon1.Reach >= Distance(Encounter(Who).X, Encounter(Who).Y) THEN 'it's a weapon and not an utility object being held.
  753.             Chancetohit = BaseChancetohit + Monster(M).Weapon1.HitBonus 'add in the weapon's hit bonus
  754.             Chancetohit = Chancetohit - Hero.Armor.PD 'subtract the hero's armor/ natural dodge
  755.             totalroll = 0
  756.             DO
  757.                 roll = INT(RND * 20) + 1
  758.                 IF roll = 1 THEN totalroll = totalroll - 20 'critical failure
  759.                 IF roll = 20 THEN totalroll = totalroll + 20
  760.                 totalroll = totalroll + roll
  761.             LOOP UNTIL roll <> 1 AND roll <> 20
  762.             damage = INT(RND * (Monster(M).Weapon1.Damage.High - Monster(M).Weapon1.Damage.Low + 1)) + Monster(M).Weapon1.Damage.Low 'random damage for the hit
  763.             damage = damage + Monster(M).Weapon1.DamageBonus 'add in the weapon's damage bonus
  764.             out$ = _TRIM$(Monster(M).Name)
  765.             IF totalroll < Chancetohit - 20 THEN 'you critically failed!
  766.                 SetTextColor PrintArea, &HFFF000F0, 0
  767.                 out$ = out$ + " CRITICALLY FAILED attacking.  They hit themselves for"
  768.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  769.                 Monster(M).Life.Low = Monster(M).Life.Low - damage
  770.             ELSEIF totalroll < Chancetohit THEN
  771.                 SetTextColor PrintArea, &HFFF0F000, 0
  772.                 out$ = out$ + " missed " + _TRIM$(Hero.Name) + ", with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  773.             ELSEIF totalroll > Chancetohit + 20 THEN
  774.                 SetTextColor PrintArea, &HFF00FFFF, 0
  775.                 out$ = out$ + " CRITICALLY hit " + _TRIM$(Hero.Name) + " for"
  776.                 damage = damage * (totalroll / 20 + 1)
  777.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "!"
  778.                 Hero.Life.Low = Hero.Life.Low - damage
  779.             ELSEIF totalroll >= Chancetohit THEN
  780.                 SetTextColor PrintArea, &HFF00FFFF, 0
  781.                 out$ = out$ + " hit " + _TRIM$(Hero.Name) + " for"
  782.                 out$ = out$ + STR$(damage) + " damage, with " + _TRIM$(Monster(M).Weapon1.Name) + "."
  783.                 Hero.Life.Low = Hero.Life.Low - damage
  784.             END IF
  785.         ELSEIF Monster(M).Weapon1.Reach > 0 THEN
  786.             SetTextColor PrintArea, &HFFF000F0, 0
  787.             out$ = _TRIM$(Monster(M).Name) + " is too far away to attack with a " + _TRIM$(Monster(M).Weapon2.Name) + "!"
  788.         ELSE
  789.             out$ = ""
  790.         END IF
  791.         IF out$ <> "" THEN PrintOut PrintArea, out$
  792.     END IF
  793.  
  794. SUB PickUpSomething
  795.     FOR i = 1 TO EncounterLimit
  796.         IF Encounter(i).Active THEN 'Check for active/alive monsters only
  797.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  798.             IF MX = Hero.X AND MY = Hero.Y THEN 'we found something active to interact with
  799.                 N = Encounter(i).Index 'for easy of typing
  800.                 SELECT CASE Encounter(i).Type
  801.                     CASE 0 'it's a monster
  802.                         PrintOut PrintArea, "WTF?! How the hell did you step on an active monster?  You found a game bug.  Please cry a lot for me!"
  803.                         EXIT SUB
  804.                     CASE 1 'it's a weapon
  805.                     CASE 2 'it's armor
  806.                     CASE 3 'it's food
  807.                         'first see if it matches any of our existing food stocks.
  808.                         FOR j = 0 TO FoodOwned
  809.                             IF Food(N).Name = Inventory(j).Food.Name THEN 'our food matches some existing
  810.                                 Inventory(j).Food.Count = Inventory(j).Food.Count + 1
  811.                                 Encounter(i).Active = 0
  812.                                 GOTO exitchecks 'no need to check any further; we just add to the existing count of that type
  813.                             END IF
  814.                             'At this point, we can assume it's not an existing food we're carrying.
  815.                             IF FoodOwned < 103 THEN 'then we have room for more food
  816.                                 FoodOwned = FoodOwned + 1
  817.                                 Inventory(FoodOwned).Food = Food(N)
  818.                                 out$ = "You picked up a " + _TRIM$(Food(N).DisplayedName) + "."
  819.                                 PrintOut PrintArea, out$
  820.                                 Encounter(i).Active = 0
  821.                                 GOTO exitchecks 'we have now added that food to our inventory.
  822.                             ELSE
  823.                                 out$ = "You try to pick up a " + _TRIM$(Food(N).DisplayedName) + ", but have no room to carry it."
  824.                                 PrintOut PrintArea, out$
  825.                                 GOTO exitchecks 'we don't have room to loot the item currently.
  826.                             END IF
  827.                         NEXT
  828.                     CASE 4 'its an item (which hasn't been added into the game yet)
  829.                 END SELECT
  830.             END IF
  831.         END IF
  832.         exitchecks:
  833.     NEXT
  834.  
  835.  
  836. SUB MonsterDied (Who)
  837.     M = Encounter(Who).Index
  838.     SetTextColor PrintArea, &HFFFF0000, 0
  839.     out$ = _TRIM$(Monster(M).Name) + " died!  You earned " + _TRIM$(STR$(Monster(M).Level + Monster(M).ExpBonus)) + " experience."
  840.     PrintOut PrintArea, out$
  841.     Encounter(Who).Active = 0
  842.     Hero.EXP_Earned = Hero.EXP_Earned + Monster(M).Level + Monster(M).ExpBonus
  843.     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!
  844.     IF Monster(M).Found = 0 THEN
  845.         Monster(M).Found = -1 'it's a first time kill!
  846.         SetTextColor PrintArea, &HFFFFFF00, &HFFFF0000
  847.         out$ = "Congratulations!  You killed a " + _TRIM$(Monster(M).Name) + " for the first time!"
  848.         PrintOut PrintArea, out$
  849.     END IF
  850.  
  851.     'monster loot!!
  852.     R# = RND * 100
  853.     IF R# < Monster(M).Loot1.Chance THEN
  854.         GOSUB addloot
  855.  
  856.         Encounter(EncounterLimit).Type = Monster(M).Loot1.Type
  857.         IF Monster(M).Loot1.Type = 3 THEN 'Food can have various states when found
  858.             '(Other things will in time as well, but I haven't gotten to adding any them into the game yet.)
  859.             R1# = RND * 100
  860.             SELECT CASE R1#
  861.                 CASE IS < 10: cond$ = "Sickly "
  862.                 CASE IS < 25: cond$ = "Nasty "
  863.                 CASE IS < 75: cond$ = "Normal "
  864.                 CASE IS < 90: cond$ = "Good "
  865.                 CASE ELSE: cond$ = "Tasty "
  866.             END SELECT
  867.             DIM foodname AS STRING * 20
  868.             foodname = cond$ + _TRIM$(Food(Monster(M).Loot1.Index).Name)
  869.  
  870.             FOR i = 0 TO FoodInGame
  871.                 IF foodname = Food(i).Name THEN 'the food already exists
  872.                     Encounter(EncounterLimit).Index = i
  873.                     EXIT SUB
  874.                 END IF
  875.             NEXT
  876.             'At this point, we're adding a new food to our index
  877.             FoodInGame = FoodInGame + 1
  878.             F = FoodInGame
  879.             Food(F) = Food(Monster(M).Loot1.Index) 'take the base values of our food
  880.             Food(F).Name = foodname
  881.             foodname = "Unknown " + _TRIM$(Food(Monster(M).Loot1.Index).Name)
  882.             Food(F).DisplayedName = foodname
  883.             Encounter(EncounterLimit).Index = FoodInGame
  884.         ELSE
  885.             Encounter(EncounterLimit).Index = Monster(M).Loot1.Index
  886.         END IF
  887.  
  888.  
  889.  
  890.     ELSEIF R# < Monster(M).Loot2.Chance THEN
  891.         GOSUB addloot
  892.     ELSEIF R# < Monster(M).loot3.Chance THEN
  893.         GOSUB addloot
  894.     END IF
  895.  
  896.     EXIT SUB
  897.  
  898.     addloot: 'a small sub proceedure to reduce copy/paste code
  899.     EncounterLimit = EncounterLimit + 1
  900.     E = EncounterLimit 'just for ease of typing below
  901.     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
  902.     Encounter(E).Active = -1
  903.     Encounter(E).X = Encounter(Who).X
  904.     Encounter(E).Y = Encounter(Who).Y
  905.  
  906.  
  907.     PrintOut PrintArea, _TRIM$(Monster(M).Name) + " left something behind."
  908.     RETURN
  909.  
  910.  
  911. FUNCTION MoveMonster (Monster, MoveX, MoveY)
  912.     MX = Encounter(Monster).X: MY = Encounter(Monster).Y 'monster x, monster y position
  913.     D = Distance(MX, MY) 'distance from monster to the hero
  914.     E = Encounter(i).Index 'the actual monster in question
  915.     IF D > Distance(MX + MoveX, MY + MoveY) THEN
  916.         IF (MapArray(MX + MoveX, MY + MoveY) AND 32) = 0 THEN 'where we're trying to move isn't blocked
  917.             MapArray(MX, MY) = MapArray(MX, MY) AND NOT 32 'unblock where the monster is
  918.             Encounter(Monster).X = Encounter(Monster).X + MoveX
  919.             Encounter(Monster).Y = Encounter(Monster).Y + MoveY
  920.             MapArray(MX + MoveX, MY + MoveY) = MapArray(MX + MoveX, MY + MoveY) OR 32 'block where the monster moved to
  921.             MoveMonster = -1
  922.         END IF
  923.     END IF
  924.  
  925.  
  926.  
  927. SUB MonstersTurn
  928.     FOR i = 1 TO EncounterLimit
  929.         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.
  930.             MX = Encounter(i).X: MY = Encounter(i).Y 'monster x, monster y position
  931.             D = Distance(MX, MY) 'distance from monster to the hero
  932.             E = Encounter(i).Index 'the actual monster in question
  933.             IF D < Monster(E).Sight OR D <= Monster(E).Hearing OR D <= Monster(E).Detection THEN
  934.                 attack = 0
  935.                 IF D <= Monster(E).Weapon1.Reach THEN 'we're in reach for the monster to attack with their main hand.
  936.                     'insert attack code here
  937.                     Swing i, 0
  938.                     _CONTINUE
  939.                 END IF
  940.                 'if the monster didn't attack, it can now move towards the hero.
  941.                 IF MX > 0 THEN 'check to see if moving left moves us towards the hero.
  942.                     IF D > Distance(MX - 1, MY) THEN
  943.                         IF MoveMonster(i, -1, 0) THEN _CONTINUE 'move left
  944.                     END IF
  945.                 END IF
  946.                 IF MY > 0 THEN 'check to see if moving up moves us towards the hero.
  947.                     IF D > Distance(MX, MY - 1) THEN
  948.                         IF MoveMonster(i, 0, -1) THEN _CONTINUE 'move up
  949.                     END IF
  950.                 END IF
  951.                 IF MX < XH THEN 'check to see if moving right moves us towards the hero.
  952.                     IF D > Distance(MX + 1, MY) THEN
  953.                         IF MoveMonster(i, 1, 0) THEN _CONTINUE 'move right
  954.                     END IF
  955.                 END IF
  956.                 IF MY < YH THEN 'check to see if moving down moves us towards the hero.
  957.                     IF D > Distance(MX, MY + 1) THEN
  958.                         IF MoveMonster(i, 0, 1) THEN _CONTINUE 'move down
  959.                     END IF
  960.                 END IF
  961.             END IF
  962.         END IF
  963.     NEXT
  964.  
  965.  
  966.  
  967. SUB DrawMap
  968.     _DEST WorkScreen
  969.     CLS
  970.     'LINE (0, 0)-(3200, 2400), &HFF000000, BF 'clear the map
  971.     IF Hero.Weapon1.Light.Reach > Hero.Weapon2.Light.Reach THEN LightReach = Hero.Weapon1.Light.Reach ELSE LightReach = Hero.Weapon2.Light.Reach
  972.     FOR Y = 0 TO YH
  973.         FOR X = 0 TO XH
  974.             IF Distance(X, Y) <= LightReach THEN 'It's close enough to check for illumination
  975.                 IF MapArray(X, Y) <> 0 THEN MapArray(X, Y) = MapArray(X, Y) OR 1 OR 2
  976.             END IF
  977.             IF MapArray(X, Y) AND 2 THEN 'It's an uncovered part of the map, draw it
  978.                 IF MapArray(X, Y) AND 4 THEN 'it's a visible room
  979.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF303030, BF
  980.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (6 * 32, 18 * 32)-STEP(31, 31)
  981.                 END IF
  982.                 IF MapArray(X, Y) AND 8 THEN 'it's a visible path
  983.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (36 * 32, 13 * 32)-STEP(31, 31)
  984.                     '                    LINE (X * 32, Y * 32)-STEP(32, 32), &HFF707070, BF
  985.                 END IF
  986.                 IF MapArray(X, Y) AND 16 THEN 'it's the stairs to the next level
  987.                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (4 * 32, 45 * 32)-STEP(31, 31)
  988.                 END IF
  989.             END IF
  990.             'note: highlighting for the light should come AFTER the map is drawn
  991.             IF MapArray(X, Y) AND 1 THEN 'it's currently illuminated by the lightsource
  992.                 LINE (X * 32, Y * 32)-STEP(32, 32), &H40FFFF00, BF
  993.                 MapArray(X, Y) = MapArray(X, Y) - 1
  994.                 FOR I = 1 TO EncounterLimit
  995.                     IF X = Encounter(I).X AND Y = Encounter(I).Y AND Encounter(I).Active = -1 THEN
  996.                         E = Encounter(I).Index
  997.                         T = Encounter(I).Type
  998.                         SELECT CASE T
  999.                             CASE 0 'it's a monster
  1000.                                 IF Monster(E).Found THEN
  1001.                                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Monster(E).IconX, Monster(E).IconY)-STEP(31, 31)
  1002.                                 ELSE
  1003.                                     _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (1984, 1504)-STEP(31, 31)
  1004.                                 END IF
  1005.                             CASE 1 'weapon
  1006.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Weapon(E).IconX, Weapon(E).IconY)-STEP(31, 31)
  1007.                             CASE 2 'armor
  1008.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Armor(E).IconX, Armor(E).IconY)-STEP(31, 31)
  1009.                             CASE 3 'food
  1010.                                 _PUTIMAGE (X * 32, Y * 32)-STEP(32, 32), Icons, WorkScreen, (Food(E).IconX, Food(E).IconY)-STEP(31, 31)
  1011.                             CASE 4 'item
  1012.                         END SELECT
  1013.                     END IF
  1014.                 NEXT
  1015.  
  1016.             END IF
  1017.         NEXT
  1018.     NEXT
  1019.     COLOR &HFFFFFF00, 0 'Yellow Hero
  1020.     _PUTIMAGE (Hero.X * 32, Hero.Y * 32)-STEP(32, 32), Icons, WorkScreen, (2016, 1504)-STEP(31, 31)
  1021.     XOffset## = 1600 / Scale
  1022.     YOffset## = 1200 / Scale
  1023.     CenterX = Hero.X * 32 'convert hero coordinate to grid coordinate
  1024.     CenterY = Hero.Y * 32
  1025.     _DEST DisplayScreen
  1026.     LINE (0, 0)-(800, 600), &HFF000000, BF 'clear the map
  1027.     _PUTIMAGE (0, 0)-(800, 600), WorkScreen, DisplayScreen, (CenterX - XOffset##, CenterY - YOffset##)-(CenterX + XOffset##, CenterY + YOffset##)
  1028.  
  1029.  
  1030.  
  1031.  
  1032.  
  1033. SUB CreateMap (XLimit, YLimit, Rooms)
  1034.     ERASE MapArray 'clear the old map and reset everything to 0
  1035.     REDIM MapArray(XLimit, YLimit) AS _UNSIGNED _BYTE
  1036.     REDIM Distance(XLimit, YLimit) AS _UNSIGNED _BYTE
  1037.     REDIM Temp(XLimit, YLimit) AS _UNSIGNED _BYTE
  1038.     XL = 0: XH = XLimit: YL = 0: YH = YLimit 'global values to pass along our map ultimate dimensions
  1039.  
  1040.     DIM RoomCenterX(Rooms) AS _UNSIGNED _BYTE, RoomCenterY(Rooms) AS _UNSIGNED _BYTE
  1041.  
  1042.     StairRoom = INT(RND * Rooms) + 1
  1043.     FOR i = 1 TO Rooms
  1044.         DO
  1045.             RoomSize = INT(RND * 9) + 2
  1046.             RoomX = INT(RND * (XLimit - RoomSize))
  1047.             RoomY = INT(RND * (YLimit - RoomSize))
  1048.             'test for positioning
  1049.             good = -1 'it's good starting out
  1050.             FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  1051.                     IF MapArray(RoomX + X, RoomY + Y) = 4 THEN good = 0: EXIT FOR 'don't draw a room on a room
  1052.             NEXT X, Y
  1053.         LOOP UNTIL good
  1054.         FOR Y = 0 TO RoomSize: FOR X = 0 TO RoomSize
  1055.                 MapArray(RoomX + X, RoomY + Y) = 4 'go ahead and draw a room
  1056.         NEXT X, Y
  1057.         RoomCenterX(i) = RoomX + .5 * RoomSize
  1058.         RoomCenterY(i) = RoomY + .5 * RoomSize
  1059.         IF i = 1 THEN 'place the hero in the first room  (which can be anywhere randomly on our map)
  1060.             Hero.X = RoomX + INT(RND * RoomSize)
  1061.             Hero.Y = RoomY + INT(RND * RoomSize)
  1062.             MapArray(Hero.X, Hero.Y) = MapArray(Hero.X, Hero.Y) OR 32 'block the map where the hero stands
  1063.         END IF
  1064.         IF i = StairRoom THEN 'place the stairs in one of the random rooms
  1065.             DO 'But lets not place the stairs directly on top of the hero to begin with
  1066.                 StairX = RoomX + INT(RND * RoomSize)
  1067.                 StairY = RoomY + INT(RND * RoomSize)
  1068.             LOOP UNTIL StairX <> Hero.X AND StairY <> Hero.Y
  1069.             MapArray(StairX, StairY) = MapArray(StairX, StairY) OR 16
  1070.         END IF
  1071.     NEXT
  1072.     FOR i = 1 TO Rooms - 1
  1073.         StartX = RoomCenterX(i): StartY = RoomCenterY(i)
  1074.         EndX = RoomCenterX(i + 1): EndY = RoomCenterY(i + 1)
  1075.         DO UNTIL StartX = EndX AND StartY = EndY
  1076.             CoinToss = INT(RND * 100) 'Coin toss to move left/right or up/down, to go towards room, or wander a bit.
  1077.             Meander = 10
  1078.             IF CoinToss MOD 2 THEN 'even or odd, so we only walk vertical or hortizontal and not diagional
  1079.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  1080.                     XChange = SGN(EndX - StartX) '-1,0,1, drawn always towards the mouse
  1081.                     Ychange = 0
  1082.                 ELSE
  1083.                     XChange = INT(RND * 3) - 1 '-1, 0, or 1, drawn in a random direction to let the lightning wander
  1084.                     Ychange = 0
  1085.                 END IF
  1086.             ELSE
  1087.                 IF CoinToss < 100 - Meander THEN 'Lower values meander less and go directly to the target.
  1088.                     Ychange = SGN(EndY - StartY)
  1089.                     XChange = 0
  1090.                 ELSE
  1091.                     Ychange = INT(RND * 3) - 1
  1092.                     XChange = 0
  1093.                 END IF
  1094.             END IF
  1095.             StartX = StartX + XChange
  1096.             StartY = StartY + Ychange
  1097.             IF StartX < 0 THEN StartX = 0 'Make certain we move inside the bounds of our map dimensions
  1098.             IF StartY < 0 THEN StartY = 0
  1099.             IF StartX > XH THEN StartX = XH
  1100.             IF StartY > YH THEN StartY = YH
  1101.             IF MapArray(StartX, StartY) = 0 THEN MapArray(StartX, StartY) = 8 'place a path where we moved to
  1102.         LOOP
  1103.     NEXT
  1104.     PathFind
  1105.     EncounterLimit = INT(RND * 6) + 5
  1106.     FOR i = 1 TO EncounterLimit
  1107.         Encounter(i).Type = 0 'type 0 is a monster
  1108.         Encounter(i).Index = RandomMonster
  1109.         Encounter(i).Active = -1
  1110.         M = Encounter(i).Index
  1111.         Encounter(i).Life = INT(RND * Monster(M).Life.High - Monster(M).Life.Low + 1) + Monster(M).Life.Low
  1112.         valid = -1: EndlessLoopExit = 0
  1113.         DO
  1114.             EndlessLoopExit = EndlessLoopExit + 1
  1115.             Encounter(i).X = INT(RND * XLimit + 1)
  1116.             Encounter(i).Y = INT(RND * YLimit + 1)
  1117.             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.)
  1118.             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".
  1119.             '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.
  1120.             '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.
  1121.         LOOP UNTIL MapArray(Encounter(i).X, Encounter(i).Y) AND 4 AND valid 'monsters only spawn in rooms to begin with.
  1122.         MapArray(Encounter(i).X, Encounter(i).Y) = MapArray(Encounter(i).X, Encounter(i).Y) OR 32
  1123.     NEXT
  1124.     LootLimit = 0 'no loot on the map at this time.  Too bad for joo!
  1125.  
  1126. SUB PathFind
  1127.     STATIC m AS _MEM, m1 AS _MEM 'no need to keep initializing and freeing these blocks over and over.  Just reuse them...
  1128.     DIM pass AS _UNSIGNED _BYTE
  1129.     m = _MEM(Distance()): m1 = _MEM(Temp())
  1130.     _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
  1131.     _MEMFILL m, m.OFFSET, m.SIZE, 255 AS _UNSIGNED _BYTE
  1132.     Temp(Hero.X, Hero.Y) = 0
  1133.     pass = 0
  1134.     DO
  1135.         changed = 0
  1136.         y = 0
  1137.         DO
  1138.             x = 0
  1139.             DO
  1140.                 IF Distance(x, y) = 255 AND MapArray(x, y) <> 0 THEN
  1141.                     IF x < XH THEN
  1142.                         IF Temp(x + 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  1143.                     END IF
  1144.                     IF x > 0 THEN
  1145.                         IF Temp(x - 1, y) = pass THEN Distance(x, y) = pass + 1: changed = -1
  1146.                     END IF
  1147.                     IF y < YH THEN
  1148.                         IF Temp(x, y + 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  1149.                     END IF
  1150.                     IF y > 0 THEN
  1151.                         IF Temp(x, y - 1) = pass THEN Distance(x, y) = pass + 1: changed = -1
  1152.                     END IF
  1153.                 END IF
  1154.                 x = x + 1
  1155.             LOOP UNTIL x > XH
  1156.             y = y + 1
  1157.         LOOP UNTIL y > YH
  1158.         _MEMCOPY m, m.OFFSET, m.SIZE TO m1, m1.OFFSET
  1159.         pass = pass + 1
  1160.     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!
  1161.     Distance(Hero.X, Hero.Y) = 0
  1162.  
  1163. FUNCTION RandomMonster
  1164.     SELECT CASE Level 'the level we're on
  1165.         CASE 1 TO 3: MC = 3 'the monster count which we can randomly run into and battle from on the current floor
  1166.         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!
  1167.     END SELECT
  1168.     RandomMonster = INT(RND * MC) + 1
  1169.  
  1170.  
  1171. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  1172. '# SUBroutines and FUNCTIONs below #'
  1173. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------- '
  1174. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  1175.     u = UBOUND(TextHandles)
  1176.     Handle = WhichHandle
  1177.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1178.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1179.     Where = TextHandles(Handle).VerticalAlignment
  1180.     How = TextHandles(Handle).Justification
  1181.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  1182.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  1183.  
  1184.  
  1185. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  1186.     'WhichHandle is the handle which designates which text area we want to use
  1187.     'Where is where we want it to go in that text area
  1188.     '  -- Online prints the text to the current print position line in that text area.
  1189.     '  -- CenterLine centers the text to the center of that text area.
  1190.     '  -- any other value will print to that line positon in that particular box.
  1191.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  1192.     'What is the text that we want to print in our text area
  1193.     '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).
  1194.  
  1195.     D = _DEST: S = _SOURCE
  1196.     OldFont = _FONT
  1197.  
  1198.     u = UBOUND(TextHandles)
  1199.     Handle = WhichHandle
  1200.  
  1201.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1202.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1203.     IF TextHandles(Handle).HideFrame THEN
  1204.         _DEST TextHandles(Handle).SavedBackground
  1205.         _SOURCE TextHandles(Handle).SavedBackground
  1206.     END IF
  1207.     _FONT TextHandles(Handle).Font
  1208.     fh = _FONTHEIGHT: pw = _PRINTWIDTH(What)
  1209.     IF _FONTWIDTH = 0 THEN
  1210.         FOR i = 1 TO 255
  1211.             IF _PRINTWIDTH(CHR$(i)) > fw THEN fw = _PRINTWIDTH(CHR$(i))
  1212.         NEXT
  1213.     ELSE
  1214.         fw = _FONTWIDTH
  1215.     END IF
  1216.  
  1217.     h = TextHandles(Handle).h - 4: w = TextHandles(Handle).w - 4
  1218.  
  1219.     SELECT CASE Where
  1220.         CASE BottomLine
  1221.             y = h \ fh
  1222.         CASE OnLine
  1223.             y = TextHandles(Handle).Ypos
  1224.             IF y = 0 THEN y = 1
  1225.         CASE CenterLine
  1226.             linesused = 0
  1227.             tpw = pw: tw = w: tWhat$ = What
  1228.             DO UNTIL tpw <= tw
  1229.                 textallowed = WordBreak(LEFT$(tWhat$, w \ fw))
  1230.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  1231.                 linesused = linesused + 1
  1232.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  1233.                 tpw = _PRINTWIDTH(tWhat$)
  1234.             LOOP
  1235.             linesused = linesused + 1
  1236.             py = (h - linesused * fh) \ 2
  1237.             y = py \ fh + 1
  1238.             IF y < 1 THEN y = 1
  1239.         CASE ELSE
  1240.             y = Where
  1241.     END SELECT
  1242.  
  1243.     'IF y < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  1244.     blend = _BLEND
  1245.  
  1246.     DO UNTIL y * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  1247.         'first let's get a temp image handle for the existing area of the screen.
  1248.         x1 = TextHandles(Handle).x1 + 2
  1249.         y1 = TextHandles(Handle).y1 + 2
  1250.         x2 = TextHandles(Handle).x1 + w
  1251.         y2 = TextHandles(Handle).y1 + h
  1252.         nh = y2 - y1 + 1 - fh
  1253.         nw = x2 - x1 + 1
  1254.         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.
  1255.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  1256.         DrawTextArea Handle
  1257.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  1258.         y = y - 1
  1259.     LOOP
  1260.  
  1261.     IF blend THEN _BLEND
  1262.  
  1263.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  1264.  
  1265.     SELECT CASE How
  1266.         CASE LeftJustify
  1267.             x = 0
  1268.             IF pw > w THEN
  1269.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  1270.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1271.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1272.                 PlaceText Handle, y + 1, LeftJustify, MID$(What, textallowed + 1), 0
  1273.             ELSE
  1274.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1275.                 finished = -1
  1276.             END IF
  1277.         CASE CenterJustify
  1278.             IF pw > w THEN
  1279.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  1280.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1281.                 x = (w - _PRINTWIDTH(text$)) \ 2
  1282.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1283.                 PlaceText Handle, y + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  1284.             ELSE
  1285.                 x = (w - pw) \ 2
  1286.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1287.                 finished = -1
  1288.             END IF
  1289.         CASE RightJustify
  1290.             IF pw > w THEN
  1291.                 textallowed = WordBreak(LEFT$(What, w \ fw))
  1292.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1293.                 x = w - _PRINTWIDTH(text$)
  1294.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1295.                 PlaceText Handle, y + 1, RightJustify, MID$(What, textallowed + 1), 0
  1296.             ELSE
  1297.                 x = w - pw
  1298.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1299.                 finished = -1
  1300.             END IF
  1301.         CASE NoJustify
  1302.             x = TextHandles(Handle).Xpos
  1303.             firstlinelimit = (w - x) \ fw 'the limit of characters on the first line
  1304.             IF LEN(What) > firstlinelimit THEN
  1305.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  1306.                 text$ = RTRIM$(LEFT$(What, textallowed))
  1307.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), text$
  1308.                 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
  1309.             ELSE
  1310.                 _PRINTSTRING (x + 2 + TextHandles(Handle).x1, (y - 1) * fh + TextHandles(Handle).y1 + 2), What
  1311.                 finished = -1
  1312.             END IF
  1313.     END SELECT
  1314.     IF finished THEN
  1315.         SELECT CASE TextHandles(Handle).UpdateMethod
  1316.             CASE NoUpdate 'We don't update the position at all.
  1317.             CASE DoUpdate
  1318.                 TextHandles(Handle).Xpos = x + pw
  1319.                 TextHandles(Handle).Ypos = y
  1320.             CASE NewLine
  1321.                 TextHandles(Handle).Ypos = y + 1
  1322.                 TextHandles(Handle).Xpos = 1
  1323.         END SELECT
  1324.         _FONT OldFont
  1325.         _DEST D: _SOURCE S
  1326.         COLOR FG, BG
  1327.     END IF
  1328.  
  1329. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  1330.     u = UBOUND(TextHandles)
  1331.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1332.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1333.     TextHandles(Handle).TextColor = Foreground
  1334.  
  1335.  
  1336. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  1337.     u = UBOUND(TextHandles)
  1338.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1339.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1340.     TextHandles(Handle).TextBackgroundColor = Background
  1341.  
  1342. SUB SetTextFont (Handle AS INTEGER, FontName AS STRING, FontSize AS INTEGER)
  1343.     u = UBOUND(TextHandles)
  1344.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1345.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1346.     SELECT CASE TextHandles(Handle).Font
  1347.         CASE 8, 9, 14, 15, 16, 17 'In built QB64 fonts.  We don't need to free them.
  1348.         CASE IS > 1
  1349.             'we have the font already in use
  1350.             'REMOVE THIS CONDITION IF NECESSARY, AND MANUALLY FREE/RELEASE FONTS AS ABLE!!!
  1351.             _FREEFONT TextHandles(Handle).Font 'if it's in use elsewhere, this *WILL* toss an error.
  1352.     END SELECT
  1353.  
  1354.     temp = _LOADFONT(FontName, FontSize, "MONOSPACE")
  1355.     IF temp > 1 THEN
  1356.         TextHandles(Handle).Font = temp
  1357.     ELSE
  1358.         TextHandles(Handle).Font = 16 'default to font 16, in case
  1359.     END IF
  1360.  
  1361.  
  1362. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  1363.     u = UBOUND(TextHandles)
  1364.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1365.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1366.     TextHandles(Handle).TextColor = Foreground
  1367.     TextHandles(Handle).TextBackgroundColor = Background
  1368.  
  1369.  
  1370. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  1371.     u = UBOUND(TextHandles)
  1372.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1373.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1374.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  1375.     TextHandles(Handle).UpdateMethod = Method
  1376.  
  1377.  
  1378. SUB SetPrintPosition (Handle AS INTEGER, X AS INTEGER, Y AS INTEGER)
  1379.     u = UBOUND(TextHandles)
  1380.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1381.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1382.     SELECT CASE Y
  1383.         CASE BottomLine
  1384.             TextHandles(Handle).VerticalAlignment = -2
  1385.         CASE CenterLine
  1386.             TextHandles(Handle).VerticalAlignment = -1
  1387.         CASE ELSE
  1388.             TextHandles(Handle).VerticalAlignment = 0
  1389.     END SELECT
  1390.     IF X < 1 AND X > -4 THEN
  1391.         TextHandles(Handle).Justification = X
  1392.     ELSE
  1393.         TextHandles(Handle).Xpos = X
  1394.     END IF
  1395.     IF Y < 1 THEN EXIT SUB
  1396.     TextHandles(Handle).Ypos = Y
  1397.  
  1398. SUB SetPrintPositionX (Handle AS INTEGER, X AS INTEGER)
  1399.     u = UBOUND(TextHandles)
  1400.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1401.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1402.     IF X < 1 AND X > -4 THEN
  1403.         TextHandles(Handle).Justification = X
  1404.     ELSE
  1405.         TextHandles(Handle).Xpos = X
  1406.     END IF
  1407.  
  1408. SUB SetPrintPositionY (Handle AS INTEGER, Y AS INTEGER)
  1409.     u = UBOUND(TextHandles)
  1410.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1411.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1412.     SELECT CASE Y
  1413.         CASE BottomLine
  1414.             TextHandles(Handle).VerticalAlignment = -2
  1415.         CASE CenterLine
  1416.             TextHandles(Handle).VerticalAlignment = -1
  1417.         CASE ELSE
  1418.             TextHandles(Handle).VerticalAlignment = 0
  1419.     END SELECT
  1420.     IF Y < 1 THEN EXIT SUB
  1421.     TextHandles(Handle).Ypos = Y
  1422.  
  1423.  
  1424. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  1425.     u = UBOUND(TextHandles)
  1426.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1427.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1428.     GetPrintPositionY = TextHandles(Handle).Ypos
  1429.  
  1430. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  1431.     u = UBOUND(TextHandles)
  1432.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1433.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1434.     GetPrintPositionX = TextHandles(Handle).Xpos
  1435.  
  1436.  
  1437.  
  1438. FUNCTION WordBreak (text$)
  1439.     CONST Breaks = " ;,.?!-"
  1440.     FOR i = LEN(text$) TO 0 STEP -1
  1441.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  1442.         loopcount = loopcount + 1
  1443.     NEXT
  1444.     IF i = 0 THEN i = LEN(text$)
  1445.     WordBreak = i
  1446.  
  1447.  
  1448.  
  1449. SUB ClearTextArea (Handle AS INTEGER)
  1450.     u = UBOUND(TextHandles)
  1451.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1452.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1453.     IF TextHandles(Handle).SavedBackground THEN
  1454.         w = TextHandles(Handle).w
  1455.         h = TextHandles(Handle).h
  1456.         x1 = TextHandles(Handle).ScreenX
  1457.         y1 = TextHandles(Handle).ScreenY
  1458.         x2 = x1 + w - 1
  1459.         y2 = y1 + h - 1
  1460.         blend = _BLEND
  1461.         _DONTBLEND
  1462.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1463.         IF blend THEN _BLEND
  1464.     END IF
  1465.     DrawTextArea Handle
  1466.  
  1467.  
  1468.  
  1469. SUB DrawTextArea (Handle AS INTEGER)
  1470.     u = UBOUND(TextHandles)
  1471.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1472.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1473.     w = TextHandles(Handle).w
  1474.     h = TextHandles(Handle).h
  1475.     x1 = TextHandles(Handle).ScreenX
  1476.     y1 = TextHandles(Handle).ScreenY
  1477.     x2 = x1 + w - 1
  1478.     y2 = y1 + h - 1
  1479.  
  1480.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  1481.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  1482.  
  1483.  
  1484.  
  1485. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  1486.     u = UBOUND(TextHandles)
  1487.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1488.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1489.     TextHandles(Handle).FrameColor = FrameColor
  1490.     TextHandles(Handle).BackColor = BackColor
  1491.  
  1492.  
  1493.  
  1494. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  1495.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  1496.     x2 = tx2: y2 = ty2
  1497.     IF x1 > x2 THEN SWAP x1, x2
  1498.     IF y1 > y2 THEN SWAP y1, y2
  1499.     w = x2 - x1 + 1
  1500.     h = y2 - y1 + 1
  1501.     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
  1502.     'Error checking for if the user sends coordinates which are off the screen
  1503.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  1504.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  1505.  
  1506.     u = UBOUND(TextHandles)
  1507.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  1508.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  1509.     NEXT
  1510.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  1511.         Handle = u + 1
  1512.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  1513.     END IF
  1514.     TextHandles(Handle).x1 = x1
  1515.     TextHandles(Handle).y1 = y1
  1516.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  1517.     TextHandles(Handle).InUse = True
  1518.     TextHandles(Handle).Xpos = 0
  1519.     TextHandles(Handle).Ypos = 1
  1520.     TextHandles(Handle).UpdateMethod = NewLine
  1521.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  1522.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  1523.  
  1524.     IF SaveBackground THEN
  1525.         imagehandle = _NEWIMAGE(w, h, 32)
  1526.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1527.         TextHandles(Handle).SavedBackground = imagehandle
  1528.     END IF
  1529.     TextHandles(Handle).ScreenX = x1
  1530.     TextHandles(Handle).ScreenY = y1
  1531.     TextHandles(Handle).Font = 16 'default to font 16
  1532.     NewTextArea% = Handle
  1533.  
  1534. SUB FreeTextArea (Handle AS INTEGER)
  1535.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  1536.         IF TextHandles(Handle).InUse THEN
  1537.             TextHandles(Handle).InUse = False
  1538.             IF TextHandles(Handle).SavedBackground THEN
  1539.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  1540.                     w = TextHandles(Handle).w
  1541.                     h = TextHandles(Handle).h
  1542.                     x1 = TextHandles(Handle).ScreenX
  1543.                     y1 = TextHandles(Handle).ScreenY
  1544.                     x2 = x1 + w - 1
  1545.                     y2 = y1 + h - 1
  1546.                     blend = _BLEND
  1547.                     _DONTBLEND
  1548.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1549.                     IF blend THEN _BLEND
  1550.                 END IF
  1551.                 '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.
  1552.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  1553.             END IF
  1554.         ELSE
  1555.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  1556.         END IF
  1557.     ELSE
  1558.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  1559.     END IF
  1560.  
  1561. SUB HideFrame (Handle AS INTEGER)
  1562.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  1563.         TextHandles(Handle).HideFrame = -1
  1564.         w = TextHandles(Handle).w
  1565.         h = TextHandles(Handle).h
  1566.         x1 = TextHandles(Handle).ScreenX
  1567.         y1 = TextHandles(Handle).ScreenY
  1568.         x2 = x1 + w - 1
  1569.         y2 = y1 + h - 1
  1570.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1571.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1572.         IF TextHandles(Handle).SavedBackground THEN
  1573.             blend = _BLEND
  1574.             _DONTBLEND
  1575.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  1576.             _FREEIMAGE TextHandles(Handle).SavedBackground
  1577.             IF blend THEN _BLEND
  1578.         END IF
  1579.         TextHandles(Handle).SavedBackground = imagehandle
  1580.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  1581.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  1582.     END IF
  1583.  
  1584. SUB RestoreFrame (Handle AS INTEGER)
  1585.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  1586.         TextHandles(Handle).HideFrame = 0
  1587.         w = TextHandles(Handle).w
  1588.         h = TextHandles(Handle).h
  1589.         x1 = TextHandles(Handle).ScreenX
  1590.         y1 = TextHandles(Handle).ScreenY
  1591.         x2 = x1 + w - 1
  1592.         y2 = y1 + h - 1
  1593.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  1594.         blend = _BLEND
  1595.         _DONTBLEND
  1596.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  1597.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  1598.         _FREEIMAGE TextHandles(Handle).SavedBackground
  1599.         IF blend THEN _BLEND
  1600.         TextHandles(Handle).SavedBackground = imagehandle
  1601.         TextHandles(Handle).x1 = x1 'When the frames are restored, we need to recalculate our print position
  1602.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  1603.     END IF
  1604.  
  1605. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  1606.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  1607.     u = UBOUND(TextHandles)
  1608.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  1609.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  1610.     HideFrame Handle
  1611.     TextHandles(Handle).ScreenX = x1
  1612.     TextHandles(Handle).ScreenY = y1
  1613.     RestoreFrame Handle

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.  ;)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: Rogue-Like (work in progress)
« Reply #29 on: November 23, 2021, 02:14:10 pm »
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...