updated on Thu Jan 26 16:09:46 UTC 2012
[aur-mirror.git] / daggerfall / daggerfall-launcher.pl
blob9df29a211d2644ae62a79af9747b4b5c8194306b
1 #!/usr/bin/perl
2 use warnings;
3 use strict;
5 #=================================================================================
6 # Daggerfall Launcher
7 #=================================================================================
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!
14 # Run it with "--help" option to get help.
16 # Remember that you use it at your own risk :-)
18 #=================================================================================
19 # License
20 #=================================================================================
21 # Copyright (C) 2011 by Andrzej Giniewicz <gginiu@gmail.com>
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:
30 # The above copyright notice and this permission notice shall be included in
31 # all copies or substantial portions of the Software.
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.
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";
59 #=================================================================================
60 # Declarations and description of available functions
61 #=================================================================================
63 # check if terms of use were accepted
64 # no arguments
65 # returns boolean
66 sub terms_accepted;
68 # get terms of use
69 # no arguments
70 # returns array of lines
71 sub get_terms;
73 # accept terms of use
74 # no arguments
75 # no return value
76 sub accept_terms;
78 # run Daggerfall, requires that terms of use are already accepted
79 # no arguments
80 # no return value
81 sub run_daggerfall;
83 # run sound setup utility
84 # no arguments
85 # no return value
86 sub run_setup;
88 # run save fixing utility
89 # no arguments
90 # no return value
91 sub run_fixsave;
93 # run map fixing utility
94 # no arguments
95 # no return value
96 sub run_fixmaps;
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;
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;
110 # get wagon capacity in lbs
111 # no arguments
112 # returns number
113 sub get_wagon_capacity;
115 # set wagon capacity in lbs
116 # takes number representing wagon capacity
117 # no return value
118 sub set_wagon_capacity;
120 # check if skill levels above 100 are unlocked
121 # no arguments
122 # returns boolean
123 sub get_high_skills;
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;
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;
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;
141 # check if cheat mode is enabled
142 # no arguments
143 # returns boolean
144 sub get_cheat_mode;
146 # enable or disable cheat mode
147 # takes boolean, 0 to disable, 1 to enable
148 # no return value
149 sub set_cheat_mode;
151 # check if magic item repairs are enabled
152 # no arguments
153 # returns boolean
154 sub get_magic_repair;
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;
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;
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;
172 # archive current save from given slot
173 # takes slot number (0-5)
174 # no return value
175 sub archive_save;
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;
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;
194 # get list of installed mods
195 # no arguments
196 # returns array of installed mod names
197 sub get_mods;
199 # get list of enabled mods
200 # no arguments
201 # returns array of enabled mod names
202 sub get_enabled_mods;
204 # get list of available mod groups
205 # no arguments
206 # returns array of available mod group names
207 sub get_mod_groups;
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;
214 # get list of mod or group dependencies (recursively)
215 # no arguments
216 # returns array of mod names
217 sub get_all_mod_dependencies;
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;
224 # enable mod
225 # takes string (name of mod or group to enable)
226 # no return value
227 sub enable_mod;
229 # disable mod
230 # takes string (name of mod to disable)
231 # no return value
232 sub disable_mod;
234 # refresh all installed mods to currently installed versions
235 # no arguments
236 # no return value
237 sub refresh_mods;
239 #=================================================================================
240 # Gory details :-)
241 #=================================================================================
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);
249 my $gid = getgrnam($user_group);
251 sub terms_accepted
253 return ( -e catfile($daggerfall_path, $license_lock) );
256 sub accept_terms
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;
265 sub get_terms
267 open(FILE, "<$license") or die "Cannot open license";
268 my @text = <FILE>;
269 close(FILE);
270 return @text;
273 sub fix_dirs;
274 sub fix_dirs
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;
294 sub run_dosbox
296 my ($app, $exit, $no_terms) = @_;
297 $no_terms or 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);
307 fix_dirs catfile($daggerfall_path, $daggerfall_dir);
310 sub run_daggerfall
312 run_dosbox "RUN.BAT", 1, 0;
315 sub run_setup
317 run_dosbox "SETUP.EXE", 1, 1;
320 sub run_fixsave
322 run_dosbox "FIXSAVE.EXE", 0, 1;
325 sub run_fixmaps
327 run_dosbox "FIXMAPS.EXE", 0, 1;
330 sub get_brightness
333 my $pal = catfile($daggerfall_path, $palettes_dir);
334 ( -d $pal ) or return 0;
336 my $file = catfile($pal, "now");
337 ( -e $file) or return 0;
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);
347 sub set_brightness
349 my $steps = shift;
350 my $gamma = 1+$steps/10;
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"
357 'DATA' => [
358 "DAGGER.COL"
362 sub edit_palette
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";
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));
387 my @source_data = unpack("C*", $source);
388 my @target_data;
389 foreach my $byte (@source_data) {
390 push(@target_data, (transform $byte, $gamma));
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);
399 (-d catfile($daggerfall_path, $daggerfall_dir)) or die "Cannot find Daggerfall directory";
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;
408 foreach my $dir (keys %palettes) {
409 my $target_dir = catfile($daggerfall_path, $daggerfall_dir, $dir);
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);
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);
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);
437 sub get_wagon_capacity
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;
452 sub set_wagon_capacity
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);
488 sub get_high_skills
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");
502 sub set_high_skills
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");
532 open(FILE, ">$fall") or die "cannot write FALL.EXE";
533 binmode(FILE);
534 print FILE $buffer;
535 close(FILE);
538 sub find_distance
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);
563 read(FILE, $buffer, 4);
564 $step = unpack("L", $buffer);
566 close(FILE);
567 die "No settings record found";
570 sub get_view_distance
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);
584 sub set_view_distance
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);
602 sub get_label
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$/);
617 close(FILE);
618 return 0;
621 sub set_label
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;
642 if (! $found) {
643 print FILE $label." ".$value."\r\n";
645 close(FILE);
648 sub get_cheat_mode
650 return get_label "cheatmode";
653 sub set_cheat_mode
655 my $val = shift;
656 if ($val) {
657 set_label "cheatmode", 1;
658 } else {
659 set_label "cheatmode", 0;
663 sub get_magic_repair
665 return get_label "magicrepair";
668 sub set_magic_repair
670 my $val = shift;
671 if ($val) {
672 set_label "magicrepair", 1;
673 } else {
674 set_label "magicrepair", 0;
678 sub is_slot_occupied
680 my $slot = shift;
681 return ( -e catfile($daggerfall_path,$daggerfall_dir,"SAVE".$slot,"SAVENAME.TXT"))
684 sub get_save_name
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
697 sub get_current_saves
699 my %saves = ();
700 foreach my $slot (0..5) {
701 if (is_slot_occupied $slot) {
702 $saves{$slot} = get_save_name $slot
705 return %saves;
708 sub get_archived_saves
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} = {};
726 if ( ! exists $saves{$slot}{$name} ) {
727 $saves{$slot}{$name} = [];
729 push($saves{$slot}{$name}, $date);
732 return %saves;
735 sub archive_save
737 my $slot = shift;
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;
746 my $save_path = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$slot);
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;
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);
759 my $archive = catfile($daggerfall_path, $save_backup_dir, $slot."-".$name."-".$date.$archive_type);
761 my $call = $archiver_pack;
762 $call =~ s/ARCHIVE/$archive/;
764 chdir($save_path);
765 system($call);
766 chmod 0664, $archive;
767 chown -1, $gid, $archive;
770 sub expand_save_name
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;
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;
795 ( -e catfile($daggerfall_path, $save_backup_dir, $which.$archive_type) ) or return "";
796 return $which
799 sub restore_save
801 my ($which, $where) = @_;
803 my $target = catfile($daggerfall_path,$daggerfall_dir,"SAVE".$where);
804 ( -d $target) or die "No save directory for slot $where";
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);
811 my $call = $archiver_unpack;
812 $call =~ s/ARCHIVE/$source/;
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);
821 fix_dirs $target;
824 sub is_mod
826 my $mod = shift;
827 return ( -d catfile($daggerfall_path, $mods_dir, $mod) );
830 sub has_patch
832 my $mod = shift;
833 ( is_mod $mod) or return 0;
834 return ( -e catfile($daggerfall_path, $mods_dir, $mod.".patch") );
837 sub was_mod
839 my $mod = shift;
840 ( ! is_mod $mod) or return 0;
841 return ( -e catfile($daggerfall_path, $mods_dir, $mod.".enabled") );
844 sub is_group
846 my $mod = shift;
847 return (( -e catfile($daggerfall_path, $mods_dir, $mod.".extends")) and ( ! -d catfile($daggerfall_path, $mods_dir, $mod)))
850 sub is_mod_enabled;
851 sub is_mod_enabled
853 my $mod = shift;
854 if (is_mod $mod) {
855 return ( -e catfile($daggerfall_path, $mods_dir, $mod.".enabled"))
856 } elsif (was_mod $mod) {
857 return 1
858 } elsif (is_group $mod) {
859 my $file = catfile($daggerfall_path, $mods_dir, $mod.".extends");
860 open(FILE, "<$file") or die "Cannot access mods group";
861 my @mods = <FILE>;
862 close(FILE);
863 foreach my $file (@mods) {
864 $file =~ s/\r|\n//g;
865 (is_mod_enabled $file) or return 0;
867 return 1;
868 } else {
869 die "Value $mod does not point to mod or group"
873 sub get_mods
875 my @mods = ();
876 my $dir = catfile($daggerfall_path, $mods_dir);
877 ( -d $dir ) or return @mods;
878 opendir(DIR, $dir) or die "Cannot access mods directory";
879 my @files = readdir(DIR);
880 closedir(DIR);
881 @files = grep(!/^\./,@files);
882 @files = grep(!/\.enabled$/,@files);
883 @files = grep(!/\.patch$/,@files);
884 @mods = grep(!/\.extends$/,@files);
885 return sort @mods;
888 sub get_enabled_mods
890 my @mods = ();
891 my $dir = catfile($daggerfall_path, $mods_dir);
892 ( -d $dir ) or return @mods;
893 opendir(DIR, $dir) or die "Cannot access mods directory";
894 my @files = readdir(DIR);
895 closedir(DIR);
896 @files = grep(/enabled$/,@files);
897 foreach my $mod (@files) {
898 $mod =~ s/.enabled$//;
899 if (( is_mod $mod ) or (was_mod $mod)) {
900 push(@mods, $mod)
903 return sort @mods;
906 sub get_mod_groups
908 my @mods = get_mods;
909 my @groups = ();
910 my $dir = catfile($daggerfall_path, $mods_dir);
911 ( -d $dir ) or return @mods;
912 opendir(DIR, $dir) or die "Cannot access mods directory";
913 my @files = readdir(DIR);
914 closedir(DIR);
915 foreach my $modex (grep(/\.extends$/,@files)) {
916 my $mod = $modex;
917 $mod =~ s/.extends$//;
918 my @temp = grep(/^$mod$/,@mods);
919 if ($#temp) { push(@groups, $mod) }
921 return sort @groups;
924 sub get_mod_dependencies;
925 sub get_mod_dependencies
927 my ($mod, $rec) = @_;
928 my @deps = ();
929 if (was_mod $mod) {
930 my $dir = catfile($daggerfall_path, $mod_backup_dir);
931 find sub {
932 my $file = $File::Find::name;
933 ( ! -d $file) or return;
934 ($file =~ /$mod$/) or return;
935 $file =~ s/^$dir.//;
936 ($file !~ /^FALL\.EXE/) or return;
937 my $temp = $file;
938 $file =~ s/-[0-9]*-$mod$//;
939 $temp =~ s/.*-([0-9]*)-$mod$/$1/;
940 $temp or return;
941 $temp = $temp - 1;
942 find sub {
943 my $test = $File::Find::name;
944 ( ! -d $test) or return;
945 $test =~ s/^$dir.//;
946 ($test =~ /^$file-$temp/) or return;
947 ($test !~ /orig$/) or return;
948 $test =~ s/^$file-$temp-//;
950 my @temp = grep(/^$test$/, @deps);
951 if ($#temp==-1) {
952 push(@deps, $test);
955 ( $rec ) or return;
957 my @recdeps = get_mod_dependencies $test, $rec;
958 foreach my $file (@recdeps) {
959 my @temp = grep(/^$file$/, @deps);
960 if ($#temp==-1) {
961 push(@deps, $file);
964 }, $dir;
965 }, $dir;
966 return sort @deps;
968 (is_mod $mod) or (is_group $mod) or die "Value $mod does not point to mod or group";
969 my $file = catfile($daggerfall_path, $mods_dir, $mod.".extends");
970 ( -e $file ) or return @deps;
971 open(FILE, "<$file") or die "Cannot access mods group";
972 my @mods = <FILE>;
973 close(FILE);
974 foreach my $file (@mods) {
975 $file =~ s/\r|\n//g;
976 my @temp = grep(/^$file$/, @deps);
977 if ($#temp==-1) {
978 push(@deps, $file);
980 if ( ($rec) and (-e catfile($daggerfall_path, $mods_dir, $file.".extends") )) {
981 my @recdeps = get_mod_dependencies $file, $rec;
982 foreach my $file (@recdeps) {
983 my @temp = grep(/^$file$/, @deps);
984 if ($#temp==-1) {
985 push(@deps, $file);
990 return sort @deps;
993 sub get_direct_mod_dependencies
995 my $mod = shift;
996 return get_mod_dependencies $mod, 0;
999 sub get_all_mod_dependencies
1001 my $mod = shift;
1002 return get_mod_dependencies $mod, 1;
1005 sub get_mods_requiring
1007 my $mod = shift;
1008 (is_mod $mod) or (was_mod $mod) or die "Value $mod does not represent mod";
1009 my @mods = get_enabled_mods;
1010 my @result = ();
1011 foreach my $name (@mods) {
1012 my @deps = get_all_mod_dependencies $name;
1013 my @temp = grep(/^$mod$/, @deps);
1014 if ($#temp != -1) {
1015 my @temp = grep(/^$name$/, @result);
1016 if ($#temp == -1) {
1017 push(@result, $name);
1021 return @result;
1024 sub is_mod_conflicting
1026 my $mod = shift;
1027 ( is_mod $mod ) or die "$mod is not a mod";
1028 ( ! is_mod_enabled $mod ) or return 0;
1029 my @possible_conflicts = ();
1030 my $dir = catfile($daggerfall_path, $mod_backup_dir);
1031 ( -d $dir ) or return @possible_conflicts;
1032 my $moddir = catfile($daggerfall_path, $mods_dir, $mod);
1033 find sub {
1034 my $file = $File::Find::name;
1035 ( ! -d $file ) or return;
1036 $file =~ s/^$moddir.//;
1037 my @file_conflicts = ();
1038 find sub {
1039 my $backup = $File::Find::name;
1040 ( ! -d $backup) or return;
1041 $backup =~ s/^$dir.//;
1042 if ($backup =~ /^$file/) {
1043 $backup =~ s/^$_-//;
1044 ($backup !~ /0-orig/) or return;
1045 my @parts = split(/-/, $backup);
1046 $backup = join('-',@parts);
1047 my $slot = $parts[0];
1048 while (! (is_mod($backup) or was_mod($backup))) {
1049 $slot = $parts[0];
1050 shift @parts;
1051 $backup = join('-',@parts);
1053 ($backup ne $mod) or return;
1054 my @temp = grep(/^$slot-backup$/,@file_conflicts);
1055 if ($#temp==-1) {
1056 push(@file_conflicts,"$slot-$backup");
1059 }, $dir;
1060 (@file_conflicts) or return;
1061 my $conflict = (sort @file_conflicts)[-1];
1062 my @temp = split(/-/,$conflict);
1063 shift @temp;
1064 $conflict = join('-',@temp);
1065 @temp = grep(/^$conflict$/,@possible_conflicts);
1066 if ($#temp == -1) {
1067 push(@possible_conflicts, $conflict);
1069 }, $moddir;
1070 my @conflicts = ();
1071 my @deps = get_direct_mod_dependencies $mod;
1072 foreach my $conflict (@possible_conflicts) {
1073 my @temp = grep(/^$conflict$/, @deps);
1074 if ($#temp == -1) {
1075 push(@conflicts, $conflict);
1078 return sort @conflicts;
1081 sub get_file_in_mods_count
1083 my $file = shift;
1084 my $dir = catfile($daggerfall_path, $mod_backup_dir);
1085 ( -d $dir ) or return 0;
1086 my @backups = ();
1087 find sub {
1088 my $backup = $File::Find::name;
1089 $backup =~ s/^$dir.//;
1090 ( $backup eq $dir ) or push(@backups, $backup);
1091 }, $dir;
1092 @backups = grep(/^$file/, @backups);
1093 return (1+$#backups);
1096 sub rm
1098 my $file = shift;
1099 ( -e $file ) or return;
1100 ( ! -d $file ) or return;
1101 unlink @{[$file]} or die "Cannot delete file";
1104 sub dir_empty
1106 my $dir = shift;
1107 ( -d $dir ) or return 0;
1108 opendir(DIR, $dir);
1109 my @files = readdir(DIR);
1110 closedir(DIR);
1111 return ($#files == 1);
1114 sub enable_patch
1116 my $mod = shift;
1117 my $file = catfile($daggerfall_path, $mods_dir, $mod.".patch");
1118 open(FILE, "<$file") or die "Cannot open patch file";
1119 my @lines = <FILE>;
1120 close(FILE);
1121 $file = catfile($daggerfall_path, $mod_backup_dir, "FALL.EXE-$mod");
1122 open(FILE, ">$file") or die "Cannot create FALL.EXE backup";
1123 my $fall = catfile($daggerfall_path, $daggerfall_dir, "FALL.EXE");
1124 open(FALL, "<$fall") or die "Cannot open FALL.EXE file";
1125 binmode(FALL);
1126 my $buffer;
1127 read(FALL, $buffer, 1864183);
1128 foreach my $part (@lines) {
1129 $part =~ s/\r|\n//g;
1130 my @data = split(/\ /, $part);
1131 my $offset = $data[0];
1132 shift @data;
1133 my $length = $data[0];
1134 shift @data;
1135 my $out = pack("C*", @data);
1136 seek FALL, $offset, 0;
1137 my $buf;
1138 read FALL, $buf, $length;
1139 my @orig = unpack("C*", $buf);
1140 my $origval = join(" ", @orig);
1141 print FILE "$offset $length $origval\n";
1142 substr($buffer, $offset, $length, $out);
1144 close(FILE);
1145 close(FALL);
1146 open(FALL, ">$fall") or die "Cannot open FALL.EXE file";
1147 binmode(FALL);
1148 print FALL $buffer;
1149 close(FALL);
1152 sub disable_patch
1154 my $mod = shift;
1155 my $file = catfile($daggerfall_path, $mod_backup_dir, "FALL.EXE-$mod");
1156 open(FILE, "<$file") or die "Cannot read FALL.EXE backup";
1157 my @lines = <FILE>;
1158 close(FILE);
1159 my $fall = catfile($daggerfall_path, $daggerfall_dir, "FALL.EXE");
1160 open(FALL, "<$fall") or die "Cannot open FALL.EXE file";
1161 binmode(FALL);
1162 my $buffer;
1163 read(FALL, $buffer, 1864183);
1164 close(FALL);
1165 foreach my $part (@lines) {
1166 $part =~ s/\r|\n//g;
1167 my @data = split(/\ /, $part);
1168 my $offset = $data[0];
1169 shift @data;
1170 my $length = $data[0];
1171 shift @data;
1172 my $out = pack("C*", @data);
1173 substr($buffer, $offset, $length, $out);
1175 open(FALL, ">$fall") or die "Cannot open FALL.EXE file";
1176 binmode(FALL);
1177 print FALL $buffer;
1178 close(FALL);
1179 rm $file;
1182 sub enable_mod
1184 my $mod = shift;
1185 (is_mod $mod) or (is_group $mod) or die "Value $mod does not point to mod or group";
1186 (! is_mod_enabled $mod) or return;
1187 my @deps = get_direct_mod_dependencies $mod;
1188 foreach my $dep (@deps) {
1189 (is_mod_enabled $dep) or enable_mod $dep;
1191 ( is_mod $mod ) or return;
1192 my $dir = catfile($daggerfall_path, $mod_backup_dir);
1193 if ( ! -d $dir ) {
1194 mkdir $dir or die "Cannot create mod backup directory";
1195 chmod 0775, $dir;
1196 chown -1, $gid, $dir;
1198 my @conflicts = is_mod_conflicting $mod;
1199 ( ! @conflicts ) or die "Mod is conflicting with: ".join(' ', @conflicts);
1200 my $moddir = catfile($daggerfall_path, $mods_dir, $mod);
1201 find sub {
1202 my $source = $File::Find::name;
1203 my $file = $source;
1204 ($file ne $moddir) or return;
1205 $file =~ s/^$moddir.//;
1206 ( $file !~ /^FALL.EXE$/ ) or die "Bad mod, FALL.EXE can be modded only trough patches";
1207 my $target = catfile($daggerfall_path, $daggerfall_dir, $file);
1208 my $backup = catfile($dir, $file);
1209 if ( -d $source ) {
1210 if ( ! -d $target ) {
1211 mkdir $target or die "Cannot create directory";
1212 chmod 0775, $target;
1213 chown -1, $gid, $target;
1215 if ( ! -d $backup ) {
1216 mkdir $backup or die "Cannot create directory";
1217 chmod 0775, $backup;
1218 chown -1, $gid, $backup;
1220 } else {
1221 if ( ! -e $target ) {
1222 copy($source, $target) or die "Cannot copy file";
1223 chmod 0664, $target;
1224 chown -1, $gid, $target;
1225 open(FILE, ">$backup-0-$mod") or die "Cannot create file";
1226 close(FILE);
1227 chmod 0664, "$backup-0-$mod";
1228 chown -1, $gid, "$backup-0-$mod";
1229 } else {
1230 my $id = get_file_in_mods_count $file;
1231 if ($id == 0) {
1232 open(FILE, ">$backup-0-orig") or die "Cannot create file";
1233 close(FILE);
1234 chmod 0664, "$backup-0-orig";
1235 chown -1, $gid, "$backup-0-orig";
1236 $id = 1;
1238 copy($target, "$backup-$id-$mod") or die "Cannot copy file";
1239 chmod 0664, "$backup-$id-$mod";
1240 chown -1, $gid, "$backup-$id-$mod";
1241 copy($source, $target) or die "Cannot copy file";
1242 chmod 0664, $target;
1243 chown -1, $gid, $target;
1246 }, $moddir;
1247 if ( has_patch $mod ) {
1248 enable_patch $mod;
1250 open(FILE, ">$moddir.enabled") or die "Cannot create file";
1251 close(FILE);
1252 chmod 0664, "$moddir.enabled";
1253 chown -1, $gid, "$moddir.enabled";
1256 sub disable_mod
1258 my $mod = shift;
1259 ( is_mod $mod ) or ( was_mod $mod) or die "Value $mod does not represent mod";
1260 ( was_mod $mod ) or ( is_mod_enabled $mod ) or return;
1261 my @temp = get_mods_requiring $mod;
1262 my $count = $#temp+1;
1263 ( ! $count ) or die "There are $count mods requiring $mod, cannot disable";
1264 my $dir = catfile($daggerfall_path, $mod_backup_dir);
1265 find sub {
1266 my $file = $File::Find::name;
1267 $file =~ s/^$dir.//;
1268 ($file ne $dir) or return;
1269 ($file =~ /$mod$/) or return;
1270 my $id = $file;
1271 $file =~ s/-[0-9]*-$mod$//;
1272 if ($file =~ /FALL.EXE/) {
1273 disable_patch $mod;
1274 } else {
1275 $id =~ s/^$file-//;
1276 $id =~ s/-$mod$//;
1277 my $source = catfile($dir, "$file-$id-$mod");
1278 my $target = catfile($daggerfall_path, $daggerfall_dir, $file);
1279 if ($id == 0) {
1280 rm($source);
1281 rm($target);
1282 } else {
1283 move($source, $target) or die "Cannot restore backup";
1284 chmod 0664, $target;
1285 chown -1, $gid, $target;
1286 if ($id == 1) {
1287 rm(catfile($dir, "$file-0-orig"));
1291 }, $dir;
1292 my @to_remove = ();
1293 find { no_chdir => 1, wanted => sub {
1294 my $file = $File::Find::name;
1295 ($file ne $dir) or return;
1296 (-d $file) or return;
1297 (dir_empty $file) or return;
1298 push(@to_remove, $file);
1299 $file =~ s/^$dir.//;
1300 $file = catfile($daggerfall_path, $daggerfall_dir, $file);
1301 (dir_empty $file) or return;
1302 push(@to_remove, $file);
1303 }}, $dir;
1304 foreach my $file (@to_remove) {
1305 remove_tree($file) or die "Cannot remove leftover directory";
1307 rm(catfile($daggerfall_path, $mods_dir, "$mod.enabled"));
1310 sub refresh_mods
1312 my @mods = get_enabled_mods;
1313 my @enabled_mods = @mods;
1314 while ($#enabled_mods >= 0) {
1315 foreach my $mod (@enabled_mods) {
1316 my @temp = get_mods_requiring $mod;
1317 my $count = $#temp+1;
1318 if ( ! $count ) {
1319 disable_mod $mod;
1322 @enabled_mods = get_enabled_mods;
1324 foreach my $mod (@mods) {
1325 if (is_mod $mod) {
1326 enable_mod $mod
1331 #=================================================================================
1332 # Command line interface, options parsing
1333 #=================================================================================
1335 use Getopt::Long;
1337 my $opt_run_daggerfall=1;
1338 my $opt_force_run_daggerfall=0;
1339 my $opt_help=0;
1340 my $opt_accept_terms=0;
1341 my $opt_run_setup=0;
1342 my $opt_run_fixsave=0;
1343 my $opt_run_fixmaps=0;
1344 my $opt_get_brightness=0;
1345 my $opt_set_brightness="";
1346 my $opt_get_wagon_capacity=0;
1347 my $opt_set_wagon_capacity="";
1348 my $opt_get_high_skills=0;
1349 my $opt_set_high_skills="";
1350 my $opt_get_view_distance="";
1351 my %opt_set_view_distance=();
1352 my $opt_get_cheat_mode=0;
1353 my $opt_set_cheat_mode="";
1354 my $opt_get_magic_repair=0;
1355 my $opt_set_magic_repair="";
1356 my $opt_list_saves=0;
1357 my $opt_list_archived_saves=0;
1358 my $opt_archive_save="";
1359 my $opt_archive_all_saves=0;
1360 my %opt_restore_save=();
1361 my $opt_list_mods=0;
1362 my $opt_enable_mod="";
1363 my $opt_disable_mod="";
1364 my $opt_refresh_mods=0;
1365 my $die_early=0;
1367 Getopt::Long::Configure('pass_through');
1368 GetOptions (
1369 'help' => \$opt_help,
1370 'accept-terms' => \$opt_accept_terms,
1371 'run-daggerfall' => \$opt_force_run_daggerfall,
1372 'run-setup' => \$opt_run_setup,
1373 'run-fixsave' => \$opt_run_fixsave,
1374 'run-fixmaps' => \$opt_run_fixmaps,
1375 'get-brightness' => \$opt_get_brightness,
1376 'set-brightness=f' => \$opt_set_brightness,
1377 'get-wagon-capacity' => \$opt_get_wagon_capacity,
1378 'set-wagon-capacity=i' => \$opt_set_wagon_capacity,
1379 'get-high-skills' => \$opt_get_high_skills,
1380 'set-high-skills=s' => \$opt_set_high_skills,
1381 'get-view-distance=i' => \$opt_get_view_distance,
1382 'set-view-distance=i' => \%opt_set_view_distance,
1383 'get-cheat-mode' => \$opt_get_cheat_mode,
1384 'set-cheat-mode=s' => \$opt_set_cheat_mode,
1385 'get-magic-repair' => \$opt_get_magic_repair,
1386 'set-magic-repair=s' => \$opt_set_magic_repair,
1387 'list-saves' => \$opt_list_saves,
1388 'list-archived-saves' => \$opt_list_archived_saves,
1389 'archive-save=i' => \$opt_archive_save,
1390 'archive-all-saves' => \$opt_archive_all_saves,
1391 'restore-save=i' => \%opt_restore_save,
1392 'list-mods' => \$opt_list_mods,
1393 'enable-mod=s' => \$opt_enable_mod,
1394 'disable-mod=s' => \$opt_disable_mod,
1395 'refresh-mods' => \$opt_refresh_mods
1398 if ($opt_set_brightness ne "") {
1399 if ($opt_set_brightness < 0) {
1400 print "Bad value for --set-brightness ($opt_set_brightness)\n";
1401 $opt_help = 1;
1405 if ($opt_set_wagon_capacity ne "") {
1406 if (($opt_set_wagon_capacity <= 0) or ($opt_set_wagon_capacity >= 16384)) {
1407 print "Bad value for --set-wagon-capacity ($opt_set_wagon_capacity)\n";
1408 $opt_help = 1;
1412 if ($opt_set_high_skills ne "") {
1413 if ($opt_set_high_skills !~ /on|off/) {
1414 print "Bad value for --set-high-skills ($opt_set_high_skills)\n";
1415 $opt_help = 1;
1419 if ($opt_get_view_distance ne "") {
1420 if (($opt_get_view_distance < 0) or ($opt_get_view_distance > 5)) {
1421 print "Bad value for --get-view-distance ($opt_get_view_distance)\n";
1422 $opt_help = 1;
1424 if ( ! is_slot_occupied $opt_get_view_distance ) {
1425 print "No save in slot $opt_get_view_distance\n";
1426 $die_early = 1;
1430 foreach my $key (keys %opt_set_view_distance) {
1431 my $val = $opt_set_view_distance{$key};
1432 if ($key !~ /[0-5]/) {
1433 print "Bad slot value for --set-view-distance ($key)\n";
1434 $opt_help = 1;
1436 if (($val < 0) or ($val > 255)) {
1437 print "Bad view distance value for --set-view-distance $key ($val)\n";
1438 $opt_help = 1;
1440 if ( ! is_slot_occupied $key ) {
1441 print "No save in slot $key\n";
1442 $die_early = 1;
1446 if ($opt_set_cheat_mode ne "") {
1447 if ($opt_set_cheat_mode !~ /on|off/) {
1448 print "Bad value for --set-cheat-mode ($opt_set_cheat_mode)\n";
1449 $opt_help = 1;
1453 if ($opt_set_magic_repair ne "") {
1454 if ($opt_set_magic_repair !~ /on|off/) {
1455 print "Bad value for --set-magic-repair ($opt_set_magic_repair)\n";
1456 $opt_help = 1;
1460 if ($opt_archive_save ne "") {
1461 if (($opt_archive_save < 0) or ($opt_archive_save > 5)) {
1462 print "Bad value for --archive-save ($opt_archive_save)\n";
1463 $opt_help = 1;
1465 if ( ! is_slot_occupied $opt_archive_save ) {
1466 print "No save in slot $opt_archive_save\n";
1467 $die_early = 1;
1471 my %conflict_vals = ();
1472 foreach my $key (keys %opt_restore_save) {
1473 my $val = $opt_restore_save{$key};
1474 if ( (expand_save_name $key) eq "" ) {
1475 print "No save matching $key\n"
1477 if (($val < 0) or ($val > 5)) {
1478 print "Bad slot targets for --restore-save $key ($val)\n";
1479 $opt_help = 1;
1481 if (exists $conflict_vals{$val}) {
1482 print "Conflicting slot targets\n";
1483 $die_early = 1;
1484 } else {
1485 $conflict_vals{$val} = 1;
1489 if ($opt_enable_mod ne "") {
1490 if ((! is_mod $opt_enable_mod) and (! is_group $opt_enable_mod)) {
1491 print "Bad mod name for --enable-mod ($opt_enable_mod)\n";
1492 $opt_help = 1;
1493 } elsif ((is_mod $opt_enable_mod) and (is_mod_enabled $opt_enable_mod)) {
1494 print "Mod \"$opt_enable_mod\" already enabled\n";
1495 $die_early = 1;
1496 } elsif (is_mod $opt_enable_mod) {
1497 my @conflicts = is_mod_conflicting $opt_enable_mod;
1498 if (@conflicts) {
1499 print "Mod \"$opt_enable_mod\" is conflicting with: ".join(' ', @conflicts)."\n";
1500 $die_early = 1;
1505 if ($opt_disable_mod ne "") {
1506 if (! is_mod $opt_disable_mod) {
1507 print "Bad mod name for --disable-mod ($opt_disable_mod)\n";
1508 $opt_help = 1;
1509 } elsif ( ! is_mod_enabled $opt_disable_mod) {
1510 print "Mod \"$opt_disable_mod\" not enabled\n";
1511 $die_early = 1;
1515 if ($#ARGV >= 0) {
1516 foreach my $arg (@ARGV) {
1517 print "Unknown option: $arg\n";
1519 $opt_help = 1;
1522 #=================================================================================
1523 # Command line interface, commands
1524 #=================================================================================
1526 if ($opt_help) {
1527 print
1529 The Elder Scrolls II: Daggerfall launcher
1531 usage:
1532 daggerfall [options]
1534 available conflicting options:
1536 --run-setup run the sound setup utility
1537 --run-fixsave run fixsave, the save game fixing utility
1538 --run-fixmaps run fixmaps, the map fixing utility
1539 --run-daggerfall when any option is specified Daggerfall will
1540 not be started by launcher. This options
1541 forces start of game when all other tasks
1542 are finished
1544 --get-brightness returns current palette brightness
1545 0 means original, 1 means multiply gamma by 1.1,
1546 2 means multiply gamma by 1.2, etc.
1547 --set-brightness=<val> sets brightness,
1548 accept any non-negative number
1549 (reasonable values are between 0 and 10)
1551 --get-wagon-capacity returns current wagon capacity (in lbs)
1552 --set-wagon-capacity=<val> sets current wagon capacity,
1553 accepts values between 1 to 16384
1555 --get-high-skills checks if skill levels above 100 are unlocked
1556 --set-high-skills=<val> unlocks/locks skill levels above 100,
1557 accepts two values - on and off
1559 --get-cheat-mode checks if cheat mode is enabled
1560 --set-cheat-mode=<val> enables/disables cheat mode
1561 accepts two values - on and off
1563 --get-magic-repair checks if repairing of magical items is enabled
1564 --set-magic-repair=<val> enables/disabled reparis of magical items
1566 --get-view-distance=<slot> returns view distance set in given slot,
1567 accepts slot number, from 0 to 5
1568 --set-view-distance <slot>=<val> sets view distance in given slot,
1569 accepts slot number, from 0 to 5 and
1570 value, from 0 to 255
1572 --list-saves list current saves
1573 --list-archived-saves list archived saves
1574 --archive-save=<slot> archive game from given slot,
1575 accepts slot number, from 0 to 5
1576 --archive-all-saves archives all saves
1577 --restore-save <val>=<slot> restores given archived save into requested slot,
1578 accepts save description and target slot,
1579 the save description is in form
1580 <slot>-<name>-<time stamp>,
1581 where if only slot given, current name for
1582 that slot is assumed, and if time stamp is
1583 not given, latest available is assumed,
1584 e.g. \"4\" is valid shortcut to any
1585 archived game from slot 4, and \"4-name\"
1586 is valid for any game from slot 4 with
1587 given name.
1589 --list-mods lists all mods and groups. Marks which
1590 mods/groups are enabled, lists any enabled
1591 but no longer installed mods
1592 --enable-mod=<val> enabled given mod or group, taking care of
1593 dependencies
1594 --disable-mod=<val> disables given mod, checks for dependencies
1595 --refresh-mods updates all enabled mods to latest installed
1596 versions
1598 --accept-terms accept Daggerfall terms of use
1600 --help display this help message
1602 exit;
1605 if ($die_early) {
1606 exit
1609 if ($opt_accept_terms) {
1610 $opt_run_daggerfall=0;
1611 accept_terms;
1614 if ($opt_run_setup) {
1615 $opt_run_daggerfall=0;
1616 run_setup;
1619 if ($opt_run_fixsave) {
1620 $opt_run_daggerfall=0;
1621 run_fixsave;
1624 if ($opt_run_fixmaps) {
1625 $opt_run_daggerfall=0;
1626 run_fixmaps;
1629 if ($opt_get_brightness) {
1630 $opt_run_daggerfall=0;
1631 my $value = get_brightness;
1632 print "Current palette brightness: $value\n";
1635 if ($opt_set_brightness ne "") {
1636 $opt_run_daggerfall=0;
1637 set_brightness $opt_set_brightness;
1640 if ($opt_get_wagon_capacity) {
1641 $opt_run_daggerfall=0;
1642 my $value = get_wagon_capacity;
1643 print "Current wagon capacity: $value lbs\n";
1646 if ($opt_set_wagon_capacity ne "") {
1647 $opt_run_daggerfall=0;
1648 set_wagon_capacity $opt_set_wagon_capacity;
1651 if ($opt_get_high_skills) {
1652 $opt_run_daggerfall=0;
1653 if (get_high_skills) {
1654 print "High skills are enabled\n";
1655 } else {
1656 print "High skills are disabled\n";
1660 if ($opt_set_high_skills ne "") {
1661 $opt_run_daggerfall=0;
1662 set_high_skills ($opt_set_high_skills =~ /on/);
1665 if ($opt_get_view_distance ne "") {
1666 $opt_run_daggerfall=0;
1667 my $value = get_view_distance $opt_get_view_distance;
1668 print "View distance for save $opt_get_view_distance is $value.\n"
1671 foreach my $key (keys %opt_set_view_distance) {
1672 $opt_run_daggerfall=0;
1673 my $val = $opt_set_view_distance{$key};
1674 set_view_distance $key, $val;
1677 if ($opt_get_cheat_mode) {
1678 $opt_run_daggerfall=0;
1679 if (get_cheat_mode) {
1680 print "Cheat mode codes are enabled\n";
1681 } else {
1682 print "Cheat mode codes are disabled\n";
1686 if ($opt_set_cheat_mode ne "") {
1687 $opt_run_daggerfall=0;
1688 set_cheat_mode ($opt_set_cheat_mode =~ /on/);
1691 if ($opt_get_magic_repair) {
1692 $opt_run_daggerfall=0;
1693 if (get_magic_repair) {
1694 print "Magic repairs are enabled\n";
1695 } else {
1696 print "Magic repairs are disabled\n";
1700 if ($opt_set_magic_repair ne "") {
1701 $opt_run_daggerfall=0;
1702 set_magic_repair ($opt_set_magic_repair =~ /on/);
1705 if ($opt_list_saves) {
1706 $opt_run_daggerfall=0;
1707 my %saves = get_current_saves;
1708 my @slots = sort keys %saves;
1709 if ($#slots == -1) {
1710 print "No saves found\n";
1711 } else {
1712 foreach my $slot (@slots) {
1713 print "Save in slot $slot: $saves{$slot}\n"
1718 if ($opt_list_archived_saves) {
1719 $opt_run_daggerfall=0;
1720 my %saves = get_archived_saves;
1721 my @slots = sort keys %saves;
1722 if ($#slots == -1) {
1723 print "No saves found\n";
1724 } else {
1725 foreach my $slot (sort keys %saves) {
1726 print "Archived saves from slot $slot\n\n";
1727 foreach my $name (sort keys $saves{$slot}) {
1728 print " saves named $name\n\n";
1729 foreach my $date (sort @{$saves{$slot}{$name}}) {
1730 $date =~ s/_/./;
1731 $date =~ s/_/./;
1732 $date =~ s/_/, /;
1733 $date =~ s/_/:/;
1734 $date =~ s/_/:/;
1735 print " from ", $date, "\n";
1737 print "\n";
1743 if ($opt_archive_save ne "") {
1744 $opt_run_daggerfall=0;
1745 archive_save $opt_archive_save;
1746 print "Archived save from slot $opt_archive_save\n";
1749 if ($opt_archive_all_saves) {
1750 $opt_run_daggerfall=0;
1751 my $found = 0;
1752 foreach my $slot (0..5) {
1753 if ( is_slot_occupied $slot ) {
1754 $found = 1;
1755 archive_save $slot;
1756 print "Archived save from slot $slot\n";
1759 $found or print "All save slots are empty\n"
1762 foreach my $key (keys %opt_restore_save) {
1763 $opt_run_daggerfall=0;
1764 my $val = $opt_restore_save{$key};
1765 my $proceed = 1;
1766 if ( is_slot_occupied $val ) {
1767 my $ans = "";
1768 until ($ans =~ /yes|no/) {
1769 print "You will overwrite existing save in slot $val, overwrite? (yes/no) ";
1770 $ans = <>;
1771 if ($ans !~ /yes|no/) {
1772 print "Please answer with \"yes\" or \"no\"\n";
1775 if ($ans =~ /no/) {
1776 $proceed = 0;
1779 if ($proceed) {
1780 my $full = expand_save_name $key;
1781 restore_save $key, $val;
1782 print "Restored save $full into slot $val\n";
1786 if ($opt_list_mods) {
1787 $opt_run_daggerfall=0;
1788 my $any = 0;
1789 my @mods = get_mods;
1790 if ( $#mods >= 0 ) {
1791 $any = 1;
1792 print "Installed mods:\n\n";
1793 foreach my $mod (@mods) {
1794 print " $mod";
1795 if (is_mod_enabled $mod) {
1796 print " (enabled)"
1798 print "\n";
1800 print "\n";
1802 my @groups = get_mod_groups;
1803 if ( $#groups >= 0 ) {
1804 $any = 1;
1805 print "Installed groups:\n\n";
1806 foreach my $group (@groups) {
1807 print " $group";
1808 if (is_mod_enabled $group) {
1809 print " (enabled)"
1811 print "\n";
1813 print "\n";
1815 my @missing = ();
1816 my @enabled = get_enabled_mods;
1817 foreach my $mod (@enabled) {
1818 my @temp = grep(/^$mod$/, @mods);
1819 if ($#temp == -1) {
1820 push(@missing, $mod)
1823 if ( $#missing >= 0) {
1824 $any = 1;
1825 print "Enabled mods, no longer installed:\n\n";
1826 foreach my $mod (@missing) {
1827 print " $mod\n";
1829 print "\n";
1831 if (! $any) {
1832 print "No mods found\n";
1836 if ($opt_enable_mod ne "") {
1837 $opt_run_daggerfall=0;
1838 enable_mod $opt_enable_mod;
1839 if (is_mod $opt_enable_mod) {
1840 print "Enabled mod \"$opt_enable_mod\"\n"
1841 } else {
1842 print "Enabled group \"$opt_enable_mod\"\n"
1846 if ($opt_disable_mod ne "") {
1847 $opt_run_daggerfall=0;
1848 disable_mod $opt_disable_mod;
1849 if (is_mod $opt_disable_mod) {
1850 print "Disabled mod \"$opt_disable_mod\"\n"
1851 } else {
1852 print "Disabled group \"$opt_disable_mod\"\n"
1856 if ($opt_refresh_mods) {
1857 $opt_run_daggerfall=0;
1858 refresh_mods;
1859 print "Refreshed enabled mods to latest installed version\n"
1862 $opt_run_daggerfall or $opt_force_run_daggerfall or exit;
1864 if ( ! terms_accepted ) {
1865 foreach (get_terms) { print $_ }
1866 my $ans = 0;
1867 until ($ans =~ /yes|no/) {
1868 print "Do you accept the license? (yes/no) ";
1869 $ans = <>;
1870 ($ans =~ /yes|no/) or print "Please answer with \"yes\" or \"no\"\n";
1872 if ($ans =~ /yes/) {
1873 accept_terms
1874 } else {
1875 print "You should uninstall Daggerfall at once!\n";
1876 exit
1880 run_daggerfall;