Adds freebie point spending. Adds cancel as an option to MenuStyle to allow cancelling. Adds includeInRandom to MenuItem to hide specific MenuItems from GetRandomMenuItemId.

This commit is contained in:
2023-04-14 16:16:24 -07:00
parent 5e27ff5b89
commit b525394a41
9 changed files with 526 additions and 329 deletions

13
TODO.md
View File

@@ -1,16 +1,4 @@
# High Priority # High Priority
* Add freebie points see page 92 VtM
* After other generation steps allow spending the freebie points on adding dots to the sheet. This should be a nested menu like "What do you want to spend points on? -> Which of those things do you want to add a dot to?
* We probably want to show the character sheet before asking or give the user a way to display it in the main menu of this section.
* Costs
* Disciplines (any): 7 points per dot
* Attributes: 5 points per dot
* Abilities: 2 points per dot
* Virtues: 2 points per dot
* Willpower: 2 points per dot
* Humanity: 1 point per dot
* Backgrounds: 1 point per dot
* How does increasing virtues/willpower/humanity affect each other
* Add blood pool to sheet and figure out what should replace it for non-vampires. * Add blood pool to sheet and figure out what should replace it for non-vampires.
* Generation affects blood pool page 173 VtM. * Generation affects blood pool page 173 VtM.
* Make empty strings show as "blank lines" on the character sheet so they can be filled in by hand. * Make empty strings show as "blank lines" on the character sheet so they can be filled in by hand.
@@ -89,6 +77,7 @@
* Add attribute specialties and any other specialties from the book. * Add attribute specialties and any other specialties from the book.
# Low Priority # Low Priority
* How does increasing virtues/willpower/humanity affect each other
* Add post-creation questions * Add post-creation questions
* How old are you? - Already have this as age at the beginning but could move to the end. * How old are you? - Already have this as age at the beginning but could move to the end.
* What was unique about your childhood? * What was unique about your childhood?

View File

@@ -0,0 +1,27 @@
MICSFT_PC_CP437
MICSFT_PC_CP737
MICSFT_PC_CP775
MICSFT_PC_CP850
MICSFT_PC_CP852
MICSFT_PC_CP855
MICSFT_PC_CP857
MICSFT_PC_CP860
MICSFT_PC_CP861
MICSFT_PC_CP862
MICSFT_PC_CP863
MICSFT_PC_CP864
MICSFT_PC_CP865
MICSFT_PC_CP866
MICSFT_PC_CP869
MICSFT_PC_CP874
MICSFT_WINDOWS_CP1250
MICSFT_WINDOWS_CP1251
MICSFT_WINDOWS_CP1252
MICSFT_WINDOWS_CP1253
MICSFT_WINDOWS_CP1254
MICSFT_WINDOWS_CP1255
MICSFT_WINDOWS_CP1256
MICSFT_WINDOWS_CP1257
MICSFT_WINDOWS_CP1258
MICSFT_WINDOWS_CP874
MIK

View File

@@ -197,6 +197,17 @@ Const DERANGEMENT_ID_PARANOIA = 8
Const DERANGEMENT_ID_PERFECTION = 9 Const DERANGEMENT_ID_PERFECTION = 9
Const DERANGEMENT_ID_REGRESSION = 10 Const DERANGEMENT_ID_REGRESSION = 10
Dim Shared Derangements(1 To DERANGEMENTS_COUNT) As DerangementType Dim Shared Derangements(1 To DERANGEMENTS_COUNT) As DerangementType
Const DERANGEMENT_COLOR_AMNESIA = COLOR_DARK_RED
Const DERANGEMENT_COLOR_DELUSIONS_OF_GRANDEUR = COLOR_DARK_MAGENTA
Const DERANGEMENT_COLOR_FANTASY = COLOR_DARK_ORANGE
Const DERANGEMENT_COLOR_MANIC_DEPRESSION = COLOR_DARK_WHITE
Const DERANGEMENT_COLOR_MULTIPLE_PERSONALITIES = COLOR_DARK_BLUE
Const DERANGEMENT_COLOR_OBSESSION = COLOR_BRIGHT_GREEN
Const DERANGEMENT_COLOR_OVERCOMPENSATION = COLOR_BRIGHT_CYAN
Const DERANGEMENT_COLOR_PARANOIA = COLOR_BRIGHT_RED
Const DERANGEMENT_COLOR_PERFECTION = COLOR_BRIGHT_MAGENTA
Const DERANGEMENT_COLOR_REGRESSION = COLOR_BRIGHT_YELLOW
Dim Shared DerangementColors(1 To DERANGEMENTS_COUNT) As Integer Dim Shared DerangementColors(1 To DERANGEMENTS_COUNT) As Integer
Dim Shared DerangementLabels(1 To DERANGEMENTS_COUNT) As String Dim Shared DerangementLabels(1 To DERANGEMENTS_COUNT) As String
@@ -223,12 +234,46 @@ Const DERANGEMENT_DESCRIPTION_PARANOIA = "You are convinced that you are being h
Const DERANGEMENT_DESCRIPTION_PERFECTION = "All your energy is directed toward preventing anything from going wong. When it does you must make a self-control roll or frenzy." Const DERANGEMENT_DESCRIPTION_PERFECTION = "All your energy is directed toward preventing anything from going wong. When it does you must make a self-control roll or frenzy."
Const DERANGEMENT_DESCRIPTION_REGRESSION = "You become childlike retreating to an earlier time when less was expected of you Willpower is regained inthe way a Child's is." Const DERANGEMENT_DESCRIPTION_REGRESSION = "You become childlike retreating to an earlier time when less was expected of you Willpower is regained inthe way a Child's is."
Const FREEBIE_POINT_COST_DISCIPLINE = 7 Const FREEBIES_COUNT = 7
Const FREEBIE_POINT_COST_ATTRIBUTE = 5 Dim Shared FreebieCosts(1 To FREEBIES_COUNT) As Integer
Const FREEBIE_POINT_COST_ABIILTY = 2 Dim Shared FreebieLabels(1 To FREEBIES_COUNT) As String
Const FREEBIE_POINT_COST_VIRTUE = 2 Dim Shared FreebieNames(1 to FREEBIES_COUNT) As String
Const FREEBIE_POINT_COST_HUMANITY = 1 Dim Shared Freebies(1 To FREEBIES_COUNT) As FreebieType
Const FREEBIE_POINT_COST_BACKGROUND = 1 Const FREEBIE_DISCIPLINE_ID = 1
Const FREEBIE_DISCIPLINE_COST = 7
Const FREEBIE_DISCIPLINE_NAME = "Discipline"
Const FREEBIE_DISCIPLINE_LABEL = "Add a discipline dot 7 points"
Const FREEBIE_ATTRIBUTE_ID = 2
Const FREEBIE_ATTRIBUTE_COST = 5
Const FREEBIE_ATTRIBUTE_NAME = "Attribute"
Const FREEBIE_ATTRIBUTE_LABEL = "Add an attribute dot 5 points"
Const FREEBIE_ABILITY_ID = 3
Const FREEBIE_ABILITY_COST = 2
Const FREEBIE_ABILITY_NAME = "Ability"
Const FREEBIE_ABILITY_LABEL = "Add an ability dot 2 points"
Const FREEBIE_VIRTUE_ID = 4
Const FREEBIE_VIRTUE_COST = 2
Const FREEBIE_VIRTUE_NAME = "Virtue"
Const FREEBIE_VIRTUE_LABEL = "Add a virtue dot 2 points"
' TODO: Make this configurable for VtDA
Const FREEBIE_HUMANITY_ID = 5
Const FREEBIE_HUMANITY_COST = 1
Const FREEBIE_HUMANITY_NAME = "Humanity"
Const FREEBIE_HUMANITY_LABEL = "Add a humanity dot 1 point"
Const FREEBIE_BACKGROUND_ID = 6
Const FREEBIE_BACKGROUND_COST = 1
Const FREEBIE_BACKGROUND_NAME = "Background"
Const FREEBIE_BACKGROUND_LABEL = "Add a background dot 1 point"
Const FREEBIE_SHOW_CHARACTER_SHEET_ID = 7
Const FREEBIE_SHOW_CHARACTER_SHEET_COST = 0
Const FREEBIE_SHOW_CHARACTER_SHEET_NAME = "Show character sheet"
Const FREEBIE_SHOW_CHARACTER_SHEET_LABEL = FREEBIE_SHOW_CHARACTER_SHEET_NAME
Type CharacterType Type CharacterType
name As String name As String
@@ -338,3 +383,10 @@ Type DerangementType
description As String description As String
textColor As Integer textColor As Integer
End Type End Type
Type FreebieType
id As Integer
cost As Integer
name As String * 32
label As String * 32
End Type

