Commit bdbb1d0

Nick committed on
Solve the halting problem
commit bdbb1d02e20fe03191c3a2e4fdf09676de44d936 parent 244ad91
5 changed files +128−76
ModifiedGBEmu.lpi +6−1
@@ -168,7 +168,7 @@
168 <PackageName Value="LCL"/> 168 <PackageName Value="LCL"/>
169 </Item6> 169 </Item6>
170 </RequiredPackages> 170 </RequiredPackages>
171 <Units Count="24"> 171 <Units Count="25">
172 <Unit0> 172 <Unit0>
173 <Filename Value="GBEmu.lpr"/> 173 <Filename Value="GBEmu.lpr"/>
174 <IsPartOfProject Value="True"/> 174 <IsPartOfProject Value="True"/>
@@ -295,6 +295,11 @@
295 <IsPartOfProject Value="True"/> 295 <IsPartOfProject Value="True"/>
296 <UnitName Value="htWaveWriter"/> 296 <UnitName Value="htWaveWriter"/>
297 </Unit23> 297 </Unit23>
298 <Unit24>
299 <Filename Value="nullstream.pas"/>
300 <IsPartOfProject Value="True"/>
301 <UnitName Value="NullStream"/>
302 </Unit24>
298 </Units> 303 </Units>
299 </ProjectOptions> 304 </ProjectOptions>
300 <CompilerOptions> 305 <CompilerOptions>
Modifiedconstants.pas +1−0
@@ -23,6 +23,7 @@ const
23 SYM_ROW = 'row'; 23 SYM_ROW = 'row';
24 SYM_CURRENT_ORDER = 'current_order'; 24 SYM_CURRENT_ORDER = 'current_order';
25 SYM_TICKS_PER_ROW = 'ticks_per_row'; 25 SYM_TICKS_PER_ROW = 'ticks_per_row';
26 SYM_ORDER_COUNT = 'order_cnt';
26 27
27 // Sound controller registers 28 // Sound controller registers
28 NR10 = $FF10; 29 NR10 = $FF10;
Addednullstream.pas +34−0
@@ -0,0 +1,34 @@
1 unit NullStream;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils;
9
10 type
11
12 { TNullStream }
13
14 TNullStream = class(TStream)
15 function Write(const Buffer; Count: Longint): Longint; override;
16 function Read(var Buffer; Count: Longint): Longint; override;
17 end;
18
19 implementation
20
21 { TNullStream }
22
23 function TNullStream.Write(const Buffer; Count: Longint): Longint;
24 begin
25 Result:= 0;
26 end;
27
28 function TNullStream.Read(var Buffer; Count: Longint): Longint;
29 begin
30 Result:= 0;
31 end;
32
33 end.
34
Modifiedrendertowave.lfm +76−61
@@ -1,53 +1,57 @@
1 object frmRenderToWave: TfrmRenderToWave 1 object frmRenderToWave: TfrmRenderToWave
2 Left = 2038 2 Left = 2038
3 Height = 313 3 Height = 548
4 Top = 144 4 Top = 144
5 Width = 451 5 Width = 789
6 BorderStyle = bsSingle 6 BorderStyle = bsSingle
7 Caption = 'Render song' 7 Caption = 'Render song'
8 ClientHeight = 313 8 ClientHeight = 548
9 ClientWidth = 451 9 ClientWidth = 789
10 DesignTimePPI = 168
10 OnShow = FormShow 11 OnShow = FormShow
11 Position = poDefault 12 Position = poDefault
12 LCLVersion = '2.0.6.0' 13 LCLVersion = '2.0.6.0'
13 object RenderButton: TButton 14 object RenderButton: TButton
14 Left = 17 15 Left = 30
15 Height = 25 16 Height = 44
16 Top = 272 17 Top = 476
17 Width = 264 18 Width = 462
18 Caption = 'Render' 19 Caption = 'Render'
19 Enabled = False 20 Enabled = False
20 OnClick = RenderButtonClick 21 OnClick = RenderButtonClick
22 ParentFont = False
21 TabOrder = 0 23 TabOrder = 0
22 end 24 end
23 object FileNameEdit1: TFileNameEdit 25 object FileNameEdit1: TFileNameEdit
24 Left = 72 26 Left = 126
25 Height = 23 27 Height = 38
26 Top = 8 28 Top = 14
27 Width = 248 29 Width = 434
28 OnAcceptFileName = FileNameEdit1AcceptFileName 30 OnAcceptFileName = FileNameEdit1AcceptFileName
29 Filter = 'Wave Files|*.wav' 31 Filter = 'Wave Files|*.wav'
30 FilterIndex = 0 32 FilterIndex = 0
31 HideDirectories = False 33 HideDirectories = False
32 ButtonWidth = 23 34 ButtonWidth = 40
33 NumGlyphs = 1 35 NumGlyphs = 1
34 MaxLength = 0 36 MaxLength = 0
37 ParentFont = False
35 TabOrder = 1 38 TabOrder = 1
36 OnChange = FileNameEdit1Change 39 OnChange = FileNameEdit1Change
37 end 40 end
38 object Label1: TLabel 41 object Label1: TLabel
39 Left = 8 42 Left = 14
40 Height = 15 43 Height = 30
41 Top = 16 44 Top = 28
42 Width = 48 45 Width = 83
43 Caption = 'Filename' 46 Caption = 'Filename'
44 ParentColor = False 47 ParentColor = False
48 ParentFont = False
45 end 49 end
46 object RadioGroup1: TRadioGroup 50 object RadioGroup1: TRadioGroup
47 Left = 8 51 Left = 14
48 Height = 58 52 Height = 102
49 Top = 40 53 Top = 70
50 Width = 193 54 Width = 338
51 AutoFill = True 55 AutoFill = True
52 Caption = 'Duration' 56 Caption = 'Duration'
53 ChildSizing.LeftRightSpacing = 6 57 ChildSizing.LeftRightSpacing = 6
@@ -57,8 +61,8 @@ object frmRenderToWave: TfrmRenderToWave
57 ChildSizing.ShrinkVertical = crsScaleChilds 61 ChildSizing.ShrinkVertical = crsScaleChilds
58 ChildSizing.Layout = cclLeftToRightThenTopToBottom 62 ChildSizing.Layout = cclLeftToRightThenTopToBottom
59 ChildSizing.ControlsPerLine = 2 63 ChildSizing.ControlsPerLine = 2
60 ClientHeight = 38 64 ClientHeight = 67
61 ClientWidth = 189 65 ClientWidth = 334
62 Columns = 2 66 Columns = 2
63 ItemIndex = 0 67 ItemIndex = 0
64 Items.Strings = ( 68 Items.Strings = (
@@ -66,107 +70,118 @@ object frmRenderToWave: TfrmRenderToWave
66 'Loops' 70 'Loops'
67 ) 71 )
68 OnClick = RadioGroup1Click 72 OnClick = RadioGroup1Click
73 ParentFont = False
69 TabOrder = 2 74 TabOrder = 2
70 end 75 end
71 object Notebook1: TNotebook 76 object Notebook1: TNotebook
72 Left = 8 77 Left = 14
73 Height = 112 78 Height = 196
74 Top = 104 79 Top = 182
75 Width = 425 80 Width = 744
76 PageIndex = 1 81 PageIndex = 0
77 TabOrder = 3 82 TabOrder = 3
78 object Page1: TPage 83 object Page1: TPage
79 object Label2: TLabel 84 object Label2: TLabel
80 Left = 16 85 Left = 28
81 Height = 15 86 Height = 30
82 Top = 24 87 Top = 42
83 Width = 44 88 Width = 77
84 Caption = 'Seconds' 89 Caption = 'Seconds'
85 ParentColor = False 90 ParentColor = False
91 ParentFont = False
86 end 92 end
87 object SecondsSpinEdit: TSpinEdit 93 object SecondsSpinEdit: TSpinEdit
88 Left = 72 94 Left = 126
89 Height = 23 95 Height = 38
90 Top = 16 96 Top = 28
91 Width = 344 97 Width = 602
92 MaxValue = 0 98 MaxValue = 0
99 ParentFont = False
93 TabOrder = 0 100 TabOrder = 0
94 end 101 end
95 end 102 end
96 object Page2: TPage 103 object Page2: TPage
97 object Label3: TLabel 104 object Label3: TLabel
98 Left = 16 105 Left = 28
99 Height = 15 106 Height = 15
100 Top = 16 107 Top = 28
101 Width = 129 108 Width = 129
102 Caption = 'Stop playing when order' 109 Caption = 'Stop playing when order'
103 ParentColor = False 110 ParentColor = False
111 ParentFont = False
104 end 112 end
105 object OrderSpinEdit: TSpinEdit 113 object OrderSpinEdit: TSpinEdit
106 Left = 160 114 Left = 280
107 Height = 23 115 Height = 23
108 Top = 8 116 Top = 14
109 Width = 248 117 Width = 434
110 MaxValue = 0 118 MaxValue = 0
119 ParentFont = False
111 TabOrder = 0 120 TabOrder = 0
112 end 121 end
113 object Label4: TLabel 122 object Label4: TLabel
114 Left = 16 123 Left = 28
115 Height = 15 124 Height = 15
116 Top = 48 125 Top = 84
117 Width = 92 126 Width = 92
118 Caption = 'has been reached' 127 Caption = 'has been reached'
119 ParentColor = False 128 ParentColor = False
129 ParentFont = False
120 end 130 end
121 object LoopTimesSpinEdit: TSpinEdit 131 object LoopTimesSpinEdit: TSpinEdit
122 Left = 160 132 Left = 280
123 Height = 23 133 Height = 23
124 Top = 40 134 Top = 70
125 Width = 248 135 Width = 434
126 MaxValue = 0 136 MaxValue = 0
137 ParentFont = False
127 TabOrder = 1 138 TabOrder = 1
128 end 139 end
129 object Label5: TLabel 140 object Label5: TLabel
130 Left = 16 141 Left = 28
131 Height = 15 142 Height = 15
132 Top = 80 143 Top = 140
133 Width = 29 144 Width = 29
134 Caption = 'times' 145 Caption = 'times'
135 ParentColor = False 146 ParentColor = False
147 ParentFont = False
136 end 148 end
137 end 149 end
138 end 150 end
139 object ProgressBar1: TProgressBar 151 object ProgressBar1: TProgressBar
140 Left = 17 152 Left = 30
141 Height = 28 153 Height = 49
142 Top = 232 154 Top = 406
143 Width = 417 155 Width = 730
156 ParentFont = False
144 TabOrder = 4 157 TabOrder = 4
145 end 158 end
146 object ComboBox1: TComboBox 159 object ComboBox1: TComboBox
147 Left = 328 160 Left = 574
148 Height = 23 161 Height = 38
149 Top = 8 162 Top = 14
150 Width = 105 163 Width = 184
151 ItemHeight = 15 164 ItemHeight = 30
152 ItemIndex = 0 165 ItemIndex = 0
153 Items.Strings = ( 166 Items.Strings = (
154 'WAV' 167 'WAV'
155 'MP3' 168 'MP3'
156 ) 169 )
157 OnChange = ComboBox1Change 170 OnChange = ComboBox1Change
171 ParentFont = False
158 Style = csDropDownList 172 Style = csDropDownList
159 TabOrder = 5 173 TabOrder = 5
160 Text = 'WAV' 174 Text = 'WAV'
161 end 175 end
162 object CancelButton: TButton 176 object CancelButton: TButton
163 Left = 288 177 Left = 504
164 Height = 25 178 Height = 44
165 Top = 272 179 Top = 476
166 Width = 146 180 Width = 256
167 Caption = 'Cancel' 181 Caption = 'Cancel'
168 Enabled = False 182 Enabled = False
169 OnClick = CancelButtonClick 183 OnClick = CancelButtonClick
184 ParentFont = False
170 TabOrder = 6 185 TabOrder = 6
171 end 186 end
172 end 187 end
Modifiedrendertowave.pas +11−14
@@ -9,8 +9,6 @@ uses
9 ExtCtrls, Spin, ComCtrls, constants, process, fgl; 9 ExtCtrls, Spin, ComCtrls, constants, process, fgl;
10 10
11 type 11 type
12 TOrdersSeenSet = specialize TFPGMap<Integer, Boolean>;
13
14 { EHaltingProblem } 12 { EHaltingProblem }
15 13
16 EHaltingProblem = class(Exception); 14 EHaltingProblem = class(Exception);
@@ -43,10 +41,8 @@ type
43 procedure FormShow(Sender: TObject); 41 procedure FormShow(Sender: TObject);
44 procedure RadioGroup1Click(Sender: TObject); 42 procedure RadioGroup1Click(Sender: TObject);
45 private 43 private
46 CurrentSeenPattern: Integer; 44 PatternsSeen, CurrentSeenPattern, TimesSeenTargetPattern: Integer;
47 TimesSeenTargetPattern: Integer;
48 45
49 OrdersSeen: TOrdersSeenSet;
50 Rendering: Boolean; 46 Rendering: Boolean;
51 CancelRequested: Boolean; 47 CancelRequested: Boolean;
52 48
@@ -86,13 +82,9 @@ begin
86 82
87 try 83 try
88 ExportWaveToFile(FileNameEdit1.FileName); 84 ExportWaveToFile(FileNameEdit1.FileName);
89 {if RadioGroup1.ItemIndex = 0 then
90 ExportWaveToFile(FileNameEdit1.FileName, SecondsSpinEdit.Value)
91 else
92 ExportWaveToFile(FileNameEdit1.FileName, OrderSpinEdit.Value, LoopTimesSpinEdit.Value);}
93 except 85 except
94 on E: Exception do begin 86 on E: Exception do begin
95 MessageDlg('Error!', 'Couldn''t write ' + FileNameEdit1.FileName + ' !' + LineEnding + 87 MessageDlg('Error!', 'Couldn''t write ' + FileNameEdit1.FileName + '!' + LineEnding +
96 LineEnding + E.Message, mtError, [mbOk], ''); 88 LineEnding + E.Message, mtError, [mbOk], '');
97 end; 89 end;
98 end; 90 end;
@@ -221,17 +213,25 @@ procedure TfrmRenderToWave.RenderLoops(TargetOrder: Integer; Loops: Integer);
221 var 213 var
222 TimesToSeePattern: Integer; 214 TimesToSeePattern: Integer;
223 OldFD: TFDCallback; 215 OldFD: TFDCallback;
216 OrderCount: Integer;
224 begin 217 begin
225 OldFD := FDCallback; 218 OldFD := FDCallback;
226 FDCallback := @OrderCheckFD; 219 FDCallback := @OrderCheckFD;
227 220
221 OrderCount := PeekSymbol(SYM_ORDER_COUNT) div 2;
222
228 CurrentSeenPattern := -1; 223 CurrentSeenPattern := -1;
229 TimesSeenTargetPattern := 0; 224 TimesSeenTargetPattern := 0;
225 PatternsSeen := 0;
230 TimesToSeePattern := (LoopTimesSpinEdit.Value+1); 226 TimesToSeePattern := (LoopTimesSpinEdit.Value+1);
227
231 while (TimesSeenTargetPattern < TimesToSeePattern) and not CancelRequested do begin 228 while (TimesSeenTargetPattern < TimesToSeePattern) and not CancelRequested do begin
232 z80_decode; 229 z80_decode;
233 ProgressBar1.Position := Trunc((TimesSeenTargetPattern / TimesToSeePattern)*100); 230 ProgressBar1.Position := Trunc((TimesSeenTargetPattern / TimesToSeePattern)*100);
234 if Random(500) = 1 then Application.ProcessMessages; 231 if Random(500) = 1 then Application.ProcessMessages;
232
233 if (PatternsSeen > OrderCount) and (TimesSeenTargetPattern <= 1) then
234 raise EHaltingProblem.Create('The specified loop point cannot be reached more than once!');
235 end; 235 end;
236 236
237 FDCallback := OldFD; 237 FDCallback := OldFD;
@@ -241,12 +241,9 @@ procedure TfrmRenderToWave.OrderCheckFD;
241 var 241 var
242 Pat: Integer; 242 Pat: Integer;
243 begin 243 begin
244 {if ((OrdersSeen.IndexOf(Pat) <> -1) and (OrdersSeen.KeyData[Pat])) and
245 (OrdersSeen.IndexOf(OrderSpinEdit.Value) = -1) then
246 raise EHaltingProblem.Create('The specified target order is never reached again in the song!');}
247
248 Pat := (PeekSymbol(SYM_CURRENT_ORDER) div 2); 244 Pat := (PeekSymbol(SYM_CURRENT_ORDER) div 2);
249 if CurrentSeenPattern <> Pat then begin 245 if CurrentSeenPattern <> Pat then begin
246 Inc(PatternsSeen);
250 CurrentSeenPattern := Pat; 247 CurrentSeenPattern := Pat;
251 248
252 if Pat = OrderSpinEdit.Value then 249 if Pat = OrderSpinEdit.Value then