Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
A little Basic D&D character Generator.
#1
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



Attached Files
.mfi   ADDCharMaker.MFI (Size: 1.6 MB / Downloads: 40)
Reply


Messages In This Thread
A little Basic D&D character Generator. - by Cobalt - 12-28-2023, 09:34 PM



Users browsing this thread: 4 Guest(s)