View File

@@ -176,16 +176,17 @@ Sub Initialize_Character_Lib
Genders(GENDER_TRANS_FEMALE) = "Trans-Female" Genders(GENDER_TRANS_FEMALE) = "Trans-Female"
Genders(GENDER_NON_BINARY) = "Non-Binary" Genders(GENDER_NON_BINARY) = "Non-Binary"
DerangementColors(DERANGEMENT_ID_AMNESIA) = COLOR_DARK_RED ' Derangements
DerangementColors(DERANGEMENT_ID_DELUSIONS_OF_GRANDEUR) = COLOR_DARK_MAGENTA DerangementColors(DERANGEMENT_ID_AMNESIA) = DERANGEMENT_COLOR_AMNESIA
DerangementColors(DERANGEMENT_ID_FANTASY) = COLOR_DARK_ORANGE DerangementColors(DERANGEMENT_ID_DELUSIONS_OF_GRANDEUR) = DERANGEMENT_COLOR_DELUSIONS_OF_GRANDEUR
DerangementColors(DERANGEMENT_ID_MANIC_DEPRESSION) = COLOR_DARK_WHITE DerangementColors(DERANGEMENT_ID_FANTASY) = DERANGEMENT_COLOR_FANTASY
DerangementColors(DERANGEMENT_ID_MULTIPLE_PERSONALITIES) = COLOR_DARK_BLUE DerangementColors(DERANGEMENT_ID_MANIC_DEPRESSION) = DERANGEMENT_COLOR_MANIC_DEPRESSION
DerangementColors(DERANGEMENT_ID_OBSESSION) = COLOR_BRIGHT_GREEN DerangementColors(DERANGEMENT_ID_MULTIPLE_PERSONALITIES) = DERANGEMENT_COLOR_MULTIPLE_PERSONALITIES
DerangementColors(DERANGEMENT_ID_OVERCOMPENSATION) = COLOR_BRIGHT_CYAN DerangementColors(DERANGEMENT_ID_OBSESSION) = DERANGEMENT_COLOR_OBSESSION
DerangementColors(DERANGEMENT_ID_PARANOIA) = COLOR_BRIGHT_RED DerangementColors(DERANGEMENT_ID_OVERCOMPENSATION) = DERANGEMENT_COLOR_OVERCOMPENSATION
DerangementColors(DERANGEMENT_ID_PERFECTION) = COLOR_BRIGHT_MAGENTA DerangementColors(DERANGEMENT_ID_PARANOIA) = DERANGEMENT_COLOR_PARANOIA
DerangementColors(DERANGEMENT_ID_REGRESSION) = COLOR_BRIGHT_YELLOW DerangementColors(DERANGEMENT_ID_PERFECTION) = DERANGEMENT_COLOR_PERFECTION
DerangementColors(DERANGEMENT_ID_REGRESSION) = DERANGEMENT_COLOR_REGRESSION
DerangementLabels(DERANGEMENT_ID_AMNESIA) = DERANGEMENT_LABEL_AMNESIA DerangementLabels(DERANGEMENT_ID_AMNESIA) = DERANGEMENT_LABEL_AMNESIA
DerangementLabels(DERANGEMENT_ID_DELUSIONS_OF_GRANDEUR) = DERANGEMENT_LABEL_DELUSIONS_OF_GRANDEUR DerangementLabels(DERANGEMENT_ID_DELUSIONS_OF_GRANDEUR) = DERANGEMENT_LABEL_DELUSIONS_OF_GRANDEUR
@@ -212,6 +213,42 @@ Sub Initialize_Character_Lib
For i = LBound(Derangements) To UBound(Derangements) For i = LBound(Derangements) To UBound(Derangements)
Call NewDerangement(Derangements(i), i, DerangementLabels(i), DerangementColors(i), DerangementDescriptions(i)) Call NewDerangement(Derangements(i), i, DerangementLabels(i), DerangementColors(i), DerangementDescriptions(i))
Next Next
' Freebies
FREEBIECOSTS(FREEBIE_DISCIPLINE_ID) = FREEBIE_DISCIPLINE_COST
FREEBIENAMES(FREEBIE_DISCIPLINE_ID) = FREEBIE_DISCIPLINE_NAME
FREEBIELABELS(FREEBIE_DISCIPLINE_ID) = FREEBIE_DISCIPLINE_LABEL
Call NewFreebie(Freebies(FREEBIE_DISCIPLINE_ID), FREEBIE_DISCIPLINE_ID, FREEBIE_DISCIPLINE_COST, FREEBIE_DISCIPLINE_NAME, FREEBIE_DISCIPLINE_LABEL)
FREEBIECOSTS(FREEBIE_ATTRIBUTE_ID) = FREEBIE_ATTRIBUTE_COST
FREEBIENAMES(FREEBIE_ATTRIBUTE_ID) = FREEBIE_ATTRIBUTE_NAME
FREEBIELABELS(FREEBIE_ATTRIBUTE_ID) = FREEBIE_ATTRIBUTE_LABEL
Call NewFreebie(Freebies(FREEBIE_ATTRIBUTE_ID), FREEBIE_ATTRIBUTE_ID, FREEBIE_ATTRIBUTE_COST, FREEBIE_ATTRIBUTE_NAME, FREEBIE_ATTRIBUTE_LABEL)
FREEBIECOSTS(FREEBIE_ABILITY_ID) = FREEBIE_ABILITY_COST
FREEBIENAMES(FREEBIE_ABILITY_ID) = FREEBIE_ABILITY_NAME
FREEBIELABELS(FREEBIE_ABILITY_ID) = FREEBIE_ABILITY_LABEL
Call NewFreebie(Freebies(FREEBIE_ABILITY_ID), FREEBIE_ABILITY_ID, FREEBIE_ABILITY_COST, FREEBIE_ABILITY_NAME, FREEBIE_ABILITY_LABEL)
FREEBIECOSTS(FREEBIE_VIRTUE_ID) = FREEBIE_VIRTUE_COST
FREEBIENAMES(FREEBIE_VIRTUE_ID) = FREEBIE_VIRTUE_NAME
FREEBIELABELS(FREEBIE_VIRTUE_ID) = FREEBIE_VIRTUE_LABEL
Call NewFreebie(Freebies(FREEBIE_VIRTUE_ID), FREEBIE_VIRTUE_ID, FREEBIE_VIRTUE_COST, FREEBIE_VIRTUE_NAME, FREEBIE_VIRTUE_LABEL)
FREEBIECOSTS(FREEBIE_HUMANITY_ID) = FREEBIE_HUMANITY_COST
FREEBIENAMES(FREEBIE_HUMANITY_ID) = FREEBIE_HUMANITY_NAME
FREEBIELABELS(FREEBIE_HUMANITY_ID) = FREEBIE_HUMANITY_LABEL
Call NewFreebie(Freebies(FREEBIE_HUMANITY_ID), FREEBIE_HUMANITY_ID, FREEBIE_HUMANITY_COST, FREEBIE_HUMANITY_NAME, FREEBIE_HUMANITY_LABEL)
FREEBIECOSTS(FREEBIE_BACKGROUND_ID) = FREEBIE_BACKGROUND_COST
FREEBIENAMES(FREEBIE_BACKGROUND_ID) = FREEBIE_BACKGROUND_NAME
FREEBIELABELS(FREEBIE_BACKGROUND_ID) = FREEBIE_BACKGROUND_LABEL
Call NewFreebie(Freebies(FREEBIE_BACKGROUND_ID), FREEBIE_BACKGROUND_ID, FREEBIE_BACKGROUND_COST, FREEBIE_BACKGROUND_NAME, FREEBIE_BACKGROUND_LABEL)
FREEBIECOSTS(FREEBIE_SHOW_CHARACTER_SHEET_ID) = FREEBIE_SHOW_CHARACTER_SHEET_COST
FREEBIENAMES(FREEBIE_SHOW_CHARACTER_SHEET_ID) = FREEBIE_SHOW_CHARACTER_SHEET_NAME
FREEBIELABELS(FREEBIE_SHOW_CHARACTER_SHEET_ID) = FREEBIE_SHOW_CHARACTER_SHEET_LABEL
Call NewFreebie(Freebies(FREEBIE_SHOW_CHARACTER_SHEET_ID), FREEBIE_SHOW_CHARACTER_SHEET_ID, FREEBIE_SHOW_CHARACTER_SHEET_COST, FREEBIE_SHOW_CHARACTER_SHEET_NAME, FREEBIE_SHOW_CHARACTER_SHEET_LABEL)
End Sub End Sub
' Character ' Character
@@ -419,7 +456,7 @@ Sub FillVirtues (ch As CharacterType, values() As Integer)
Next Next
End Sub End Sub
Function GetFreebiePoints(ch as CharacterType) Function GetFreebiePoints(ch As CharacterType)
GetFreebiePoints = ch.freebiePoints GetFreebiePoints = ch.freebiePoints
End Function End Function
@@ -929,3 +966,33 @@ Sub FillDerangements (ch As CharacterType, myDerangements() As DerangementType)
ReDim myDerangements(count) As DerangementType ReDim myDerangements(count) As DerangementType
myDerangements(0) = Derangements(ch.derangementId) myDerangements(0) = Derangements(ch.derangementId)
End Sub End Sub
' Roads
function GetRoadName$(ch as charactertype)
getroadname = ch.roadName
end function
sub SetRoadName(ch as charactertype, roadName as string)
ch.roadname = roadname
end sub
function GetRoadValue(ch as charactertype)
getroadvalue = ch.roadValue
end function
sub SetRoadValue(ch as charactertype, roadValue as integer)
ch.roadvalue = roadvalue
end sub
' Freebies
sub NewFreebie (freebie As FreebieType, id As integer, cost As integer, freebieName As string, freebieLabel As string)
freebie.id = id
freebie.cost = cost
freebie.name = freebieName
freebie.label = freebieLabel
end sub
' Scalars
function GetGeneration(ch as charactertype)
getgeneration = ch.generation
end function

