Commit 2148192

Nick committed on
Add uge2source
commit 2148192cd06754227326253350449227f1ad3f09 parent cfbfc9c
4 changed files +302−125
Modifiedcodegen.pas +107−111
@@ -6,14 +6,16 @@ interface
6 6
7 uses 7 uses
8 Classes, SysUtils, Math, Instruments, Song, Utils, 8 Classes, SysUtils, Math, Instruments, Song, Utils,
9 HugeDatatypes, Constants, Dialogs, strutils, FileUtil, LazFileUtils, 9 HugeDatatypes, Constants, Dialogs, strutils, FileUtil, LazFileUtils, process;
10 lclintf, process;
11 10
12 type 11 type
12 EAssemblyException = class(Exception);
13 ECodegenRenameError = class(Exception);
14
13 TExportMode = (emNormal, emPreview, emGBS); 15 TExportMode = (emNormal, emPreview, emGBS);
14 16
15 function RenderPreviewRom(Song: TSong): boolean; 17 procedure RenderPreviewRom(Song: TSong);
16 function RenderSongToFile(Song: TSong; Filename: string; Mode: TExportMode = emNormal): boolean; 18 procedure RenderSongToFile(Song: TSong; Filename: string; Mode: TExportMode = emNormal);
17 procedure RenderSongToGBDKC(Song: TSong; DescriptorName: String; Filename: string); 19 procedure RenderSongToGBDKC(Song: TSong; DescriptorName: String; Filename: string);
18 procedure RenderSongToRGBDSAsm(Song: TSong; DescriptorName: String; Filename: string); 20 procedure RenderSongToRGBDSAsm(Song: TSong; DescriptorName: String; Filename: string);
19 21
@@ -425,21 +427,32 @@ begin
425 Stream.Free; 427 Stream.Free;
426 end; 428 end;
427 429
428 function RenderPreviewROM(Song: TSong): boolean; 430 procedure RenderPreviewROM(Song: TSong);
429 begin 431 begin
430 Result := RenderSongToFile(Song, 'preview.gb', emPreview); 432 RenderSongToFile(Song, 'preview.gb', emPreview);
431 end; 433 end;
432 434
433 function RenderSongToFile(Song: TSong; Filename: String; Mode: TExportMode = emNormal): boolean; 435 procedure RenderSongToFile(Song: TSong; Filename: String; Mode: TExportMode = emNormal);
434 { TODO: Refactor this whole monstrosity. }
435 var 436 var
436 OutFile: Text; 437 OutFile: Text;
437 I: integer; 438 I: integer;
438 Proc: TProcess; 439 Proc: TProcess;
439 OutSL: TStringList;
440 FilePath: string; 440 FilePath: string;
441 RenameSucceeded: Boolean; 441 RenameSucceeded: Boolean;
442 442
443 procedure Die;
444 var
445 OutSL: TStringList;
446 begin
447 OutSL := TStringList.Create;
448 try
449 OutSL.LoadFromStream(Proc.Output);
450 raise EAssemblyException.Create(OutSL.Text);
451 finally
452 OutSL.Free;
453 end;
454 end;
455
443 procedure WriteHTT(F: string; S: string); 456 procedure WriteHTT(F: string; S: string);
444 begin 457 begin
445 AssignFile(OutFile, F); 458 AssignFile(OutFile, F);
@@ -495,9 +508,6 @@ var
495 508
496 Result := Proc.ExitCode; 509 Result := Proc.ExitCode;
497 end; 510 end;
498
499 label
500 AssemblyError, Cleanup; // Eh, screw good practice. How bad can it be?
501 begin 511 begin
502 Song := OptimizeSong(Song); 512 Song := OptimizeSong(Song);
503 513
@@ -525,111 +535,103 @@ begin
525 CloseFile(OutFile); 535 CloseFile(OutFile);
526 536
527 // Build the file 537 // Build the file
528 OutSL := TStringList.Create;
529 Proc := TProcess.Create(nil); 538 Proc := TProcess.Create(nil);
530 Proc.Options := Proc.Options + [poWaitOnExit, poUsePipes, poStdErrToOutput, poNoConsole]; 539 Proc.Options := Proc.Options + [poWaitOnExit, poUsePipes, poStdErrToOutput, poNoConsole];
531 540
532 // Assemble 541 try
533 if Mode = emPreview then 542 // Assemble
534 begin 543 if Mode = emPreview then
535 if Assemble(Filename + '_driver.obj', 'hUGEDriver/hUGEDriver.asm', ['PREVIEW_MODE']) <> 0 then 544 begin
536 goto AssemblyError; 545 if Assemble(Filename + '_driver.obj', 'hUGEDriver/hUGEDriver.asm', ['PREVIEW_MODE']) <> 0 then
537 end 546 Die;
538 else 547 end
539 begin 548 else
540 if Assemble(Filename + '_driver.obj', 'hUGEDriver/hUGEDriver.asm', []) <> 0 then 549 begin
541 goto AssemblyError; 550 if Assemble(Filename + '_driver.obj', 'hUGEDriver/hUGEDriver.asm', []) <> 0 then
542 end; 551 Die;
543 552 end;
544 if Assemble(Filename + '_song.obj',
545 'hUGEDriver/song.asm',
546 ['SONG_DESCRIPTOR=song', 'TICKS='+IntToStr(Song.TicksPerRow)]) <> 0 then
547 goto AssemblyError;
548
549 if Mode = emGBS then
550 begin
551 if Assemble(
552 Filename + '_gbs.obj', 'hUGEDriver/gbs.asm',
553 ['SONG_DESCRIPTOR=song',
554 'GBS_TITLE='+PadRight(Song.Name, 32),
555 'GBS_AUTHOR='+PadRight(Song.Artist, 32),
556 'GBS_COPYRIGHT='+PadRight(IntToStr(CurrentYear), 32)]
557 ) <> 0 then goto AssemblyError;
558 end
559 else
560 begin
561 if Assemble(Filename + '_player.obj', 'hUGEDriver/player.asm', ['SONG_DESCRIPTOR=song']) <> 0 then
562 goto AssemblyError;
563 end;
564
565 // Link
566 if Mode = emGBS then
567 begin
568 if Link(Filename + '.gbs',
569 [Filename + '_driver.obj',
570 Filename + '_song.obj',
571 Filename + '_gbs.obj']) <> 0 then goto AssemblyError;
572 end
573 else
574 begin
575 if Link(Filename + '.gb',
576 [Filename + '_driver.obj',
577 Filename + '_song.obj',
578 Filename + '_player.obj'],
579 Filename + '.map',
580 Filename + '.sym') <> 0 then goto AssemblyError;
581 end;
582 553
583 // Fix 554 if Assemble(Filename + '_song.obj',
584 if Mode = emGBS then 555 'hUGEDriver/song.asm',
585 RectifyGBSFile(Filename + '.gbs') 556 ['SONG_DESCRIPTOR=song', 'TICKS='+IntToStr(Song.TicksPerRow)]) <> 0 then
586 else 557 Die;
587 begin
588 if (Fix(Filename + '.gb') <> 0) then
589 goto AssemblyError;
590 end;
591 558
592 // Move to destination 559 if Mode = emGBS then
593 if Mode <> emPreview then 560 begin
594 begin 561 if Assemble(
595 if FileExists(FilePath) then 562 Filename + '_gbs.obj', 'hUGEDriver/gbs.asm',
596 DeleteFile(FilePath); 563 ['SONG_DESCRIPTOR=song',
564 'GBS_TITLE='+PadRight(Song.Name, 32),
565 'GBS_AUTHOR='+PadRight(Song.Artist, 32),
566 'GBS_COPYRIGHT='+PadRight(IntToStr(CurrentYear), 32)]
567 ) <> 0 then Die;
568 end
569 else
570 begin
571 if Assemble(Filename + '_player.obj', 'hUGEDriver/player.asm', ['SONG_DESCRIPTOR=song']) <> 0 then
572 Die;
573 end;
597 574
598 case Mode of 575 // Link
599 emGBS: RenameSucceeded := RenameFile(Filename + '.gbs', FilePath); 576 if Mode = emGBS then
600 else RenameSucceeded := RenameFile(Filename + '.gb', FilePath); 577 begin
578 if Link(Filename + '.gbs',
579 [Filename + '_driver.obj',
580 Filename + '_song.obj',
581 Filename + '_gbs.obj']) <> 0 then Die;
582 end
583 else
584 begin
585 if Link(Filename + '.gb',
586 [Filename + '_driver.obj',
587 Filename + '_song.obj',
588 Filename + '_player.obj'],
589 Filename + '.map',
590 Filename + '.sym') <> 0 then Die;
601 end; 591 end;
602 592
603 if not RenameSucceeded then 593 // Fix
594 if Mode = emGBS then
595 RectifyGBSFile(Filename + '.gbs')
596 else
604 begin 597 begin
605 MessageDlg('Error!', 598 if (Fix(Filename + '.gb') <> 0) then
606 'Couldn''t create file at ' + FilePath + 599 Die;
607 '. Make sure your path is correct!',
608 mtError,
609 [mbOK],
610 0);
611 Result := False;
612 goto Cleanup;
613 end; 600 end;
614 {$ifdef DEVELOPMENT}
615 RenameFile(Filename + '.sym', FilePath + '.sym');
616 RenameFile(Filename + '.map', FilePath + '.map');
617 {$endif}
618 {$ifdef PRODUCTION}
619 DeleteFile(Filename + '.sym');
620 DeleteFile(Filename + '.map');
621 {$endif}
622 601
623 DeleteFile(Filename + '_driver.obj'); 602 // Move to destination
624 DeleteFile(Filename + '_song.obj'); 603 if Mode <> emPreview then
625 DeleteFile(Filename + '_player.obj'); 604 begin
626 DeleteFile(Filename + '_gbs.obj'); 605 if FileExists(FilePath) then
627 end; 606 DeleteFile(FilePath);
628 607
629 Result := True; 608 case Mode of
630 goto Cleanup; 609 emGBS: RenameSucceeded := RenameFile(Filename + '.gbs', FilePath);
610 else RenameSucceeded := RenameFile(Filename + '.gb', FilePath);
611 end;
631 612
632 AssemblyError: 613 if not RenameSucceeded then
614 raise ECodegenRenameError.Create(FilePath);
615
616 {$ifdef DEVELOPMENT}
617 RenameFile(Filename + '.sym', FilePath + '.sym');
618 RenameFile(Filename + '.map', FilePath + '.map');
619 {$endif}
620 {$ifdef PRODUCTION}
621 DeleteFile(Filename + '.sym');
622 DeleteFile(Filename + '.map');
623 {$endif}
624
625 DeleteFile(Filename + '_driver.obj');
626 DeleteFile(Filename + '_song.obj');
627 DeleteFile(Filename + '_player.obj');
628 DeleteFile(Filename + '_gbs.obj');
629 end;
630 finally
631 Proc.Free;
632 end;
633
634 {AssemblyError:
633 Result := False; 635 Result := False;
634 OutSL.LoadFromStream(Proc.Output); 636 OutSL.LoadFromStream(Proc.Output);
635 637
@@ -657,13 +659,7 @@ begin
657 {$ifdef PRODUCTION} 659 {$ifdef PRODUCTION}
658 OpenURL('https://github.com/SuperDisk/hUGETracker/issues'); 660 OpenURL('https://github.com/SuperDisk/hUGETracker/issues');
659 {$endif} 661 {$endif}
660 end; 662 end;}
661
662 Cleanup:
663 // No need to destroy Song-- OptimizeSong's output has the same lifetime
664 // as its argument.
665 Proc.Free;
666 OutSL.Free;
667 end; 663 end;
668 664
669 end. 665 end.
Modifiedconstants.pas +1−14
@@ -5,7 +5,7 @@ unit Constants;
5 interface 5 interface
6 6
7 uses 7 uses
8 fgl, Graphics, LMessages; 8 fgl;
9 9
10 type 10 type
11 TIntToIntMap = specialize TFPGMap<Integer, Integer>; 11 TIntToIntMap = specialize TFPGMap<Integer, Integer>;
@@ -18,19 +18,8 @@ type
18 TRoutineIndex = 0..15; 18 TRoutineIndex = 0..15;
19 19
20 const 20 const
21 clGameboyBlack = TColor($211807);
22 clGameboyMidGreen = TColor($6CC086);
23
24 UGE_FORMAT_VERSION = 4; 21 UGE_FORMAT_VERSION = 4;
25 22
26 INSTRUMENTS_COUNT = 45;
27 ROUTINES_COUNT = 16;
28 WAVES_COUNT = 16;
29
30 LM_FD = LM_USER + 0;
31 LM_UNDO_OCCURED = LM_USER + 1;
32 LM_PREVIEW_NOTE = LM_USER + 2;
33
34 SYM_ROW = 'row'; 23 SYM_ROW = 'row';
35 SYM_TICK = 'tick'; 24 SYM_TICK = 'tick';
36 SYM_CURRENT_ORDER = 'current_order'; 25 SYM_CURRENT_ORDER = 'current_order';
@@ -151,8 +140,6 @@ function NoteCodeToString(NoteCode: Integer): String;
151 140
152 implementation 141 implementation
153 142
154 uses LCLType;
155
156 function NoteCodeToString(NoteCode: Integer): String; 143 function NoteCodeToString(NoteCode: Integer): String;
157 begin 144 begin
158 if not NoteMap.TryGetData(NoteCode, Result) then 145 if not NoteMap.TryGetData(NoteCode, Result) then
Addeduge2source.lpi +96−0
@@ -0,0 +1,96 @@
1 <?xml version="1.0" encoding="UTF-8"?>
2 <CONFIG>
3 <ProjectOptions>
4 <Version Value="11"/>
5 <PathDelim Value="\"/>
6 <General>
7 <Flags>
8 <MainUnitHasCreateFormStatements Value="False"/>
9 <MainUnitHasScaledStatement Value="False"/>
10 </Flags>
11 <SessionStorage Value="InProjectDir"/>
12 <MainUnit Value="0"/>
13 <Title Value="uge2source"/>
14 <UseAppBundle Value="False"/>
15 <ResourceType Value="res"/>
16 </General>
17 <BuildModes Count="1">
18 <Item1 Name="Default" Default="True"/>
19 </BuildModes>
20 <PublishOptions>
21 <Version Value="2"/>
22 <UseFileFilters Value="True"/>
23 </PublishOptions>
24 <RunParams>
25 <FormatVersion Value="2"/>
26 <Modes Count="0"/>
27 </RunParams>
28 <RequiredPackages Count="1">
29 <Item1>
30 <PackageName Value="LazUtils"/>
31 </Item1>
32 </RequiredPackages>
33 <Units Count="8">
34 <Unit0>
35 <Filename Value="uge2source.lpr"/>
36 <IsPartOfProject Value="True"/>
37 </Unit0>
38 <Unit1>
39 <Filename Value="codegen.pas"/>
40 <IsPartOfProject Value="True"/>
41 <UnitName Value="Codegen"/>
42 </Unit1>
43 <Unit2>
44 <Filename Value="constants.pas"/>
45 <IsPartOfProject Value="True"/>
46 <UnitName Value="Constants"/>
47 </Unit2>
48 <Unit3>
49 <Filename Value="song.pas"/>
50 <IsPartOfProject Value="True"/>
51 <UnitName Value="Song"/>
52 </Unit3>
53 <Unit4>
54 <Filename Value="hugedatatypes.pas"/>
55 <IsPartOfProject Value="True"/>
56 </Unit4>
57 <Unit5>
58 <Filename Value="instruments.pas"/>
59 <IsPartOfProject Value="True"/>
60 </Unit5>
61 <Unit6>
62 <Filename Value="utils.pas"/>
63 <IsPartOfProject Value="True"/>
64 </Unit6>
65 <Unit7>
66 <Filename Value="waves.pas"/>
67 <IsPartOfProject Value="True"/>
68 </Unit7>
69 </Units>
70 </ProjectOptions>
71 <CompilerOptions>
72 <Version Value="11"/>
73 <PathDelim Value="\"/>
74 <Target>
75 <Filename Value="uge2source"/>
76 </Target>
77 <SearchPaths>
78 <IncludeFiles Value="$(ProjOutDir)"/>
79 <OtherUnitFiles Value="C:\Projects\GB-Stuff\uge"/>
80 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
81 </SearchPaths>
82 </CompilerOptions>
83 <Debugging>
84 <Exceptions Count="3">
85 <Item1>
86 <Name Value="EAbort"/>
87 </Item1>
88 <Item2>
89 <Name Value="ECodetoolError"/>
90 </Item2>
91 <Item3>
92 <Name Value="EFOpenError"/>
93 </Item3>
94 </Exceptions>
95 </Debugging>
96 </CONFIG>
Addeduge2source.lpr +98−0
@@ -0,0 +1,98 @@
1 program uge2source;
2
3 {$mode objfpc}{$H+}
4
5 uses
6 {$IFDEF UNIX}{$IFDEF UseCThreads}
7 cthreads,
8 {$ENDIF}{$ENDIF}
9 Classes, SysUtils, CustApp,
10 Song, Codegen;
11
12 type
13
14 { TUGE2Source }
15
16 TUGE2Source = class(TCustomApplication)
17 protected
18 procedure DoRun; override;
19 public
20 constructor Create(TheOwner: TComponent); override;
21 destructor Destroy; override;
22 procedure WriteHelp; virtual;
23 end;
24
25 { TUGE2Source }
26
27 procedure TUGE2Source.DoRun;
28 var
29 ErrorMsg: String;
30 Song: TSong;
31 NonOpts: TStringArray;
32 S: TStream;
33 begin
34 // quick check parameters
35 ErrorMsg:=CheckOptions('h', 'help');
36 if ErrorMsg<>'' then begin
37 ShowException(Exception.Create(ErrorMsg));
38 Terminate;
39 Exit;
40 end;
41
42 // parse parameters
43 if HasOption('h', 'help') or (ParamCount = 0) then begin
44 WriteHelp;
45 Terminate;
46 Exit;
47 end;
48
49 // Grab non-options
50 NonOpts := GetNonOptions('h', ['help']);
51
52 S := TFileStream.Create(NonOpts[0], fmOpenRead);
53
54 try
55 ReadSongFromStream(S, Song);
56 finally
57 S.Free;
58 end;
59
60 case LowerCase(ExtractFileExt(NonOpts[2])) of
61 '.c': begin
62 RenderSongToGBDKC(Song, NonOpts[1], NonOpts[2]);
63 end;
64 '.asm': begin
65 RenderSongToRGBDSAsm(Song, NonOpts[1], NonOpts[2]);
66 end;
67 else raise Exception.Create('Output file must be either .C or .ASM, but was ' + NonOpts[2]);
68 end;
69 end;
70
71 Terminate;
72 end;
73
74 constructor TUGE2Source.Create(TheOwner: TComponent);
75 begin
76 inherited Create(TheOwner);
77 StopOnException:=True;
78 end;
79
80 destructor TUGE2Source.Destroy;
81 begin
82 inherited Destroy;
83 end;
84
85 procedure TUGE2Source.WriteHelp;
86 begin
87 writeln('Usage: ', ExeName, ' infile.uge descriptor outfile.(asm|c)');
88 end;
89
90 var
91 Application: TUGE2Source;
92 begin
93 Application:=TUGE2Source.Create(nil);
94 Application.Title:='uge2source';
95 Application.Run;
96 Application.Free;
97 end.
98