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:
27
dos/qb64/Supported Encodings.md
Normal file
27
dos/qb64/Supported Encodings.md
Normal 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
|
||||
@@ -197,6 +197,17 @@ Const DERANGEMENT_ID_PARANOIA = 8
|
||||
Const DERANGEMENT_ID_PERFECTION = 9
|
||||
Const DERANGEMENT_ID_REGRESSION = 10
|
||||
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 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_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 FREEBIE_POINT_COST_ATTRIBUTE = 5
|
||||
Const FREEBIE_POINT_COST_ABIILTY = 2
|
||||
Const FREEBIE_POINT_COST_VIRTUE = 2
|
||||
Const FREEBIE_POINT_COST_HUMANITY = 1
|
||||
Const FREEBIE_POINT_COST_BACKGROUND = 1
|
||||
Const FREEBIES_COUNT = 7
|
||||
Dim Shared FreebieCosts(1 To FREEBIES_COUNT) As Integer
|
||||
Dim Shared FreebieLabels(1 To FREEBIES_COUNT) As String
|
||||
Dim Shared FreebieNames(1 to FREEBIES_COUNT) As String
|
||||
Dim Shared Freebies(1 To FREEBIES_COUNT) As FreebieType
|
||||
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
|
||||
name As String
|
||||
@@ -338,3 +383,10 @@ Type DerangementType
|
||||
description As String
|
||||
textColor As Integer
|
||||
End Type
|
||||
|
||||
Type FreebieType
|
||||
id As Integer
|
||||
cost As Integer
|
||||
name As String * 32
|
||||
label As String * 32
|
||||
End Type
|
||||
|
||||
@@ -176,16 +176,17 @@ Sub Initialize_Character_Lib
|
||||
Genders(GENDER_TRANS_FEMALE) = "Trans-Female"
|
||||
Genders(GENDER_NON_BINARY) = "Non-Binary"
|
||||
|
||||
DerangementColors(DERANGEMENT_ID_AMNESIA) = COLOR_DARK_RED
|
||||
DerangementColors(DERANGEMENT_ID_DELUSIONS_OF_GRANDEUR) = COLOR_DARK_MAGENTA
|
||||
DerangementColors(DERANGEMENT_ID_FANTASY) = COLOR_DARK_ORANGE
|
||||
DerangementColors(DERANGEMENT_ID_MANIC_DEPRESSION) = COLOR_DARK_WHITE
|
||||
DerangementColors(DERANGEMENT_ID_MULTIPLE_PERSONALITIES) = COLOR_DARK_BLUE
|
||||
DerangementColors(DERANGEMENT_ID_OBSESSION) = COLOR_BRIGHT_GREEN
|
||||
DerangementColors(DERANGEMENT_ID_OVERCOMPENSATION) = COLOR_BRIGHT_CYAN
|
||||
DerangementColors(DERANGEMENT_ID_PARANOIA) = COLOR_BRIGHT_RED
|
||||
DerangementColors(DERANGEMENT_ID_PERFECTION) = COLOR_BRIGHT_MAGENTA
|
||||
DerangementColors(DERANGEMENT_ID_REGRESSION) = COLOR_BRIGHT_YELLOW
|
||||
' Derangements
|
||||
DerangementColors(DERANGEMENT_ID_AMNESIA) = DERANGEMENT_COLOR_AMNESIA
|
||||
DerangementColors(DERANGEMENT_ID_DELUSIONS_OF_GRANDEUR) = DERANGEMENT_COLOR_DELUSIONS_OF_GRANDEUR
|
||||
DerangementColors(DERANGEMENT_ID_FANTASY) = DERANGEMENT_COLOR_FANTASY
|
||||
DerangementColors(DERANGEMENT_ID_MANIC_DEPRESSION) = DERANGEMENT_COLOR_MANIC_DEPRESSION
|
||||
DerangementColors(DERANGEMENT_ID_MULTIPLE_PERSONALITIES) = DERANGEMENT_COLOR_MULTIPLE_PERSONALITIES
|
||||
DerangementColors(DERANGEMENT_ID_OBSESSION) = DERANGEMENT_COLOR_OBSESSION
|
||||
DerangementColors(DERANGEMENT_ID_OVERCOMPENSATION) = DERANGEMENT_COLOR_OVERCOMPENSATION
|
||||
DerangementColors(DERANGEMENT_ID_PARANOIA) = DERANGEMENT_COLOR_PARANOIA
|
||||
DerangementColors(DERANGEMENT_ID_PERFECTION) = DERANGEMENT_COLOR_PERFECTION
|
||||
DerangementColors(DERANGEMENT_ID_REGRESSION) = DERANGEMENT_COLOR_REGRESSION
|
||||
|
||||
DerangementLabels(DERANGEMENT_ID_AMNESIA) = DERANGEMENT_LABEL_AMNESIA
|
||||
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)
|
||||
Call NewDerangement(Derangements(i), i, DerangementLabels(i), DerangementColors(i), DerangementDescriptions(i))
|
||||
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
|
||||
|
||||
' Character
|
||||
@@ -419,7 +456,7 @@ Sub FillVirtues (ch As CharacterType, values() As Integer)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Function GetFreebiePoints(ch as CharacterType)
|
||||
Function GetFreebiePoints(ch As CharacterType)
|
||||
GetFreebiePoints = ch.freebiePoints
|
||||
End Function
|
||||
|
||||
@@ -929,3 +966,33 @@ Sub FillDerangements (ch As CharacterType, myDerangements() As DerangementType)
|
||||
ReDim myDerangements(count) As DerangementType
|
||||
myDerangements(0) = Derangements(ch.derangementId)
|
||||
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
|
||||
|
||||
@@ -17,5 +17,9 @@ Const COLOR_BRIGHT_ORANGE = 14
|
||||
Const COLOR_BRIGHT_YELLOW = 14
|
||||
Const COLOR_BRIGHT_WHITE = 15
|
||||
|
||||
Const COLOR_FOREGROUND_DEFAULT = COLOR_DARK_WHITE
|
||||
Const COLOR_BACKGROUND_DEFAULT = COLOR_DARK_BLACK
|
||||
|
||||
Dim Shared ScreenColor As Integer
|
||||
ScreenColor = COLOR_DARK_WHITE
|
||||
ScreenColor = COLOR_FOREGROUND_DEFAULT
|
||||
|
||||
|
||||
@@ -1,9 +1,20 @@
|
||||
Sub SetColor (c As Integer)
|
||||
ScreenColor = c
|
||||
Color c
|
||||
End Sub
|
||||
|
||||
Function GetColor ()
|
||||
GetColor = ScreenColor
|
||||
End Function
|
||||
|
||||
Sub SetColor (c As Integer)
|
||||
ScreenColor = c
|
||||
Color c
|
||||
End Sub
|
||||
|
||||
Function GetColor ()
|
||||
GetColor = ScreenColor
|
||||
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
|
||||
|
||||
@@ -5,10 +5,15 @@ Type MenuStyle
|
||||
screenWidth As Integer
|
||||
randomItemName As String
|
||||
randomItemId As Integer
|
||||
randomItemColor as integer
|
||||
cancelItemName As String
|
||||
cancelItemId As Integer
|
||||
cancelItemColor as integer
|
||||
idLabelSeparator As String
|
||||
labelValueSeparator As String
|
||||
menuItemSpacer As String
|
||||
showRandom As Integer
|
||||
showCancel as integer
|
||||
useColors As Integer
|
||||
End Type
|
||||
|
||||
@@ -18,4 +23,5 @@ Type MenuItem
|
||||
value As Integer
|
||||
color As Integer
|
||||
isVisible As Integer
|
||||
includeInRandom as integer
|
||||
End Type
|
||||
|
||||
337
dos/sbf/menus.bm
337
dos/sbf/menus.bm
@@ -1,158 +1,179 @@
|
||||
Function GetRandomMenuItemId (items() As MenuItem, count As Integer)
|
||||
numVisibleItems = 0
|
||||
Dim visibleItems(count) As Integer
|
||||
For i = 1 To count
|
||||
If items(i).isVisible Then
|
||||
visibleItems(numVisibleItems) = i
|
||||
numVisibleItems = numVisibleItems + 1
|
||||
End If
|
||||
Next
|
||||
i = GetRandomInt(0, numVisibleItems - 1)
|
||||
GetRandomMenuItemId = visibleItems(i)
|
||||
End Function
|
||||
|
||||
Sub BuildMenu (items() As MenuItem, labels() As String, count As Integer)
|
||||
For i = 1 To count
|
||||
Dim mi As MenuItem
|
||||
Call NewMenuItem(mi, labels(i), i)
|
||||
items(i) = mi
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Sub BuildMenuWithValues (items() As MenuItem, labels() As String, values() As Integer, count As Integer)
|
||||
For i = 1 To count
|
||||
Dim mi As MenuItem
|
||||
Call NewMenuItemWithValue(mi, labels(i), i, values(i))
|
||||
items(i) = mi
|
||||
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
|
||||
|
||||
Sub AdjustMenuStyle (style As MenuStyle, items() As MenuItem, count As Integer, ignoreValue As Integer)
|
||||
maxIdWidth = 0
|
||||
maxItemWidth = 0
|
||||
maxValueWidth = 0
|
||||
|
||||
For i = 1 To count
|
||||
If items(i).isVisible Then
|
||||
maxIdWidth = MaxI(maxIdWidth, Len(itos$(items(i).id)))
|
||||
maxItemWidth = MaxI(maxItemWidth, Len(items(i).label + style.labelValueSeparator))
|
||||
maxValueWidth = MaxI(maxValueWidth, Len(itos$(items(i).value)))
|
||||
End If
|
||||
Next
|
||||
If style.showRandom Then
|
||||
maxIdWidth = MaxI(maxIdWidth, Len("0"))
|
||||
maxItemWidth = MaxI(maxItemWidth, Len(style.randomItemName))
|
||||
End If
|
||||
style.idWidth = maxIdWidth
|
||||
style.labelWidth = maxItemWidth
|
||||
If Not ignoreValue Then style.valueWidth = maxValueWidth Else style.valueWidth = 0
|
||||
End Sub
|
||||
|
||||
Sub PrintMenu (items() As MenuItem, count As Integer, style As MenuStyle)
|
||||
Dim randomItem As MenuItem
|
||||
Call NewMenuItem(randomItem, style.randomItemName, style.randomItemId)
|
||||
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
|
||||
Print GetTitleWithoutValue$(randomItem, style)
|
||||
End If
|
||||
Else
|
||||
Dim emptyItem As MenuItem
|
||||
Call NewMenuItem(emptyItem, "", 0)
|
||||
itemWidth = Len(GetTitle$(emptyItem, style))
|
||||
itemsPerRow = style.screenWidth \ (itemWidth + Len(style.menuItemSpacer))
|
||||
columnWidth = style.screenWidth \ itemsPerRow
|
||||
|
||||
column = 0
|
||||
For i = 1 To count
|
||||
If items(i).isVisible Then
|
||||
itemText$ = GetTitle$(items(i), style)
|
||||
If column <> (itemsPerRow - 1) Then
|
||||
If i <> count Or style.showRandom Then
|
||||
textLength = Len(itemText$)
|
||||
itemText$ = MakeFitL$(RTrim$(itemText$) + style.menuItemSpacer, textLength + Len(style.menuItemSpacer), " ")
|
||||
End If
|
||||
End If
|
||||
Print MakeFitC$(itemText$, columnWidth, " ");
|
||||
End If
|
||||
column = (column + 1) Mod itemsPerRow
|
||||
If column = 0 Then Print ""
|
||||
Next
|
||||
If style.showRandom Then
|
||||
Print MakeFitC$(GetTitleWithoutValue$(randomItem, style), columnWidth, " ")
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Function GetTitle$ (mi As MenuItem, ms As MenuStyle)
|
||||
id$ = itos$(mi.id)
|
||||
label$ = mi.label
|
||||
If ms.valueWidth > 0 Then label$ = label$ + ms.labelValueSeparator
|
||||
value$ = itos$(mi.value)
|
||||
GetTitle$ = MakeFitR$(id$, ms.idWidth, " ") + ms.idLabelSeparator + MakeFitL$(label$, ms.labelWidth, " ") + MakeFitR$(value$, ms.valueWidth, " ")
|
||||
End Function
|
||||
|
||||
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), " ")
|
||||
End Function
|
||||
|
||||
Sub NewMenuStyle (ms As MenuStyle)
|
||||
ms.idWidth = 0
|
||||
ms.labelWidth = 0
|
||||
ms.valueWidth = 0
|
||||
ms.screenWidth = 80
|
||||
ms.randomItemName = "Random"
|
||||
ms.randomItemId = 0
|
||||
ms.idLabelSeparator = " = "
|
||||
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
|
||||
|
||||
Sub NewMenuItemWithValue (mi As MenuItem, label As String, id As Integer, value As Integer)
|
||||
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
|
||||
Function GetRandomMenuItemId (items() As MenuItem, count As Integer)
|
||||
numVisibleItems = 0
|
||||
Dim visibleItems(count) As Integer
|
||||
For i = 1 To count
|
||||
If items(i).isVisible and items(i).includeinrandom Then
|
||||
visibleItems(numVisibleItems) = i
|
||||
numVisibleItems = numVisibleItems + 1
|
||||
End If
|
||||
Next
|
||||
i = GetRandomInt(0, numVisibleItems - 1)
|
||||
GetRandomMenuItemId = visibleItems(i)
|
||||
End Function
|
||||
|
||||
Sub BuildMenu (items() As MenuItem, labels() As String, count As Integer)
|
||||
For i = 1 To count
|
||||
Dim mi As MenuItem
|
||||
Call NewMenuItem(mi, labels(i), i)
|
||||
items(i) = mi
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Sub BuildMenuWithValues (items() As MenuItem, labels() As String, values() As Integer, count As Integer)
|
||||
For i = 1 To count
|
||||
Dim mi As MenuItem
|
||||
Call NewMenuItemWithValue(mi, labels(i), i, values(i))
|
||||
items(i) = mi
|
||||
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
|
||||
|
||||
Sub AdjustMenuStyle (style As MenuStyle, items() As MenuItem, count As Integer, ignoreValue As Integer)
|
||||
maxIdWidth = 0
|
||||
maxItemWidth = 0
|
||||
maxValueWidth = 0
|
||||
|
||||
For i = 1 To count
|
||||
If items(i).isVisible Then
|
||||
maxIdWidth = MaxI(maxIdWidth, Len(itos$(items(i).id)))
|
||||
maxItemWidth = MaxI(maxItemWidth, Len(items(i).label + style.labelValueSeparator))
|
||||
maxValueWidth = MaxI(maxValueWidth, Len(itos$(items(i).value)))
|
||||
End If
|
||||
Next
|
||||
If style.showRandom Then
|
||||
maxIdWidth = MaxI(maxIdWidth, Len(itos$(style.randomItemId)))
|
||||
maxItemWidth = MaxI(maxItemWidth, Len(style.randomItemName))
|
||||
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.labelWidth = maxItemWidth
|
||||
If Not ignoreValue Then style.valueWidth = maxValueWidth Else style.valueWidth = 0
|
||||
End Sub
|
||||
|
||||
Sub PrintMenu (items() As MenuItem, count As Integer, style As MenuStyle)
|
||||
Dim randomItem As MenuItem
|
||||
Call NewMenuItemWithColor(randomItem, style.randomItemName, style.randomItemColor, style.randomItemId)
|
||||
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
|
||||
If items(i).isVisible Then
|
||||
title$ = GetTitle$(items(i), style)
|
||||
Call PrintWithMaybeColor(title$, items(i).color, style.useColors)
|
||||
End If
|
||||
Next
|
||||
If style.showCancel Then
|
||||
cancelLabel$ = GetTitleWithoutValue$(cancelItem, style)
|
||||
Call PrintWithMaybeColor(cancelLabel$, cancelItem.color, style.useColors)
|
||||
End If
|
||||
If style.showRandom Then
|
||||
randomLabel$ = GetTitleWithoutValue$(randomItem, style)
|
||||
Call PrintWithMaybeColor(randomLabel$, randomItem.color, style.useColors)
|
||||
End If
|
||||
Else
|
||||
Dim emptyItem As MenuItem
|
||||
Call NewMenuItem(emptyItem, "", 0)
|
||||
itemWidth = Len(GetTitle$(emptyItem, style))
|
||||
itemsPerRow = style.screenWidth \ (itemWidth + Len(style.menuItemSpacer))
|
||||
columnWidth = style.screenWidth \ itemsPerRow
|
||||
|
||||
column = 0
|
||||
For i = 1 To count
|
||||
If items(i).isVisible Then
|
||||
itemText$ = GetTitle$(items(i), style)
|
||||
If column <> (itemsPerRow - 1) Then
|
||||
If i <> count Or style.showRandom Then
|
||||
textLength = Len(itemText$)
|
||||
itemText$ = MakeFitL$(RTrim$(itemText$) + style.menuItemSpacer, textLength + Len(style.menuItemSpacer), " ")
|
||||
End If
|
||||
End If
|
||||
label$ = MakeFitC$(itemText$, columnWidth, " ")
|
||||
Call PrintWithMaybeColor(label$, items(i).color, style.useColors)
|
||||
End If
|
||||
column = (column + 1) Mod itemsPerRow
|
||||
If column = 0 Then Print ""
|
||||
Next
|
||||
If style.showCancel Then
|
||||
cancelLabel$ = MakeFitC$(GetTitleWithoutValue$(cancelItem, style), columnWidth, " ")
|
||||
Call PrintWithMaybeColor(cancelLabel$, cancelItem.color, style.useColors)
|
||||
End If
|
||||
If style.showRandom Then
|
||||
randomLabel$ = MakeFitC$(GetTitleWithoutValue$(randomItem, style), columnWidth, " ")
|
||||
Call PrintWithMaybeColor(randomLabel$, randomItem.color, style.useColors)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Function GetTitle$ (mi As MenuItem, ms As MenuStyle)
|
||||
id$ = itos$(mi.id)
|
||||
label$ = mi.label
|
||||
If ms.valueWidth > 0 Then label$ = label$ + ms.labelValueSeparator
|
||||
value$ = itos$(mi.value)
|
||||
GetTitle$ = MakeFitR$(id$, ms.idWidth, " ") + ms.idLabelSeparator + MakeFitL$(label$, ms.labelWidth, " ") + MakeFitR$(value$, ms.valueWidth, " ")
|
||||
End Function
|
||||
|
||||
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), " ")
|
||||
End Function
|
||||
|
||||
Sub NewMenuStyle (ms As MenuStyle)
|
||||
ms.idWidth = 0
|
||||
ms.labelWidth = 0
|
||||
ms.valueWidth = 0
|
||||
ms.screenWidth = 80
|
||||
ms.randomItemName = "Random"
|
||||
ms.randomItemId = 0
|
||||
ms.randomItemColor = COLOR_FOREGROUND_DEFAULT
|
||||
ms.cancelItemName = "Cancel"
|
||||
ms.cancelItemId = -1
|
||||
ms.cancelItemColor = COLOR_FOREGROUND_DEFAULT
|
||||
ms.idLabelSeparator = " = "
|
||||
ms.labelValueSeparator = ": "
|
||||
ms.menuItemSpacer = ", "
|
||||
ms.showRandom = TRUE
|
||||
ms.showCancel = false
|
||||
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
|
||||
mi.includeInRandom = true
|
||||
End Sub
|
||||
|
||||
Sub NewMenuItemWithValue (mi As MenuItem, label As String, id As Integer, value As Integer)
|
||||
mi.id = id
|
||||
mi.label = label
|
||||
mi.value = value
|
||||
mi.color = COLOR_DEFAULT
|
||||
mi.isVisible = TRUE
|
||||
mi.includeInRandom = 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
|
||||
|
||||
284
dos/sbf/sbf.bas
284
dos/sbf/sbf.bas
@@ -4,6 +4,7 @@ Randomize Timer
|
||||
|
||||
Const FALSE = 0
|
||||
Const TRUE = Not FALSE
|
||||
Const isDebugging = TRUE
|
||||
|
||||
Const INITIAL_GENERATION = 13
|
||||
|
||||
@@ -84,7 +85,8 @@ End Sub
|
||||
|
||||
Sub SplashScreen
|
||||
' Splash screen
|
||||
MaybeCls ' " "
|
||||
MaybeCls
|
||||
' " "
|
||||
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 "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
|
||||
Input choice
|
||||
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
|
||||
If choice = items(i).id And items(i).isVisible Then
|
||||
acceptChoice = TRUE
|
||||
@@ -229,21 +232,6 @@ Function ChooseStringIdWithValues (labels() As String, values() As Integer, styl
|
||||
ChooseStringIdWithValues = choice
|
||||
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)
|
||||
MaybeCls
|
||||
' Check array bounds
|
||||
@@ -294,7 +282,7 @@ Sub CGGetDisciplines (ch As CharacterType)
|
||||
Dim ms As MenuStyle
|
||||
Call NewMenuStyle(ms)
|
||||
disciplinePoints = GetDisciplinePoints
|
||||
Dim disciplineValues(DISCIPLINES_COUNT) As Integer
|
||||
Dim disciplineValues(1 To DISCIPLINES_COUNT) As Integer
|
||||
While disciplinePoints > 0
|
||||
MaybeCls
|
||||
Call FillDisciplines(ch, disciplineValues())
|
||||
@@ -401,7 +389,7 @@ Sub CGGetBackgrounds (ch As CharacterType)
|
||||
Dim ms As MenuStyle
|
||||
Call NewMenuStyle(ms)
|
||||
backgroundPoints = GetBackgroundPoints
|
||||
Dim backgroundValues(BACKGROUNDS_COUNT) As Integer
|
||||
Dim backgroundValues(1 To BACKGROUNDS_COUNT) As Integer
|
||||
While backgroundPoints > 0
|
||||
MaybeCls
|
||||
Call FillBackgrounds(ch, backgroundValues())
|
||||
@@ -425,7 +413,6 @@ 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
|
||||
@@ -439,7 +426,6 @@ Sub CGGetDerangement (ch As CharacterType)
|
||||
ms.useColors = TRUE
|
||||
|
||||
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 Sub
|
||||
|
||||
@@ -447,71 +433,55 @@ Sub CGSpendFreebiePoints (ch As CharacterType)
|
||||
freebiePoints = GetFreebiePoints(ch)
|
||||
Dim ms As MenuStyle
|
||||
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)
|
||||
MaybeCls
|
||||
Print "freebiePoints = "; itos$(freebiePoints)
|
||||
Call MaybePrint("freebiePoints = " + itos$(freebiePoints))
|
||||
' Build the menu
|
||||
numMenuItems = 0
|
||||
If freebiePoints >= FREEBIE_POINT_COST_DISCIPLINE Then
|
||||
numMenuItems = numMenuItems + 1
|
||||
menuItemIds(numMenuItems) = 1
|
||||
labels(numMenuItems) = "Add a discipline dot 7 points"
|
||||
End If
|
||||
If freebiePoints >= FREEBIE_POINT_COST_ATTRIBUTE Then
|
||||
numMenuItems = numMenuItems + 1
|
||||
menuItemIds(numMenuItems) = 2
|
||||
labels(numMenuItems) = "Add an attribute dot 5 points"
|
||||
End If
|
||||
If freebiePoints >= FREEBIE_POINT_COST_ability Then
|
||||
numMenuItems = numMenuItems + 1
|
||||
menuItemIds(numMenuItems) = 3
|
||||
labels(numMenuItems) = "Add an ability dot 2 points"
|
||||
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"
|
||||
ReDim availableFreebies(1 To FREEBIES_COUNT) As FreebieType
|
||||
numAvailableFreebies = 0
|
||||
For index = 1 To FREEBIES_COUNT
|
||||
If Freebies(index).cost <= freebiePoints Then
|
||||
numAvailableFreebies = numAvailableFreebies + 1
|
||||
availableFreebies(numAvailableFreebies) = Freebies(index)
|
||||
End If
|
||||
Next
|
||||
|
||||
ReDim menuItems(1 To numAvailableFreebies) As MenuItem
|
||||
For index = 1 To numAvailableFreebies
|
||||
Dim mi As MenuItem
|
||||
Call NewMenuItem(mi, availableFreebies(index).label, availableFreebies(index).id)
|
||||
If index = FREEBIE_SHOW_CHARACTER_SHEET_ID Then mi.includeInRandom = FALSE
|
||||
menuItems(index) = mi
|
||||
Next
|
||||
|
||||
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)
|
||||
Case 1
|
||||
Select Case id
|
||||
Case FREEBIE_DISCIPLINE_ID
|
||||
Call CGSpendDisciplinePoint(ch)
|
||||
Case 2
|
||||
Case FREEBIE_ATTRIBUTE_ID
|
||||
Call CGSpendAttributePoint(ch)
|
||||
Case 3
|
||||
Case FREEBIE_ABILITY_ID
|
||||
Call CGSpendAbilityPoint(ch)
|
||||
Case 4
|
||||
Case FREEBIE_VIRTUE_ID
|
||||
Call CGSpendVirtuePoint(ch)
|
||||
Case 5
|
||||
Case FREEBIE_HUMANITY_ID
|
||||
Call CGSpendHumanityPoint(ch)
|
||||
Case 6
|
||||
Case FREEBIE_BACKGROUND_ID
|
||||
Call CGSpendBackgroundPoint(ch)
|
||||
Case 7
|
||||
Case FREEBIE_SHOW_CHARACTER_SHEET_ID
|
||||
Call ShowCharacterSheet(ch)
|
||||
End Select
|
||||
|
||||
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
|
||||
End Sub
|
||||
|
||||
@@ -519,50 +489,52 @@ Sub CGSpendDisciplinePoint (ch As CharacterType)
|
||||
MaybeCls
|
||||
Dim ms As MenuStyle
|
||||
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())
|
||||
discipline = ChooseStringIdWithValuesAndCancel(Disciplines(), disciplineValues(), ms, DISCIPLINES_COUNT, "Which discipline do you want to spend 1 of your " + itos$(disciplinePoints) + " points on?")
|
||||
If discipline > 0 Then
|
||||
Call SetDiscipline(ch, discipline, GetDiscipline(ch, discipline) + 1)
|
||||
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - 7)
|
||||
prompt$ = "Which discipline do you want to spend 1 of your " + itos$(disciplinePoints) + " points on?"
|
||||
id = ChooseStringIdWithValues(Disciplines(), disciplineValues(), ms, DISCIPLINES_COUNT, prompt$)
|
||||
If id <> ms.cancelItemId Then
|
||||
Call SetDiscipline(ch, id, GetDiscipline(ch, id) + 1)
|
||||
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - FREEBIE_DISCIPLINE_COST)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Type AttributeReference
|
||||
Type GroupedStatReference
|
||||
id As Integer
|
||||
groupIndex As Integer
|
||||
attributeIndex As Integer
|
||||
itemIndex As Integer
|
||||
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)
|
||||
MaybeCls
|
||||
'TODO: Paragraph
|
||||
'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
|
||||
Dim ms As MenuStyle
|
||||
Call NewMenuStyle(ms)
|
||||
|
||||
ms.showCancel = TRUE
|
||||
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)
|
||||
numAttributes = numAttributes + numAttributesInGroup(attributeGroupIndex)
|
||||
Next
|
||||
|
||||
Dim attributes(numAttributes) As AttributeReference
|
||||
Dim labels(numAttributes) As String
|
||||
Dim values(numAttributes) As Integer
|
||||
Dim attributes(1 To numAttributes) As GroupedStatReference
|
||||
Dim labels(1 To numAttributes) As String
|
||||
Dim values(1 To numAttributes) As Integer
|
||||
|
||||
attributeIndex = 1
|
||||
For attributeGroupIndex = 1 To ABILITY_GROUPS_COUNT
|
||||
For attributeGroupIndex = 1 To ATTRIBUTE_GROUPS_COUNT
|
||||
For index = 1 To numAttributesInGroup(attributeGroupIndex)
|
||||
Dim attribute As AttributeReference
|
||||
attribute.id = attributeIndex
|
||||
attribute.groupIndex = attributeGroupIndex
|
||||
attribute.attributeIndex = index
|
||||
Dim attribute As GroupedStatReference
|
||||
Call NewGroupedStatReference(attribute, attributeIndex, attributeGroupIndex, index)
|
||||
attributes(attributeIndex) = attribute
|
||||
labels(attributeIndex) = GetAttributeName$(attributeGroupIndex, index)
|
||||
values(attributeIndex) = GetAttributeValue(ch, attributeGroupIndex, index)
|
||||
@@ -570,43 +542,87 @@ Sub CGSpendAttributePoint (ch As CharacterType)
|
||||
Next
|
||||
Next
|
||||
|
||||
attributeIndex = ChooseStringIdWithValuesAndCancel(labels(), values(), ms, numAttributes, "Which attribute do you want to add one dot to?")
|
||||
If attributeIndex > 0 Then
|
||||
Dim attr As AttributeReference
|
||||
attr = attributes(attributeIndex)
|
||||
Call SetAttributeValue(ch, attr.groupIndex, attr.attributeIndex, GetAttributeValue(ch, at.groupindex, at.attributeindex) + 1)
|
||||
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - 5)
|
||||
' TODO: Make this show values.
|
||||
prompt$ = "Which attribute do you want to add one dot to?"
|
||||
ms.cancelItemId = numAttributes + 1
|
||||
id = ChooseStringIdWithValues(labels(), values(), ms, numAttributes, prompt$)
|
||||
If id <> ms.cancelItemId Then
|
||||
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 Sub
|
||||
|
||||
Sub CGSpendAbilityPoint (ch As CharacterType)
|
||||
'TODO: Paragraph
|
||||
'Choose an abililty group; Allow cancel
|
||||
'Choose an ability; Allow cancel
|
||||
'If an ability was chosen then add that ability point to ch and subtract 2 freebie points
|
||||
Print "TODO: Fill in CGSpendAbilityPoint"
|
||||
End Sub
|
||||
Sub CGSpendVirtuePoint (ch As CharacterType)
|
||||
'TODO: Paragraph
|
||||
'Choose a virtue; Allow cancel
|
||||
'If a virtue was chosen that add that virtue point to ch and subtract 2 freebie points.
|
||||
Print "TODO: Fill in CGSpendVirtuePoint"
|
||||
End Sub
|
||||
Sub CGSpendHumanityPoint (ch As CharacterType)
|
||||
'TODO: Paragraph
|
||||
'Confirm they want to add the point
|
||||
'If they say yes then add the humanity point to ch and subtract 1 freebie point.
|
||||
Print "TODO: Fill in CGSpendHumanityPoint"
|
||||
End Sub
|
||||
Sub CGSpendBackgroundPoint (ch As CharacterType)
|
||||
'TODO: Paragraph
|
||||
'Choose a background; Allow cancel
|
||||
'If they chose a background then add the background and subtract 1 freebie point.
|
||||
Print "TODO: Fill in CGSpendBackgroundPoint"
|
||||
Dim ms As MenuStyle
|
||||
Call NewMenuStyle(ms)
|
||||
ms.showCancel = TRUE
|
||||
done = FALSE
|
||||
While Not done
|
||||
MaybeCls
|
||||
ms.cancelItemId = ABILITY_GROUPS_COUNT + 1
|
||||
abilityGroupIndex = ChooseStringId(AbilityGroups(), ms, ABILITY_GROUPS_COUNT, "What kind of ability would you like to add 1 dot to?")
|
||||
If abilityGroupIndex = ms.cancelItemId Then Exit Sub
|
||||
|
||||
numAbilities = GetNumItemsForAbilityGroup(abilityGroupIndex)
|
||||
Dim labels(1 To numAbilities) As String
|
||||
Call FillAbilitiesForAbilityGroup(abilityGroupIndex, labels())
|
||||
ms.cancelItemId = numAbilities + 1
|
||||
abilityIndex = ChooseStringId(labels(), ms, numAbilities, "What ability would you like to add 1 dot to?")
|
||||
If abilityIndex <> ms.cancelItemId Then
|
||||
Call SetAbilityValue(ch, abilityGroupIndex, abilityIndex, GetAbilityValue(ch, abilityGroupIndex, abilityIndex) + 1)
|
||||
Call SetFreebiePoints(ch, GetFreebiePoints(ch) - FREEBIE_ABILITY_COST)
|
||||
done = TRUE
|
||||
End If
|
||||
Wend
|
||||
End Sub
|
||||
|
||||
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
|
||||
|
||||
' Ignore this warning ch is not used yet because the sub is not implemented yet.
|
||||
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)?
|
||||
' 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 |
|
||||
'| Str. 5 App. 2 Int. 1 | Concept: llllll |
|
||||
'| Dex. 3 Cha. 2 Per. 1 |---------------------------------------|
|
||||
'| Sta. 2 Man. 4 Wit. 4 | Derangements: |
|
||||
'| Sta. 2 Man. 4 Wit. 4 | Derangementss: |
|
||||
'|--------------------------------------| _____________________________________ |
|
||||
'| Disciplines: | _____________________________________ |
|
||||
'| Obtenebration | _____________________________________ |
|
||||
@@ -767,10 +783,10 @@ Sub CharacterGenerator ()
|
||||
End Sub
|
||||
|
||||
Sub ShowCharacterSheet (ch As CharacterType)
|
||||
Dim disciplineValues(DISCIPLINES_COUNT) As Integer
|
||||
Dim disciplineValues(1 To DISCIPLINES_COUNT) As Integer
|
||||
Call FillDisciplines(ch, disciplineValues())
|
||||
|
||||
Dim backgroundValues(BACKGROUNDS_COUNT) As Integer
|
||||
Dim backgroundValues(1 To BACKGROUNDS_COUNT) As Integer
|
||||
Call FillBackgrounds(ch, backgroundValues())
|
||||
|
||||
'... 0123456789
|
||||
@@ -861,34 +877,34 @@ End Sub
|
||||
|
||||
' Simpler character generator with fewer questions and more things done randomly without asking.
|
||||
Sub CharacterGeneratorForDummies
|
||||
Print "CharacterGeneratorForDummies"
|
||||
Call MaybePrint("CharacterGeneratorForDummies")
|
||||
End Sub
|
||||
|
||||
' 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.
|
||||
' In practice it's just slower than rolling the dice
|
||||
Sub CombatComputer
|
||||
Print "CombatComputer"
|
||||
Call MaybePrint("CombatComputer")
|
||||
End Sub
|
||||
|
||||
' Asks for a number of dice and a difficulty. Rolls the dice, calculates botches and successes.
|
||||
Sub DiceRoller
|
||||
Print "DiceRoller"
|
||||
Call MaybePrint("DiceRoller")
|
||||
End Sub
|
||||
|
||||
' Like the character generator if you choose random for everything. Should do random names/ages too, but doesn't yet.
|
||||
Sub RandomCharacterGenerator
|
||||
Print "RandomCharacterGenerator"
|
||||
Call MaybePrint("RandomCharacterGenerator")
|
||||
End Sub
|
||||
|
||||
' This had a function at one point but got taken out. Will only come back if the disassembly can figure it out.
|
||||
Sub Choice6
|
||||
Print "Unnamed choice 6"
|
||||
Call MaybePrint("Unnamed choice 6")
|
||||
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.
|
||||
Sub VehicleGenerator
|
||||
Print "VehicleGenerator"
|
||||
Call MaybePrint("VehicleGenerator")
|
||||
End Sub
|
||||
|
||||
Sub PressAnyKeyToContinue ()
|
||||
@@ -1004,6 +1020,10 @@ Sub MaybeCls ()
|
||||
If Not isDebugging Then Cls
|
||||
End Sub
|
||||
|
||||
Sub MaybePrint (message As String)
|
||||
If isDebugging Then Print message
|
||||
End Sub
|
||||
|
||||
'$include: 'colors.bm'
|
||||
'$include: 'menus.bm'
|
||||
'$include: 'character.bm'
|
||||
|
||||
Reference in New Issue
Block a user