maj/StorytellersBestFriend
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Extracts menu stuff.

Browse Source 
closes #7
This commit is contained in:
Tom Hicks
2023-03-11 09:36:25 -08:00
parent 53b0de7079
commit b3c9bb61e8
3 changed files with 183 additions and 182 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
dos/sbf/menus.bi Normal file
View File

@@ -0,0 +1,21 @@
Type MenuStyle
idWidth As Integer
labelWidth As Integer
valueWidth As Integer
screenWidth As Integer
randomItemName As String
randomItemId As Integer
idLabelSeparator As String
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

158
dos/sbf/menus.bm Normal file
View File

@@ -0,0 +1,158 @@
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

186
dos/sbf/sbf.bas
View File

@@ -10,6 +10,9 @@ Const BACKGROUND_POINTS = 5
Const VIRTUE_POINTS = 7 Const VIRTUE_POINTS = 7
Const INITIAL_GENERATION = 13 Const INITIAL_GENERATION = 13
'$include: 'colors.bi'
'$include: 'menus.bi'
' Each set of these index constants "NAME_*" should start at 1 and go up to NAMES_COUNT without leaving any holes. ' Each set of these index constants "NAME_*" should start at 1 and go up to NAMES_COUNT without leaving any holes.
' This also goes the same for sub indexes like NAME_GROUP_SUBGROUP_* each NAME_GROUP_* set should have GetNumNamesInGroup(NAME_GROUP) items. ' This also goes the same for sub indexes like NAME_GROUP_SUBGROUP_* each NAME_GROUP_* set should have GetNumNamesInGroup(NAME_GROUP) items.
Const CLAN_ANARCH = 1 Const CLAN_ANARCH = 1
@@ -33,8 +36,6 @@ Const CLAN_VENTRUE = 18
Const CLANS_COUNT = 18 Const CLANS_COUNT = 18
Dim Shared Clans(1 To CLANS_COUNT) As String Dim Shared Clans(1 To CLANS_COUNT) As String
'$include: 'colors.bi'
Const ARCHETYPE_ARCHITECT = 1 Const ARCHETYPE_ARCHITECT = 1
Const ARCHETYPE_AUTOCRAT = 2 Const ARCHETYPE_AUTOCRAT = 2
Const ARCHETYPE_BARBARIAN = 3 Const ARCHETYPE_BARBARIAN = 3
@@ -335,28 +336,6 @@ Type CharacterType
background_status As Integer background_status As Integer
End Type End Type
Type MenuStyle
idWidth As Integer
labelWidth As Integer
valueWidth As Integer
screenWidth As Integer
randomItemName As String
randomItemId As Integer
idLabelSeparator As String
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
Type DerangementType Type DerangementType
id As Integer id As Integer
label As String label As String
@@ -703,19 +682,6 @@ Function GetRandomInt (min As Integer, max As Integer)
GetRandomInt = Int(Rnd * (max - min + 1)) + min GetRandomInt = Int(Rnd * (max - min + 1)) + min
End Function End Function
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
Function MaxI (val1 As Integer, val2 As Integer) Function MaxI (val1 As Integer, val2 As Integer)
If (val1 > val2) Then If (val1 > val2) Then
MaxI = val1 MaxI = val1
@@ -1248,34 +1214,6 @@ Sub NewCharacter (ch As CharacterType)
Next Next
End Sub End Sub
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
Function ChooseStringId (labels() As String, style As MenuStyle, count As Integer, prompt As String) Function ChooseStringId (labels() As String, style As MenuStyle, count As Integer, prompt As String)
Cls Cls
Dim mnuItems(1 To count) As MenuItem Dim mnuItems(1 To count) As MenuItem
@@ -1935,123 +1873,6 @@ Sub FillAttributeAbbreviationsInGroup (group As Integer, abbreviations() As Stri
End Sub 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
Sub NewDerangement (derangement As DerangementType, id As Integer, label As String, textColor As Integer, description As String) Sub NewDerangement (derangement As DerangementType, id As Integer, label As String, textColor As Integer, description As String)
derangement.id = id derangement.id = id
@@ -2178,6 +1999,7 @@ Sub MakeWrapLines (lines() As String, text As String, maxWidth As Integer, maxLi
End Sub End Sub
'$include: 'colors.bm' '$include: 'colors.bm'
'$include: 'menus.bm'
Sub Test Sub Test
'End 'End