Apple-2-Tools
/
ProDOS-perl
mirror of https://github.com/softwarejanitor/ProDOS.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

More work on procreation.

This commit is contained in:
Leeland Heins 2019-03-07 10:59:05 -06:00 committed by GitHub
parent db860e06a1
commit c09f4a4fae
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 23 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
ProDOS.pm
View File

@ -2310,7 +2310,6 @@ sub create_subdir {
my @bytes = unpack "C*", $buf;
# Create the subdirectory sector.
my $file_storage_type = 0xd0;
$file_storage_type |= length($subdirname);
my $file_type = 0x0f;
@ -2335,8 +2334,31 @@ sub create_subdir {
#}
#print "'\n";
# Create the subdirectory block.
my @subdirbytes = ();
# Get list of free blocks.
my @free_blocks = get_free_blocks($pofile, $debug);
# Get block from free block list for this directory.
my $subdirblknum = pop @free_blocks;
my $subdir_key_pointer = $subdirblknum;
##FIXME
my $subdirbuf = pack "C*", @subdirbytes;
# Write the new directory block out.
if (!write_blk($pofile, $subdirblknum, \$subdirbuf)) {
print "I/O Error writing block $subdirblknum\n";
return 0;
}
# Mark the subdir block as used.
my @used_blocks = ();
push @used_blocks, $subdirblknum;
$rv = reserve_blocks($pofile, \@used_blocks, $debug);
# Write file descriptive entry back out.
##FIXME
$buf = pack "C*", @bytes;