View File

@@ -17,5 +17,9 @@ Const COLOR_BRIGHT_ORANGE = 14
Const COLOR_BRIGHT_YELLOW = 14 Const COLOR_BRIGHT_YELLOW = 14
Const COLOR_BRIGHT_WHITE = 15 Const COLOR_BRIGHT_WHITE = 15
Const COLOR_FOREGROUND_DEFAULT = COLOR_DARK_WHITE
Const COLOR_BACKGROUND_DEFAULT = COLOR_DARK_BLACK
Dim Shared ScreenColor As Integer Dim Shared ScreenColor As Integer
ScreenColor = COLOR_DARK_WHITE ScreenColor = COLOR_FOREGROUND_DEFAULT

View File

@@ -7,3 +7,14 @@ Function GetColor ()
GetColor = ScreenColor GetColor = ScreenColor
End Function End Function
Sub PrintWithMaybeColor (message As String, textColor As Integer, useColors As Integer)
Dim oldColor As Integer
If useColors = TRUE Then
oldColor = GetColor
SetColor (textColor)
End If
Print message
If useColors = TRUE Then
SetColor (oldColor)
End If
End Sub

View File

@@ -5,10 +5,15 @@ Type MenuStyle
screenWidth As Integer screenWidth As Integer
randomItemName As String randomItemName As String
randomItemId As Integer randomItemId As Integer
randomItemColor as integer
cancelItemName As String
cancelItemId As Integer
cancelItemColor as integer
idLabelSeparator As String idLabelSeparator As String
labelValueSeparator As String labelValueSeparator As String
menuItemSpacer As String menuItemSpacer As String
showRandom As Integer showRandom As Integer
showCancel as integer
useColors As Integer useColors As Integer
End Type End Type
@@ -18,4 +23,5 @@ Type MenuItem
value As Integer value As Integer
color As Integer color As Integer
isVisible As Integer isVisible As Integer
includeInRandom as integer
End Type End Type

