SHARE
TWEET

Daggerfall Launcher

a guest Jul 11th, 2011 123 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/bin/perl
  2. use warnings;
  3. use strict;
  4.  
  5. #=================================================================================
  6. #  Daggerfall Launcher
  7. #=================================================================================
  8. #
  9. #  This launcher should work, but I cannot guarantee that,
  10. #  it was written on Arch Linux and not tried anywhere else
  11. #  if you want to use it on other system, adjust configuration
  12. #  below and keep your fingers crossed!
  13. #
  14. #  Run it with "--help" option to get help.
  15. #
  16. #  Remember that you use it at your own risk :-)
  17.  
  18. #=================================================================================
  19. #  License
  20. #=================================================================================
  21. # Copyright (C) 2011 by Andrzej Giniewicz <gginiu@gmail.com>
  22. #
  23. # Permission is hereby granted, free of charge, to any person obtaining a copy
  24. # of this software and associated documentation files (the "Software"), to deal
  25. # in the Software without restriction, including without limitation the rights
  26. # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  27. # copies of the Software, and to permit persons to whom the Software is
  28. # furnished to do so, subject to the following conditions:
  29. #
  30. # The above copyright notice and this permission notice shall be included in
  31. # all copies or substantial portions of the Software.
  32. #
  33. # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  34. # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  35. # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  36. # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  37. # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  38. # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  39. # THE SOFTWARE.
  40.  
  41. #=================================================================================
  42. #  Configuration variables
  43. #=================================================================================
  44. my $user_group = 'games';
  45. my $daggerfall_path = "/usr/share/games/daggerfall";
  46. my $license = "/usr/share/licenses/daggerfall/license";
  47. my $dosbox = "/usr/bin/dosbox";
  48. my $dosbox_config = "dagger.conf";
  49. my $daggerfall_dir = "DAGGER";
  50. my $palettes_dir = "palettes";
  51. my $license_lock = "terms-accepted";
  52. my $save_backup_dir = "save-backups";
  53. my $archive_type = ".tar.xz";
  54. my $archiver_pack = "tar -cJf 'ARCHIVE' *";
  55. my $archiver_unpack = "tar -xJf 'ARCHIVE'";
  56. my $mods_dir = "mods";
  57. my $mod_backup_dir = "modbackup";
  58.  
  59. #=================================================================================
  60. #  Declarations and description of available functions
  61. #=================================================================================
  62.  
  63. # check if terms of use were accepted
  64. #   no arguments
  65. #   returns boolean
  66. sub terms_accepted;
  67.  
  68. # get terms of use
  69. #   no arguments
  70. #   returns array of lines
  71. sub get_terms;
  72.  
  73. # accept terms of use
  74. #   no arguments
  75. #   no return value
  76. sub accept_terms;
  77.  
  78. # run Daggerfall, requires that terms of use are already accepted
  79. #   no arguments
  80. #   no return value
  81. sub run_daggerfall;
  82.  
  83. # run sound setup utility
  84. #   no arguments
  85. #   no return value
  86. sub run_setup;
  87.  
  88. # run save fixing utility
  89. #   no arguments
  90. #   no return value
  91. sub run_fixsave;
  92.  
  93. # run map fixing utility
  94. #   no arguments
  95. #   no return value
  96. sub run_fixmaps;
  97.  
  98. # get brightness increase in steps
  99. # (0 steps = no change; 1 step = multiply gamma by 1.1, 2 steps = multiply gamma by 1.2, etc)
  100. #   no arguments
  101. #   returns number
  102. sub get_brightness;
  103.  
  104. # set brightness increase in steps
  105. # (0 steps = no change; 1 step = multiply gamma by 1.1, 2 steps = multiply gamma by 1.2, etc)
  106. #   takes number of steps
  107. #   no return value
  108. sub set_brightness;
  109.  
  110. # get wagon capacity in lbs
  111. #   no arguments
  112. #   returns number
  113. sub get_wagon_capacity;
  114.  
  115. # set wagon capacity in lbs
  116. #   takes number representing wagon capacity
  117. #   no return value
  118. sub set_wagon_capacity;
  119.  
  120. # check if skill levels above 100 are unlocked
  121. #   no arguments
  122. #   returns boolean
  123. sub get_high_skills;
  124.  
  125. # enable or disable skill levels above 100
  126. #   takes boolean, 0 to disable, 1 to enable
  127. #   no return value
  128. sub set_high_skills;
  129.  
  130. # get view distance in save stored in given slot
  131. #   takes save slot number (0 to 5)
  132. #   returns view distance (0 to 255)
  133. sub get_view_distance;
  134.  
  135. # set view distance in save stored in given slot
  136. # (in-game this cannot be set higher than 127)
  137. #   takes save slot number (0 to 5) and view distance (0 to 255)
  138. #   no return value
  139. sub set_view_distance;
  140.  
  141. # check if cheat mode is enabled
  142. #   no arguments
  143. #   returns boolean
  144. sub get_cheat_mode;
  145.  
  146. # enable or disable cheat mode
  147. #   takes boolean, 0 to disable, 1 to enable
  148. #   no return value
  149. sub set_cheat_mode;
  150.  
  151. # check if magic item repairs are enabled
  152. #   no arguments
  153. #   returns boolean
  154. sub get_magic_repair;
  155.  
  156. # enable or disable magic item repairs
  157. #   takes boolean, 0 to disable, 1 to enable
  158. #   no return value
  159. sub set_magic_repair;
  160.  
  161. # get current save names
  162. #   no arguments
  163. #   returns hash from slot numbers (0-5) to save names (strings)
  164. sub get_current_saves;
  165.  
  166. # get archived save names
  167. #   no arguments
  168. #   returns hash from slot numbers (0-5) to hashes from names (strings) to array
  169. #           of dates (YYYY_MM_DD_HH_MM_SS) when saves were archived
  170. sub get_archived_saves;
  171.  
  172. # archive current save from given slot
  173. #   takes slot number (0-5)
  174. #   no return value
  175. sub archive_save;
  176.  
  177. # check if there is save in given slot
  178. #   takes slot number (0-5)
  179. #   returns boolean, 1 for occupied slot, 0 otherwise
  180. sub is_slot_occupied;
  181.  
  182. # restore selected save into given slot
  183. # (possible specifications:
  184. #    (slot numer) -> same as (slot number)-(game name), where (game name) is
  185. #      name of game currently in given slot
  186. #    (slot number)-(game name) -> same as (slot number)-(game name)-(date),
  187. #      where (date) is date of last archived save from given slot with given name
  188. #    (slot number)-(game name)-(date) -> full specification, unpacks save named
  189. #     (game name) archived from slot (slot number) on (date)
  190. #   takes archived save specification (string) and target slot (0-5)
  191. #   no return value
  192. sub restore_save;
  193.  
  194. # get list of installed mods
  195. #   no arguments
  196. #   returns array of installed mod names
  197. sub get_mods;
  198.  
  199. # get list of enabled mods
  200. #   no arguments
  201. #   returns array of enabled mod names
  202. sub get_enabled_mods;
  203.  
  204. # get list of available mod groups
  205. #   no arguments
  206. #   returns array of available mod group names
  207. sub get_mod_groups;
  208.  
  209. # get list of mod or group dependencies
  210. #   no arguments
  211. #   returns array of mod and group names
  212. sub get_direct_mod_dependencies;
  213.  
  214. # get list of mod or group dependencies (recursively)
  215. #   no arguments
  216. #   returns array of mod names
  217. sub get_all_mod_dependencies;
  218.  
  219. # get list of enabled mods requiring given mod
  220. #   takes string (mod name)
  221. #   returns array of mod names
  222. sub get_mods_requiring;
  223.  
  224. # enable mod
  225. #   takes string (name of mod or group to enable)
  226. #   no return value
  227. sub enable_mod;
  228.  
  229. # disable mod
  230. #   takes string (name of mod to disable)
  231. #   no return value
  232. sub disable_mod;
  233.  
  234. # refresh all installed mods to currently installed versions
  235. #   no arguments
  236. #   no return value
  237. sub refresh_mods;
  238.  
  239. #=================================================================================
  240. #  Gory details :-)
  241. #=================================================================================
  242.  
  243. use File::Copy qw(copy move);
  244. use File::Find qw(find);
  245. use File::Path qw(remove_tree);
  246. use File::Spec::Functions qw(catfile);
  247. use List::Util qw(min max);
  248.  
  249. my $gid = getgrnam($user_group);
  250.  
  251. sub terms_accepted
  252. {
  253.         return ( -e catfile($daggerfall_path, $license_lock) );
  254. }
  255.  
  256. sub accept_terms
  257. {
  258.         my $file = catfile($daggerfall_path, $license_lock);
  259.         open(FILE, ">$file") or die "Cannot create license lock";
  260.         close(FILE);
  261.         chmod 0664, $file;
  262.         chown -1, $gid, $file;
  263. }
  264.  
  265. sub get_terms
  266. {
  267.         open(FILE, "<$license") or die "Cannot open license";
  268.         my @text = <FILE>;
  269.         close(FILE);
  270.         return @text;
  271. }
  272.  
  273. sub fix_dirs;
  274. sub fix_dirs
  275. {
  276.         my $path = shift;
  277.         chmod 0775, $path;
  278.         chown -1, $gid, $path;
  279.         opendir(DIR, $path) or die "Cannot access target directory";
  280.         my @files = readdir(DIR);
  281.         closedir(DIR);
  282.         @files = grep(!/\./, @files);
  283.         foreach my $file (@files) {
  284.                 my $full = catfile($path, $file);
  285.                 if ( -d $full) {
  286.                         fix_dirs $full;
  287.                 } else {
  288.                         chmod 0664, $full;
  289.                         chown -1, $gid, $full;
  290.                 }
  291.         }
  292. }
  293.  
  294. sub run_dosbox
  295. {
  296.         my ($app, $exit) = @_;
  297.         terms_accepted or die "Terms of usage not accepted";
  298.         my $run = catfile($daggerfall_path, $daggerfall_dir, $app);
  299.         ( -e $run) or die "Cannot find requested application";
  300.         my $cfg = catfile($daggerfall_path, $dosbox_config);
  301.         ( -e $cfg) or die "Cannot find dosbox config file";
  302.         if ($exit) {
  303.                 system($dosbox." ".$run." -exit -conf ".$cfg);
  304.         } else {
  305.                 system($dosbox." ".$run." -conf ".$cfg);
  306.         }
  307.         fix_dirs catfile($daggerfall_path, $daggerfall_dir);
  308. }
  309.  
  310. sub run_daggerfall
  311. {
  312.         run_dosbox "RUN.BAT", 1;
  313. }
  314.  
  315. sub run_setup
  316. {
  317.         run_dosbox "SETUP.EXE", 1;
  318. }
  319.  
  320. sub run_fixsave
  321. {
  322.         run_dosbox "FIXSAVE.EXE", 0;
  323. }
  324.  
  325. sub run_fixmaps
  326. {
  327.         run_dosbox "FIXMAPS.EXE", 0;
  328. }
  329.  
  330. sub get_brightness
  331. {
  332.  
  333.         my $pal = catfile($daggerfall_path, $palettes_dir);
  334.         ( -d $pal ) or return 0;
  335.  
  336.         my $file = catfile($pal, "now");
  337.         ( -e $file) or return 0;
  338.  
  339.         open(FILE, "<$file") or die "Cannot open brighness record";
  340.         binmode(FILE);
  341.         my $buffer="";
  342.         read(FILE, $buffer, 8);
  343.         close(FILE);
  344.         return unpack("d", $buffer);
  345. }
  346.  
  347. sub set_brightness
  348. {
  349.         my $steps = shift;
  350.         my $gamma = 1+$steps/10;
  351.  
  352.         my %palettes = (
  353.                 'ARENA2' => [
  354.                         "MAP.PAL", "ART_PAL.COL", "DANKBMAP.COL", "FMAP_PAL.COL",
  355.                         "NIGHTSKY.COL", "OLDMAP.PAL", "OLDPAL.PAL", "PAL.PAL", "PAL.RAW"
  356.                 ],
  357.                 'DATA' => [
  358.                         "DAGGER.COL"
  359.                 ]
  360.         );
  361.  
  362.         sub edit_palette
  363.         {
  364.                 my ($source_file, $gamma) = @_;
  365.                 my $palette_size = -s $source_file;
  366.                 my $source;
  367.                 my $target = "";
  368.                 open(FILE, "<$source_file") or die "cannot open $source_file";
  369.                 binmode(FILE);
  370.                 if ($palette_size == 768) {
  371.                         read(FILE, $source, 768);
  372.                 } elsif ($palette_size == 776) {
  373.                         read(FILE, $target, 8);
  374.                         read(FILE, $source, 768);
  375.                 } else {
  376.                         close(FILE);
  377.                         die "$source_file is unknown palette format\n";
  378.                 }
  379.                 close(FILE);
  380.                 $target eq "\x08\x03\x00\x00\x23\xb1\x00\x00"
  381.                         || $target eq ""
  382.                         || die "$source_file is unknown palette format\n";
  383.                 sub transform {
  384.                         my ($c, $g) = @_;
  385.                         return max(0,min(int(255*(0.385/($g-0.5)+0.23)*($c/255)**(1/$g)+0.5),255));
  386.                 }
  387.                 my @source_data = unpack("C*", $source);
  388.                 my @target_data;
  389.                 foreach my $byte (@source_data) {
  390.                         push(@target_data, (transform $byte, $gamma));
  391.                 }
  392.                 $target = $target . pack("C*", @target_data);
  393.                 open(FILE, ">$source_file") or die "cannot write $source_file";
  394.                 binmode(FILE);
  395.                 print FILE $target;
  396.                 close(FILE);
  397.         }
  398.  
  399.         (-d catfile($daggerfall_path, $daggerfall_dir)) or die "Cannot find Daggerfall directory";
  400.  
  401.         my $source_dir = catfile($daggerfall_path, $palettes_dir);
  402.         if ( ! -d $source_dir ) {
  403.                 mkdir $source_dir or die "Cannot create palettes directory";
  404.                 chmod 0775, $source_dir;
  405.                 chown -1, $gid, $source_dir;
  406.         }
  407.  
  408.         foreach my $dir (keys %palettes) {
  409.                 my $target_dir = catfile($daggerfall_path, $daggerfall_dir, $dir);
  410.  
  411.                 foreach my $palette (@{$palettes{$dir}}) {
  412.                         if ( ! -e catfile($source_dir, $palette) ) {
  413.                                 copy(
  414.                                         catfile($target_dir, $palette),
  415.                                         catfile($source_dir, $palette)
  416.                                 ) or die "Cannot copy palette file";
  417.                                 chmod 0664, catfile($source_dir, $palette);
  418.                                 chown -1, $gid, catfile($source_dir, $palette);
  419.                         }
  420.                         copy(
  421.                                 catfile($source_dir, $palette),
  422.                                 catfile($target_dir, $palette)
  423.                         ) or die "Cannot copy palette file";
  424.                         chmod 0664, catfile($target_dir, $palette);
  425.                         chown -1, $gid, catfile($target_dir, $palette);
  426.                         edit_palette(catfile($target_dir, $palette), $gamma);
  427.                 }
  428.         }
  429.  
  430.         my $file = catfile($source_dir, "now");
  431.         open(FILE, ">$file") or die "Cannot save brighness record";
  432.         binmode(FILE);
  433.         print FILE pack("d", $steps);
  434.         close(FILE);
  435. }
  436.  
  437. sub get_wagon_capacity
  438. {
  439.         my $fall = catfile($daggerfall_path, $daggerfall_dir, "FALL.EXE");
  440.         ( -e $fall ) or die "Cannot find FALL.EXE";
  441.         ( -s $fall == 1864183 ) or die "Wrong FALL.EXE length";
  442.         open(FILE, "<$fall") or die "cannot open FALL.EXE";
  443.         binmode(FILE);
  444.         seek(FILE, 917011, 0);
  445.         my $buffer="";
  446.         read(FILE, $buffer, 2);
  447.         close(FILE);
  448.         my @bytes = unpack("C*", $buffer);
  449.         return $bytes[0]/4+$bytes[1]*64;
  450. }
  451.  
  452. sub set_wagon_capacity
  453. {
  454.         my $val = shift;
  455.         my $len = length $val;
  456.         my $rep = int((5-$len)/2);
  457.         my $out = " "x$rep . "/" . " "x$rep . $val;
  458.         if (length $out == 5) { $out = $out." " };
  459.         my $high = int($val/64);
  460.         my $low = 4*$val-256*$high;
  461.         (length $out == 6) and
  462.                 ($low >= 0) and
  463.                 ($low <= 255) and
  464.                 ($high >= 0) and
  465.                 ($high <= 255)
  466.                 or die "Bad value $val.";
  467.         my $bytes = pack("C*", ($low, $high));
  468.         my $fall = catfile($daggerfall_path, $daggerfall_dir, "FALL.EXE");
  469.         ( -e $fall ) or die "Cannot find FALL.EXE";
  470.         ( -s $fall == 1864183 ) or die "Wrong FALL.EXE length";
  471.         open(FILE, "<$fall") or die "cannot open FALL.EXE";
  472.         binmode(FILE);
  473.         my $buffer;
  474.         read(FILE, $buffer, 917011);
  475.         $buffer = $buffer.$bytes;
  476.         seek(FILE, 2, 1);
  477.         read(FILE, $buffer,854164,917013);
  478.         $buffer = $buffer.$out;
  479.         seek(FILE, 6, 1);
  480.         read(FILE, $buffer,93000,1771183);
  481.         close(FILE);
  482.         open(FILE, ">$fall") or die "cannot write FALL.EXE";
  483.         binmode(FILE);
  484.         print FILE $buffer;
  485.         close(FILE);
  486. }
  487.  
  488. sub get_high_skills
  489. {
  490.         my $fall = catfile($daggerfall_path, $daggerfall_dir, "FALL.EXE");
  491.         ( -e $fall ) or die "Cannot find FALL.EXE";
  492.         ( -s $fall == 1864183 ) or die "Wrong FALL.EXE length";
  493.         open(FILE, "<$fall") or die "cannot open FALL.EXE";
  494.         binmode(FILE);
  495.         seek(FILE, 556836, 0);
  496.         my $buffer="";
  497.         read(FILE, $buffer, 1);
  498.         close(FILE);
  499.         return ($buffer eq "\xc8");
  500. }
  501.  
  502. sub set_high_skills
  503. {
  504.         my $enable = shift;
  505.         my $fall = catfile($daggerfall_path, $daggerfall_dir, "FALL.EXE");
  506.         ( -e $fall ) or die "Cannot find FALL.EXE";
  507.         ( -s $fall == 1864183 ) or die "Wrong FALL.EXE length";
  508.         open(FILE, "<$fall") or die "cannot open FALL.EXE";
  509.         binmode(FILE);
  510.         my $buffer;
  511.         read(FILE, $buffer, 1864183);
  512.         close(FILE);
  513.         if ($enable) {
  514.                 substr($buffer, 556836, 2, "\xc8\x72");
  515.                 substr($buffer, 558213, 2, "\xc8\x77");
  516.                 substr($buffer, 558234, 2, "\xc8\x76");
  517.                 substr($buffer, 558253, 1, "\xc8");
  518.                 substr($buffer, 558320, 2, "\xc8\x76");
  519.                 substr($buffer, 558342, 1, "\xc8");
  520.                 substr($buffer, 558833, 1, "\xc8");
  521.                 substr($buffer, 557953, 1, "\x7f");
  522.         } else {
  523.                 substr($buffer, 556836, 2, "\x64\x7c");
  524.                 substr($buffer, 558213, 2, "\x64\x7f");
  525.                 substr($buffer, 558234, 2, "\x64\x7e");
  526.                 substr($buffer, 558253, 1, "\x64");
  527.                 substr($buffer, 558320, 2, "\x64\x7e");
  528.                 substr($buffer, 558342, 1, "\x64");
  529.                 substr($buffer, 558833, 1, "\x64");
  530.                 substr($buffer, 557953, 1, "\x64");
  531.         }
  532.         open(FILE, ">$fall") or die "cannot write FALL.EXE";
  533.         binmode(FILE);
  534.         print FILE $buffer;
  535.         close(FILE);
  536. }
  537.  
  538. sub find_distance
  539. {
  540.         my $slot = shift;
  541.         my $file = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$slot,"SAVETREE.DAT");
  542.         open(FILE, "<$file") or die "cannot open save from slot $slot";
  543.         my $buffer;
  544.         my $step;
  545.         my $ans;
  546.         binmode(FILE);
  547.         seek(FILE, 19, 1);
  548.         read(FILE, $buffer, 4);
  549.         $step = unpack("L", $buffer);
  550.         seek(FILE, $step, 1);
  551.         read(FILE, $buffer, 4);
  552.         $step = unpack("L", $buffer);
  553.         while ($step > 0) {
  554.                 read(FILE, $buffer, 1);
  555.                 if (unpack("C", $buffer) == 23) {
  556.                         seek(FILE, 71, 1);
  557.                         $ans = tell FILE;
  558.                         close(FILE);
  559.                         return $ans;
  560.                 } else {
  561.                         seek(FILE, $step-1, 1);
  562.                 }
  563.                 read(FILE, $buffer, 4);
  564.                 $step = unpack("L", $buffer);
  565.         }
  566.         close(FILE);
  567.         die "No settings record found";
  568. }
  569.  
  570. sub get_view_distance
  571. {
  572.         my $slot = shift;
  573.         my $place = find_distance $slot;
  574.         my $file = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$slot,"SAVETREE.DAT");
  575.         open(FILE, "<$file") or die "cannot open save from slot $slot";
  576.         binmode(FILE);
  577.         seek(FILE, $place, 1);
  578.         my $buffer;
  579.         read(FILE, $buffer, 1);
  580.         close(FILE);
  581.         return unpack("C", $buffer);
  582. }
  583.  
  584. sub set_view_distance
  585. {
  586.         my ($slot, $value) = @_;
  587.         my $place = find_distance $slot;
  588.         ($value>0) && ($value < 266) || die "Wrong distance value";
  589.         my $file = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$slot,"SAVETREE.DAT");
  590.         my $buffer;
  591.         open(FILE, "<$file") or die "cannot open save from slot $slot";
  592.         binmode(FILE);
  593.         read(FILE, $buffer, -s $file);
  594.         close(FILE);
  595.         substr($buffer, $place, 1, pack("C", $value));
  596.         open(FILE, ">$file") or die "cannot write save from slot $slot";
  597.         binmode(FILE);
  598.         print FILE $buffer;
  599.         close(FILE);
  600. }
  601.  
  602. sub get_label
  603. {
  604.         my $label = shift;
  605.         $label =~ tr/[A-Z]/[a-z]/;
  606.         my $file = catfile($daggerfall_path,$daggerfall_dir,"Z.CFG");
  607.         open(FILE, "<$file") or die "cannot open config file";
  608.         while (<FILE>) {
  609.                 my $line = $_;
  610.                 $line =~ tr/[A-Z]/[a-z]/;
  611.                 $line =~ s/\s+//g;
  612.                 if ($line =~ /^$label/) {
  613.                         close(FILE);
  614.                         return ($line =~ /1$/);
  615.                 }
  616.         }
  617.         close(FILE);
  618.         return 0;
  619. }
  620.  
  621. sub set_label
  622. {
  623.         my ($label, $value) = @_;
  624.         $label =~ tr/[A-Z]/[a-z]/;
  625.         my $file = catfile($daggerfall_path,$daggerfall_dir,"Z.CFG");
  626.         open(FILE, "<$file") or die "cannot open config file";
  627.         my @lines = <FILE>;
  628.         close(FILE);
  629.         open(FILE, ">$file") or die "cannot write to config file";
  630.         my $found = 0;
  631.         foreach my $line (@lines) {
  632.                 my $copy = $line;
  633.                 $copy =~ tr/[A-Z]/[a-z]/;
  634.                 $copy =~ s/\s+//g;
  635.                 if ($copy =~ /^$label/) {
  636.                         $found = 1;
  637.                         print FILE $label." ".$value."\r\n";
  638.                 } else {
  639.                         print FILE $line;
  640.                 }
  641.         }
  642.         if (! $found) {
  643.                 print FILE $label." ".$value."\r\n";
  644.         }
  645.         close(FILE);
  646. }
  647.  
  648. sub get_cheat_mode
  649. {
  650.         return get_label "cheatmode";
  651. }
  652.  
  653. sub set_cheat_mode
  654. {
  655.         my $val = shift;
  656.         if ($val) {
  657.                 set_label "cheatmode", 1;
  658.         } else {
  659.                 set_label "cheatmode", 0;
  660.         }
  661. }
  662.  
  663. sub get_magic_repair
  664. {
  665.         return get_label "magicrepair";
  666. }
  667.  
  668. sub set_magic_repair
  669. {
  670.         my $val = shift;
  671.         if ($val) {
  672.                 set_label "magicrepair", 1;
  673.         } else {
  674.                 set_label "magicrepair", 0;
  675.         }
  676. }
  677.  
  678. sub is_slot_occupied
  679. {
  680.         my $slot = shift;
  681.         return ( -e catfile($daggerfall_path,$daggerfall_dir,"SAVE".$slot,"SAVENAME.TXT"))
  682. }
  683.  
  684. sub get_save_name
  685. {
  686.         my $slot = shift;
  687.         ( is_slot_occupied $slot ) or die "Slot empty";
  688.         my $file = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$slot,"SAVENAME.TXT");
  689.         my $name = "";
  690.         open(FILE, "<$file") or die "Cannot open save file";
  691.         binmode(FILE);
  692.         read(FILE,$name,32);
  693.         $name =~ s/\x00.*//;
  694.         return $name
  695. }
  696.  
  697. sub get_current_saves
  698. {
  699.         my %saves = ();
  700.         foreach my $slot (0..5) {
  701.                 if (is_slot_occupied $slot) {
  702.                         $saves{$slot} = get_save_name $slot
  703.                 }
  704.         }
  705.         return %saves;
  706. }
  707.  
  708. sub get_archived_saves
  709. {
  710.         my %saves = ();
  711.         my $dir = catfile($daggerfall_path, $save_backup_dir);
  712.         ( -d $dir) or return %saves;
  713.         opendir(DIR, $dir) or die "Cannot access save backup directory";
  714.         my @files = readdir(DIR);
  715.         closedir(DIR);
  716.         foreach my $file (@files) {
  717.                 if ( $file !~ /^\./) {
  718.                         $file =~ s/$archive_type$//;
  719.                         my @struct = split /-/, $file;
  720.                         my $slot = $struct[0];
  721.                         my $date = $struct[-1];
  722.                         my $name = join('-',@struct[1..($#struct-1)]);
  723.                         if ( ! exists $saves{$slot} ) {
  724.                                 $saves{$slot} = {};
  725.                         }
  726.                         if ( ! exists $saves{$slot}{$name} ) {
  727.                                 $saves{$slot}{$name} = [];
  728.                         }
  729.                         push($saves{$slot}{$name}, $date);
  730.                 }
  731.         }
  732.         return %saves;
  733. }
  734.  
  735. sub archive_save
  736. {
  737.         my $slot = shift;
  738.  
  739.         my $dir = catfile($daggerfall_path, $save_backup_dir);
  740.         if ( ! -d $dir) {
  741.                 mkdir $dir or die "Cannot create save backup directory";
  742.                 chmod 0775, $dir;
  743.                 chown -1, $gid, $dir;
  744.         }
  745.  
  746.         my $save_path = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$slot);
  747.  
  748.         my $file = catfile($save_path,"SAVENAME.TXT");
  749.         ( -e $file ) or die "No save in slot $slot";
  750.         my $name;
  751.         open(FILE, "<$file") or die "Cannot open save file";
  752.         binmode(FILE);
  753.         read(FILE,$name,32);
  754.         $name =~ s/\x00.*//g;
  755.  
  756.         my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
  757.         my $date = sprintf("%4d_%02d_%02d_%02d_%02d_%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
  758.  
  759.         my $archive = catfile($daggerfall_path, $save_backup_dir, $slot."-".$name."-".$date.$archive_type);
  760.  
  761.         my $call = $archiver_pack;
  762.         $call =~ s/ARCHIVE/$archive/;
  763.  
  764.         chdir($save_path);
  765.         system($call);
  766.         chmod 0664, $archive;
  767.         chown -1, $gid, $archive;
  768. }
  769.  
  770. sub expand_save_name
  771. {
  772.         my $which = shift;
  773.         if ($which =~ /^[0-5]$/) {
  774.                 my $file = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$which, "SAVENAME.TXT");
  775.                 ( -e $file) or return "";
  776.                 my $name;
  777.                 open(FILE, "<$file") or return "";
  778.                 binmode(FILE);
  779.                 read(FILE,$name,32);
  780.                 $name =~ s/\x00.*//g;
  781.                 $which = $which."-".$name;
  782.         }
  783.         if ($which !~ /[0-9][0-9][0-9][0-9]_[0-9][0-9]_[0-9][0-9]_[0-9][0-9]_[0-9][0-9]_[0-9][0-9]$/) {
  784.                 my $dir = catfile($daggerfall_path, $save_backup_dir);
  785.                 opendir(DIR, $dir) or return "";
  786.                 my @files = readdir(DIR);
  787.                 closedir(DIR);
  788.                 @files = sort grep(/^$which/, @files);
  789.                 ($#files > 0) or return "";
  790.                 my $last = $files[-1];
  791.                 $last =~ s/$archive_type$//;
  792.                 $last =~ s/^$which//;
  793.                 $which = $which.$last;
  794.         }
  795.         ( -e catfile($daggerfall_path, $save_backup_dir, $which.$archive_type) ) or return "";
  796.         return $which
  797. }
  798.  
  799. sub restore_save
  800. {
  801.         my ($which, $where) = @_;
  802.  
  803.         my $target = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$where);
  804.         ( -d $target) or die "No save directory for slot $where";
  805.  
  806.         $which = expand_save_name $which;
  807.         $which or die "No stored save meets requirements";
  808.         $which = $which.$archive_type;
  809.         my $source = catfile($daggerfall_path, $save_backup_dir, $which);
  810.  
  811.         my $call = $archiver_unpack;
  812.         $call =~ s/ARCHIVE/$source/;
  813.  
  814.         opendir(DIR, $target) or die "Cannot access target directory";
  815.         my @files = readdir(DIR);
  816.         closedir(DIR);
  817.         ( $#files == 1) or remove_tree($target, {keep_root => 1} ) or die "Cannot cleanup target directory";
  818.         chdir($target) or die "Cannot access target directory";
  819.         system($call);
  820.  
  821.         fix_dirs $target;
  822. }
  823.  
  824. sub is_mod
  825. {
  826.         my $mod = shift;
  827.         return ( -d catfile($daggerfall_path, $mods_dir, $mod) );
  828. }
  829.  
  830. sub was_mod
  831. {
  832.         my $mod = shift;
  833.         ( ! is_mod $mod) or return 0;
  834.         return ( -e catfile($daggerfall_path, $mods_dir, $mod.".enabled") );
  835. }
  836.  
  837. sub is_group
  838. {
  839.         my $mod = shift;
  840.         return (( -e catfile($daggerfall_path, $mods_dir, $mod.".extends")) and ( ! -d catfile($daggerfall_path, $mods_dir, $mod)))
  841. }
  842.  
  843. sub is_mod_enabled;
  844. sub is_mod_enabled
  845. {
  846.         my $mod = shift;
  847.         if (is_mod $mod) {
  848.                 return ( -e catfile($daggerfall_path, $mods_dir, $mod.".enabled"))
  849.         } elsif (was_mod $mod) {
  850.                 return 1
  851.         } elsif (is_group $mod)  {
  852.                 my $file = catfile($daggerfall_path, $mods_dir, $mod.".extends");
  853.                 open(FILE, "<$file") or die "Cannot access mods group";
  854.                 my @mods = <FILE>;
  855.                 close(FILE);
  856.                 foreach my $file (@mods) {
  857.                         $file =~ s/\r|\n//g;
  858.                         (is_mod_enabled $file) or return 0;
  859.                 }
  860.                 return 1;
  861.         } else {
  862.                 die "Value $mod does not point to mod or group"
  863.         }
  864. }
  865.  
  866. sub get_mods
  867. {
  868.         my @mods = ();
  869.         my $dir = catfile($daggerfall_path, $mods_dir);
  870.         ( -d $dir ) or return @mods;
  871.         opendir(DIR, $dir) or die "Cannot access mods directory";
  872.         my @files = readdir(DIR);
  873.         closedir(DIR);
  874.         @files = grep(!/^\./,@files);
  875.         @files = grep(!/enabled$/,@files);
  876.         @mods = grep(!/extends$/,@files);
  877.         return sort @mods;
  878. }
  879.  
  880. sub get_enabled_mods
  881. {
  882.         my @mods = ();
  883.         my $dir = catfile($daggerfall_path, $mods_dir);
  884.         ( -d $dir ) or return @mods;
  885.         opendir(DIR, $dir) or die "Cannot access mods directory";
  886.         my @files = readdir(DIR);
  887.         closedir(DIR);
  888.         @files = grep(/enabled$/,@files);
  889.         foreach my $mod (@files) {
  890.                 $mod =~ s/.enabled$//;
  891.                 if (( is_mod $mod ) or (was_mod $mod)) {
  892.                         push(@mods, $mod)
  893.                 }
  894.         }
  895.         return sort @mods;
  896. }
  897.  
  898. sub get_mod_groups
  899. {
  900.         my @mods = ();
  901.         my @groups = ();
  902.         my $dir = catfile($daggerfall_path, $mods_dir);
  903.         ( -d $dir ) or return @mods;
  904.         opendir(DIR, $dir) or die "Cannot access mods directory";
  905.         my @files = readdir(DIR);
  906.         closedir(DIR);
  907.         @files = grep(!/^\./,@files);
  908.         @files = grep(!/enabled$/,@files);
  909.         @mods = grep(!/extends$/,@files);
  910.         foreach my $modex (grep(/extends$/,@files)) {
  911.                 my $mod = $modex;
  912.                 $mod =~ s/.extends$//;
  913.                 my @temp = grep(/^$mod$/,@mods);
  914.                 if ($#temp) { push(@groups, $mod) }
  915.         }
  916.         return sort @groups;
  917. }
  918.  
  919. sub get_mod_dependencies;
  920. sub get_mod_dependencies
  921. {
  922.         my ($mod, $rec) = @_;
  923.         my @deps = ();
  924.         if (was_mod $mod) {
  925.                 my $dir = catfile($daggerfall_path, $mod_backup_dir);
  926.                 find sub {
  927.                         my $file = $File::Find::name;
  928.                         ( ! -d $file) or return;
  929.                         ($file =~ /$mod$/) or return;
  930.                         $file =~ s/^$dir.//;
  931.                         my $temp = $file;
  932.                         $file =~ s/-[0-9]*-$mod$//;
  933.                         $temp =~ s/.*-([0-9]*)-$mod$/$1/;
  934.                         $temp or return;
  935.                         $temp = $temp - 1;
  936.                         find sub {
  937.                                 my $test = $File::Find::name;
  938.                                 ( ! -d $test) or return;
  939.                                 $test =~ s/^$dir.//;
  940.                                 ($test =~ /^$file-$temp/) or return;
  941.                                 ($test !~ /orig$/) or return;
  942.                                 $test =~ s/^$file-$temp-//;
  943.  
  944.                                 my @temp = grep(/^$test$/, @deps);
  945.                                 if ($#temp==-1) {
  946.                                         push(@deps, $test);
  947.                                 }
  948.  
  949.                                 ( $rec ) or return;
  950.  
  951.                                 my @recdeps = get_mod_dependencies $test, $rec;
  952.                                 foreach my $file (@recdeps) {
  953.                                         my @temp = grep(/^$file$/, @deps);
  954.                                         if ($#temp==-1) {
  955.                                                 push(@deps, $file);
  956.                                         }
  957.                                 }
  958.                         }, $dir;
  959.                 }, $dir;
  960.                 return sort @deps;
  961.         }
  962.         (is_mod $mod) or (is_group $mod) or die "Value $mod does not point to mod or group";
  963.         my $file = catfile($daggerfall_path, $mods_dir, $mod.".extends");
  964.         ( -e $file ) or return @deps;
  965.         open(FILE, "<$file") or die "Cannot access mods group";
  966.         my @mods = <FILE>;
  967.         close(FILE);
  968.         foreach my $file (@mods) {
  969.                 $file =~ s/\r|\n//g;
  970.                 my @temp = grep(/^$file$/, @deps);
  971.                 if ($#temp==-1) {
  972.                         push(@deps, $file);
  973.                 }
  974.                 if ( ($rec) and (-e catfile($daggerfall_path, $mods_dir, $file.".extends") )) {
  975.                         my @recdeps = get_mod_dependencies $file, $rec;
  976.                         foreach my $file (@recdeps) {
  977.                                 my @temp = grep(/^$file$/, @deps);
  978.                                 if ($#temp==-1) {
  979.                                         push(@deps, $file);
  980.                                 }
  981.                         }
  982.                 }
  983.         }
  984.         return sort @deps;
  985. }
  986.  
  987. sub get_direct_mod_dependencies
  988. {
  989.         my $mod = shift;
  990.         return get_mod_dependencies $mod, 0;
  991. }
  992.  
  993. sub get_all_mod_dependencies
  994. {
  995.         my $mod = shift;
  996.         return get_mod_dependencies $mod, 1;
  997. }
  998.  
  999. sub get_mods_requiring
  1000. {
  1001.         my $mod = shift;
  1002.         (is_mod $mod) or (was_mod $mod) or die "Value $mod does not represent mod";
  1003.         my @mods = get_enabled_mods;
  1004.         my @result = ();
  1005.         foreach my $name (@mods) {
  1006.                 my @deps = get_all_mod_dependencies $name;
  1007.                 my @temp = grep(/^$mod$/, @deps);
  1008.                 if ($#temp != -1) {
  1009.                         my @temp = grep(/^$name$/, @result);
  1010.                         if ($#temp == -1) {
  1011.                                 push(@result, $name);
  1012.                         }
  1013.                 }
  1014.         }
  1015.         return @result;
  1016. }
  1017.  
  1018. sub is_mod_conflicting
  1019. {
  1020.         my $mod = shift;
  1021.         ( is_mod $mod ) or die "$mod is not a mod";
  1022.         ( ! is_mod_enabled $mod ) or return 0;
  1023.         my @possible_conflicts = ();
  1024.         my $dir = catfile($daggerfall_path, $mod_backup_dir);
  1025.         ( -d $dir ) or return @possible_conflicts;
  1026.         my $moddir = catfile($daggerfall_path, $mods_dir, $mod);
  1027.         find sub {
  1028.                 my $file = $File::Find::name;
  1029.                 ( ! -d $file ) or return;
  1030.                 $file =~ s/^$moddir.//;
  1031.                 my @file_conflicts = ();
  1032.                 find sub {
  1033.                         my $backup = $File::Find::name;
  1034.                         ( ! -d $backup) or return;
  1035.                         $backup =~ s/^$dir.//;
  1036.                         if ($backup =~ /^$file/) {
  1037.                                 $backup =~ s/^$_-//;
  1038.                                 ($backup !~ /0-orig/) or return;
  1039.                                 my @parts = split(/-/, $backup);
  1040.                                 $backup = join('-',@parts);
  1041.                                 my $slot = $parts[0];
  1042.                                 while (! (is_mod($backup) or was_mod($backup))) {
  1043.                                         $slot = $parts[0];
  1044.                                         shift @parts;
  1045.                                         $backup = join('-',@parts);
  1046.                                 }
  1047.                                 ($backup ne $mod) or return;
  1048.                                 my @temp = grep(/^$slot-backup$/,@file_conflicts);
  1049.                                 if ($#temp==-1) {
  1050.                                         push(@file_conflicts,"$slot-$backup");
  1051.                                 }
  1052.                         }
  1053.                 }, $dir;
  1054.                 (@file_conflicts) or return;
  1055.                 my $conflict = (sort @file_conflicts)[-1];
  1056.                 my @temp = split(/-/,$conflict);
  1057.                 shift @temp;
  1058.                 $conflict = join('-',@temp);
  1059.                 @temp = grep(/^$conflict$/,@possible_conflicts);
  1060.                 if ($#temp == -1) {
  1061.                         push(@possible_conflicts, $conflict);
  1062.                 }
  1063.         }, $moddir;
  1064.         my @conflicts = ();
  1065.         my @deps = get_direct_mod_dependencies $mod;
  1066.         foreach my $conflict (@possible_conflicts) {
  1067.                 my @temp = grep(/^$conflict$/, @deps);
  1068.                 if ($#temp == -1) {
  1069.                         push(@conflicts, $conflict);
  1070.                 }
  1071.         }
  1072.         return sort @conflicts;
  1073. }
  1074.  
  1075. sub get_file_in_mods_count
  1076. {
  1077.         my $file = shift;
  1078.         my $dir = catfile($daggerfall_path, $mod_backup_dir);
  1079.         ( -d $dir ) or return 0;
  1080.         my @backups = ();
  1081.         find sub {
  1082.                 my $backup = $File::Find::name;
  1083.                 $backup =~ s/^$dir.//;
  1084.                 ( $backup eq $dir ) or push(@backups, $backup);
  1085.         }, $dir;
  1086.         @backups = grep(/^$file/, @backups);
  1087.         return (1+$#backups);
  1088. }
  1089.  
  1090. sub enable_mod
  1091. {
  1092.         my $mod = shift;
  1093.         (is_mod $mod) or (is_group $mod) or die "Value $mod does not point to mod or group";
  1094.         (! is_mod_enabled $mod) or return;
  1095.         my @deps = get_direct_mod_dependencies $mod;
  1096.         foreach my $dep (@deps) {
  1097.                 (is_mod_enabled $dep) or enable_mod $dep;
  1098.         }
  1099.         ( is_mod $mod ) or return;
  1100.         my $dir = catfile($daggerfall_path, $mod_backup_dir);
  1101.         if ( ! -d $dir ) {
  1102.                 mkdir $dir or die "Cannot create mod backup directory";
  1103.                 chmod 0775, $dir;
  1104.                 chown -1, $gid, $dir;
  1105.         }
  1106.         my @conflicts = is_mod_conflicting $mod;
  1107.         ( ! @conflicts ) or die "Mod is conflicting with: ".join(' ', @conflicts);
  1108.         my $moddir = catfile($daggerfall_path, $mods_dir, $mod);
  1109.         find sub {
  1110.                 my $source = $File::Find::name;
  1111.                 my $file = $source;
  1112.                 $file =~ s/^$moddir.//;
  1113.                 ($file ne $moddir) or return;
  1114.                 my $target = catfile($daggerfall_path, $daggerfall_dir, $file);
  1115.                 my $backup = catfile($dir, $file);
  1116.                 if ( -d $source ) {
  1117.                         if ( ! -d $target ) {
  1118.                                 mkdir $target or die "Cannot create directory";
  1119.                                 chmod 0775, $target;
  1120.                                 chown -1, $gid, $target;
  1121.                         }
  1122.                         if ( ! -d $backup ) {
  1123.                                 mkdir $backup or die "Cannot create directory";
  1124.                                 chmod 0775, $backup;
  1125.                                 chown -1, $gid, $backup;
  1126.                         }
  1127.                 } else {
  1128.                         if ( ! -e $target ) {
  1129.                                 copy($source, $target) or die "Cannot copy file";
  1130.                                 chmod 0664, $target;
  1131.                                 chown -1, $gid, $target;
  1132.                                 open(FILE, ">$backup-0-$mod") or die "Cannot create file";
  1133.                                 close(FILE);
  1134.                                 chmod 0664, "$backup-0-$mod";
  1135.                                 chown -1, $gid, "$backup-0-$mod";
  1136.                         } else {
  1137.                                 my $id = get_file_in_mods_count $file;
  1138.                                 if ($id == 0) {
  1139.                                         open(FILE, ">$backup-0-orig") or die "Cannot create file";
  1140.                                         close(FILE);
  1141.                                         chmod 0664, "$backup-0-orig";
  1142.                                         chown -1, $gid, "$backup-0-orig";
  1143.                                         $id = 1;
  1144.                                 }
  1145.                                 copy($target, "$backup-$id-$mod") or die "Cannot copy file";
  1146.                                 chmod 0664, "$backup-$id-$mod";
  1147.                                 chown -1, $gid, "$backup-$id-$mod";
  1148.                                 copy($source, $target) or die "Cannot copy file";
  1149.                                 chmod 0664, $target;
  1150.                                 chown -1, $gid, $target;
  1151.                         }
  1152.                 }
  1153.         }, $moddir;
  1154.         open(FILE, ">$moddir.enabled") or die "Cannot create file";
  1155.         close(FILE);
  1156.         chmod 0664, "$moddir.enabled";
  1157.         chown -1, $gid, "$moddir.enabled";
  1158. }
  1159.  
  1160. sub rm
  1161. {
  1162.         my $file = shift;
  1163.         ( -e $file ) or return;
  1164.         ( ! -d $file ) or return;
  1165.         unlink @{[$file]} or die "Cannot delete file";
  1166. }
  1167.  
  1168. sub dir_empty
  1169. {
  1170.         my $dir = shift;
  1171.         ( -d $dir ) or return 0;
  1172.         opendir(DIR, $dir);
  1173.         my @files = readdir(DIR);
  1174.         closedir(DIR);
  1175.         return ($#files == 1);
  1176. }
  1177.  
  1178. sub disable_mod
  1179. {
  1180.         my $mod = shift;
  1181.         ( is_mod $mod ) or ( was_mod $mod) or die "Value $mod does not represent mod";
  1182.         ( was_mod $mod ) or ( is_mod_enabled $mod ) or return;
  1183.         my @temp = get_mods_requiring $mod;
  1184.         my $count = $#temp+1;
  1185.         ( ! $count ) or die "There are $count mods requiring $mod, cannot disable";
  1186.         my $dir = catfile($daggerfall_path, $mod_backup_dir);
  1187.         find sub {
  1188.                 my $file = $File::Find::name;
  1189.                 $file =~ s/^$dir.//;
  1190.                 ($file ne $dir) or return;
  1191.                 ($file =~ /$mod$/) or return;
  1192.                 my $id = $file;
  1193.                 $file =~ s/-[0-9]*-$mod$//;
  1194.                 $id =~ s/^$file-//;
  1195.                 $id =~ s/-$mod$//;
  1196.                 my $source = catfile($dir, "$file-$id-$mod");
  1197.                 my $target = catfile($daggerfall_path, $daggerfall_dir, $file);
  1198.                 if ($id == 0) {
  1199.                         rm($source);
  1200.                         rm($target);
  1201.                 } else {
  1202.                         move($source, $target) or die "Cannot restore backup";
  1203.                         chmod 0664, $target;
  1204.                         chown -1, $gid, $target;
  1205.                         if ($id == 1) {
  1206.                                 rm(catfile($dir, "$file-0-orig"));
  1207.                         }
  1208.                 }
  1209.         }, $dir;
  1210.         my @to_remove = ();
  1211.         find { no_chdir => 1, wanted => sub {
  1212.                 my $file = $File::Find::name;
  1213.                 ($file ne $dir) or return;
  1214.                 (-d $file) or return;
  1215.                 (dir_empty $file) or return;
  1216.                 push(@to_remove, $file);
  1217.                 $file =~ s/^$dir.//;
  1218.                 $file = catfile($daggerfall_path, $daggerfall_dir, $file);
  1219.                 (dir_empty $file) or return;
  1220.                 push(@to_remove, $file);
  1221.         }}, $dir;
  1222.         foreach my $file (@to_remove) {
  1223.                 remove_tree($file) or die "Cannot remove leftover directory";
  1224.         }
  1225.         rm(catfile($daggerfall_path, $mods_dir, "$mod.enabled"));
  1226. }
  1227.  
  1228. sub refresh_mods
  1229. {
  1230.         my @mods = get_enabled_mods;
  1231.         my @enabled_mods = @mods;
  1232.         while ($#enabled_mods >= 0) {
  1233.                 foreach my $mod (@enabled_mods) {
  1234.                         my @temp = get_mods_requiring $mod;
  1235.                         my $count = $#temp+1;
  1236.                         if ( ! $count ) {
  1237.                                 disable_mod $mod;
  1238.                         }
  1239.                 }
  1240.                 @enabled_mods = get_enabled_mods;
  1241.         }
  1242.         foreach my $mod (@mods) {
  1243.                 if (is_mod $mod) {
  1244.                         enable_mod $mod
  1245.                 }
  1246.         }
  1247. }
  1248.  
  1249. #=================================================================================
  1250. #  Command line interface, options parsing
  1251. #=================================================================================
  1252.  
  1253. use Getopt::Long;
  1254.  
  1255. my $opt_run_daggerfall=1;
  1256. my $opt_force_run_daggerfall=0;
  1257. my $opt_help=0;
  1258. my $opt_accept_terms=0;
  1259. my $opt_run_setup=0;
  1260. my $opt_run_fixsave=0;
  1261. my $opt_run_fixmaps=0;
  1262. my $opt_get_brightness=0;
  1263. my $opt_set_brightness="";
  1264. my $opt_get_wagon_capacity=0;
  1265. my $opt_set_wagon_capacity="";
  1266. my $opt_get_high_skills=0;
  1267. my $opt_set_high_skills="";
  1268. my $opt_get_view_distance="";
  1269. my %opt_set_view_distance=();
  1270. my $opt_get_cheat_mode=0;
  1271. my $opt_set_cheat_mode="";
  1272. my $opt_get_magic_repair=0;
  1273. my $opt_set_magic_repair="";
  1274. my $opt_list_saves=0;
  1275. my $opt_list_archived_saves=0;
  1276. my $opt_archive_save="";
  1277. my $opt_archive_all_saves=0;
  1278. my %opt_restore_save=();
  1279. my $opt_list_mods=0;
  1280. my $opt_enable_mod="";
  1281. my $opt_disable_mod="";
  1282. my $opt_refresh_mods=0;
  1283. my $die_early=0;
  1284.  
  1285. Getopt::Long::Configure('pass_through');
  1286. GetOptions (
  1287.         'help' => \$opt_help,
  1288.         'accept-terms' => \$opt_accept_terms,
  1289.         'run-daggerfall' => \$opt_force_run_daggerfall,
  1290.         'run-setup' => \$opt_run_setup,
  1291.         'run-fixsave' => \$opt_run_fixsave,
  1292.         'run-fixmaps' => \$opt_run_fixmaps,
  1293.         'get-brightness' => \$opt_get_brightness,
  1294.         'set-brightness=f' => \$opt_set_brightness,
  1295.         'get-wagon-capacity' => \$opt_get_wagon_capacity,
  1296.         'set-wagon-capacity=i' => \$opt_set_wagon_capacity,
  1297.         'get-high-skills' => \$opt_get_high_skills,
  1298.         'set-high-skills=s' => \$opt_set_high_skills,
  1299.         'get-view-distance=i' => \$opt_get_view_distance,
  1300.         'set-view-distance=i' => \%opt_set_view_distance,
  1301.         'get-cheat-mode' => \$opt_get_cheat_mode,
  1302.         'set-cheat-mode=s' => \$opt_set_cheat_mode,
  1303.         'get-magic-repair' => \$opt_get_magic_repair,
  1304.         'set-magic-repair=s' => \$opt_set_magic_repair,
  1305.         'list-saves' => \$opt_list_saves,
  1306.         'list-archived-saves' => \$opt_list_archived_saves,
  1307.         'archive-save=i' => \$opt_archive_save,
  1308.         'archive-all-saves' => \$opt_archive_all_saves,
  1309.         'restore-save=i' => \%opt_restore_save,
  1310.         'list-mods' => \$opt_list_mods,
  1311.         'enable-mod=s' => \$opt_enable_mod,
  1312.         'disable-mod=s' => \$opt_disable_mod,
  1313.         'refresh-mods' => \$opt_refresh_mods
  1314. );
  1315.  
  1316. if ($opt_set_brightness ne "") {
  1317.         if ($opt_set_brightness < 0) {
  1318.                 print "Bad value for --set-brightness ($opt_set_brightness)\n";
  1319.                 $opt_help = 1;
  1320.         }
  1321. }
  1322.  
  1323. if ($opt_set_wagon_capacity ne "") {
  1324.         if (($opt_set_wagon_capacity <= 0) or ($opt_set_wagon_capacity >= 16384)) {
  1325.                 print "Bad value for --set-wagon-capacity ($opt_set_wagon_capacity)\n";
  1326.                 $opt_help = 1;
  1327.         }
  1328. }
  1329.  
  1330. if ($opt_set_high_skills ne "") {
  1331.         if ($opt_set_high_skills !~ /on|off/) {
  1332.                 print "Bad value for --set-high-skills ($opt_set_high_skills)\n";
  1333.                 $opt_help = 1;
  1334.         }
  1335. }
  1336.  
  1337. if ($opt_get_view_distance ne "") {
  1338.         if (($opt_get_view_distance < 0) or ($opt_get_view_distance > 5)) {
  1339.                 print "Bad value for --get-view-distance ($opt_get_view_distance)\n";
  1340.                 $opt_help = 1;
  1341.         }
  1342.         if ( ! is_slot_occupied $opt_get_view_distance ) {
  1343.                 print "No save in slot $opt_get_view_distance\n";
  1344.                 $die_early = 1;
  1345.         }
  1346. }
  1347.  
  1348. foreach my $key (keys %opt_set_view_distance) {
  1349.         my $val = $opt_set_view_distance{$key};
  1350.         if ($key !~ /[0-5]/) {
  1351.                 print "Bad slot value for --set-view-distance ($key)\n";
  1352.                 $opt_help = 1;
  1353.         }
  1354.         if (($val < 0) or ($val > 255)) {
  1355.                 print "Bad view distance value for --set-view-distance $key ($val)\n";
  1356.                 $opt_help = 1;
  1357.         }
  1358.         if ( ! is_slot_occupied $key ) {
  1359.                 print "No save in slot $key\n";
  1360.                 $die_early = 1;
  1361.         }
  1362. }
  1363.  
  1364. if ($opt_set_cheat_mode ne "") {
  1365.         if ($opt_set_cheat_mode !~ /on|off/) {
  1366.                 print "Bad value for --set-cheat-mode ($opt_set_cheat_mode)\n";
  1367.                 $opt_help = 1;
  1368.         }
  1369. }
  1370.  
  1371. if ($opt_set_magic_repair ne "") {
  1372.         if ($opt_set_magic_repair !~ /on|off/) {
  1373.                 print "Bad value for --set-magic-repair ($opt_set_magic_repair)\n";
  1374.                 $opt_help = 1;
  1375.         }
  1376. }
  1377.  
  1378. if ($opt_archive_save ne "") {
  1379.         if (($opt_archive_save < 0) or ($opt_archive_save > 5)) {
  1380.                 print "Bad value for --archive-save ($opt_archive_save)\n";
  1381.                 $opt_help = 1;
  1382.         }
  1383.         if ( ! is_slot_occupied $opt_archive_save ) {
  1384.                 print "No save in slot $opt_archive_save\n";
  1385.                 $die_early = 1;
  1386.         }
  1387. }
  1388.  
  1389. my %conflict_vals = ();
  1390. foreach my $key (keys %opt_restore_save) {
  1391.         my $val = $opt_restore_save{$key};
  1392.         if ( (expand_save_name $key) eq "" ) {
  1393.                 print "No save matching $key\n"
  1394.         }
  1395.         if (($val < 0) or ($val > 5)) {
  1396.                 print "Bad slot targets for --restore-save $key ($val)\n";
  1397.                 $opt_help = 1;
  1398.         }
  1399.         if (exists $conflict_vals{$val}) {
  1400.                 print "Conflicting slot targets\n";
  1401.                 $die_early = 1;
  1402.         } else {
  1403.                 $conflict_vals{$val} = 1;
  1404.         }
  1405. }
  1406.  
  1407. if ($opt_enable_mod ne "") {
  1408.         if ((! is_mod $opt_enable_mod) and (! is_group $opt_enable_mod)) {
  1409.                 print "Bad mod name for --enable-mod ($opt_enable_mod)\n";
  1410.                 $opt_help = 1;
  1411.         } elsif ((is_mod $opt_enable_mod) and (is_mod_enabled $opt_enable_mod)) {
  1412.                 print "Mod \"$opt_enable_mod\" already enabled\n";
  1413.                 $die_early = 1;
  1414.         } elsif (is_mod $opt_enable_mod) {
  1415.                 my @conflicts = is_mod_conflicting $opt_enable_mod;
  1416.                 if (@conflicts) {
  1417.                         print "Mod \"$opt_enable_mod\" is conflicting with: ".join(' ', @conflicts)."\n";
  1418.                         $die_early = 1;
  1419.                 }
  1420.         }
  1421. }
  1422.  
  1423. if ($opt_disable_mod ne "") {
  1424.         if (! is_mod $opt_disable_mod) {
  1425.                 print "Bad mod name for --disable-mod ($opt_disable_mod)\n";
  1426.                 $opt_help = 1;
  1427.         } elsif  ( ! is_mod_enabled $opt_disable_mod) {
  1428.                 print "Mod \"$opt_disable_mod\" not enabled\n";
  1429.                 $die_early = 1;
  1430.         }
  1431. }
  1432.  
  1433. if ($#ARGV >= 0) {
  1434.         foreach my $arg (@ARGV) {
  1435.                 print "Unknown option: $arg\n";
  1436.         }
  1437.         $opt_help = 1;
  1438. }
  1439.  
  1440. #=================================================================================
  1441. #  Command line interface, commands
  1442. #=================================================================================
  1443.  
  1444. if ($opt_help) {
  1445.         print
  1446. "
  1447. The Elder Scrolls II: Daggerfall launcher
  1448.  
  1449. usage:
  1450.  daggerfall [options]
  1451.  
  1452. available conflicting options:
  1453.  
  1454.  --run-setup                       run the sound setup utility
  1455.  --run-fixsave                     run fixsave, the save game fixing utility
  1456.  --run-fixmaps                     run fixmaps, the map fixing utility
  1457.  --run-daggerfall                  when any option is specified Daggerfall will
  1458.                                    not be started by launcher. This options
  1459.                                    forces start of game when all other tasks
  1460.                                    are finished
  1461.  
  1462.  --get-brightness                  returns current palette brightness
  1463.                                     0 means original, 1 means multiply gamma by 1.1,
  1464.                                     2 means multiply gamma by 1.2, etc.
  1465.  --set-brightness=<val>            sets brightness,
  1466.                                    accept any non-negative number
  1467.                                    (reasonable values are between 0 and 10)
  1468.  
  1469.  --get-wagon-capacity              returns current wagon capacity (in lbs)
  1470.  --set-wagon-capacity=<val>        sets current wagon capacity,
  1471.                                    accepts values between 1 to 16384
  1472.  
  1473.  --get-high-skills                 checks if skill levels above 100 are unlocked
  1474.  --set-high-skills=<val>           unlocks/locks skill levels above 100,
  1475.                                    accepts two values - on and off
  1476.  
  1477.  --get-cheat-mode                  checks if cheat mode is enabled
  1478.  --set-cheat-mode=<val>            enables/disables cheat mode
  1479.                                    accepts two values - on and off
  1480.  
  1481.  --get-magic-repair                checks if repairing of magical items is enabled
  1482.  --set-magic-repair=<val>          enables/disabled reparis of magical items
  1483.  
  1484.  --get-view-distance=<slot>        returns view distance set in given slot,
  1485.                                    accepts slot number, from 0 to 5
  1486.  --set-view-distance <slot>=<val>  sets view distance in given slot,
  1487.                                    accepts slot number, from 0 to 5 and
  1488.                                    value, from 0 to 255
  1489.  
  1490.  --list-saves                      list current saves
  1491.  --list-archived-saves             list archived saves
  1492.  --archive-save=<slot>             archive game from given slot,
  1493.                                    accepts slot number, from 0 to 5
  1494.  --archive-all-saves               archives all saves
  1495.  --restore-save <val>=<slot>       restores given archived save into requested slot,
  1496.                                    accepts save description and target slot,
  1497.                                    the save description is in form
  1498.                                      <slot>-<name>-<time stamp>,
  1499.                                    where if only slot given, current name for
  1500.                                    that slot is assumed, and if time stamp is
  1501.                                    not given, latest available is assumed,
  1502.                                    e.g. \"4\" is valid shortcut to any
  1503.                                    archived game from slot 4, and \"4-name\"
  1504.                                    is valid for any game from slot 4 with
  1505.                                    given name.
  1506.  
  1507.  --list-mods                       lists all mods and groups. Marks which
  1508.                                    mods/groups are enabled, lists any enabled
  1509.                                    but no longer installed mods
  1510.  --enable-mod=<val>                enabled given mod or group, taking care of
  1511.                                    dependencies
  1512.  --disable-mod=<val>               disables given mod, checks for dependencies
  1513.  --refresh-mods                    updates all enabled mods to latest installed
  1514.                                    versions
  1515.  
  1516.  --accept-terms                    accept Daggerfall terms of use
  1517.  
  1518.  --help                            display this help message
  1519. ";
  1520.         exit;
  1521. }
  1522.  
  1523. if ($die_early) {
  1524.         exit
  1525. }
  1526.  
  1527. if ($opt_accept_terms) {
  1528.         $opt_run_daggerfall=0;
  1529.         accept_terms;
  1530. }
  1531.  
  1532. if ($opt_run_setup) {
  1533.         $opt_run_daggerfall=0;
  1534.         run_setup;
  1535. }
  1536.  
  1537. if ($opt_run_fixsave) {
  1538.         $opt_run_daggerfall=0;
  1539.         run_fixsave;
  1540. }
  1541.  
  1542. if ($opt_run_fixmaps) {
  1543.         $opt_run_daggerfall=0;
  1544.         run_fixmaps;
  1545. }
  1546.  
  1547. if ($opt_get_brightness) {
  1548.         $opt_run_daggerfall=0;
  1549.         my $value = get_brightness;
  1550.         print "Current palette brightness: $value\n";
  1551. }
  1552.  
  1553. if ($opt_set_brightness ne "") {
  1554.         $opt_run_daggerfall=0;
  1555.         set_brightness $opt_set_brightness;
  1556. }
  1557.  
  1558. if ($opt_get_wagon_capacity) {
  1559.         $opt_run_daggerfall=0;
  1560.         my $value = get_wagon_capacity;
  1561.         print "Current wagon capacity: $value lbs\n";
  1562. }
  1563.  
  1564. if ($opt_set_wagon_capacity ne "") {
  1565.         $opt_run_daggerfall=0;
  1566.         set_wagon_capacity $opt_set_wagon_capacity;
  1567. }
  1568.  
  1569. if ($opt_get_high_skills) {
  1570.         $opt_run_daggerfall=0;
  1571.         if (get_high_skills) {
  1572.                 print "High skills are enabled\n";
  1573.         } else {
  1574.                 print "High skills are disabled\n";
  1575.         }
  1576. }
  1577.        
  1578. if ($opt_set_high_skills ne "") {
  1579.         $opt_run_daggerfall=0;
  1580.         set_high_skills ($opt_set_high_skills =~ /on/);
  1581. }
  1582.  
  1583. if ($opt_get_view_distance ne "") {
  1584.         $opt_run_daggerfall=0;
  1585.         my $value = get_view_distance $opt_get_view_distance;
  1586.         print "View distance for save $opt_get_view_distance is $value.\n"
  1587. }
  1588.  
  1589. foreach my $key (keys %opt_set_view_distance) {
  1590.         $opt_run_daggerfall=0;
  1591.         my $val = $opt_set_view_distance{$key};
  1592.         set_view_distance $key, $val;
  1593. }
  1594.  
  1595. if ($opt_get_cheat_mode) {
  1596.         $opt_run_daggerfall=0;
  1597.         if (get_cheat_mode) {
  1598.                 print "Cheat mode codes are enabled\n";
  1599.         } else {
  1600.                 print "Cheat mode codes are disabled\n";
  1601.         }
  1602. }
  1603.        
  1604. if ($opt_set_cheat_mode ne "") {
  1605.         $opt_run_daggerfall=0;
  1606.         set_cheat_mode ($opt_set_cheat_mode =~ /on/);
  1607. }
  1608.  
  1609. if ($opt_get_magic_repair) {
  1610.         $opt_run_daggerfall=0;
  1611.         if (get_magic_repair) {
  1612.                 print "Magic repairs are enabled\n";
  1613.         } else {
  1614.                 print "Magic repairs are disabled\n";
  1615.         }
  1616. }
  1617.        
  1618. if ($opt_set_magic_repair ne "") {
  1619.         $opt_run_daggerfall=0;
  1620.         set_magic_repair ($opt_set_magic_repair =~ /on/);
  1621. }
  1622.  
  1623. if ($opt_list_saves) {
  1624.         $opt_run_daggerfall=0;
  1625.         my %saves = get_current_saves;
  1626.         my @slots = sort keys %saves;
  1627.         if ($#slots == -1) {
  1628.                 print "No saves found\n";
  1629.         } else {
  1630.                 foreach my $slot (@slots) {
  1631.                         print "Save in slot $slot: $saves{$slot}\n"
  1632.                 }
  1633.         }
  1634. }
  1635.  
  1636. if ($opt_list_archived_saves) {
  1637.         $opt_run_daggerfall=0;
  1638.         my %saves = get_archived_saves;
  1639.         my @slots = sort keys %saves;
  1640.         if ($#slots == -1) {
  1641.                 print "No saves found\n";
  1642.         } else {
  1643.                 foreach my $slot (sort keys %saves) {
  1644.                         print "Archived saves from slot $slot\n\n";
  1645.                         foreach my $name (sort keys $saves{$slot}) {
  1646.                         print " saves named $name\n\n";
  1647.                                 foreach my $date (sort @{$saves{$slot}{$name}}) {
  1648.                                         $date =~ s/_/./;
  1649.                                         $date =~ s/_/./;
  1650.                                         $date =~ s/_/, /;
  1651.                                         $date =~ s/_/:/;
  1652.                                         $date =~ s/_/:/;
  1653.                                         print "  from ", $date, "\n";
  1654.                                 }
  1655.                                 print "\n";
  1656.                         }
  1657.                 }
  1658.         }
  1659. }
  1660.  
  1661. if ($opt_archive_save ne "") {
  1662.         $opt_run_daggerfall=0;
  1663.         archive_save $opt_archive_save;
  1664.         print "Archived save from slot $opt_archive_save\n";
  1665. }
  1666.  
  1667. if ($opt_archive_all_saves) {
  1668.         $opt_run_daggerfall=0;
  1669.         my $found = 0;
  1670.         foreach my $slot (0..5) {
  1671.                 if ( is_slot_occupied $slot ) {
  1672.                         $found = 1;
  1673.                         archive_save $slot;
  1674.                         print "Archived save from slot $slot\n";
  1675.                 }
  1676.         }
  1677.         $found or print "All save slots are empty\n"
  1678. }
  1679.  
  1680. foreach my $key (keys %opt_restore_save) {
  1681.         $opt_run_daggerfall=0;
  1682.         my $val = $opt_restore_save{$key};
  1683.         my $proceed = 1;
  1684.         if ( is_slot_occupied $val ) {
  1685.                 my $ans = "";
  1686.                 until ($ans =~ /yes|no/) {
  1687.                         print "You will overwrite existing save in slot $val, overwrite? (yes/no) ";
  1688.                         $ans = <>;
  1689.                         if ($ans !~ /yes|no/) {
  1690.                                 print "Please answer with \"yes\" or \"no\"\n";
  1691.                         }
  1692.                 }
  1693.                 if ($ans =~ /no/) {
  1694.                         $proceed = 0;
  1695.                 }
  1696.         }
  1697.         if ($proceed) {
  1698.                 my $full = expand_save_name $key;
  1699.                 restore_save $key, $val;
  1700.                 print "Restored save $full into slot $val\n";
  1701.         }
  1702. }
  1703.  
  1704. if ($opt_list_mods) {
  1705.         $opt_run_daggerfall=0;
  1706.         my $any = 0;
  1707.         my @mods = get_mods;
  1708.         if ( $#mods >= 0 ) {
  1709.                 $any = 1;
  1710.                 print "Installed mods:\n\n";
  1711.                 foreach my $mod (@mods) {
  1712.                         print " $mod";
  1713.                         if (is_mod_enabled $mod) {
  1714.                                 print " (enabled)"
  1715.                         }
  1716.                         print "\n";
  1717.                 }
  1718.                 print "\n";
  1719.         }
  1720.         my @groups = get_mod_groups;
  1721.         if ( $#groups  >= 0 ) {
  1722.                 $any = 1;
  1723.                 print "Installed groups:\n\n";
  1724.                 foreach my $group (@groups) {
  1725.                         print " $group";
  1726.                         if (is_mod_enabled $group) {
  1727.                                 print " (enabled)"
  1728.                         }
  1729.                         print "\n";
  1730.                 }
  1731.                 print "\n";
  1732.         }
  1733.         my @missing = ();
  1734.         my @enabled = get_enabled_mods;
  1735.         foreach my $mod (@enabled) {
  1736.                 my @temp = grep(/^$mod$/, @mods);
  1737.                 if ($#temp == -1) {
  1738.                         push(@missing, $mod)
  1739.                 }
  1740.         }
  1741.         if ( $#missing >= 0) {
  1742.                 $any = 1;
  1743.                 print "Enabled mods, no longer installed:\n\n";
  1744.                 foreach my $mod (@missing) {
  1745.                         print " $mod\n";
  1746.                 }
  1747.                 print "\n";
  1748.         }
  1749.         if (! $any) {
  1750.                 print "No mods found\n";
  1751.         }
  1752. }
  1753.  
  1754. if ($opt_enable_mod ne "") {
  1755.         $opt_run_daggerfall=0;
  1756.         enable_mod $opt_enable_mod;
  1757.         if (is_mod $opt_enable_mod) {
  1758.                 print "Enabled mod \"$opt_enable_mod\"\n"
  1759.         } else {
  1760.                 print "Enabled group \"$opt_enable_mod\"\n"
  1761.         }
  1762. }
  1763.  
  1764. if ($opt_disable_mod ne "") {
  1765.         $opt_run_daggerfall=0;
  1766.         disable_mod $opt_disable_mod;
  1767.         if (is_mod $opt_disable_mod) {
  1768.                 print "Disabled mod \"$opt_disable_mod\"\n"
  1769.         } else {
  1770.                 print "Disabled group \"$opt_disable_mod\"\n"
  1771.         }
  1772. }
  1773.  
  1774. if ($opt_refresh_mods) {
  1775.         $opt_run_daggerfall=0;
  1776.         refresh_mods;
  1777.         print "Refreshed enabled mods to latest installed version\n"
  1778. }
  1779.  
  1780. $opt_run_daggerfall or $opt_force_run_daggerfall or exit;
  1781.  
  1782. if ( ! terms_accepted ) {
  1783.         foreach (get_terms) { print $_ }
  1784.         my $ans = 0;
  1785.         until ($ans =~ /yes|no/) {
  1786.                 print "Do you accept the license? (yes/no) ";
  1787.                 $ans = <>;
  1788.                 ($ans =~ /yes|no/) or print "Please answer with \"yes\" or \"no\"\n";
  1789.         }
  1790.         if ($ans =~ /yes/) {
  1791.                 accept_terms
  1792.         } else {
  1793.                 print "You should uninstall Daggerfall at once!\n";
  1794.                 exit
  1795.         }
  1796. }
  1797.  
  1798. run_daggerfall;
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top