Adds virtues.

TODO.md

@@ -1,6 +1,4 @@
 # High Priority
-* Calculate roadValue aka humanity in VtM, and something else in WtA.
-* Calculate willpower.
 * Input/Print derangements. These are only for Malkavian vampires.
     * If the clan is malk then ask to pick a derangement. Maybe more than one?
     * Print any derangements on the character on the character sheet.
@@ -60,6 +58,12 @@
     * Look into pulling out these "classes" into separate bas files as appropriate.
     * I want to get this definition clutter out of the main bas.
 * Make empty strings show as "blank lines" on the character sheet so they can be filled in by hand.
+* Input/Print derangements. These are only for Malkavian vampires.
+    * This has been done in th default ruleset.
+    * Figure out how to support something like this for various rulesets.
+    * VtDA has malks so it would need this.
+    * WtA doesn't obviously have them, but it may have something else that requires a specific question/addition to CharacterType.
+    * Make this generic if possible.
 
 # Super-Low Priority
 * Make GetAttributePointsForRank and GetAbilityPointsForRank use a formula maybe.

dos/sbf/sbf.bas

@@ -1,12 +1,6 @@
 $Debug
 ' Setup
 ' TODO: See if other combinations of clan and other variables cause sub questions.
-' TODO: Calculate generation
-' TODO: Calculate conscience
-' TODO: Calculate self-control
-' TODO: Calculate courage
-' TODO: Calculate humanity/road
-' TODO: Calculate willpower
 ' TODO: Add blood pool to sheet
 ' TODO: Input/Print derangements
 ' TODO: Create a way to choose between VtM, VtDA, and WtA then load the appropriate lookup tables.
@@ -204,6 +198,28 @@ Const GENDER_NON_BINARY = 5
 Const GENDERS_COUNT = 5
 Dim Shared Genders(1 To GENDERS_COUNT) As String
 
+Const COLOR_DARK_BLACK = 0
+Const COLOR_DARK_BLUE = 1
+Const COLOR_DARK_GREEN = 2
+Const COLOR_DARK_CYAN = 3
+Const COLOR_DARK_RED = 4
+Const COLOR_DARK_MAGENTA = 5
+Const COLOR_DARK_ORANGE = 6
+Const COLOR_DARK_YELLOW = 6
+Const COLOR_DARK_WHITE = 7
+Const COLOR_BRIGHT_BLACK = 8
+Const COLOR_BRIGHT_BLUE = 9
+Const COLOR_BRIGHT_GREEN = 10
+Const COLOR_BRIGHT_CYAN = 11
+Const COLOR_BRIGHT_RED = 12
+Const COLOR_BRIGHT_MAGENTA = 13
+Const COLOR_BRIGHT_ORANGE = 14
+Const COLOR_BRIGHT_YELLOW = 14
+Const COLOR_BRIGHT_WHITE = 15
+
+Dim Shared ScreenColor As Integer
+ScreenColor = COLOR_DARK_WHITE
+
 Type CharacterType
     name As String
     player As String
@@ -223,6 +239,7 @@ Type CharacterType
     roadValue As Integer
     willpower As Integer
     bloodPool As Integer
+    derangementId As Integer
     ' Disciplines
     discipline_animalism As Integer
     discipline_auspex As Integer
@@ -315,11 +332,14 @@ Type MenuStyle
     labelValueSeparator As String
     menuItemSpacer As String
     showRandom As Integer
+    useColors As Integer
 End Type
+
 Type MenuItem
     label As String
     id As Integer
     value As Integer
+    color As Integer
     isVisible As Integer
 End Type
 
@@ -328,8 +348,6 @@ Call InitializeMemory
 
 ' Run "tests" at startup. Uncomment the end instruction to see the output and not run the rest of the program.
 Call Test
-'End
-
 Call SplashScreen
 Call MainMenu
 
@@ -1184,7 +1202,6 @@ Sub NewCharacter (ch As CharacterType)
 End Sub
 
 Sub BuildMenu (items() As MenuItem, labels() As String, count As Integer)
-    ReDim items(1 To count) As MenuItem
     For i = 1 To count
         Dim mi As MenuItem
         Call NewMenuItem(mi, labels(i), i)
@@ -1193,7 +1210,6 @@ Sub BuildMenu (items() As MenuItem, labels() As String, count As Integer)
 End Sub
 
 Sub BuildMenuWithValues (items() As MenuItem, labels() As String, values() As Integer, count As Integer)
-    ReDim items(1 To count) As MenuItem
     For i = 1 To count
         Dim mi As MenuItem
         Call NewMenuItemWithValue(mi, labels(i), i, values(i))
