+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: A little Basic D&D character Generator. (/showthread.php?tid=2358)
A little Basic D&D character Generator. - Cobalt - 12-28-2023
Something I have been fiddling with for a while, not sure just what to do with it yet.
With it you can create a D&D style character with basic D&D attribute stats.
The HP,MP, NXP are all based on the 6 main stats or combinations there of.
Right now a player could re-roll the stats a total of 6 times( 1 initial roll then 5 more, unless you know the special names!) to try and get a stat grouping they want. This seems like a decent number otherwise somebody may sit there re-rolling to beat the band.
Save entering the name everything is done with the mouse, RE-Roll stats, change character portrait, look at pack.
There is nothing to be done with the pack, simply allows the player to see their starting money and weight.
I think its interesting to look at and see what it generates, but I really am unsure about just where to take it now.
Code: (Select All)
TYPE Player_Stat
Name AS STRING * 16
Title AS _BYTE
Strength AS _BYTE
Dexterity AS _BYTE
Constitution AS _BYTE
Intelligence AS _BYTE
Wisdom AS _BYTE
Charisma AS _BYTE
HP AS _BYTE
MP AS _BYTE
Max_HP AS _BYTE
Max_MP AS _BYTE
Xp AS LONG
Nxp AS LONG
Level AS _BYTE
Age AS _UNSIGNED _BYTE
Race AS _BYTE
Weapon AS _BYTE
Armor AS _BYTE
Cp AS LONG
Sp AS LONG
Gp AS LONG
Pp AS LONG
Ix AS _BYTE 'portrat location
Iy AS _BYTE ' " "
Ac AS _BYTE
Bonus AS _BYTE
END TYPE
TYPE Item
Name AS STRING * 24
Pow AS _BYTE 'Attack Bonus 0 to 18
Ac AS _BYTE 'AC bonus -5 to +15
Cost AS LONG 'Cost in Cp
Weight AS LONG
END TYPE
SCREEN _NEWIMAGE(800, 600, 32)
RANDOMIZE TIMER
CONST TRUE = -1, FALSE = NOT TRUE
DIM SHARED Layer(8) AS LONG, Font(4) AS LONG, P AS Player_Stat, Pack(12, 1) AS _BYTE, L%%
DIM SHARED Titles(15) AS STRING, Race(5) AS STRING, Wep(63) AS Item, Arm(63) AS Item, Item(127) AS Item
DATA "Adventurer","Novice","Aspirant","Battler","Fighter","Adept","Chevalier","Veteran","Warrior","Swordman","Hero","Soldier","Myrmidon","Champion","Superhero","Paladin": ',"Lord"
DATA "Mystery","Human","Zombie","Dwarf","Elf","Anthromorph"
DATA "Bare Fist",0,0,0,0,"Bamboo Stick",1,0,15,125
DATA "Thin Cloth",0,0,0,200,"Heavy Cloth",0,1,75,550,"Gambeson",0,4,250,2200
DATA "Herb Pack",0,0,5,50,"Ration",0,0,25,250,"Water Skin",0,0,100,1000,"Picks(L_Gr)",0,0,250,125,"Tent",0,0,2500,5000
DATA "Keys of Diamond",0,0,25000,285
FOR i% = 0 TO 15: READ Titles(i%): NEXT
FOR i% = 0 TO 5: READ Race(i%): NEXT
FOR i% = 0 TO 1: READ Wep(i%).Name, Wep(i%).Pow, Wep(i%).Ac, Wep(i%).Cost, Wep(i%).Weight: NEXT
FOR i% = 0 TO 2: READ Arm(i%).Name, Arm(i%).Pow, Arm(i%).Ac, Arm(i%).Cost, Arm(i%).Weight: NEXT
FOR i% = 1 TO 6: READ Item(i%).Name, Item(i%).Pow, Item(i%).Ac, Item(i%).Cost, Item(i%).Weight: NEXT
Layer(0) = _DISPLAY
Layer(1) = _COPYIMAGE(Layer(0))
'Layer(2) = _LOADIMAGE("8x6CharSheet.bmp", 32)
'Layer(3) = _LOADIMAGE("portraits2.jpg", 32)
'Layer(4) = _LOADIMAGE("ButtonOver.bmp", 32)
'Layer(5) = _LOADIMAGE("8x6PackSheet.bmp", 32)
'Layer(6) = _LOADIMAGE("8x6MakerSheet.bmp", 32)
'Font(1) = _LOADFONT("ComicRunes.otf", 40, "monospace")
'Font(2) = _LOADFONT("ComicRunes.otf", 24, "monospace")
'Font(3) = _LOADFONT("DwarvenStonecraftCyr.otf", 24, "monospace")
MFI_Loader "ADDCharMaker.MFI"
_FONT Font(1)
_PRINTMODE _KEEPBACKGROUND
_FONT Font(2), Layer(1)
_PRINTMODE _KEEPBACKGROUND , Layer(1)
_SCREENMOVE 10, 10
COLOR _RGB32(0)
_CLEARCOLOR _RGB32(255), Layer(4)
'Stat_Maker
_DELAY .25
_SCREENMOVE 256, 10
_DELAY .1
_DEST Layer(1)
COLOR _RGB32(255, 0, 0)
_DEST Layer(0)
Character_Creator
Pack(0, 0) = 1 'item id
Pack(0, 1) = 2 '# of item
DO
_PUTIMAGE , Layer(2), Layer(1)
_PUTIMAGE (590, 80), Layer(3), Layer(1), (160 * P.Ix, 120 * P.Iy)-STEP(159, 119) 'display portrat
_FONT Font(1), Layer(1)
_PRINTSTRING (293 - 18 * (LEN(RTRIM$(P.Name)) / 2), 28), P.Name, Layer(1) 'Display Name
Nul%% = _MOUSEINPUT
IF _MOUSEX > 30 AND _MOUSEY > 490 AND _MOUSEX < 264 AND _MOUSEY < 524 THEN 'Pack
_PUTIMAGE (29, 487), Layer(4), Layer(1), (1, 4)-STEP(239, 43)
Selection%% = 1
ELSEIF _MOUSEX > 30 AND _MOUSEY > 536 AND _MOUSEX < 264 AND _MOUSEY < 570 THEN 'Exit
_PUTIMAGE (29, 533), Layer(4), Layer(1), (1, 50)-STEP(239, 43)
Selection%% = 2
ELSE
Selection%% = 0
END IF
IF _MOUSEBUTTON(1) THEN
SELECT CASE Selection%%
CASE 1 'Pack
RunPack
DO: LOOP WHILE _MOUSEINPUT
CASE 2 'Exit
ExitFlag%% = TRUE
END SELECT
END IF
IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
Fill_Stats
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
DO: LOOP WHILE _MOUSEINPUT
LOOP UNTIL ExitFlag%%
'LINE (319, 20)-STEP(2, 40), _RGB32(255, 0, 0), BF
'LINE (128, 40)-STEP(329, 2), _RGB32(255, 0, 0), BF
'160,120
SUB Character_Creator
CLS
Rolls%% = 6 'player can reroll stats 6 times
Enter_Name
FOR i%% = 1 TO LEN(RTRIM$(P.Name))
b% = b% + ASC(MID$(LCASE$(P.Name), i%%, 1))
NEXT i%%
b% = b% * L%%
IF b% = 2600 THEN Rolls%% = 60
IF b% = 2755 THEN Rolls%% = 60
_DEST Layer(1)
COLOR _RGB32(0)
_DEST Layer(0)
DO
_PUTIMAGE , Layer(6), Layer(1)
_PUTIMAGE (590, 80), Layer(3), Layer(1), (160 * P.Ix, 120 * P.Iy)-STEP(159, 119) 'display portrat
_FONT Font(1), Layer(1)
_PRINTSTRING (293 - 18 * (LEN(RTRIM$(P.Name)) / 2), 28), P.Name, Layer(1) 'Display Name
'_FONT Font(2)
Nul% = Determine_Race
Nul%% = _MOUSEINPUT
IF _MOUSEX > 30 AND _MOUSEY > 444 AND _MOUSEX < 264 AND _MOUSEY < 478 THEN 'Reroll
_PUTIMAGE (29, 441), Layer(4), Layer(1), (1, 188)-STEP(239, 43)
Selection%% = 1
ELSEIF _MOUSEX > 30 AND _MOUSEY > 490 AND _MOUSEX < 264 AND _MOUSEY < 524 THEN 'Pick
_PUTIMAGE (28, 487), Layer(4), Layer(1), (1, 234)-STEP(239, 43)
Selection%% = 2
ELSEIF _MOUSEX > 30 AND _MOUSEY > 536 AND _MOUSEX < 264 AND _MOUSEY < 570 THEN 'Exit
_PUTIMAGE (29, 533), Layer(4), Layer(1), (1, 50)-STEP(239, 43)
Selection%% = 3
ELSEIF _MOUSEX > 598 AND _MOUSEY > 222 AND _MOUSEX < 662 AND _MOUSEY < 254 THEN 'Portrat left
_PUTIMAGE (593, 221), Layer(4), Layer(1), (42, 282)-STEP(69, 32)
Selection%% = 4
ELSEIF _MOUSEX > 688 AND _MOUSEY > 222 AND _MOUSEX < 752 AND _MOUSEY < 254 THEN 'Portrat right
_PUTIMAGE (688, 220), Layer(4), Layer(1), (135, 281)-STEP(69, 32)
Selection%% = 5
ELSE
Selection%% = 0
END IF
IF _MOUSEBUTTON(1) THEN
SELECT CASE Selection%%
CASE 1 'Reroll
IF Rolls%% THEN 'only remake states if player has rolls left
Rolls%% = Rolls%% - 1
Stat_Maker
END IF
CASE 2 ' Pick this character
Exitflag%% = TRUE
IF Rolls%% = 6 THEN END: Stat_Maker_Auto 'if player never rolled then auto roll stats
CASE 3 'Exit
Exitflag%% = TRUE
CASE 4 ' Prev portrat
P.Ix = P.Ix - 1
IF P.Ix < 0 THEN P.Ix = 10: P.Iy = P.Iy - 1
IF P.Iy < 0 THEN P.Iy = 9
IF P.Iy = 9 AND P.Ix > 8 THEN P.Ix = 8
CASE 5 'Next portrat
P.Ix = P.Ix + 1
IF P.Ix > 10 THEN P.Ix = 0: P.Iy = P.Iy + 1
IF P.Iy = 9 AND P.Ix = 9 THEN P.Ix = 0: P.Iy = 0
END SELECT
Mouse_Lock 'pause while button is depressed
END IF
IF INKEY$ = CHR$(27) THEN Exitflag%% = TRUE
_PRINTSTRING (208, 442), LTRIM$(STR$(Rolls%%)), Layer(1) 'display rolls player has left over button
_DEST Layer(1)
Fill_Stats
_FONT Font(2)
_DEST Layer(0)
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
DO: LOOP WHILE _MOUSEINPUT
LOOP UNTIL Exitflag%%
END SUB
SUB Mouse_Lock
DO
nul% = _MOUSEINPUT
_LIMIT 90
LOOP WHILE _MOUSEBUTTON(1)
END SUB
FUNCTION Determine_Race%%
Result%% = TRUE
SELECT CASE P.Ix + (P.Iy * 11)
CASE 0, 1, 2, 8, 9, 10, 14, 18, 20, 22, 30, 34 TO 42, 56, 58 TO 62, 74, 80 TO 86, 96 TO 100 'human
P.Race = 1
CASE 3, 7, 11, 12, 13, 33, 43, 63 TO 71, 75, 76 'mystery
P.Race = 0
CASE 93, 101 TO 107 'Zombie
P.Race = 2
CASE 6, 15, 16, 17, 19, 31, 32, 45, 46, 57, 79 'Dwarf
P.Race = 3
CASE 21, 23 TO 29, 87, 92, 95 'Elf
P.Race = 4
CASE 4, 5, 44, 47 TO 55, 77, 78, 88 TO 91, 94 'Anthromorph
P.Race = 5
CASE ELSE
P.Race = INT(RND * 5)
Result%% = FALSE 'error flag denoting value not found.
END SELECT
Determine_Race = Result%%
END FUNCTION
SUB RunPack
CLS
_PUTIMAGE , Layer(5), Layer(0)
Fill_Pack
Layer(7) = _COPYIMAGE(_DISPLAY)
DO
_PUTIMAGE , Layer(7), Layer(1)
Nul%% = _MOUSEINPUT
IF _MOUSEX > 280 AND _MOUSEY > 536 AND _MOUSEX < 512 AND _MOUSEY < 570 THEN 'use\equip
_PUTIMAGE (277, 531), Layer(4), Layer(1), (1, 96)-STEP(239, 43)
Selection%% = 1
ELSEIF _MOUSEX > 525 AND _MOUSEY > 536 AND _MOUSEX < 756 AND _MOUSEY < 570 THEN 'Drop
_PUTIMAGE (521, 529), Layer(4), Layer(1), (1, 142)-STEP(239, 43)
Selection%% = 2
ELSEIF _MOUSEX > 30 AND _MOUSEY > 536 AND _MOUSEX < 264 AND _MOUSEY < 570 THEN 'Exit
_PUTIMAGE (29, 533), Layer(4), Layer(1), (1, 50)-STEP(239, 43)
Selection%% = 3
ELSE
Selection%% = 0
END IF
IF _MOUSEBUTTON(1) THEN
SELECT CASE Selection%%
CASE 1 'Use\Equip
CASE 3 'Exit
ExitFlag%% = TRUE
_DELAY .1
END SELECT
END IF
IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
DO: LOOP WHILE _MOUSEINPUT
LOOP UNTIL ExitFlag%%
END SUB
SUB Stat_Maker
P.Title = 0
P.Strength = INT(RND * 15) + 1
P.Dexterity = INT(RND * 15) + 1
P.Constitution = INT(RND * 15) + 1
P.Intelligence = INT(RND * 15) + 1
P.Wisdom = INT(RND * 15) + 1
P.Charisma = INT(RND * 15) + 1
P.HP = INT(RND * P.Strength) + INT(RND * P.Constitution) + P.Constitution \ 2 + 1
P.MP = INT(RND * P.Intelligence) + INT(RND * P.Wisdom) + P.Wisdom \ 2
P.Max_HP = P.HP
P.Max_MP = P.MP
XpNeed%% = P.Strength + P.Dexterity + P.Constitution + P.Intelligence + P.Wisdom + P.Charisma
P.Nxp = (INT(RND * XpNeed%% * 2) * 2 + 10) * (P.HP / 12)
P.Level = 0
P.Age = INT(RND * 6) + 16
P.Weapon = 0
P.Armor = 0
P.Cp = (INT(RND * P.Nxp) + 25) * P.Charisma + 100
IF P.Charisma > 13 AND (P.Race = 1 OR P.Race = 4) THEN P.Sp = INT(RND * P.Charisma) ELSE P.Sp = 0
P.Gp = 0
P.Pp = 0
END SUB
SUB Stat_Maker_Auto
P.Title = 0
P.Strength = INT(RND * 15) + 1
P.Dexterity = INT(RND * 15) + 1
P.Constitution = INT(RND * 15) + 1
P.Intelligence = INT(RND * 15) + 1
P.Wisdom = INT(RND * 15) + 1
P.Charisma = INT(RND * 15) + 1
P.HP = INT(RND * P.Strength) + INT(RND * P.Constitution) + P.Constitution \ 2
P.MP = INT(RND * P.Intelligence) + INT(RND * P.Wisdom) + P.Wisdom \ 2
P.Max_HP = P.HP
P.Max_MP = P.MP
XpNeed%% = P.Strength + P.Dexterity + P.Constitution + P.Intelligence + P.Wisdom + P.Charisma
P.Nxp = (INT(RND * XpNeed%% * 2) * 2 + 10) * (P.HP / 12)
P.Level = 0
P.Age = INT(RND * 6) + 16
P.Weapon = 0
P.Armor = 0
P.Ix = INT(RND * 11) 'player image
P.Iy = INT(RND * 10)
P.Cp = INT(RND * P.Nxp) + 25 * P.Charisma + 100
IF P.Charisma > 13 AND (P.Race = 1 OR P.Race = 4) THEN P.Sp = INT(RND * P.Charisma) ELSE P.Sp = 0
P.Gp = 0
P.Pp = 0
SELECT CASE P.Ix + (P.Iy * 11)
CASE 0, 1, 2, 8, 9, 10, 14, 18, 20, 22, 30, 34 TO 42, 56, 58 TO 62, 74, 80 TO 86, 96 TO 100 'human
P.Race = 1
CASE 3, 11, 12, 13, 33, 43, 63 TO 71, 75, 76 'mystery
P.Race = 0
CASE 93, 101 TO 107 'Zombie
P.Race = 2
CASE 6, 15, 16, 17, 19, 31, 32, 45, 46, 55, 79 'Dwarf
P.Race = 3
CASE 21, 23 TO 29, 87, 92, 95 'Elf
P.Race = 4
CASE 4, 5, 44, 47 TO 55, 77, 78, 88 TO 91, 94 'Anthromorph
P.Race = 5
CASE ELSE
P.Race = INT(RND * 5)
END SELECT
END SUB
SUB Fill_Stats
_FONT Font(2), Layer(1)
_PRINTSTRING (192, 206), LTRIM$(STR$(P.Strength)), Layer(1)
_PRINTSTRING (192, 238), LTRIM$(STR$(P.Dexterity)), Layer(1)
_PRINTSTRING (192, 270), LTRIM$(STR$(P.Constitution)), Layer(1)
_PRINTSTRING (192, 302), LTRIM$(STR$(P.Intelligence)), Layer(1)
_PRINTSTRING (192, 334), LTRIM$(STR$(P.Wisdom)), Layer(1)
IF P.Race = 1 OR P.Race = 4 THEN _PRINTSTRING (192, 366), LTRIM$(STR$(P.Charisma)), Layer(1) 'Humans and Elves suffer no charm loss
IF P.Race = 3 OR P.Race = 5 THEN _PRINTSTRING (192, 366), LTRIM$(STR$(P.Charisma \ 2 + 1)), Layer(1) 'Dwarves and Anthro suffer 1/2 charm
IF P.Race = 0 OR P.Race = 2 THEN _PRINTSTRING (192, 366), LTRIM$(STR$(P.Charisma \ 3 + 1)), Layer(1) 'Zombies and Mystery suffer 1/3 charm
_PRINTSTRING (600, 276), LTRIM$(STR$(P.HP)), Layer(1)
_PRINTSTRING (600, 302), LTRIM$(STR$(P.MP)), Layer(1)
_PRINTSTRING (664, 276), LTRIM$(STR$(P.Max_HP)), Layer(1)
_PRINTSTRING (664, 302), LTRIM$(STR$(P.Max_MP)), Layer(1)
_PRINTSTRING (600, 330), LTRIM$(STR$(P.Xp)), Layer(1)
_PRINTSTRING (604, 356), LTRIM$(STR$(P.Nxp)), Layer(1)
_PRINTSTRING (316, 294), LTRIM$(Wep(P.Weapon).Name), Layer(1)
_PRINTSTRING (316, 490), LTRIM$(Arm(P.Armor).Name), Layer(1)
_PRINTSTRING (624, 384), LTRIM$(STR$(P.Level)), Layer(1)
_PRINTSTRING (624, 410), RTRIM$(Race(P.Race)), Layer(1)
_PRINTSTRING (624, 438), LTRIM$(STR$(P.Age)), Layer(1)
_PRINTSTRING (506, 332), LTRIM$(STR$(ABS(Attack_Bonus))), Layer(1)
_PRINTSTRING (508, 528), LTRIM$(STR$(ABS(Ac_Bonus))), Layer(1)
IF Attack_Bonus > 0 THEN _PUTIMAGE (542, 346), Layer(4), Layer(1), (0, 280)-STEP(14, 14)
IF Attack_Bonus < 0 THEN _PUTIMAGE (542, 346), Layer(4), Layer(1), (0, 295)-STEP(14, 14)
IF Ac_Bonus > 0 THEN _PUTIMAGE (544, 544), Layer(4), Layer(1), (0, 280)-STEP(14, 14)
IF Ac_Bonus < 0 THEN _PUTIMAGE (544, 544), Layer(4), Layer(1), (0, 295)-STEP(14, 14)
_FONT Font(3), Layer(1)
_PRINTSTRING (293 - 19 * (LEN(RTRIM$(Titles(P.Title))) / 2), 144), Titles(P.Title), Layer(1)
END SUB
SUB Fill_Pack
_FONT Font(1)
_PRINTSTRING (293 - 18 * (LEN(RTRIM$(P.Name)) / 2), 28), P.Name
_PUTIMAGE (590, 80), Layer(3), Layer(0), (160 * P.Ix, 120 * P.Iy)-STEP(159, 119)
_FONT Font(2)
_PRINTSTRING (600, 276), LTRIM$(STR$(P.Cp))
_PRINTSTRING (600, 298), LTRIM$(STR$(P.Sp))
_PRINTSTRING (600, 321), LTRIM$(STR$(P.Gp))
_PRINTSTRING (600, 344), LTRIM$(STR$(P.Pp))
_PRINTSTRING (600, 370), LTRIM$(STR$(Load_Weight)) + "Kg"
FOR i%% = 0 TO 11 STEP 2
_PRINTSTRING (60, 210), RTRIM$(Item(Pack(i%%, 0)).Name)
_PRINTSTRING (335, 210), RTRIM$(Item(Pack(i%% + 1, 0)).Name)
IF Pack(i%%, 1) > 0 THEN _PRINTSTRING (247, 212 + 25 * i%%), LTRIM$(STR$(Pack(i%%, 1)))
IF Pack(i%% + 1, 1) > 0 THEN _PRINTSTRING (522, 212 + 25 * i%%), LTRIM$(STR$(Pack(i%% + 1, 1)))
NEXT i%%
_FONT Font(3)
_PRINTSTRING (293 - 19 * (LEN(RTRIM$(Titles(P.Title))) / 2), 144), Titles(P.Title)
FOR i%% = 0 TO 11 STEP 2
IF Pack(i%%, 1) > 0 THEN _PRINTSTRING (230, 220 + 25 * i%%), "x"
IF Pack(i%% + 1, 1) > 0 THEN _PRINTSTRING (505, 220 + 25 * i%%), "x"
NEXT i%%
END SUB
FUNCTION Load_Weight!
Result& = 7000 'base weight of empty pack(grams)
Result& = Result& + P.Cp * 5 + P.Sp * 5 + P.Gp * 5 + P.Pp * 5 'weight of coins
Result& = Result& + Wep(P.Weapon).Weight + Arm(P.Armor).Weight 'weight of main equiped items
FOR i%% = 1 TO 12 'weight of items in pack
T& = T& + Item(Pack(i%%, 0)).Weight * Pack(i%%, 1)
NEXT i%%
KgOut! = Result& + T&
Load_Weight = INT(KgOut! / 10) / 100 '0.01 inc
END FUNCTION
FUNCTION Attack_Bonus%%
IF P.Strength <= 3 THEN Result%% = -1
IF P.Strength = 1 THEN Result%% = -2
IF P.Strength = 0 THEN Result%% = 0 'dont allow -1 before stat creation
IF P.Strength >= 13 THEN Result%% = 1
IF P.Strength = 15 THEN Result%% = 2
Attack_Bonus = Wep(P.Weapon).Pow + Result%%
END FUNCTION
FUNCTION Ac_Bonus%%
IF P.Dexterity <= 3 THEN Result%% = -1
IF P.Dexterity = 1 THEN Result%% = -2
IF P.Dexterity = 0 THEN Result%% = 0 'dont allow -1 before stat creation
IF P.Dexterity >= 13 THEN Result%% = 1
IF P.Dexterity = 15 THEN Result%% = 2
Ac_Bonus = Arm(P.Armor).Ac + Result%%
END FUNCTION
SUB Enter_Name
DO
_PUTIMAGE , Layer(6), Layer(1)
KBD& = _KEYHIT
SELECT CASE KBD&
CASE 13
ExitFlag%% = TRUE
P.Name = n$
IF n$ = "" THEN P.Name = "Loser"
CASE 8 'Back Space
n$ = LEFT$(n$, LEN(n$) - 1)
CASE 32 TO 122
IF LEN(n$) < 16 THEN n$ = n$ + CHR$(KBD&)
END SELECT
_PRINTSTRING (144, 144), "Pick a Name " + STR$(LEN(n$)) + "of 16 letters", Layer(1)
_PRINTSTRING (293 - 18 * 8, 28), n$, Layer(1)
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
LOOP UNTIL ExitFlag%%
L%% = LEN(RTRIM$(P.Name))
END SUB
SUB MFI_Loader (FN$)
DIM Size(128) AS LONG, FOffset(128) AS LONG
OPEN FN$ FOR BINARY AS #1
GET #1, , c~%% 'retrieve number of files
FOR I~%% = 1 TO c~%%
GET #1, , FOffset(I~%%)
GET #1, , Size(I~%%)
FOffset&(I~%%) = FOffset&(I~%%) + 1
NEXT I~%%
Layer(2) = LoadGFX(FOffset(1), Size(1))
Layer(3) = LoadGFX(FOffset(2), Size(2))
Layer(4) = LoadGFX(FOffset(3), Size(3))
Layer(5) = LoadGFX(FOffset(4), Size(4))
Layer(6) = LoadGFX(FOffset(5), Size(5))
Font(1) = LoadFFX(FOffset(6), Size(6), 40)
Font(2) = LoadFFX(FOffset(6), Size(6), 24)
Font(3) = LoadFFX(FOffset(7), Size(7), 24)
CLOSE #1
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB
REM '$include: 'MFI_Loader2.bi'
FUNCTION LoadGFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadGFX& = _LOADIMAGE("temp.dat", 32)
END FUNCTION
FUNCTION LoadFFX& (Foff&, Size&, Fize%%)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadFFX& = _LOADFONT("temp.dat", Fize%%, "monospace")
END FUNCTION
FUNCTION LoadSFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadSFX& = _SNDOPEN("temp.dat")
END FUNCTION
RE: A little Basic D&D character Generator. - SMcNeill - 12-28-2023
Believe it or not, this is the *EXACT* same style program which got me into programming allllll those many ages ago, back when I was a kid. Back then, we played D&D all the time, and the concept of being able to create a character with the computer doing all the heavy lifting was truly appealing, and this is 100% the first REAL program I ever wrote. Back then, we played under 2nd edition rules, so I had fun sorting out which race could be what class, what multi-class, which alignments, what minimal stats were required, proper saving throws to use, ect, ect...
AD&D and character creation is what drew me into programming all those ages ago. It's nice to see folks are still following in that tradition and are still writing programs to help them with their games. Just out of curiousity, which edition is this tool for? I was going to work on a 5th edition version sometime soon(tm), and just got a copy of all the 5th ed rulebooks not so long ago to use for reference. If you need a copy of those books, let me know, and I'll hook you up with the whole shebang of everything 5th ed, if you want them.
RE: A little Basic D&D character Generator. - Cobalt - 12-29-2023
(12-28-2023, 10:04 PM)SMcNeill Wrote: Believe it or not, this is the *EXACT* same style program which got me into programming allllll those many ages ago, back when I was a kid. Back then, we played D&D all the time, and the concept of being able to create a character with the computer doing all the heavy lifting was truly appealing, and this is 100% the first REAL program I ever wrote. Back then, we played under 2nd edition rules, so I had fun sorting out which race could be what class, what multi-class, which alignments, what minimal stats were required, proper saving throws to use, ect, ect...
AD&D and character creation is what drew me into programming all those ages ago. It's nice to see folks are still following in that tradition and are still writing programs to help them with their games. Just out of curiousity, which edition is this tool for? I was going to work on a 5th edition version sometime soon(tm), and just got a copy of all the 5th ed rulebooks not so long ago to use for reference. If you need a copy of those books, let me know, and I'll hook you up with the whole shebang of everything 5th ed, if you want them.
I didn't really pick one, I just garnered a quick look online for the base stats and went from there. Though I could use the 1st edition DMG that I was given by my older brother long ago. along with a lot of other AD&D books. Though I really wasn't going for a hard core D&D but more of an "inspired by" kind of thing. More than likely the stuff I glanced over online would be 5th edition based.
But again, I'm not really sure just what to do with this now, I was just playing around with ideas, like each coin weighs 5 grams and the most that could be carried in a pack would be 10000 coin at which time the pack would break beyond repair. Or small coin pouches could carry 100 coins with out loosing any, or 150 with a 20% chance of coins falling out. That's where this stemmed from anyway. I'd like to put it to use in a game, but I really don't have a story or even an idea for a story to try and develop.
RE: A little Basic D&D character Generator. - James D Jarvis - 12-30-2023
Neato. I'm playing with this sort of thing all the time.
RE: A little Basic D&D character Generator. - SpriggsySpriggs - 01-03-2024
I've never played Dungeons and Dragons (unless you count Baldur's Gate 3 on PC) but this would probably make it kind of fun to try.
RE: A little Basic D&D character Generator. - OldMoses - 01-07-2024
Ah, role playing. One of those hobbies that life has put on a back burner, but I still find myself using as an excuse to code.
I used to play D&D and I probably tried writing a character generator in Applesoft Basic, but I don't know whatever became of such a thing if I had done it. I pretty quickly went to Chaosium's Runequest game system and never looked back. I wrote several character generators for that system, one for each edition that I went to. RQ characters are VERY data driven and there are lots of tables and modifiers to deal with, so a generator is a must have for me. RQ is a lethal system, so characters die in droves and it takes a great deal of time to create them. The latest one is written in QB64 and is both a generator and database system that handles multiple characters at once. I once posted it on the old forum.
I also GM'ed Traveller, which is the inspiration for my starship combat utility. I have yet to try a character generator for that one. Traveller is a strange one where a character can "die" during chargen.