View File

@@ -2,7 +2,7 @@ Function GetRandomMenuItemId (items() As MenuItem, count As Integer)
numVisibleItems = 0 numVisibleItems = 0
Dim visibleItems(count) As Integer Dim visibleItems(count) As Integer
For i = 1 To count For i = 1 To count
If items(i).isVisible Then If items(i).isVisible and items(i).includeinrandom Then
visibleItems(numVisibleItems) = i visibleItems(numVisibleItems) = i
numVisibleItems = numVisibleItems + 1 numVisibleItems = numVisibleItems + 1
End If End If
@@ -52,9 +52,13 @@ Sub AdjustMenuStyle (style As MenuStyle, items() As MenuItem, count As Integer,
End If End If
Next Next
If style.showRandom Then If style.showRandom Then
maxIdWidth = MaxI(maxIdWidth, Len("0")) maxIdWidth = MaxI(maxIdWidth, Len(itos$(style.randomItemId)))
maxItemWidth = MaxI(maxItemWidth, Len(style.randomItemName)) maxItemWidth = MaxI(maxItemWidth, Len(style.randomItemName))
End If End If
If style.showCancel Then
maxIdWidth = MaxI(maxIdWidth, Len(itos$(style.cancelItemId)))
maxItemWidth = MaxI(maxItemWidth, Len(style.cancelItemName))
End If
style.idWidth = maxIdWidth style.idWidth = maxIdWidth
style.labelWidth = maxItemWidth style.labelWidth = maxItemWidth
If Not ignoreValue Then style.valueWidth = maxValueWidth Else style.valueWidth = 0 If Not ignoreValue Then style.valueWidth = maxValueWidth Else style.valueWidth = 0
@@ -62,22 +66,26 @@ End Sub
Sub PrintMenu (items() As MenuItem, count As Integer, style As MenuStyle) Sub PrintMenu (items() As MenuItem, count As Integer, style As MenuStyle)
Dim randomItem As MenuItem Dim randomItem As MenuItem
Call NewMenuItem(randomItem, style.randomItemName, style.randomItemId) Call NewMenuItemWithColor(randomItem, style.randomItemName, style.randomItemColor, style.randomItemId)
If count <= 10 Then Dim cancelItem As MenuItem
Call NewMenuItemWithColor(cancelItem, style.cancelItemName, style.cancelItemColor, style.cancelItemId)
actualCount = count
If style.showCancel = TRUE Then actualCount = actualCount + 1
If style.showRandom = TRUE Then actualCount = actualCount + 1
If actualCount <= 10 Then
For i = 1 To count For i = 1 To count
If items(i).isVisible Then If items(i).isVisible Then
If style.useColors Then title$ = GetTitle$(items(i), style)
oldColor = GetColor Call PrintWithMaybeColor(title$, items(i).color, style.useColors)
SetColor (items(i).color)
End If
Print GetTitle$(items(i), style)
If style.useColors Then
Call SetColor(oldColor)
End If
End If End If
Next Next
If style.showCancel Then
cancelLabel$ = GetTitleWithoutValue$(cancelItem, style)
Call PrintWithMaybeColor(cancelLabel$, cancelItem.color, style.useColors)
End If
If style.showRandom Then If style.showRandom Then
Print GetTitleWithoutValue$(randomItem, style) randomLabel$ = GetTitleWithoutValue$(randomItem, style)
Call PrintWithMaybeColor(randomLabel$, randomItem.color, style.useColors)
End If End If
Else Else
Dim emptyItem As MenuItem Dim emptyItem As MenuItem
@@ -96,13 +104,19 @@ Sub PrintMenu (items() As MenuItem, count As Integer, style As MenuStyle)
itemText$ = MakeFitL$(RTrim$(itemText$) + style.menuItemSpacer, textLength + Len(style.menuItemSpacer), " ") itemText$ = MakeFitL$(RTrim$(itemText$) + style.menuItemSpacer, textLength + Len(style.menuItemSpacer), " ")
End If End If
End If End If
Print MakeFitC$(itemText$, columnWidth, " "); label$ = MakeFitC$(itemText$, columnWidth, " ")
Call PrintWithMaybeColor(label$, items(i).color, style.useColors)
End If End If
column = (column + 1) Mod itemsPerRow column = (column + 1) Mod itemsPerRow
If column = 0 Then Print "" If column = 0 Then Print ""
Next Next
If style.showCancel Then
cancelLabel$ = MakeFitC$(GetTitleWithoutValue$(cancelItem, style), columnWidth, " ")
Call PrintWithMaybeColor(cancelLabel$, cancelItem.color, style.useColors)
End If
If style.showRandom Then If style.showRandom Then
Print MakeFitC$(GetTitleWithoutValue$(randomItem, style), columnWidth, " ") randomLabel$ = MakeFitC$(GetTitleWithoutValue$(randomItem, style), columnWidth, " ")
Call PrintWithMaybeColor(randomLabel$, randomItem.color, style.useColors)
End If End If
End If End If
End Sub End Sub
@@ -116,7 +130,7 @@ Function GetTitle$ (mi As MenuItem, ms As MenuStyle)
End Function End Function
Function GetTitleWithoutValue$ (mi As MenuItem, ms As MenuStyle) Function GetTitleWithoutValue$ (mi As MenuItem, ms As MenuStyle)
GetTitleWithoutValue$ = MakeFitR$(itos(mi.id), ms.idWidth, " ") + ms.idLabelSeparator + MakeFitL$(mi.label, ms.labelWidth + ms.valueWidth + Len(ms.labelValueSeparator), " ") GetTitleWithoutValue$ = MakeFitR$(itos$(mi.id), ms.idWidth, " ") + ms.idLabelSeparator + MakeFitL$(mi.label, ms.labelWidth + ms.valueWidth + Len(ms.labelValueSeparator), " ")
End Function End Function
Sub NewMenuStyle (ms As MenuStyle) Sub NewMenuStyle (ms As MenuStyle)
@@ -126,10 +140,15 @@ Sub NewMenuStyle (ms As MenuStyle)
ms.screenWidth = 80 ms.screenWidth = 80
ms.randomItemName = "Random" ms.randomItemName = "Random"
ms.randomItemId = 0 ms.randomItemId = 0
ms.randomItemColor = COLOR_FOREGROUND_DEFAULT
ms.cancelItemName = "Cancel"
ms.cancelItemId = -1
ms.cancelItemColor = COLOR_FOREGROUND_DEFAULT
ms.idLabelSeparator = " = " ms.idLabelSeparator = " = "
ms.labelValueSeparator = ": " ms.labelValueSeparator = ": "
ms.menuItemSpacer = ", " ms.menuItemSpacer = ", "
ms.showRandom = TRUE ms.showRandom = TRUE
ms.showCancel = false
ms.useColors = FALSE ms.useColors = FALSE
End Sub End Sub
@@ -139,6 +158,7 @@ Sub NewMenuItem (mi As MenuItem, label As String, id As Integer)
mi.value = 0 mi.value = 0
mi.color = COLOR_DEFAULT mi.color = COLOR_DEFAULT
mi.isVisible = TRUE mi.isVisible = TRUE
mi.includeInRandom = true
End Sub End Sub
Sub NewMenuItemWithValue (mi As MenuItem, label As String, id As Integer, value As Integer) Sub NewMenuItemWithValue (mi As MenuItem, label As String, id As Integer, value As Integer)
@@ -147,6 +167,7 @@ Sub NewMenuItemWithValue (mi As MenuItem, label As String, id As Integer, value
mi.value = value mi.value = value
mi.color = COLOR_DEFAULT mi.color = COLOR_DEFAULT
mi.isVisible = TRUE mi.isVisible = TRUE
mi.includeInRandom = true
End Sub End Sub
Sub NewMenuItemWithColor (mi As MenuItem, label As String, textColor As Integer, id As Integer) Sub NewMenuItemWithColor (mi As MenuItem, label As String, textColor As Integer, id As Integer)

View File

@@ -4,6 +4,7 @@ Randomize Timer
Const FALSE = 0 Const FALSE = 0
Const TRUE = Not FALSE Const TRUE = Not FALSE
Const isDebugging = TRUE
Const INITIAL_GENERATION = 13 Const INITIAL_GENERATION = 13
@@ -84,7 +85,8 @@ End Sub
Sub SplashScreen Sub SplashScreen
' Splash screen ' Splash screen
MaybeCls ' " " MaybeCls
' " "
Print "Welcome to Tom's Storyteller's Best Friend. This is a program that is meant to" Print "Welcome to Tom's Storyteller's Best Friend. This is a program that is meant to"
Print "aid storytellers in running Vampire: the Masquerade Chronicles and Vampire: the" Print "aid storytellers in running Vampire: the Masquerade Chronicles and Vampire: the"
Print "Dark Ages Chronicles. This program could aid in running campaigns for other" Print "Dark Ages Chronicles. This program could aid in running campaigns for other"
@@ -183,6 +185,7 @@ Function GetMenuChoice (items() As MenuItem, style As MenuStyle, count As Intege
Do Do
Input choice Input choice
If style.showRandom And choice = style.randomItemId Then acceptChoice = TRUE If style.showRandom And choice = style.randomItemId Then acceptChoice = TRUE
If style.showCancel And choice = style.cancelItemId Then acceptChoice = TRUE
For i = 1 To count For i = 1 To count
If choice = items(i).id And items(i).isVisible Then If choice = items(i).id And items(i).isVisible Then
acceptChoice = TRUE acceptChoice = TRUE
@@ -229,21 +232,6 @@ Function ChooseStringIdWithValues (labels() As String, values() As Integer, styl
ChooseStringIdWithValues = choice ChooseStringIdWithValues = choice
End Function End Function
Function ChooseStringIdWithValuesAndCancel (labels() As String, values() As Integer, style As MenuStyle, count As Integer, prompt As String)
MaybeCls
Dim mnuItems(1 To count + 1) As MenuItem
Call BuildMenuWithValues(mnuItems(), labels(), values(), count)
Dim cancelMenuItem As MenuItem
Call NewMenuItemWithValue(cancelMenuItem, "Cancel", count + 1, -1)
mnuItems(count + 1) = cancelMenuItem
Call AdjustMenuStyle(style, mnuItems(), count, FALSE)
Print prompt
Call PrintMenu(mnuItems(), count, style)
choice = GetMenuChoice(mnuItems(), style, count)
If choice = style.randomItemId Then choice = GetRandomMenuItemId(mnuItems(), count - 1)
ChooseStringIdWithValuesAndCancel = choice
End Function
Function ChooseStringIdWithColors (labels() As String, colors() As Integer, style As MenuStyle, prompt As String) Function ChooseStringIdWithColors (labels() As String, colors() As Integer, style As MenuStyle, prompt As String)
MaybeCls MaybeCls
' Check array bounds ' Check array bounds
@@ -294,7 +282,7 @@ Sub CGGetDisciplines (ch As CharacterType)
Dim ms As MenuStyle Dim ms As MenuStyle
Call NewMenuStyle(ms) Call NewMenuStyle(ms)
disciplinePoints = GetDisciplinePoints disciplinePoints = GetDisciplinePoints
Dim disciplineValues(DISCIPLINES_COUNT) As Integer Dim disciplineValues(1 To DISCIPLINES_COUNT) As Integer
While disciplinePoints > 0 While disciplinePoints > 0
MaybeCls MaybeCls
Call FillDisciplines(ch, disciplineValues()) Call FillDisciplines(ch, disciplineValues())
@@ -401,7 +389,7 @@ Sub CGGetBackgrounds (ch As CharacterType)
Dim ms As MenuStyle Dim ms As MenuStyle
Call NewMenuStyle(ms) Call NewMenuStyle(ms)
backgroundPoints = GetBackgroundPoints backgroundPoints = GetBackgroundPoints
Dim backgroundValues(BACKGROUNDS_COUNT) As Integer Dim backgroundValues(1 To BACKGROUNDS_COUNT) As Integer
While backgroundPoints > 0 While backgroundPoints > 0
MaybeCls MaybeCls
Call FillBackgrounds(ch, backgroundValues()) Call FillBackgrounds(ch, backgroundValues())
@@ -425,7 +413,6 @@ Sub CGSpendVirtuePoints (ch As CharacterType)
While virtuePoints > 0 While virtuePoints > 0
Call FillVirtues(ch, values()) 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?") 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) Call SetVirtue(ch, virtue, GetVirtue(ch, virtue) + 1)
virtuePoints = virtuePoints - 1 virtuePoints = virtuePoints - 1
Wend Wend
@@ -439,7 +426,6 @@ Sub CGGetDerangement (ch As CharacterType)
ms.useColors = TRUE ms.useColors = TRUE
ch.derangementId = ChooseStringIdWithColors(DerangementLabels(), DerangementColors(), ms, "Which derangement do you want?") ch.derangementId = ChooseStringIdWithColors(DerangementLabels(), DerangementColors(), ms, "Which derangement do you want?")
If ch.derangementId = 0 Then ch.derangementId = GetRandomInt(1, DERANGEMENTS_COUNT)
End If End If
End Sub End Sub
@@ -447,71 +433,55 @@ Sub CGSpendFreebiePoints (ch As CharacterType)
freebiePoints = GetFreebiePoints(ch) freebiePoints = GetFreebiePoints(ch)
Dim ms As MenuStyle Dim ms As MenuStyle
Call NewMenuStyle(ms) Call NewMenuStyle(ms)
Dim labels(1 To 7) As String
Dim menuItemIds(1 To 7) As Integer
' TODO: Find a better way to handle these menuItemIds mabye a new Choose* function and some constants
While (freebiePoints > 0) While (freebiePoints > 0)
MaybeCls MaybeCls
Print "freebiePoints = "; itos$(freebiePoints) Call MaybePrint("freebiePoints = " + itos$(freebiePoints))
' Build the menu ' Build the menu
numMenuItems = 0 ReDim availableFreebies(1 To FREEBIES_COUNT) As FreebieType
If freebiePoints >= FREEBIE_POINT_COST_DISCIPLINE Then numAvailableFreebies = 0
numMenuItems = numMenuItems + 1 For index = 1 To FREEBIES_COUNT
menuItemIds(numMenuItems) = 1 If Freebies(index).cost <= freebiePoints Then
labels(numMenuItems) = "Add a discipline dot 7 points" numAvailableFreebies = numAvailableFreebies + 1
availableFreebies(numAvailableFreebies) = Freebies(index)
End If End If
If freebiePoints >= FREEBIE_POINT_COST_ATTRIBUTE Then Next
numMenuItems = numMenuItems + 1
menuItemIds(numMenuItems) = 2 ReDim menuItems(1 To numAvailableFreebies) As MenuItem
labels(numMenuItems) = "Add an attribute dot 5 points" For index = 1 To numAvailableFreebies
End If Dim mi As MenuItem
If freebiePoints >= FREEBIE_POINT_COST_ability Then Call NewMenuItem(mi, availableFreebies(index).label, availableFreebies(index).id)
numMenuItems = numMenuItems + 1 If index = FREEBIE_SHOW_CHARACTER_SHEET_ID Then mi.includeInRandom = FALSE
menuItemIds(numMenuItems) = 3 menuItems(index) = mi
labels(numMenuItems) = "Add an ability dot 2 points" Next
End If
If freebiePoints >= FREEBIE_POINT_COST_VIRTUE Then
numMenuItems = numMenuItems + 1
menuItemIds(numMenuItems) = 4
labels(numMenuItems) = "Add a virtue dot 2 points"
End If
If freebiePoints >= FREEBIE_POINT_COST_HUMANITY Then
' TODO: Make this configurable for VtDA
numMenuItems = numMenuItems + 1
menuItemIds(numMenuItems) = 5
labels(numMenuItems) = "Add a humanity dot 1 point"
End If
If freebiePoints >= FREEBIE_POINT_COST_BACKGROUND Then
numMenuItems = numMenuItems + 1
menuItemIds(numMenuItems) = 6
labels(numMenuItems) = "Add a background dot 1 point"
End If
' TODO: Exclude this option from the randomized Ids. Maybe use a different Choose* function or just do it here.
numMenuItems = numMenuItems + 1
menuItemIds(numMenuItems) = 7
labels(numMenuItems) = "Show character sheet"
prompt$ = "You have " + itos$(freebiePoints) + " freebie points remaining what would you like to spend the points on?" prompt$ = "You have " + itos$(freebiePoints) + " freebie points remaining what would you like to spend the points on?"
id = ChooseStringId(labels(), ms, numMenuItems, prompt$) id = ChooseMenuItemId(menuItems(), ms, numAvailableFreebies, prompt$, TRUE)
Select Case menuItemIds(id) Select Case id
Case 1 Case FREEBIE_DISCIPLINE_ID
Call CGSpendDisciplinePoint(ch) Call CGSpendDisciplinePoint(ch)
Case 2 Case FREEBIE_ATTRIBUTE_ID
Call CGSpendAttributePoint(ch) Call CGSpendAttributePoint(ch)
Case 3 Case FREEBIE_ABILITY_ID
Call CGSpendAbilityPoint(ch) Call CGSpendAbilityPoint(ch)
Case 4 Case FREEBIE_VIRTUE_ID
Call CGSpendVirtuePoint(ch) Call CGSpendVirtuePoint(ch)
Case 5 Case FREEBIE_HUMANITY_ID
Call CGSpendHumanityPoint(ch) Call CGSpendHumanityPoint(ch)
Case 6 Case FREEBIE_BACKGROUND_ID
Call CGSpendBackgroundPoint(ch) Call CGSpendBackgroundPoint(ch)
Case 7 Case FREEBIE_SHOW_CHARACTER_SHEET_ID
Call ShowCharacterSheet(ch) Call ShowCharacterSheet(ch)
End Select End Select
freebiePoints = GetFreebiePoints(ch) freebiePoints = GetFreebiePoints(ch)
Call MaybePrint("Auspex: " + itos$(GetDiscipline(ch, DISCIPLINE_AUSPEX)))
Call MaybePrint("Strength: " + itos$(GetAttributeValue(ch, ATTRIBUTE_GROUP_PHYSICAL, ATTRIBUTE_STRENGTH)))
Call MaybePrint("Acting: " + itos$(GetAbilityValue(ch, ABILITY_TALENTS_ID, TALENT_ACTING)))
Call MaybePrint("Conscience: " + itos$(GetVirtue(ch, VIRTUE_CONSCIENCE)))
Call MaybePrint("Humanity: " + itos$(GetRoadValue(ch)))
Call MaybePrint("Generation (Background): " + itos$(GetBackground(ch, BACKGROUND_GENERATION)))
Call MaybePrint("Generation: " + itos$(GetGeneration(ch)))
Wend Wend
End Sub End Sub
@@ -519,50 +489,52 @@ Sub CGSpendDisciplinePoint (ch As CharacterType)
MaybeCls MaybeCls
Dim ms As MenuStyle Dim ms As MenuStyle
Call NewMenuStyle(ms) Call NewMenuStyle(ms)
Dim disciplineValues(DISCIPLINES_COUNT) As Integer ms.showCancel = TRUE
ms.cancelItemId = DISCIPLINES_COUNT + 1
Dim disciplineValues(1 To DISCIPLINES_COUNT) As Integer
Call FillDisciplines(ch, disciplineValues()) Call FillDisciplines(ch, disciplineValues())
discipline = ChooseStringIdWithValuesAndCancel(Disciplines(), disciplineValues(), ms, DISCIPLINES_COUNT, "Which discipline do you want to spend 1 of your " + itos$(disciplinePoints) + " points on?") prompt$ = "Which discipline do you want to spend 1 of your " + itos$(disciplinePoints) + " points on?"
If discipline > 0 Then id = ChooseStringIdWithValues(Disciplines(), disciplineValues(), ms, DISCIPLINES_COUNT, prompt$)
Call SetDiscipline(ch, discipline, GetDiscipline(ch, discipline) + 1) If id <> ms.cancelItemId Then
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - 7) Call SetDiscipline(ch, id, GetDiscipline(ch, id) + 1)
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - FREEBIE_DISCIPLINE_COST)
End If End If
End Sub End Sub
Type AttributeReference Type GroupedStatReference
id As Integer id As Integer
groupIndex As Integer groupIndex As Integer
attributeIndex As Integer itemIndex As Integer
End Type End Type
Sub NewGroupedStatReference (ref As GroupedStatReference, id As Integer, groupIndex As Integer, itemIndex As Integer)
ref.id = id
ref.groupIndex = groupIndex
ref.itemIndex = itemIndex
End Sub
Sub CGSpendAttributePoint (ch As CharacterType) Sub CGSpendAttributePoint (ch As CharacterType)
MaybeCls MaybeCls
'TODO: Paragraph Dim ms As MenuStyle
'Choose an attribute maybe choose a group then choose an attribute, but try to only have the one choice.
'Allow cancel
'If an attribute was chosen then add that attribute point to ch and subtract 5 freebie points from ch
Print "TODO: Fill in CGSpendAttributePoint"
Dim ms As MenuStyle ' With values
Call NewMenuStyle(ms) Call NewMenuStyle(ms)
ms.showCancel = TRUE
numAttributes = 0 numAttributes = 0
Dim numAttributesInGroup(1 To ABILITY_GROUPS_COUNT) As Integer Dim numAttributesInGroup(1 To ATTRIBUTE_GROUPS_COUNT) As Integer
For attributeGroupIndex = 1 To ABILITY_GROUPS_COUNT For attributeGroupIndex = 1 To ATTRIBUTE_GROUPS_COUNT
numAttributesInGroup(attributeGroupIndex) = GetNumAttributesInGroup(attributeGroupIndex) numAttributesInGroup(attributeGroupIndex) = GetNumAttributesInGroup(attributeGroupIndex)
numAttributes = numAttributes + numAttributesInGroup(attributeGroupIndex) numAttributes = numAttributes + numAttributesInGroup(attributeGroupIndex)
Next Next
Dim attributes(numAttributes) As AttributeReference Dim attributes(1 To numAttributes) As GroupedStatReference
Dim labels(numAttributes) As String Dim labels(1 To numAttributes) As String
Dim values(numAttributes) As Integer Dim values(1 To numAttributes) As Integer
attributeIndex = 1 attributeIndex = 1
For attributeGroupIndex = 1 To ABILITY_GROUPS_COUNT For attributeGroupIndex = 1 To ATTRIBUTE_GROUPS_COUNT
For index = 1 To numAttributesInGroup(attributeGroupIndex) For index = 1 To numAttributesInGroup(attributeGroupIndex)
Dim attribute As AttributeReference Dim attribute As GroupedStatReference
attribute.id = attributeIndex Call NewGroupedStatReference(attribute, attributeIndex, attributeGroupIndex, index)
attribute.groupIndex = attributeGroupIndex
attribute.attributeIndex = index
attributes(attributeIndex) = attribute attributes(attributeIndex) = attribute
labels(attributeIndex) = GetAttributeName$(attributeGroupIndex, index) labels(attributeIndex) = GetAttributeName$(attributeGroupIndex, index)
values(attributeIndex) = GetAttributeValue(ch, attributeGroupIndex, index) values(attributeIndex) = GetAttributeValue(ch, attributeGroupIndex, index)
@@ -570,43 +542,87 @@ Sub CGSpendAttributePoint (ch As CharacterType)
Next Next
Next Next
attributeIndex = ChooseStringIdWithValuesAndCancel(labels(), values(), ms, numAttributes, "Which attribute do you want to add one dot to?") ' TODO: Make this show values.
If attributeIndex > 0 Then prompt$ = "Which attribute do you want to add one dot to?"
Dim attr As AttributeReference ms.cancelItemId = numAttributes + 1
attr = attributes(attributeIndex) id = ChooseStringIdWithValues(labels(), values(), ms, numAttributes, prompt$)
Call SetAttributeValue(ch, attr.groupIndex, attr.attributeIndex, GetAttributeValue(ch, at.groupindex, at.attributeindex) + 1) If id <> ms.cancelItemId Then
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - 5) Dim attr As GroupedStatReference
attr = attributes(id)
Call SetAttributeValue(ch, attr.groupIndex, attr.itemIndex, GetAttributeValue(ch, attr.groupIndex, attr.itemIndex) + 1)
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - FREEBIE_ATTRIBUTE_COST)
End If End If
End Sub End Sub
Sub CGSpendAbilityPoint (ch As CharacterType) Sub CGSpendAbilityPoint (ch As CharacterType)
'TODO: Paragraph Dim ms As MenuStyle
'Choose an abililty group; Allow cancel Call NewMenuStyle(ms)
'Choose an ability; Allow cancel ms.showCancel = TRUE
'If an ability was chosen then add that ability point to ch and subtract 2 freebie points done = FALSE
Print "TODO: Fill in CGSpendAbilityPoint" While Not done
End Sub MaybeCls
Sub CGSpendVirtuePoint (ch As CharacterType) ms.cancelItemId = ABILITY_GROUPS_COUNT + 1
'TODO: Paragraph abilityGroupIndex = ChooseStringId(AbilityGroups(), ms, ABILITY_GROUPS_COUNT, "What kind of ability would you like to add 1 dot to?")
'Choose a virtue; Allow cancel If abilityGroupIndex = ms.cancelItemId Then Exit Sub
'If a virtue was chosen that add that virtue point to ch and subtract 2 freebie points.
Print "TODO: Fill in CGSpendVirtuePoint" numAbilities = GetNumItemsForAbilityGroup(abilityGroupIndex)
End Sub Dim labels(1 To numAbilities) As String
Sub CGSpendHumanityPoint (ch As CharacterType) Call FillAbilitiesForAbilityGroup(abilityGroupIndex, labels())
'TODO: Paragraph ms.cancelItemId = numAbilities + 1
'Confirm they want to add the point abilityIndex = ChooseStringId(labels(), ms, numAbilities, "What ability would you like to add 1 dot to?")
'If they say yes then add the humanity point to ch and subtract 1 freebie point. If abilityIndex <> ms.cancelItemId Then
Print "TODO: Fill in CGSpendHumanityPoint" Call SetAbilityValue(ch, abilityGroupIndex, abilityIndex, GetAbilityValue(ch, abilityGroupIndex, abilityIndex) + 1)
End Sub Call SetFreebiePoints(ch, GetFreebiePoints(ch) - FREEBIE_ABILITY_COST)
Sub CGSpendBackgroundPoint (ch As CharacterType) done = TRUE
'TODO: Paragraph End If
'Choose a background; Allow cancel Wend
'If they chose a background then add the background and subtract 1 freebie point. End Sub
Print "TODO: Fill in CGSpendBackgroundPoint"
Sub CGSpendVirtuePoint (ch As CharacterType)
Dim ms As MenuStyle
Call NewMenuStyle(ms)
ms.showCancel = TRUE
ms.cancelItemId = VIRTUES_COUNT + 1
prompt$ = "What virtue would you like to add 1 dot to?"
id = ChooseStringId(Virtues(), ms, VIRTUES_COUNT, prompt$)
If id <> ms.cancelItemId Then
Call SetVirtue(ch, id, GetVirtue(ch, id) + 1)
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - FREEBIE_ABILITY_COST)
End If
End Sub
Sub CGSpendHumanityPoint (ch As CharacterType)
numLabels = 2
Dim labels(1 To numLabels) As String
labels(1) = "Yes"
labels(2) = "No"
Dim ms As MenuStyle
Call NewMenuStyle(ms)
ms.showRandom = FALSE
prompt$ = "Are you sure you want to add a dot to " + GetRoadName$(ch) + "?"
id = ChooseStringId(labels(), ms, numLabels, prompt$)
If id = 1 Then
Call SetRoadValue(ch, GetRoadValue(ch) + 1)
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - FREEBIE_HUMANITY_COST)
End If
End Sub
Sub CGSpendBackgroundPoint (ch As CharacterType)
Dim ms As MenuStyle
Call NewMenuStyle(ms)
ms.showCancel = TRUE
ms.cancelItemId = BACKGROUNDS_COUNT + 1
prompt$ = "Which background would you like to add 1 dot to?"
id = ChooseStringId(Backgrounds(), ms, BACKGROUNDS_COUNT, prompt$)
If id <> ms.cancelItemId Then
Call SetBackground(ch, id, GetBackground(ch, id) + 1)
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - FREEBIE_BACKGROUND_COST)
End If
End Sub End Sub
' Ignore this warning ch is not used yet because the sub is not implemented yet.
Sub SaveCharacterSheet (ch As CharacterType) Sub SaveCharacterSheet (ch As CharacterType)
Call MaybePrint("TODO: Fill in SaveCharacterSheet")
Call MaybePrint(ch.name)
' Where do you want the file to be saved? (default is C:\Windows\Desktop)? ' Where do you want the file to be saved? (default is C:\Windows\Desktop)?
' What do you want the file to be called? (default is CHAR1)? ' What do you want the file to be called? (default is CHAR1)?
@@ -619,7 +635,7 @@ Sub SaveCharacterSheet (ch As CharacterType)
'| Physical Social Mental | Haven: kkkkkk | '| Physical Social Mental | Haven: kkkkkk |
'| Str. 5 App. 2 Int. 1 | Concept: llllll | '| Str. 5 App. 2 Int. 1 | Concept: llllll |
'| Dex. 3 Cha. 2 Per. 1 |---------------------------------------| '| Dex. 3 Cha. 2 Per. 1 |---------------------------------------|
'| Sta. 2 Man. 4 Wit. 4 | Derangements: | '| Sta. 2 Man. 4 Wit. 4 | Derangementss: |
'|--------------------------------------| _____________________________________ | '|--------------------------------------| _____________________________________ |
'| Disciplines: | _____________________________________ | '| Disciplines: | _____________________________________ |
'| Obtenebration | _____________________________________ | '| Obtenebration | _____________________________________ |
@@ -767,10 +783,10 @@ Sub CharacterGenerator ()
End Sub End Sub
Sub ShowCharacterSheet (ch As CharacterType) Sub ShowCharacterSheet (ch As CharacterType)
Dim disciplineValues(DISCIPLINES_COUNT) As Integer Dim disciplineValues(1 To DISCIPLINES_COUNT) As Integer
Call FillDisciplines(ch, disciplineValues()) Call FillDisciplines(ch, disciplineValues())
Dim backgroundValues(BACKGROUNDS_COUNT) As Integer Dim backgroundValues(1 To BACKGROUNDS_COUNT) As Integer
Call FillBackgrounds(ch, backgroundValues()) Call FillBackgrounds(ch, backgroundValues())
'... 0123456789 '... 0123456789
@@ -861,34 +877,34 @@ End Sub
' Simpler character generator with fewer questions and more things done randomly without asking. ' Simpler character generator with fewer questions and more things done randomly without asking.
Sub CharacterGeneratorForDummies Sub CharacterGeneratorForDummies
Print "CharacterGeneratorForDummies" Call MaybePrint("CharacterGeneratorForDummies")
End Sub End Sub
' Maybe just remove this. It's kinda pointless. It asks some questions and calculates a contested roll. ' Maybe just remove this. It's kinda pointless. It asks some questions and calculates a contested roll.
' C1 dice pool, C1 difficulty, C2 dice pool, C2 difficulty, then rolls all the dice and does the math. ' C1 dice pool, C1 difficulty, C2 dice pool, C2 difficulty, then rolls all the dice and does the math.
' In practice it's just slower than rolling the dice ' In practice it's just slower than rolling the dice
Sub CombatComputer Sub CombatComputer
Print "CombatComputer" Call MaybePrint("CombatComputer")
End Sub End Sub
' Asks for a number of dice and a difficulty. Rolls the dice, calculates botches and successes. ' Asks for a number of dice and a difficulty. Rolls the dice, calculates botches and successes.
Sub DiceRoller Sub DiceRoller
Print "DiceRoller" Call MaybePrint("DiceRoller")
End Sub End Sub
' Like the character generator if you choose random for everything. Should do random names/ages too, but doesn't yet. ' Like the character generator if you choose random for everything. Should do random names/ages too, but doesn't yet.
Sub RandomCharacterGenerator Sub RandomCharacterGenerator
Print "RandomCharacterGenerator" Call MaybePrint("RandomCharacterGenerator")
End Sub End Sub
' This had a function at one point but got taken out. Will only come back if the disassembly can figure it out. ' This had a function at one point but got taken out. Will only come back if the disassembly can figure it out.
Sub Choice6 Sub Choice6
Print "Unnamed choice 6" Call MaybePrint("Unnamed choice 6")
End Sub End Sub
' Like the character generator but for vehicles. Much simpler with fewer questions. Prints a vehicle sheet when done. Never finished and crashes mid way through currently. ' Like the character generator but for vehicles. Much simpler with fewer questions. Prints a vehicle sheet when done. Never finished and crashes mid way through currently.
Sub VehicleGenerator Sub VehicleGenerator
Print "VehicleGenerator" Call MaybePrint("VehicleGenerator")
End Sub End Sub
Sub PressAnyKeyToContinue () Sub PressAnyKeyToContinue ()
@@ -1004,6 +1020,10 @@ Sub MaybeCls ()
If Not isDebugging Then Cls If Not isDebugging Then Cls
End Sub End Sub
Sub MaybePrint (message As String)
If isDebugging Then Print message
End Sub
'$include: 'colors.bm' '$include: 'colors.bm'
'$include: 'menus.bm' '$include: 'menus.bm'
'$include: 'character.bm' '$include: 'character.bm'