Commit 9db3edc

Nick committed on
Preliminary work on preventing the halting issue
commit 9db3edc42d2b99b52f7fbd5b5ccfe0f3d662fe12 parent 8037b8f
3 changed files +40−12
Modifiedrendertowave.lfm +4−1
@@ -73,7 +73,7 @@ object frmRenderToWave: TfrmRenderToWave
73 Height = 152 73 Height = 152
74 Top = 136 74 Top = 136
75 Width = 272 75 Width = 272
76 PageIndex = 1 76 PageIndex = 0
77 TabOrder = 3 77 TabOrder = 3
78 object Page1: TPage 78 object Page1: TPage
79 object Label2: TLabel 79 object Label2: TLabel
@@ -89,6 +89,7 @@ object frmRenderToWave: TfrmRenderToWave
89 Height = 23 89 Height = 23
90 Top = 32 90 Top = 32
91 Width = 192 91 Width = 192
92 MaxValue = 0
92 TabOrder = 0 93 TabOrder = 0
93 end 94 end
94 end 95 end
@@ -106,6 +107,7 @@ object frmRenderToWave: TfrmRenderToWave
106 Height = 23 107 Height = 23
107 Top = 32 108 Top = 32
108 Width = 248 109 Width = 248
110 MaxValue = 0
109 TabOrder = 0 111 TabOrder = 0
110 end 112 end
111 object Label4: TLabel 113 object Label4: TLabel
@@ -121,6 +123,7 @@ object frmRenderToWave: TfrmRenderToWave
121 Height = 23 123 Height = 23
122 Top = 88 124 Top = 88
123 Width = 248 125 Width = 248
126 MaxValue = 0
124 TabOrder = 1 127 TabOrder = 1
125 end 128 end
126 object Label5: TLabel 129 object Label5: TLabel
Modifiedrendertowave.pas +30−5
@@ -6,9 +6,14 @@ interface
6 6
7 uses 7 uses
8 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn, 8 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn,
9 ExtCtrls, Spin, ComCtrls, constants; 9 ExtCtrls, Spin, ComCtrls, constants, fgl;
10 10
11 type 11 type
12 TOrdersSeenSet = specialize TFPGMap<Integer, Boolean>;
13
14 { EHaltingProblem }
15
16 EHaltingProblem = class(Exception);
12 17
13 { TfrmRenderToWave } 18 { TfrmRenderToWave }
14 19
@@ -37,6 +42,8 @@ type
37 CurrentSeenPattern: Integer; 42 CurrentSeenPattern: Integer;
38 TimesSeenTargetPattern: Integer; 43 TimesSeenTargetPattern: Integer;
39 44
45 OrdersSeen: TOrdersSeenSet;
46
40 procedure ExportWaveToFile(Filename: String; Seconds: Integer); overload; 47 procedure ExportWaveToFile(Filename: String; Seconds: Integer); overload;
41 procedure ExportWaveToFile(Filename: String; OrderNum: Integer; Loops: Integer); overload; 48 procedure ExportWaveToFile(Filename: String; OrderNum: Integer; Loops: Integer); overload;
42 49
@@ -93,6 +100,8 @@ var
93 CompletedCycles: QWord = 0; 100 CompletedCycles: QWord = 0;
94 CyclesToDo: QWord; 101 CyclesToDo: QWord;
95 begin 102 begin
103 Button1.Enabled := False;
104
96 CyclesToDo := (70224*60)*Seconds; 105 CyclesToDo := (70224*60)*Seconds;
97 ProgressBar1.Position := 0; 106 ProgressBar1.Position := 0;
98 107
@@ -113,6 +122,8 @@ begin
113 end; 122 end;
114 123
115 EndWritingSoundToFile; 124 EndWritingSoundToFile;
125
126 Button1.Enabled:=True;
116 end; 127 end;
117 128
118 procedure TfrmRenderToWave.ExportWaveToFile(Filename: String; 129 procedure TfrmRenderToWave.ExportWaveToFile(Filename: String;
@@ -120,6 +131,8 @@ procedure TfrmRenderToWave.ExportWaveToFile(Filename: String;
120 var 131 var
121 TimesToSeePattern: Integer; 132 TimesToSeePattern: Integer;
122 begin 133 begin
134 Button1.Enabled:=False;
135
123 TimesToSeePattern := (LoopTimesSpinEdit.Value+1); 136 TimesToSeePattern := (LoopTimesSpinEdit.Value+1);
124 TimesSeenTargetPattern := 0; 137 TimesSeenTargetPattern := 0;
125 CurrentSeenPattern := -1; 138 CurrentSeenPattern := -1;
@@ -135,19 +148,31 @@ begin
135 load('hUGEDriver/preview.gb'); 148 load('hUGEDriver/preview.gb');
136 SymbolTable := ParseSymFile('hUGEDriver/preview.sym'); 149 SymbolTable := ParseSymFile('hUGEDriver/preview.sym');
137 150
138 while TimesSeenTargetPattern < TimesToSeePattern do begin 151 try
139 z80_decode; 152 while TimesSeenTargetPattern < TimesToSeePattern do begin
140 ProgressBar1.Position := Trunc((TimesSeenTargetPattern / TimesToSeePattern)*100); 153 z80_decode;
141 if Random(500) = 1 then Application.ProcessMessages; 154 ProgressBar1.Position := Trunc((TimesSeenTargetPattern / TimesToSeePattern)*100);
155 if Random(500) = 1 then Application.ProcessMessages;
156 end;
157 except
158 on E: EHaltingProblem do begin
159 MessageDlg('Error!', E.Message, mtError, [mbOK], '');
160 end;
142 end; 161 end;
143 162
144 EndWritingSoundToFile; 163 EndWritingSoundToFile;
164
165 Button1.Enabled:=True;
145 end; 166 end;
146 167
147 procedure TfrmRenderToWave.OrderCheckFD; 168 procedure TfrmRenderToWave.OrderCheckFD;
148 var 169 var
149 Pat: Integer; 170 Pat: Integer;
150 begin 171 begin
172 {if ((OrdersSeen.IndexOf(Pat) <> -1) and (OrdersSeen.KeyData[Pat])) and
173 (OrdersSeen.IndexOf(OrderSpinEdit.Value) = -1) then
174 raise EHaltingProblem.Create('The specified target order is never reached again in the song!');}
175
151 Pat := (PeekSymbol(SYM_CURRENT_ORDER) div 2); 176 Pat := (PeekSymbol(SYM_CURRENT_ORDER) div 2);
152 if CurrentSeenPattern <> Pat then begin 177 if CurrentSeenPattern <> Pat then begin
153 CurrentSeenPattern := Pat; 178 CurrentSeenPattern := Pat;
Modifiedtracker.lfm +6−6
@@ -1,7 +1,7 @@
1 object frmTracker: TfrmTracker 1 object frmTracker: TfrmTracker
2 Left = 2122 2 Left = 2081
3 Height = 714 3 Height = 714
4 Top = 119 4 Top = 140
5 Width = 1181 5 Width = 1181
6 Caption = 'hUGETracker' 6 Caption = 'hUGETracker'
7 ClientHeight = 694 7 ClientHeight = 694
@@ -69,12 +69,12 @@ object frmTracker: TfrmTracker
69 ParentFont = False 69 ParentFont = False
70 object SongInformationGroupbox: TGroupBox 70 object SongInformationGroupbox: TGroupBox
71 Left = 8 71 Left = 8
72 Height = 231 72 Height = 136
73 Top = 8 73 Top = 8
74 Width = 729 74 Width = 305
75 Caption = 'Song information' 75 Caption = 'Song information'
76 ClientHeight = 211 76 ClientHeight = 116
77 ClientWidth = 725 77 ClientWidth = 301
78 ParentFont = False 78 ParentFont = False
79 TabOrder = 0 79 TabOrder = 0
80 object Label15: TLabel 80 object Label15: TLabel