@@ -1201,6 +1217,18 @@ Sub BuildMenuWithValues (items() As MenuItem, labels() As String, values() As In
     Next
 End Sub
 
+Sub BuildMenuWithColors (items() As MenuItem, labels() As String, colors() As Integer)
+    ' Check array bounds
+    If LBound(items) <> 1 Or LBound(colors) <> 1 Or UBound(items) <> UBound(colors) Then End
+
+    count = UBound(items)
+    For i = 1 To count
+        Dim mi As MenuItem
+        Call NewMenuItemWithColor(mi, labels(i), colors(i), i)
+        items(i) = mi
+    Next
+End Sub
+
 Function ChooseStringId (labels() As String, style As MenuStyle, count As Integer, prompt As String)
     Cls
     Dim mnuItems(1 To count) As MenuItem
@@ -1225,6 +1253,25 @@ Function ChooseStringIdWithValues (labels() As String, values() As Integer, styl
     ChooseStringIdWithValues = choice
 End Function
 
+Function ChooseStringIdWithColors (labels() As String, colors() As Integer, style As MenuStyle, prompt As String)
+    Cls
+    ' Check array bounds
+    If LBound(labels) <> 1 Or LBound(colors) <> 1 Or UBound(labels) <> UBound(colors) Then
+        ChooseStringIdWithColors = -1
+        End
+    End If
+
+    count = UBound(labels)
+    Dim mnuItems(1 To count) As MenuItem
+    Call BuildMenuWithColors(mnuItems(), labels(), colors())
+    Call AdjustMenuStyle(style, mnuItems(), count, TRUE)
+    Print prompt
+    Call PrintMenu(mnuItems(), count, style)
+    choice = GetMenuChoice(mnuItems(), style, count)
+    If choice = style.randomItemId Then choice = GetRandomMenuItemId(mnuItems(), count)
+    ChooseStringIdWithColors = choice
+End Function
+
 Function ChooseMenuItemId (items() As MenuItem, style As MenuStyle, count As Integer, prompt As String, ignoreValue As Integer)
     Cls
     Call AdjustMenuStyle(style, items(), count, ignoreValue)
@@ -1259,7 +1306,6 @@ Sub CGGetDisciplines (ch As CharacterType)
     Dim disciplineValues(DISCIPLINES_COUNT) As Integer
     While disciplinePoints > 0
         Cls
-        Print "Which discipline do you want to spend 1 of your " + itos$(disciplinePoints) + " discipline points on?"
         Call FillDisciplines(ch, disciplineValues())
         discipline = ChooseStringIdWithValues(Disciplines(), disciplineValues(), ms, DISCIPLINES_COUNT, "Which discipline do you want to spend 1 of your " + itos$(disciplinePoints) + " points on?")
         Call SetDiscipline(ch, discipline, GetDiscipline(ch, discipline) + 1)
@@ -1404,11 +1450,21 @@ Sub CGSpendVirtuePoints (ch As CharacterType)
     While virtuePoints > 0
         Call FillVirtues(ch, values())
         virtue = ChooseStringIdWithValues(Virtues(), values(), ms, VIRTUES_COUNT, "Which virtue do you want to spend 1 of your " + itos$(virtuePoints) + " points on?")
+        If virtue = 0 Then virtue = GetRandomInt(1, VIRTUES_COUNT)
         Call SetVirtue(ch, virtue, GetVirtue(ch, virtue) + 1)
         virtuePoints = virtuePoints - 1
     Wend
 End Sub
 
+Sub SetColor (c As Integer)
+    ScreenColor = c
+    Color c
+End Sub
+
+Function GetColor ()
+    GetColor = ScreenColor
+End Function
+
 Sub CGSpendFreebiePoints (ch As CharacterType)
 End Sub
 
@@ -1654,7 +1710,6 @@ Sub ShowCharacterSheet (ch As CharacterType)
     Next
     Print "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>͹"
     Print "<22> Backgrounds:                         <20> Virtues:                              <20>"
-    Print "                                         " + MakeFitB$("Conscience:", itos$(ch.conscience), 37, " ") + " <20>"
     Print "<22> " + MakeFitL$(backgroundStrings(0), 36, " ") + " <20> " + MakeFitB$("Conscience:", itos$(ch.conscience), 37, " ") + " <20>"
     Print "<22> " + MakeFitL$(backgroundStrings(1), 36, " ") + " <20> " + MakeFitB$("Self-Control:", itos$(ch.selfControl), 37, " ") + " <20>"
     Print "<22> " + MakeFitL$(backgroundStrings(2), 36, " ") + " <20> " + MakeFitB$("Courage:", itos$(ch.courage), 37, " ") + " <20>"
@@ -1844,9 +1899,6 @@ Sub FillAttributeAbbreviationsInGroup (group As Integer, abbreviations() As Stri
     End Select
 End Sub
 
-Sub Test
-    'End
-End Sub
 
 Sub AdjustMenuStyle (style As MenuStyle, items() As MenuItem, count As Integer, ignoreValue As Integer)
     maxIdWidth = 0
@@ -1875,7 +1927,14 @@ Sub PrintMenu (items() As MenuItem, count As Integer, style As MenuStyle)
     If count <= 10 Then
         For i = 1 To count
             If items(i).isVisible Then
+                If style.useColors Then
+                    oldColor = GetColor
+                    SetColor (items(i).color)
+                End If
                 Print GetTitle$(items(i), style)
+                If style.useColors Then
+                    Call SetColor(oldColor)
+                End If
             End If
         Next
         If style.showRandom Then
@@ -1932,12 +1991,14 @@ Sub NewMenuStyle (ms As MenuStyle)
     ms.labelValueSeparator = ": "
     ms.menuItemSpacer = ", "
     ms.showRandom = TRUE
+    ms.useColors = FALSE
 End Sub
 
 Sub NewMenuItem (mi As MenuItem, label As String, id As Integer)
     mi.id = id
     mi.label = label
     mi.value = 0
+    mi.color = COLOR_DEFAULT
     mi.isVisible = TRUE
 End Sub
 
@@ -1945,6 +2006,15 @@ Sub NewMenuItemWithValue (mi As MenuItem, label As String, id As Integer, value
     mi.id = id
     mi.label = label
     mi.value = value
+    mi.color = COLOR_DEFAULT
+    mi.isVisible = TRUE
+End Sub
+
+Sub NewMenuItemWithColor (mi As MenuItem, label As String, textColor As Integer, id As Integer)
+    mi.id = id
+    mi.label = label
+    mi.value = 0
+    mi.color = textColor
     mi.isVisible = TRUE
 End Sub
 
@@ -1960,3 +2030,7 @@ Function GetVirtuePoints ()
     GetVirtuePoints = VIRTUE_POINTS
 End Function
 
+Sub Test
+    'End
+End Sub
+