Login

***Cobalt*** · 12-28-2023, 09:34 PM

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

**SMcNeill** · 12-28-2023, 10:04 PM

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.

Wink

***Cobalt*** · 12-29-2023, 01:36 AM

(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.

James D Jarvis · 12-30-2023, 01:17 AM

Neato. I'm playing with this sort of thing all the time.

SpriggsySpriggs · 01-03-2024, 12:39 PM

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.

OldMoses · 01-07-2024, 01:52 PM

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.

Login
Username/Email:
Password:	Lost Password?
	Remember me