home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / vrac / editdsg.zip / EDITDSG.BAS next >
BASIC Source File  |  1994-11-30  |  12KB  |  456 lines
  1. DECLARE FUNCTION PlayerDesc$ (FieldType$, PlayerValue AS LONG)
  2. DECLARE FUNCTION PlayerInc (FieldType$, PlayerValue AS LONG)
  3. DECLARE FUNCTION Getkey ()
  4.   
  5.    'DOOM 2 SaveGame Editor (1.666).
  6.    '
  7.    'Purpose: To modify files DOOMSAV?.DSG (the saved-games files).
  8.    '
  9.    'Date: November 29, 1994
  10.    '
  11.    'To be executed in the MSDOS QBASIC Interpreter.
  12.    'The current working directory should contain the .DSG files
  13.  
  14.    TYPE datat
  15.      Label AS STRING * 20
  16.      FieldType AS STRING * 160
  17.      Address AS INTEGER
  18.    END TYPE
  19.  
  20.    CONST MAXPLAYERS = 2
  21.    CONST MAXITEMS = 100
  22.  
  23.    CONST PGUP = -73
  24.    CONST PGDOWN = -81
  25.    CONST LEFT = -75
  26.    CONST RIGHT = -77
  27.    CONST UP = -72
  28.    CONST DOWN = -80
  29.    CONST ENTER = 13
  30.    CONST CTRLC = 3
  31.    CONST ESCAPE = 27
  32.   
  33.    DIM dirlist(40) AS STRING * 60
  34.    DIM datatable(MAXITEMS) AS datat
  35.    DIM PlayerValue(MAXPLAYERS, MAXITEMS) AS LONG
  36.    DIM PlayerCol(MAXPLAYERS) AS INTEGER
  37.    DIM byte1 AS STRING * 1
  38.    DIM byte2 AS STRING * 2
  39.    DIM byte50 AS STRING * 50
  40.  
  41.    title$ = "DOOM][ SaveGame Editor"
  42.    tmpfile$ = "~DSGEDIT.!~}"
  43.   
  44.    FOR i = 1 TO MAXPLAYERS
  45.      PlayerCol(i) = 3 + (i * 12)
  46.    NEXT i
  47.  
  48.    FOR i = 1 TO 40
  49.      dirlist(i) = SPACE$(60)
  50.    NEXT i
  51.   
  52.    SCREEN 0
  53.    WIDTH 80, 50
  54.    COLOR 7, 1
  55.    GOSUB loaddata
  56.    GOSUB getdirlisting
  57.   
  58.    DO
  59.      GOSUB displaydirlisting
  60.      LOCATE 49, 49: LINE INPUT ; todo$
  61.      IF RTRIM$(todo$) = "" THEN EXIT DO
  62.      IF dirlength = 0 THEN EXIT DO
  63.      filenum = INT(VAL(todo$))
  64.      IF filenum >= 1 AND filenum <= dirlength THEN
  65.         OPEN LEFT$(dirlist(filenum), 12) FOR BINARY AS #2
  66.         GOSUB displayplayer
  67.         GOSUB editplayer
  68.         CLOSE #2
  69.      ELSE
  70.         LOCATE 49, 1: PRINT SPACE$(78);
  71.         LOCATE 49, 1: PRINT "INVALID SAVEGAME NUMBER.  PRESS [ENTER]...";
  72.         LINE INPUT ; todo$
  73.      END IF
  74.    LOOP
  75.   
  76.    SCREEN 0
  77.    WIDTH 80, 25
  78.    END
  79.  
  80. getdirlisting:
  81.    SHELL "dir *.dsg > " + tmpfile$   'Generate directory listing into text file
  82.    OPEN tmpfile$ FOR INPUT AS #1
  83.   
  84.    i = 0
  85.    ERASE dirlist       'Clear out .DSG directory listing array
  86.    DO WHILE EOF(1) = 0   'Load .DSG directory listing into array from tmp file
  87.       LINE INPUT #1, buffer$
  88.       IF LEN(buffer$) > 40 AND MID$(buffer$, 14, 3) <> "DIR" AND MID$(buffer$, 10, 3) = "DSG" THEN
  89.          i = i + 1
  90.          dirlist(i) = RTRIM$(MID$(buffer$, 1, 8)) + "." + RTRIM$(MID$(buffer$, 10, 3))
  91.         
  92.          OPEN dirlist(i) FOR BINARY AS #3  'Get .DSG file description
  93.            GET #3, 1, byte50
  94.            tmp1 = INSTR(1, byte50, CHR$(0))
  95.            IF tmp1 > 1 THEN
  96.              MID$(dirlist(i), 16, tmp1 - 1) = MID$(byte50, 1, tmp1 - 1)
  97.              MID$(dirlist(i), 45, 11) = MID$(byte50, 25, 11)
  98.            END IF
  99.          CLOSE #3
  100.  
  101.       END IF
  102.       IF i >= 40 THEN EXIT DO
  103.    LOOP
  104.    CLOSE #1
  105.    KILL tmpfile$
  106.    dirlength = i
  107. RETURN
  108.  
  109. displaydirlisting:
  110.    CLS
  111.    LOCATE 1, 1: PRINT title$
  112.    LOCATE 1, 32: PRINT "Saved-Game Directory Listing"
  113.    
  114.    COLOR 15, 1
  115.    LOCATE 3, 15: PRINT "Filename";
  116.    LOCATE 3, 30: PRINT "Description";
  117.    LOCATE 3, 59: PRINT "Version";
  118.    COLOR 7, 1
  119.  
  120.    FOR i = 1 TO dirlength
  121.      LOCATE i + 3, 10: PRINT RTRIM$(STR$(i)); ") ", dirlist(i)
  122.    NEXT i
  123.    IF dirlength = 0 THEN
  124.      LOCATE 4, 10: PRINT "<No .DSG Files found>"
  125.      LOCATE 49, 1: PRINT "[ENTER] = Exit.";
  126.    ELSE
  127.      LOCATE 49, 1: PRINT "Enter SaveGame number to edit, [ENTER] to quit: ";
  128.    END IF
  129.    
  130. RETURN
  131.  
  132.  
  133. readdatafile:
  134.  
  135.   'Load Player Data
  136.  
  137.   FOR Player = 1 TO MAXPLAYERS
  138.     FOR i = 1 TO datatablelen
  139.       GET #2, datatable(i).Address + 1 + ((Player - 1) * 280), byte2
  140.       a = ASC(LEFT$(byte2, 1))
  141.       b = ASC(RIGHT$(byte2, 1))
  142.       readtmp$ = RTRIM$(datatable(i).FieldType)
  143.       IF readtmp$ = "Int" OR readtmp$ = "2123" THEN
  144.         PlayerValue(Player, i) = a + (256 * b)
  145.       ELSE
  146.         PlayerValue(Player, i) = a
  147.       END IF
  148.     NEXT i
  149.   NEXT Player
  150.  
  151. RETURN
  152.  
  153. writedatafile:
  154.   'Player Write data
  155.  
  156.   FOR Player = 1 TO MAXPLAYERS
  157.     FOR i = 1 TO datatablelen
  158.       b = INT(PlayerValue(Player, i) / 256)
  159.       a = PlayerValue(Player, i) - (b * 256)
  160.    
  161.       writetmp$ = RTRIM$(datatable(i).FieldType)
  162.       IF writetmp$ = "Int" OR writetmp$ = "2123" THEN
  163.         byte2 = CHR$(a) + CHR$(b)
  164.         PUT #2, datatable(i).Address + 1 + ((Player - 1) * 280), byte2
  165.       ELSE
  166.         byte1 = CHR$(a)
  167.         PUT #2, datatable(i).Address + 1 + ((Player - 1) * 280), byte1
  168.       END IF
  169.     NEXT i
  170.   NEXT Player
  171.  
  172. RETURN
  173.  
  174. displayplayer:
  175.   CLS
  176.  
  177.   GOSUB readdatafile
  178.  
  179.   LOCATE 1, 1: PRINT title$;
  180.   LOCATE 1, 32: PRINT "Current File: "; MID$(dirlist(filenum), 1, 30);
  181.  
  182.   COLOR 15, 1
  183.   FOR i = 1 TO MAXPLAYERS
  184.     LOCATE 2, PlayerCol(i): PRINT "Player"; LTRIM$(STR$(i));
  185.   NEXT i
  186.   COLOR 7, 1
  187.  
  188.   '
  189.   'Print Player data
  190.   '
  191.   FOR i = 1 TO datatablelen
  192.     LOCATE i + 2, 1: PRINT datatable(i).Label;
  193.     FOR j = 1 TO MAXPLAYERS
  194.       SELECT CASE RTRIM$(datatable(i).FieldType)
  195.          CASE IS = "Int", "2123"
  196.            tmpdata$ = LTRIM$(STR$(PlayerValue(j, i)))
  197.          CASE ELSE
  198.            tmpdata$ = PlayerDesc$(datatable(i).FieldType, PlayerValue(j, i))
  199.       END SELECT
  200.       LOCATE i + 2, PlayerCol(j): PRINT tmpdata$;
  201.     NEXT j
  202.   NEXT i
  203.  
  204.   LOCATE 49, 1: PRINT "Arrows = Move   + or =: Add1    - or _: Sub1    PGUP: Add10  PGDOWN: Sub10";
  205.   LOCATE 50, 1: PRINT "ESCAPE = Done   . or >: Add100  , or <: Sub100    SPACEBAR = Toggle";
  206.  
  207. RETURN
  208.  
  209. editplayer:
  210.   Player = 1
  211.   item = 1
  212.  
  213.   DO
  214.     LOCATE item + 2, PlayerCol(Player) - 1, 1, 0, 8
  215.     keyhit = Getkey
  216.     
  217.     SELECT CASE keyhit
  218.       CASE IS = ESCAPE, CTRLC
  219.         EXIT DO
  220.       CASE IS = LEFT
  221.         Player = Player - 1
  222.         IF Player < 1 THEN
  223.           Player = MAXPLAYERS
  224.           item = item - 1
  225.         END IF
  226.         IF item < 1 THEN item = 1
  227.       CASE IS = RIGHT
  228.         Player = Player + 1
  229.         IF Player > MAXPLAYERS THEN
  230.           Player = 1
  231.           item = item + 1
  232.         END IF
  233.         IF item > datatablelen THEN item = datatablelen
  234.       CASE IS = UP
  235.         IF item > 1 THEN item = item - 1
  236.       CASE IS = DOWN
  237.         IF item < datatablelen THEN item = item + 1
  238.       CASE IS = PGUP
  239.         changeval = 10
  240.         GOSUB increment
  241.       CASE IS = PGDOWN
  242.         changeval = 10
  243.         GOSUB decrement
  244.       CASE IS = ASC("-"), ASC("_")
  245.         changeval = 1
  246.         GOSUB decrement
  247.       CASE IS = ASC("="), ASC("+")
  248.         changeval = 1
  249.         GOSUB increment
  250.       CASE IS = ASC("["), ASC(","), ASC("<")
  251.         changeval = 100
  252.         GOSUB decrement
  253.       CASE IS = ASC("]"), ASC("."), ASC(">")
  254.         changeval = 100
  255.         GOSUB increment
  256.       CASE IS = 32   'Spacebar
  257.         fieldtypetmp$ = RTRIM$(datatable(item).FieldType)
  258.           IF fieldtypetmp$ <> "Int" AND fieldtypetmp$ <> "2123" THEN
  259.           PlayerValue(Player, item) = PlayerInc(datatable(item).FieldType, PlayerValue(Player, item))
  260.           LOCATE item + 2, PlayerCol(Player)
  261.           PRINT PlayerDesc$(datatable(item).FieldType, PlayerValue(Player, item))
  262.         END IF
  263.       CASE ELSE
  264.     END SELECT
  265.   LOOP
  266.   
  267.   
  268.   DO
  269.     LOCATE 48, 1: PRINT SPACE$(60);
  270.     LOCATE 48, 1: PRINT "Save changes? (Y/N) ";
  271.     keyhit = Getkey
  272.     SELECT CASE keyhit
  273.       CASE ASC("Y"), ASC("y")
  274.         PRINT "Yes, Writing changes...";
  275.         GOSUB writedatafile
  276.         EXIT DO
  277.       CASE ASC("N"), ASC("n")
  278.         PRINT "No, exiting.";
  279.         EXIT DO
  280.       CASE ELSE
  281.     END SELECT
  282.   LOOP
  283.  
  284. RETURN
  285.  
  286. increment:
  287.   incrtmp$ = RTRIM$(datatable(item).FieldType)
  288.   IF incrtmp$ = "2123" THEN
  289.     changeval = 2123
  290.     incrtmp$ = "Int"
  291.   END IF
  292.   IF incrtmp$ = "Int" THEN
  293.      PlayerValue(Player, item) = PlayerValue(Player, item) + changeval
  294.      IF PlayerValue(Player, item) > 64000 THEN PlayerValue(Player, item) = 64000
  295.      LOCATE item + 2, PlayerCol(Player)
  296.      PRINT LEFT$(LTRIM$(STR$(PlayerValue(Player, item))) + SPACE$(5), 5);
  297.   END IF
  298. RETURN
  299.  
  300. decrement:
  301.   incrtmp$ = RTRIM$(datatable(item).FieldType)
  302.   IF incrtmp$ = "2123" THEN
  303.     changeval = 2123
  304.     incrtmp$ = "Int"
  305.   END IF
  306.   IF incrtmp$ = "Int" THEN
  307.      PlayerValue(Player, item) = PlayerValue(Player, item) - changeval
  308.      IF PlayerValue(Player, item) < 0 THEN PlayerValue(Player, item) = 0
  309.      LOCATE item + 2, PlayerCol(Player)
  310.      PRINT LEFT$(LTRIM$(STR$(PlayerValue(Player, item))) + SPACE$(5), 5);
  311.   END IF
  312. RETURN
  313.  
  314. loaddata:
  315.   i = 1
  316.  
  317.   FOR i = 1 TO MAXITEMS
  318.     READ tmp1$, tmp3, tmp2$
  319.     IF tmp3 = -1 THEN EXIT FOR
  320.     datatable(i).Label = tmp1$
  321.     datatable(i).FieldType = tmp2$
  322.     datatable(i).Address = tmp3
  323.     FOR Player = 1 TO MAXPLAYERS
  324.       PlayerValue(Player, i) = 0
  325.     NEXT Player
  326.   NEXT i
  327.  
  328.   datatablelen = i - 1
  329.  
  330. RETURN
  331.  
  332. '    Label        Addr Field Type
  333. '    ==========    === =================
  334. DATA Health       , 84,Int
  335. DATA Armor        , 88,Int
  336. DATA Invulnerable , 96,2123
  337. DATA Beserk       ,100,2123
  338. DATA Invisible    ,104,2123
  339. DATA Radiation    ,108,2123
  340. DATA Computer Map?,112,(0)No _(1)Yes_
  341. DATA Light Amp    ,116,2123
  342. DATA Blue Key?    ,120,(0)No _(1)Yes_
  343. DATA Yellow Key?  ,124,(0)No _(1)Yes_
  344. DATA Red Key?     ,128,(0)No _(1)Yes_
  345. DATA Blu Skul Key?,132,(0)No _(1)Yes_
  346. DATA Yel Skul Key?,136,(0)No _(1)Yes_
  347. DATA Red Skul Key?,140,(0)No _(1)Yes_
  348. DATA #Player Kills,148,Int
  349. DATA Curr Weapon  ,164,(0)Knuckles  _(1)Pistol    _(2)Shot gun  _(3)Chain gun _(4)Rocket gun_(5)Plasma gun_(6)BFG9000   _(7)Chainsaw  _(8)Supershotg_
  350. DATA Pistol?      ,176,(0)No _(1)Yes_
  351. DATA Shotgun?     ,180,(0)No _(1)Yes_
  352. DATA Chaingun?    ,184,(0)No _(1)Yes_
  353. DATA Rocketgun?   ,188,(0)No _(1)Yes_
  354. DATA Plasmagun?   ,192,(0)No _(1)Yes_
  355. DATA BFG9000?     ,196,(0)No _(1)Yes_
  356. DATA Chainsaw?    ,200,(0)No _(1)Yes_
  357. DATA SuperShotgun?,204,(0)No _(1)Yes_
  358. DATA #Bullets     ,208,Int
  359. DATA #Shells      ,212,Int
  360. DATA #Cells       ,216,Int
  361. DATA #Rockets     ,220,Int
  362. DATA Max Bullets  ,224,Int
  363. DATA Max Shells   ,228,Int
  364. DATA Max Cells    ,232,Int
  365. DATA Max Rockets  ,236,Int
  366. DATA Special      ,248,(0)None       _(1)Thru walls _(2)God Mode   _(3)God+ThrWall_
  367. DATA Bonus Health ,260,Int
  368.  
  369.  
  370. DATA -1,-1,-1
  371.  
  372. FUNCTION Getkey
  373.   
  374.   DO
  375.     tmp$ = INKEY$
  376.   LOOP WHILE tmp$ = ""
  377.  
  378.   IF LEN(tmp$) > 1 THEN
  379.     returnval = -ASC(RIGHT$(tmp$, 1))
  380.   ELSE
  381.     returnval = ASC(tmp$)
  382.   END IF
  383.  
  384.   Getkey = returnval
  385.  
  386. END FUNCTION
  387.  
  388. FUNCTION PlayerDesc$ (FieldType$, PlayerValue AS LONG)
  389.   tmp1 = INSTR(1, FieldType$, "(" + LTRIM$(RTRIM$(STR$(PlayerValue))) + ")")
  390.   IF tmp1 = 0 THEN
  391.     PlayerDesc$ = "   "
  392.     EXIT FUNCTION
  393.   END IF
  394.  
  395.   tmp2 = INSTR(tmp1, FieldType$, ")")
  396.   tmp3 = INSTR(tmp1, FieldType$, "_")
  397.  
  398.   IF tmp3 = 0 THEN tmp3 = LEN(FieldType$)
  399.   IF tmp2 + 1 >= tmp3 - 1 THEN
  400.     PlayerDesc$ = "   "
  401.     EXIT FUNCTION
  402.   END IF
  403.   PlayerDesc$ = MID$(FieldType$, tmp2 + 1, tmp3 - tmp2 - 1)
  404. END FUNCTION
  405.  
  406. FUNCTION PlayerInc (FieldType$, PlayerValue AS LONG)
  407.  
  408.    tmp1 = INSTR(1, FieldType$, "(" + LTRIM$(RTRIM$(STR$(PlayerValue))) + ")")
  409. PRINT PlayerValue
  410.  
  411.    IF tmp1 = 0 THEN
  412.      PlayerInc = PlayerValue
  413.      EXIT FUNCTION
  414.    END IF
  415.  
  416.    tmp2 = INSTR(tmp1 + 1, FieldType$, "(")
  417.    IF tmp2 = 0 THEN
  418.      GOSUB WrapAround
  419.      EXIT FUNCTION
  420.    END IF
  421.     
  422.    tmp3 = INSTR(tmp2, FieldType$, ")")
  423.     
  424.    IF tmp3 = 0 THEN
  425.      GOSUB WrapAround
  426.      EXIT FUNCTION
  427.    END IF
  428.  
  429.    IF tmp2 >= tmp3 THEN
  430.      PlayerInc = 0
  431.      EXIT FUNCTION
  432.    END IF
  433.  
  434.    PlayerInc = VAL(MID$(FieldType$, tmp2 + 1, tmp3 - tmp2 - 1))
  435.    EXIT FUNCTION
  436.  
  437. WrapAround:
  438.   
  439.   tmp2 = INSTR(1, FieldType$, "(")
  440.   IF tmp2 = 0 THEN
  441.     PlayerInc = PlayerValue
  442.     RETURN
  443.   END IF
  444.  
  445.   tmp3 = INSTR(tmp2, FieldType$, ")")
  446.   IF tmp3 = 0 THEN
  447.     PlayerInc = PlayerValue
  448.     RETURN
  449.   END IF
  450.   
  451.   PlayerInc = VAL(MID$(FieldType$, tmp2 + 1, tmp3 - tmp2 - 1))
  452.   RETURN
  453.  
  454. END FUNCTION
  455.  
  456.