]> 4ch.mooo.com Git - 16.git/blob - 16/ADT2PLAY/ILOADERS.INC
i hate being tired wwww i will work on the project some more sometime wwww
[16.git] / 16 / ADT2PLAY / ILOADERS.INC
1 {\r
2         function  check_byte(var data; _byte: Byte; size: Longint): Boolean;\r
3         procedure insert_command(cmd,cmd2: Word; patterns: Byte; chan: Byte; exceptions: tByteSet);\r
4         procedure import_old_a2m_event1(patt,line,chan: Byte; old_chunk: tOLD_CHUNK;\r
5                                         processing_whole_song: Boolean);\r
6         procedure replace_old_adsr(patterns: Byte);\r
7         procedure import_old_a2m_patterns1(block: Byte; count: Byte);\r
8         procedure import_old_a2m_event2(patt,line,chan: Byte; old_chunk: tOLD_CHUNK);\r
9         procedure import_old_a2m_patterns2(block: Byte; count: Byte);\r
10         procedure import_old_flags;\r
11         procedure import_old_songdata(old_songdata: pOLD_FIXED_SONGDATA);\r
12         procedure import_old_instruments(old_songdata: pOLD_FIXED_SONGDATA;\r
13                                          new_songdata: pFIXED_SONGDATA;\r
14                                          instr,count: Byte);\r
15         procedure import_single_old_instrument(old_songdata: pOLD_FIXED_SONGDATA;\r
16                                                pos,instr: Byte);\r
17         procedure a2m_file_loader;\r
18         procedure a2t_file_loader;\r
19         procedure a2p_file_loader;\r
20         function  dec2hex(dec: Byte): Byte;\r
21         function  truncate_string(str: String): String;\r
22         procedure amd_file_loader;\r
23         procedure import_cff_event(patt,line,chan,byte0,byte1,byte2: Byte);\r
24         procedure import_cff_patterns(var data; patterns: Byte);\r
25         procedure cff_file_loader;\r
26         procedure import_standard_instrument(inst: Byte; var data);\r
27         procedure dfm_file_loader;\r
28         procedure import_hsc_event(patt,line,chan: Byte; event: Word);\r
29         procedure import_hsc_patterns(var data; patterns: Byte);\r
30         procedure import_hsc_instrument(inst: Byte; var data);\r
31         procedure hsc_file_loader;\r
32         procedure mtk_file_loader;\r
33         procedure rad_file_loader;\r
34         procedure fix_s3m_commands(patterns: Byte);\r
35         procedure fix_single_pattern(patt: Byte);\r
36         procedure s3m_file_loader;\r
37         procedure fix_fmk_commands(patterns: Byte);\r
38         procedure import_fin_instrument(inst: Byte; var data);\r
39         procedure fmk_file_loader;\r
40         procedure import_sat_instrument(inst: Byte; var data);\r
41         function  import_sat_instrument_name(var data; inst: Byte): String;\r
42         procedure sat_file_loader;\r
43         function  _sal(op1,op2: Word): Byte;\r
44         function  _sar(op1,op2: Word): Byte;\r
45         procedure import_sa2_effect(effect,def1,def2: Byte;\r
46                                     var out1,out2: Byte);\r
47         procedure sa2_file_loader;\r
48 }\r
49 \r
50 function check_byte(var data; _byte: Byte; size: Longint): Boolean;\r
51 \r
52 var\r
53   result: Boolean;\r
54 \r
55 begin\r
56   asm\r
57         mov     edi,[data]\r
58         mov     ecx,size\r
59         jecxz   @@1\r
60         mov     al,_byte\r
61         repnz   scasb\r
62         jnz     @@1\r
63         mov     result,TRUE\r
64         jmp     @@2\r
65 @@1:    mov     result,FALSE\r
66 @@2:\r
67   end;\r
68   check_byte := result;\r
69 end;\r
70 \r
71 procedure insert_command(cmd,cmd2: Word; patterns: Byte; chan: Byte; exceptions: tByteSet);\r
72 \r
73 var\r
74   chunk: tCHUNK;\r
75   temp2,temp3: Byte;\r
76   patt_break: Byte;\r
77   order,patt: Byte;\r
78   patts: String;\r
79 \r
80 begin\r
81   patts := '';\r
82   order := 0; patt := BYTE_NULL;\r
83 \r
84   Repeat\r
85     If (Pos(CHR(songdata.pattern_order[order]),patts) <> 0) or\r
86        (songdata.pattern_order[order] >= $80) then Inc(order)\r
87     else\r
88       begin\r
89         patt := songdata.pattern_order[order];\r
90         patt_break := songdata.patt_len;\r
91         For temp3 := 1 to songdata.nm_tracks do\r
92           For temp2 := 0 to PRED(songdata.patt_len) do\r
93             begin\r
94               get_chunk(patt,temp2,temp3,chunk);\r
95               If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) or\r
96                  (chunk.effect_def2 in [ef_PositionJump,ef_PatternBreak]) then\r
97                 patt_break := temp2;\r
98 \r
99               If (temp3 = chan) and (temp2 <= patt_break) then\r
100                 If (cmd2 = 0) then\r
101                   If (chunk.effect_def+chunk.effect = 0) or\r
102                      (chunk.effect_def in exceptions) then\r
103                     begin\r
104                       chunk.effect_def := HI(cmd);\r
105                       chunk.effect := LO(cmd);\r
106                       put_chunk(patt,temp2,temp3,chunk);\r
107                       EXIT;\r
108                     end\r
109                   else If (chunk.effect_def2+chunk.effect2 = 0) or\r
110                           (chunk.effect_def2 in exceptions) then\r
111                          begin\r
112                            chunk.effect_def2 := HI(cmd);\r
113                            chunk.effect2 := LO(cmd);\r
114                            put_chunk(patt,temp2,temp3,chunk);\r
115                            EXIT;\r
116                          end\r
117                        else\r
118                 else If ((chunk.effect_def+chunk.effect = 0) or\r
119                          (chunk.effect_def in exceptions)) and\r
120                         ((chunk.effect_def2+chunk.effect2 = 0) or\r
121                          (chunk.effect_def2 in exceptions)) then\r
122                        begin\r
123                          chunk.effect_def := HI(cmd);\r
124                          chunk.effect := LO(cmd);\r
125                          chunk.effect_def2 := HI(cmd2);\r
126                          chunk.effect2 := LO(cmd2);\r
127                          put_chunk(patt,temp2,temp3,chunk);\r
128                          EXIT;\r
129                        end;\r
130             end;\r
131         Inc(order);\r
132         patts := patts+CHR(patt);\r
133       end;\r
134   until (patt >= patterns) or (order > $7f);\r
135 end;\r
136 \r
137 var\r
138   adsr_carrier: array[1..9] of Boolean;\r
139 \r
140 procedure import_old_a2m_event1(patt,line,chan: Byte; old_chunk: tOLD_CHUNK;\r
141                                 processing_whole_song: Boolean);\r
142 \r
143 const\r
144   fx_Arpeggio          = $00;\r
145   fx_FSlideUp          = $01;\r
146   fx_FSlideDown        = $02;\r
147   fx_FSlideUpFine      = $03;\r
148   fx_FSlideDownFine    = $04;\r
149   fx_TonePortamento    = $05;\r
150   fx_TPortamVolSlide   = $06;\r
151   fx_Vibrato           = $07;\r
152   fx_VibratoVolSlide   = $08;\r
153   fx_SetOpIntensity    = $09;\r
154   fx_SetInsVolume      = $0a;\r
155   fx_PatternBreak      = $0b;\r
156   fx_PatternJump       = $0c;\r
157   fx_SetTempo          = $0d;\r
158   fx_SetTimer          = $0e;\r
159   fx_Extended          = $0f;\r
160   fx_ex_DefAMdepth     = $00;\r
161   fx_ex_DefVibDepth    = $01;\r
162   fx_ex_DefWaveform    = $02;\r
163   fx_ex_ManSlideUp     = $03;\r
164   fx_ex_ManSlideDown   = $04;\r
165   fx_ex_VSlideUp       = $05;\r
166   fx_ex_VSlideDown     = $06;\r
167   fx_ex_VSlideUpFine   = $07;\r
168   fx_ex_VSlideDownFine = $08;\r
169   fx_ex_RetrigNote     = $09;\r
170   fx_ex_SetAttckRate   = $0a;\r
171   fx_ex_SetDecayRate   = $0b;\r
172   fx_ex_SetSustnLevel  = $0c;\r
173   fx_ex_SetReleaseRate = $0d;\r
174   fx_ex_SetFeedback    = $0e;\r
175   fx_ex_ExtendedCmd    = $0f;\r
176 \r
177 var\r
178   chunk: tCHUNK;\r
179 \r
180 begin\r
181   FillChar(chunk,SizeOf(chunk),0);\r
182   chunk.note := old_chunk.note;\r
183   chunk.instr_def := old_chunk.instr_def;\r
184   chunk.effect_def := old_chunk.effect_def;\r
185   chunk.effect := old_chunk.effect;\r
186 \r
187   Case old_chunk.effect_def of\r
188     fx_Arpeggio:        chunk.effect_def := ef_Arpeggio;\r
189     fx_FSlideUp:        chunk.effect_def := ef_FSlideUp;\r
190     fx_FSlideDown:      chunk.effect_def := ef_FSlideDown;\r
191     fx_FSlideUpFine:    chunk.effect_def := ef_FSlideUpFine;\r
192     fx_FSlideDownFine:  chunk.effect_def := ef_FSlideDownFine;\r
193     fx_TonePortamento:  chunk.effect_def := ef_TonePortamento;\r
194     fx_TPortamVolSlide: chunk.effect_def := ef_TPortamVolSlide;\r
195     fx_Vibrato:         chunk.effect_def := ef_Vibrato;\r
196     fx_VibratoVolSlide: chunk.effect_def := ef_VibratoVolSlide;\r
197     fx_SetInsVolume:    chunk.effect_def := ef_SetInsVolume;\r
198     fx_PatternJump:     chunk.effect_def := ef_PositionJump;\r
199     fx_PatternBreak:    chunk.effect_def := ef_PatternBreak;\r
200     fx_SetTempo:        chunk.effect_def := ef_SetSpeed;\r
201     fx_SetTimer:        chunk.effect_def := ef_SetTempo;\r
202 \r
203     fx_SetOpIntensity:\r
204       If (old_chunk.effect DIV 16 <> 0) then\r
205         begin\r
206           chunk.effect_def := ef_SetCarrierVol;\r
207           chunk.effect := 3+(old_chunk.effect DIV 16)*4;\r
208         end\r
209       else If (old_chunk.effect MOD 16 <> 0) then\r
210              begin\r
211                chunk.effect_def := ef_SetModulatorVol;\r
212                chunk.effect := 3+(old_chunk.effect MOD 16)*4;\r
213              end\r
214            else chunk.effect_def := 0;\r
215 \r
216     fx_Extended:\r
217       Case old_chunk.effect DIV 16 of\r
218         fx_ex_DefAMdepth:\r
219           begin\r
220             chunk.effect_def := ef_Extended;\r
221             chunk.effect := ef_ex_SetTremDepth*16+old_chunk.effect MOD 16;\r
222           end;\r
223 \r
224         fx_ex_DefVibDepth:\r
225           begin\r
226             chunk.effect_def := ef_Extended;\r
227             chunk.effect := ef_ex_SetVibDepth*16+old_chunk.effect MOD 16;\r
228           end;\r
229 \r
230 \r
231         fx_ex_DefWaveform:\r
232           begin\r
233             chunk.effect_def := ef_SetWaveform;\r
234             Case old_chunk.effect MOD 16 of\r
235               0..3: chunk.effect := (old_chunk.effect MOD 16)*16+$0f;\r
236               4..7: chunk.effect := $0f0+(old_chunk.effect MOD 16)-4;\r
237             end;\r
238           end;\r
239 \r
240         fx_ex_VSlideUp:\r
241           begin\r
242             chunk.effect_def := ef_VolSlide;\r
243             chunk.effect := (old_chunk.effect MOD 16)*16;\r
244           end;\r
245 \r
246         fx_ex_VSlideDown:\r
247           begin\r
248             chunk.effect_def := ef_VolSlide;\r
249             chunk.effect := old_chunk.effect MOD 16;\r
250           end;\r
251 \r
252         fx_ex_VSlideUpFine:\r
253           begin\r
254             chunk.effect_def := ef_VolSlideFine;\r
255             chunk.effect := (old_chunk.effect MOD 16)*16;\r
256           end;\r
257 \r
258         fx_ex_VSlideDownFine:\r
259           begin\r
260             chunk.effect_def := ef_VolSlideFine;\r
261             chunk.effect := old_chunk.effect MOD 16;\r
262           end;\r
263 \r
264         fx_ex_ManSlideUp:\r
265           begin\r
266             chunk.effect_def := ef_Extended2;\r
267             chunk.effect := ef_ex2_FineTuneUp*16+old_chunk.effect MOD 16;\r
268           end;\r
269 \r
270         fx_ex_ManSlideDown:\r
271           begin\r
272             chunk.effect_def := ef_Extended2;\r
273             chunk.effect := ef_ex2_FineTuneDown*16+old_chunk.effect MOD 16;\r
274           end;\r
275 \r
276         fx_ex_RetrigNote:\r
277           begin\r
278             chunk.effect_def := ef_RetrigNote;\r
279             chunk.effect := SUCC(old_chunk.effect MOD 16);\r
280           end;\r
281 \r
282         fx_ex_SetAttckRate:\r
283           begin\r
284             chunk.effect_def := ef_Extended;\r
285             chunk.effect := old_chunk.effect MOD 16;\r
286             If NOT adsr_carrier[chan] then\r
287               Inc(chunk.effect,ef_ex_SetAttckRateM*16)\r
288             else Inc(chunk.effect,ef_ex_SetAttckRateC*16);\r
289           end;\r
290 \r
291         fx_ex_SetDecayRate:\r
292           begin\r
293             chunk.effect_def := ef_Extended;\r
294             chunk.effect := old_chunk.effect MOD 16;\r
295             If NOT adsr_carrier[chan] then\r
296               Inc(chunk.effect,ef_ex_SetDecayRateM*16)\r
297             else Inc(chunk.effect,ef_ex_SetDecayRateC*16);\r
298           end;\r
299 \r
300         fx_ex_SetSustnLevel:\r
301           begin\r
302             chunk.effect_def := ef_Extended;\r
303             chunk.effect := old_chunk.effect MOD 16;\r
304             If NOT adsr_carrier[chan] then\r
305               Inc(chunk.effect,ef_ex_SetSustnLevelM*16)\r
306             else Inc(chunk.effect,ef_ex_SetSustnLevelC*16);\r
307           end;\r
308 \r
309         fx_ex_SetReleaseRate:\r
310           begin\r
311             chunk.effect_def := ef_Extended;\r
312             chunk.effect := old_chunk.effect MOD 16;\r
313             If NOT adsr_carrier[chan] then\r
314               Inc(chunk.effect,ef_ex_SetRelRateM*16)\r
315             else Inc(chunk.effect,ef_ex_SetRelRateC*16);\r
316           end;\r
317 \r
318         fx_ex_SetFeedback:\r
319           begin\r
320             chunk.effect_def := ef_Extended;\r
321             chunk.effect := ef_ex_SetFeedback*16+old_chunk.effect MOD 16;\r
322           end;\r
323 \r
324         fx_ex_ExtendedCmd:\r
325           If (old_chunk.effect MOD 16 in [0..9]) then\r
326             begin\r
327               chunk.effect_def := ef_Extended;\r
328               chunk.effect := ef_ex_ExtendedCmd*16;\r
329 \r
330               Case old_chunk.effect MOD 16 of\r
331                 0: Inc(chunk.effect,ef_ex_cmd_RSS);\r
332                 1: Inc(chunk.effect,ef_ex_cmd_LockVol);\r
333                 2: Inc(chunk.effect,ef_ex_cmd_UnlockVol);\r
334                 3: Inc(chunk.effect,ef_ex_cmd_LockVP);\r
335                 4: Inc(chunk.effect,ef_ex_cmd_UnlockVP);\r
336 \r
337                 5: begin\r
338                      If processing_whole_song then chunk.effect_def := 255\r
339                      else chunk.effect_def := 0;\r
340                      chunk.effect := 0;\r
341                      adsr_carrier[chan] := TRUE;\r
342                    end;\r
343 \r
344                 6: begin\r
345                      If processing_whole_song then chunk.effect_def := 255\r
346                      else chunk.effect_def := 0;\r
347                      If processing_whole_song then chunk.effect := 1\r
348                      else chunk.effect := 0;\r
349                      adsr_carrier[chan] := FALSE;\r
350                    end;\r
351 \r
352                 7: Inc(chunk.effect,ef_ex_cmd_VSlide_car);\r
353                 8: Inc(chunk.effect,ef_ex_cmd_VSlide_mod);\r
354                 9: Inc(chunk.effect,ef_ex_cmd_VSlide_def);\r
355               end;\r
356             end\r
357           else begin\r
358                  chunk.effect_def := 0;\r
359                  chunk.effect := 0;\r
360                end;\r
361       end;\r
362   end;\r
363 \r
364   put_chunk(patt,line,chan,chunk);\r
365 end;\r
366 \r
367 procedure replace_old_adsr(patterns: Byte);\r
368 \r
369 var\r
370   chunk,chunk2: tCHUNK;\r
371   temp2,temp3: Byte;\r
372   patt_break: Byte;\r
373   order,patt: Byte;\r
374   patts: String;\r
375 \r
376 begin\r
377   patts := '';\r
378   FillChar(adsr_carrier,SizeOf(adsr_carrier),0);\r
379 \r
380   order := 0; patt := BYTE_NULL;\r
381   Repeat\r
382     If (songdata.pattern_order[order] >= $80) then Inc(order)\r
383     else\r
384       begin\r
385         patt := songdata.pattern_order[order];\r
386         patt_break := BYTE_NULL;\r
387         For temp2 := 0 to $3f do\r
388           For temp3 := 1 to 9 do\r
389             begin\r
390               get_chunk(patt,temp2,temp3,chunk);\r
391               chunk2 := chunk;\r
392 \r
393               If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) then\r
394                 patt_break := temp2;\r
395 \r
396               If (chunk.effect_def in [$ff,ef_Extended]) then\r
397                 begin\r
398                   If (chunk.effect_def = $ff) then\r
399                     begin\r
400                       chunk2.effect_def := 0;\r
401                       chunk2.effect := 0;\r
402 \r
403                       If (temp2 <= patt_break) then\r
404                         Case chunk.effect of\r
405                           0: adsr_carrier[temp3] := TRUE;\r
406                           1: adsr_carrier[temp3] := FALSE;\r
407                         end;\r
408                     end;\r
409 \r
410                   If (chunk.effect_def = ef_Extended) then\r
411                     Case chunk.effect DIV 16 of\r
412                       ef_ex_SetAttckRateM,\r
413                       ef_ex_SetAttckRateC:\r
414                         If adsr_carrier[temp3] then\r
415                           chunk2.effect := ef_ex_SetAttckRateC*16+chunk.effect MOD 16\r
416                         else chunk2.effect := ef_ex_SetAttckRateM*16+chunk.effect MOD 16;\r
417 \r
418                       ef_ex_SetDecayRateM,\r
419                       ef_ex_SetDecayRateC:\r
420                         If adsr_carrier[temp3] then\r
421                           chunk2.effect := ef_ex_SetDecayRateC*16+chunk.effect MOD 16\r
422                         else chunk2.effect := ef_ex_SetDecayRateM*16+chunk.effect MOD 16;\r
423 \r
424                       ef_ex_SetSustnLevelM,\r
425                       ef_ex_SetSustnLevelC:\r
426                         If adsr_carrier[temp3] then\r
427                           chunk2.effect := ef_ex_SetSustnLevelC*16+chunk.effect MOD 16\r
428                         else chunk2.effect := ef_ex_SetSustnLevelM*16+chunk.effect MOD 16;\r
429 \r
430                       ef_ex_SetRelRateM,\r
431                       ef_ex_SetRelRateC:\r
432                         If adsr_carrier[temp3] then\r
433                           chunk2.effect := ef_ex_SetRelRateC*16+chunk.effect MOD 16\r
434                         else chunk2.effect := ef_ex_SetRelRateM*16+chunk.effect MOD 16;\r
435                     end;\r
436 \r
437                   If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then\r
438                     If (chunk.effect_def <> chunk2.effect_def) or\r
439                        (chunk.effect <> chunk2.effect) then\r
440                       put_chunk(patt,temp2,temp3,chunk2);\r
441                 end;\r
442             end;\r
443         Inc(order);\r
444         patts := patts+CHR(patt);\r
445       end;\r
446   until (patt >= patterns) or (order > $7f);\r
447 end;\r
448 \r
449 procedure import_old_a2m_patterns1(block: Byte; count: Byte);\r
450 \r
451 procedure get_old_chunk(pattern,line,channel: Byte; var chunk: tOLD_CHUNK);\r
452 begin chunk := old_hash_buffer[pattern][line][channel]; end;\r
453 \r
454 var\r
455   patt,line,chan: Byte;\r
456   chunk: tOLD_CHUNK;\r
457 \r
458 begin { import_old_a2m_patterns1 }\r
459   For patt := 0 to max(PRED(count),15) do\r
460     For line := 0 to $3f do\r
461       For chan := 1 to 9 do\r
462         begin\r
463           get_old_chunk(patt,line,chan,chunk);\r
464           import_old_a2m_event1(block*16+patt,line,chan,chunk,TRUE);\r
465         end;\r
466 end;\r
467 \r
468 procedure import_old_a2m_event2(patt,line,chan: Byte; old_chunk: tOLD_CHUNK);\r
469 \r
470 const\r
471   ef_ManualFSlide = 22;\r
472 \r
473 var\r
474   chunk: tCHUNK;\r
475 \r
476 begin\r
477   FillChar(chunk,SizeOf(chunk),0);\r
478   chunk.note := old_chunk.note;\r
479   chunk.instr_def := old_chunk.instr_def;\r
480 \r
481   If (old_chunk.effect_def <> ef_ManualFSlide) then\r
482     begin\r
483       chunk.effect_def := old_chunk.effect_def;\r
484       chunk.effect := old_chunk.effect;\r
485     end\r
486   else If (old_chunk.effect DIV 16 <> 0) then\r
487          begin\r
488            chunk.effect_def := ef_Extended2;\r
489            chunk.effect := ef_ex2_FineTuneUp*16+old_chunk.effect DIV 16;\r
490          end\r
491        else begin\r
492               chunk.effect_def := ef_Extended2;\r
493               chunk.effect := ef_ex2_FineTuneDown*16+old_chunk.effect MOD 16;\r
494             end;\r
495 \r
496   put_chunk(patt,line,chan,chunk);\r
497 end;\r
498 \r
499 procedure import_old_a2m_patterns2(block: Byte; count: Byte);\r
500 \r
501 procedure get_old_chunk(pattern,line,channel: Byte; var chunk: tOLD_CHUNK);\r
502 begin chunk := hash_buffer[pattern][channel][line]; end;\r
503 \r
504 var\r
505   patt,line,chan: Byte;\r
506   chunk: tOLD_CHUNK;\r
507 \r
508 begin { import_old_a2m_patterns2 }\r
509   For patt := 0 to max(PRED(count),7) do\r
510     For line := 0 to $3f do\r
511       For chan := 1 to 18 do\r
512         begin\r
513           get_old_chunk(patt,line,chan,chunk);\r
514           import_old_a2m_event2(block*8+patt,line,chan,chunk);\r
515         end;\r
516 end;\r
517 \r
518 procedure import_old_flags;\r
519 \r
520 var\r
521   temp: Byte;\r
522 \r
523 begin\r
524   If (songdata.common_flag OR 2 = songdata.common_flag) then\r
525     For temp := 1 to 20 do\r
526       songdata.lock_flags[temp] := songdata.lock_flags[temp] OR $10;\r
527 \r
528   If (songdata.common_flag OR 4 = songdata.common_flag) then\r
529     For temp := 1 to 20 do\r
530       songdata.lock_flags[temp] := songdata.lock_flags[temp] OR $20;\r
531 \r
532   If (songdata.common_flag OR $20 = songdata.common_flag) then\r
533     For temp := 1 to 20 do\r
534       songdata.lock_flags[temp] := songdata.lock_flags[temp] AND NOT 3;\r
535 end;\r
536 \r
537 procedure import_old_songdata(old_songdata: pOLD_FIXED_SONGDATA);\r
538 \r
539 var\r
540   temp: Byte;\r
541 \r
542 begin\r
543   songdata.songname := old_songdata^.songname;\r
544   songdata.composer := old_songdata^.composer;\r
545 \r
546   For temp := 1 to 250 do\r
547     begin\r
548       songdata.instr_names[temp] := old_songdata^.instr_names[temp];\r
549       songdata.instr_data[temp].fm_data := old_songdata^.instr_data[temp].fm_data;\r
550       songdata.instr_data[temp].panning := old_songdata^.instr_data[temp].panning;\r
551       songdata.instr_data[temp].fine_tune := old_songdata^.instr_data[temp].fine_tune;\r
552       songdata.instr_data[temp].perc_voice := 0;\r
553     end;\r
554 \r
555   Move(old_songdata^.pattern_order,\r
556        songdata.pattern_order,\r
557        SizeOf(old_songdata^.pattern_order));\r
558 \r
559   songdata.tempo := old_songdata^.tempo;\r
560   songdata.speed := old_songdata^.speed;\r
561   songdata.common_flag := old_songdata^.common_flag;\r
562   import_old_flags;\r
563 end;\r
564 \r
565 \r
566 procedure a2m_file_loader;\r
567 \r
568 type\r
569   tOLD_HEADER = Record\r
570                   ident: array[1..10] of Char;\r
571                   crc32: Longint;\r
572                   ffver: Byte;\r
573                   patts: Byte;\r
574                   b0len: Word;\r
575                   b1len: Word;\r
576                   b2len: Word;\r
577                   b3len: Word;\r
578                   b4len: Word;\r
579                   b5len: Word;\r
580                   b6len: Word;\r
581                   b7len: Word;\r
582                   b8len: Word;\r
583                 end;\r
584 type\r
585   tHEADER = Record\r
586               ident: array[1..10] of Char;\r
587               crc32: Longint;\r
588               ffver: Byte;\r
589               patts: Byte;\r
590               b0len: Longint;\r
591               b1len: array[0..15] of Longint;\r
592             end;\r
593 \r
594 const\r
595   id = '_A2module_';\r
596 \r
597 const\r
598   old_a2m_header_size = 26;\r
599 \r
600 var\r
601   f: File;\r
602   header: tHEADER;\r
603   header2: tOLD_HEADER;\r
604   temp,temp2: Longint;\r
605   crc: Longint;\r
606   xlen: array[0..6] of Word;\r
607 \r
608 begin\r
609   {$i-}\r
610   Assign(f,songdata_source);\r
611   ResetF(f);\r
612   {$i+}\r
613   If (IOresult <> 0) then\r
614     begin\r
615       CloseF(f);\r
616       EXIT;\r
617     end;\r
618 \r
619   FillChar(buf1,SizeOf(buf1),0);\r
620   BlockReadF(f,header,SizeOf(header),temp);\r
621   If NOT ((temp = SizeOf(header)) and (header.ident = id)) then\r
622     begin\r
623       CloseF(f);\r
624       EXIT;\r
625     end;\r
626 \r
627   load_flag := $7f;\r
628   If NOT (header.ffver in [1..11]) then\r
629     begin\r
630       CloseF(f);\r
631       EXIT;\r
632     end;\r
633 \r
634   init_old_songdata;\r
635   If (header.ffver in [1..4]) then\r
636     begin\r
637       FillChar(adsr_carrier,SizeOf(adsr_carrier),BYTE(FALSE));\r
638       ResetF(f);\r
639       BlockReadF(f,header2,SizeOf(header2),temp);\r
640       If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then\r
641         begin\r
642           CloseF(f);\r
643           EXIT;\r
644         end;\r
645 \r
646       xlen[0] := header2.b2len;\r
647       xlen[1] := header2.b3len;\r
648       xlen[2] := header2.b4len;\r
649 \r
650       SeekF(f,old_a2m_header_size);\r
651       If (IOresult <> 0) then\r
652         begin\r
653           CloseF(f);\r
654           EXIT;\r
655         end;\r
656 \r
657       crc := DWORD_NULL;\r
658       BlockReadF(f,buf1,header2.b0len,temp);\r
659       If NOT (temp = header2.b0len) then\r
660         begin\r
661           CloseF(f);\r
662           EXIT;\r
663         end;\r
664 \r
665       crc := Update32(buf1,temp,crc);\r
666       BlockReadF(f,buf1,header2.b1len,temp);\r
667       If NOT (temp = header2.b1len) then\r
668         begin\r
669           CloseF(f);\r
670           EXIT;\r
671         end;\r
672 \r
673       crc := Update32(buf1,temp,crc);\r
674       For temp2 := 0 to 2 do\r
675         If ((header2.patts-1) DIV 16 > temp2) then\r
676           begin\r
677             BlockReadF(f,buf1,xlen[temp2],temp);\r
678             If NOT (temp = xlen[temp2]) then\r
679               begin\r
680                 CloseF(f);\r
681                 EXIT;\r
682               end;\r
683             crc := Update32(buf1,temp,crc);\r
684           end;\r
685 \r
686       crc := Update32(header2.b0len,2,crc);\r
687       crc := Update32(header2.b1len,2,crc);\r
688 \r
689       For temp2 := 0 to 2 do\r
690         crc := Update32(xlen[temp2],2,crc);\r
691 \r
692       If (crc <> header2.crc32) then\r
693         begin\r
694           CloseF(f);\r
695           EXIT;\r
696         end;\r
697 \r
698       init_songdata;\r
699       load_flag := 0;\r
700 \r
701       songdata.patt_len := 64;\r
702       If adjust_tracks then songdata.nm_tracks := 9\r
703       else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
704 \r
705       SeekF(f,old_a2m_header_size);\r
706       If (IOresult <> 0) then\r
707         begin\r
708           CloseF(f);\r
709           EXIT;\r
710         end;\r
711 \r
712       BlockReadF(f,buf1,header2.b0len,temp);\r
713       If NOT (temp = header2.b0len) then\r
714         begin\r
715           CloseF(f);\r
716           EXIT;\r
717         end;\r
718 \r
719       Case header2.ffver of\r
720         4: Move(buf1,old_songdata,header2.b0len);\r
721         3: LZSS_decompress(buf1,old_songdata,header2.b0len);\r
722         2: LZW_decompress(buf1,old_songdata);\r
723         1: SIXPACK_decompress(buf1,old_songdata,header2.b0len);\r
724       end;\r
725 \r
726       For temp := 1 to 250 do\r
727         old_songdata.instr_data[temp].panning := 0;\r
728 \r
729       BlockReadF(f,buf1,header2.b1len,temp);\r
730       If NOT (temp = header2.b1len) then\r
731         begin\r
732           CloseF(f);\r
733           EXIT;\r
734         end;\r
735 \r
736       Case header2.ffver of\r
737         4: Move(buf1,old_hash_buffer,header2.b1len);\r
738         3: LZSS_decompress(buf1,old_hash_buffer,header2.b1len);\r
739         2: LZW_decompress(buf1,old_hash_buffer);\r
740         1: SIXPACK_decompress(buf1,old_hash_buffer,header2.b1len);\r
741       end;\r
742       import_old_a2m_patterns1(0,16);\r
743 \r
744       For temp2 := 0 to 2 do\r
745         If ((header2.patts-1) DIV 16 > temp2) then\r
746           begin\r
747             BlockReadF(f,buf1,xlen[temp2],temp);\r
748             If NOT (temp = xlen[temp2]) then\r
749               begin\r
750                 CloseF(f);\r
751                 EXIT;\r
752               end;\r
753 \r
754             Case header2.ffver of\r
755               4: Move(buf1,old_hash_buffer,xlen[temp2]);\r
756               3: LZSS_decompress(buf1,old_hash_buffer,xlen[temp2]);\r
757               2: LZW_decompress(buf1,old_hash_buffer);\r
758               1: SIXPACK_decompress(buf1,old_hash_buffer,xlen[temp2]);\r
759             end;\r
760             import_old_a2m_patterns1(SUCC(temp2),16);\r
761           end;\r
762 \r
763       replace_old_adsr(header2.patts);\r
764       import_old_songdata(Addr(old_songdata));\r
765     end;\r
766 \r
767   If (header.ffver in [5..8]) then\r
768     begin\r
769       ResetF(f);\r
770       BlockReadF(f,header2,SizeOf(header2),temp);\r
771       If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then\r
772         begin\r
773           CloseF(f);\r
774           EXIT;\r
775         end;\r
776 \r
777       xlen[0] := header2.b2len;\r
778       xlen[1] := header2.b3len;\r
779       xlen[2] := header2.b4len;\r
780       xlen[3] := header2.b5len;\r
781       xlen[4] := header2.b6len;\r
782       xlen[5] := header2.b7len;\r
783       xlen[6] := header2.b8len;\r
784 \r
785       crc := DWORD_NULL;\r
786       BlockReadF(f,buf1,header2.b0len,temp);\r
787       If NOT (temp = header2.b0len) then\r
788         begin\r
789           CloseF(f);\r
790           EXIT;\r
791         end;\r
792 \r
793       crc := Update32(buf1,temp,crc);\r
794       BlockReadF(f,buf1,header2.b1len,temp);\r
795       If NOT (temp = header2.b1len) then\r
796         begin\r
797           CloseF(f);\r
798           EXIT;\r
799         end;\r
800 \r
801       crc := Update32(buf1,temp,crc);\r
802       For temp2 := 0 to 6 do\r
803         If ((header2.patts-1) DIV 8 > temp2) then\r
804           begin\r
805             BlockReadF(f,buf1,xlen[temp2],temp);\r
806             If NOT (temp = xlen[temp2]) then\r
807               begin\r
808                 CloseF(f);\r
809                 EXIT;\r
810               end;\r
811             crc := Update32(buf1,temp,crc);\r
812           end;\r
813 \r
814       crc := Update32(header2.b0len,2,crc);\r
815       crc := Update32(header2.b1len,2,crc);\r
816 \r
817       For temp2 := 0 to 6 do\r
818         crc := Update32(xlen[temp2],2,crc);\r
819 \r
820       If (crc <> header2.crc32) then\r
821         begin\r
822           CloseF(f);\r
823           EXIT;\r
824         end;\r
825 \r
826       init_songdata;\r
827       load_flag := 0;\r
828 \r
829       songdata.patt_len := 64;\r
830       If adjust_tracks then songdata.nm_tracks := 18\r
831       else If (songdata.nm_tracks < 18) then songdata.nm_tracks := 18;\r
832 \r
833       SeekF(f,SizeOf(header2));\r
834       If (IOresult <> 0) then\r
835         begin\r
836           CloseF(f);\r
837           EXIT;\r
838         end;\r
839 \r
840       BlockReadF(f,buf1,header2.b0len,temp);\r
841       If NOT (temp = header2.b0len) then\r
842         begin\r
843           CloseF(f);\r
844           EXIT;\r
845         end;\r
846 \r
847       Case header2.ffver of\r
848         8: Move(buf1,old_songdata,header2.b0len);\r
849         7: LZSS_decompress(buf1,old_songdata,header2.b0len);\r
850         6: LZW_decompress(buf1,old_songdata);\r
851         5: SIXPACK_decompress(buf1,old_songdata,header2.b0len);\r
852       end;\r
853 \r
854       BlockReadF(f,buf1,header2.b1len,temp);\r
855       If NOT (temp = header2.b1len) then\r
856         begin\r
857           CloseF(f);\r
858           EXIT;\r
859         end;\r
860 \r
861       Case header2.ffver of\r
862         8: Move(buf1,hash_buffer,header2.b1len);\r
863         7: LZSS_decompress(buf1,hash_buffer,header2.b1len);\r
864         6: LZW_decompress(buf1,hash_buffer);\r
865         5: SIXPACK_decompress(buf1,hash_buffer,header2.b1len);\r
866       end;\r
867       import_old_a2m_patterns2(0,8);\r
868 \r
869       For temp2 := 0 to 6 do\r
870         If ((header2.patts-1) DIV 8 > temp2) then\r
871           begin\r
872             BlockReadF(f,buf1,xlen[temp2],temp);\r
873             If NOT (temp = xlen[temp2]) then\r
874               begin\r
875                 CloseF(f);\r
876                 EXIT;\r
877               end;\r
878 \r
879             Case header2.ffver of\r
880               8: Move(buf1,hash_buffer,header2.b2len);\r
881               7: LZSS_decompress(buf1,hash_buffer,header2.b2len);\r
882               6: LZW_decompress(buf1,hash_buffer);\r
883               5: SIXPACK_decompress(buf1,hash_buffer,header2.b2len);\r
884             end;\r
885             import_old_a2m_patterns2(SUCC(temp2),8);\r
886           end;\r
887       import_old_songdata(Addr(old_songdata));\r
888     end;\r
889 \r
890   If (header.ffver in [9,10,11]) then\r
891     begin\r
892       crc := DWORD_NULL;\r
893       BlockReadF(f,buf1,header.b0len,temp);\r
894       If NOT (temp = header.b0len) then\r
895         begin\r
896           CloseF(f);\r
897           EXIT;\r
898         end;\r
899 \r
900       crc := Update32(buf1,temp,crc);\r
901       BlockReadF(f,buf1,header.b1len[0],temp);\r
902       If NOT (temp = header.b1len[0]) then\r
903         begin\r
904           CloseF(f);\r
905           EXIT;\r
906         end;\r
907 \r
908       crc := Update32(buf1,temp,crc);\r
909       For temp2 := 1 to 15 do\r
910         If ((header.patts-1) DIV 8 > PRED(temp2)) then\r
911           begin\r
912             BlockReadF(f,buf1,header.b1len[temp2],temp);\r
913             If NOT (temp = header.b1len[temp2]) then\r
914               begin\r
915                 CloseF(f);\r
916                 EXIT;\r
917               end;\r
918             crc := Update32(buf1,temp,crc);\r
919           end;\r
920 \r
921       crc := Update32(header.b0len,2,crc);\r
922       For temp2 := 0 to 15 do\r
923         crc := Update32(header.b1len[temp2],2,crc);\r
924 \r
925       If (crc <> header.crc32) then\r
926         begin\r
927           CloseF(f);\r
928           EXIT;\r
929         end;\r
930 \r
931       init_songdata;\r
932       load_flag := 0;\r
933 \r
934       SeekF(f,SizeOf(header));\r
935       If (IOresult <> 0) then\r
936         begin\r
937           CloseF(f);\r
938           EXIT;\r
939         end;\r
940 \r
941       BlockReadF(f,buf1,header.b0len,temp);\r
942       If NOT (temp = header.b0len) then\r
943         begin\r
944           CloseF(f);\r
945           EXIT;\r
946         end;\r
947 \r
948       APACK_decompress(buf1,songdata);\r
949       BlockReadF(f,buf1,header.b1len[0],temp);\r
950       If NOT (temp = header.b1len[0]) then\r
951         begin\r
952           CloseF(f);\r
953           EXIT;\r
954         end;\r
955 \r
956       If (header.ffver = 9) then\r
957         import_old_flags;\r
958 \r
959 \r
960       APACK_decompress(buf1,pattdata^[0]);\r
961       For temp2 := 1 to 15 do\r
962         If ((header.patts-1) DIV 8 > PRED(temp2)) then\r
963           begin\r
964             BlockReadF(f,buf1,header.b1len[temp2],temp);\r
965             If NOT (temp = header.b1len[temp2]) then\r
966               begin\r
967                 CloseF(f);\r
968                 EXIT;\r
969               end;\r
970 \r
971             If (temp2*8+8 <= max_patterns) then\r
972               APACK_decompress(buf1,pattdata^[temp2])\r
973             else limit_exceeded := TRUE;\r
974           end;\r
975     end;\r
976 \r
977   speed := songdata.speed;\r
978   tempo := songdata.tempo;\r
979 \r
980   CloseF(f);\r
981   songdata_title := NameOnly(songdata_source);\r
982   Case header.ffver of\r
983     1..4: load_flag := 1;\r
984     else  load_flag := 2;\r
985   end;\r
986 end;\r
987 \r
988 procedure a2t_file_loader;\r
989 \r
990 type\r
991   tOLD_HEADER1 = Record\r
992                    ident: array[1..15] of Char;\r
993                    crc32: Longint;\r
994                    ffver: Byte;\r
995                    patts: Byte;\r
996                    tempo: Byte;\r
997                    speed: Byte;\r
998                    b0len: Word;\r
999                    b1len: Word;\r
1000                    b2len: Word;\r
1001                    b3len: Word;\r
1002                    b4len: Word;\r
1003                    b5len: Word;\r
1004                  end;\r
1005 type\r
1006   tOLD_HEADER2 = Record\r
1007                    ident: array[1..15] of Char;\r
1008                    crc32: Longint;\r
1009                    ffver: Byte;\r
1010                    patts: Byte;\r
1011                    tempo: Byte;\r
1012                    speed: Byte;\r
1013                    cflag: Byte;\r
1014                    b0len: Word;\r
1015                    b1len: Word;\r
1016                    b2len: Word;\r
1017                    b3len: Word;\r
1018                    b4len: Word;\r
1019                    b5len: Word;\r
1020                    b6len: Word;\r
1021                    b7len: Word;\r
1022                    b8len: Word;\r
1023                    b9len: Word;\r
1024                  end;\r
1025 type\r
1026   tOLD_HEADER3 = Record\r
1027                    ident: array[1..15] of Char;\r
1028                    crc32: Longint;\r
1029                    ffver: Byte;\r
1030                    patts: Byte;\r
1031                    tempo: Byte;\r
1032                    speed: Byte;\r
1033                    cflag: Byte;\r
1034                    patln: Word;\r
1035                    nmtrk: Byte;\r
1036                    mcspd: Word;\r
1037                    b0len: Longint;\r
1038                    b1len: Longint;\r
1039                    b2len: Longint;\r
1040                    b3len: Longint;\r
1041                    b4len: array[0..15] of Longint;\r
1042                  end;\r
1043 type\r
1044   tOLD_HEADER4 = Record\r
1045                    ident: array[1..15] of Char;\r
1046                    crc32: Longint;\r
1047                    ffver: Byte;\r
1048                    patts: Byte;\r
1049                    tempo: Byte;\r
1050                    speed: Byte;\r
1051                    cflag: Byte;\r
1052                    patln: Word;\r
1053                    nmtrk: Byte;\r
1054                    mcspd: Word;\r
1055                    is4op: Byte;\r
1056                    locks: array[1..20] of Byte;\r
1057                    b0len: Longint;\r
1058                    b1len: Longint;\r
1059                    b2len: Longint;\r
1060                    b3len: Longint;\r
1061                    b4len: array[0..15] of Longint;\r
1062                  end;\r
1063 type\r
1064   tHEADER = Record\r
1065               ident: array[1..15] of Char;\r
1066               crc32: Longint;\r
1067               ffver: Byte;\r
1068               patts: Byte;\r
1069               tempo: Byte;\r
1070               speed: Byte;\r
1071               cflag: Byte;\r
1072               patln: Word;\r
1073               nmtrk: Byte;\r
1074               mcspd: Word;\r
1075               is4op: Byte;\r
1076               locks: array[1..20] of Byte;\r
1077               b0len: Longint;\r
1078               b1len: Longint;\r
1079               b2len: Longint;\r
1080               b3len: Longint;\r
1081               b4len: Longint;\r
1082               b5len: array[0..15] of Longint;\r
1083             end;\r
1084 const\r
1085   id = '_A2tiny_module_';\r
1086 \r
1087 var\r
1088   f: File;\r
1089   header: tHEADER;\r
1090   header2: tOLD_HEADER1;\r
1091   header3: tOLD_HEADER2;\r
1092   header4: tOLD_HEADER3;\r
1093   header5: tOLD_HEADER4;\r
1094   temp,temp2: Longint;\r
1095   crc: Longint;\r
1096   xlen: array[0..6] of Word;\r
1097 \r
1098 begin\r
1099   {$i-}\r
1100   Assign(f,songdata_source);\r
1101   ResetF(f);\r
1102   {$i+}\r
1103   If (IOresult <> 0) then\r
1104     begin\r
1105       CloseF(f);\r
1106       EXIT;\r
1107     end;\r
1108 \r
1109   FillChar(buf1,SizeOf(buf1),0);\r
1110   BlockReadF(f,header,SizeOf(header),temp);\r
1111   If NOT ((temp = SizeOf(header)) and (header.ident = id)) then\r
1112     begin\r
1113       CloseF(f);\r
1114       EXIT;\r
1115     end;\r
1116 \r
1117   load_flag := $7f;\r
1118   If NOT (header.ffver in [1..11]) then\r
1119     begin\r
1120       CloseF(f);\r
1121       EXIT;\r
1122     end;\r
1123 \r
1124   init_old_songdata;\r
1125   If (header.ffver in [1..4]) then\r
1126     begin\r
1127       FillChar(adsr_carrier,SizeOf(adsr_carrier),BYTE(FALSE));\r
1128       ResetF(f);\r
1129       BlockReadF(f,header2,SizeOf(header2),temp);\r
1130       If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then\r
1131         begin\r
1132           CloseF(f);\r
1133           EXIT;\r
1134         end;\r
1135 \r
1136       xlen[0] := header2.b3len;\r
1137       xlen[1] := header2.b4len;\r
1138       xlen[2] := header2.b5len;\r
1139 \r
1140       crc := DWORD_NULL;\r
1141       BlockReadF(f,buf1,header2.b0len,temp);\r
1142       If NOT (temp = header2.b0len) then\r
1143         begin\r
1144           CloseF(f);\r
1145           EXIT;\r
1146         end;\r
1147 \r
1148       crc := Update32(buf1,temp,crc);\r
1149       BlockReadF(f,buf1,header2.b1len,temp);\r
1150       If NOT (temp = header2.b1len) then\r
1151         begin\r
1152           CloseF(f);\r
1153           EXIT;\r
1154         end;\r
1155 \r
1156       crc := Update32(buf1,temp,crc);\r
1157       BlockReadF(f,buf1,header2.b2len,temp);\r
1158       If NOT (temp = header2.b2len) then\r
1159         begin\r
1160           CloseF(f);\r
1161           EXIT;\r
1162         end;\r
1163 \r
1164       crc := Update32(buf1,temp,crc);\r
1165       For temp2 := 0 to 2 do\r
1166         If ((header2.patts-1) DIV 16 > temp2) then\r
1167           begin\r
1168             BlockReadF(f,buf1,xlen[temp2],temp);\r
1169             If NOT (temp = xlen[temp2]) then\r
1170               begin\r
1171                 CloseF(f);\r
1172                 EXIT;\r
1173               end;\r
1174             crc := Update32(buf1,temp,crc);\r
1175           end;\r
1176 \r
1177       crc := Update32(header2.b0len,2,crc);\r
1178       crc := Update32(header2.b1len,2,crc);\r
1179       crc := Update32(header2.b2len,2,crc);\r
1180 \r
1181       For temp2 := 0 to 2 do\r
1182         crc := Update32(xlen[temp2],2,crc);\r
1183 \r
1184       If (crc <> header2.crc32) then\r
1185         begin\r
1186           CloseF(f);\r
1187           EXIT;\r
1188         end;\r
1189 \r
1190       init_songdata;\r
1191       load_flag := 0;\r
1192 \r
1193       songdata.patt_len := 64;\r
1194       If adjust_tracks then songdata.nm_tracks := 9\r
1195       else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
1196 \r
1197       SeekF(f,SizeOf(header2));\r
1198       If (IOresult <> 0) then\r
1199         begin\r
1200           CloseF(f);\r
1201           EXIT;\r
1202         end;\r
1203 \r
1204       BlockReadF(f,buf1,header2.b0len,temp);\r
1205       If NOT (temp = header2.b0len) then\r
1206         begin\r
1207           CloseF(f);\r
1208           EXIT;\r
1209         end;\r
1210 \r
1211       old_songdata.tempo := header2.tempo;\r
1212       old_songdata.speed := header2.speed;\r
1213 \r
1214       Case header2.ffver of\r
1215         4: Move(buf1,old_songdata.instr_data,header2.b0len);\r
1216         3: LZSS_decompress(buf1,old_songdata.instr_data,header2.b0len);\r
1217         2: LZW_decompress(buf1,old_songdata.instr_data);\r
1218         1: SIXPACK_decompress(buf1,old_songdata.instr_data,header2.b0len);\r
1219       end;\r
1220 \r
1221       For temp := 1 to 250 do\r
1222         old_songdata.instr_data[temp].panning := 0;\r
1223 \r
1224       BlockReadF(f,buf1,header2.b1len,temp);\r
1225       If NOT (temp = header2.b1len) then\r
1226         begin\r
1227           CloseF(f);\r
1228           EXIT;\r
1229         end;\r
1230 \r
1231       Case header2.ffver of\r
1232         4: Move(buf1,old_songdata.pattern_order,header2.b1len);\r
1233         3: LZSS_decompress(buf1,old_songdata.pattern_order,header2.b1len);\r
1234         2: LZW_decompress(buf1,old_songdata.pattern_order);\r
1235         1: SIXPACK_decompress(buf1,old_songdata.pattern_order,header2.b1len);\r
1236       end;\r
1237 \r
1238       BlockReadF(f,buf1,header2.b2len,temp);\r
1239       If NOT (temp = header2.b2len) then\r
1240         begin\r
1241           CloseF(f);\r
1242           EXIT;\r
1243         end;\r
1244 \r
1245       FillChar(old_hash_buffer,SizeOf(old_hash_buffer),0);\r
1246       Case header2.ffver of\r
1247         4: Move(buf1,old_hash_buffer,header2.b2len);\r
1248         3: LZSS_decompress(buf1,old_hash_buffer,header2.b2len);\r
1249         2: LZW_decompress(buf1,old_hash_buffer);\r
1250         1: SIXPACK_decompress(buf1,old_hash_buffer,header2.b2len);\r
1251       end;\r
1252       import_old_a2m_patterns1(0,16);\r
1253 \r
1254       For temp2 := 0 to 2 do\r
1255         If ((header2.patts-1) DIV 16 > temp2) then\r
1256           begin\r
1257             BlockReadF(f,buf1,xlen[temp2],temp);\r
1258             If NOT (temp = xlen[temp2]) then\r
1259               begin\r
1260                 CloseF(f);\r
1261                 EXIT;\r
1262               end;\r
1263 \r
1264             FillChar(old_hash_buffer,SizeOf(old_hash_buffer),0);\r
1265             Case header2.ffver of\r
1266               4: Move(buf1,old_hash_buffer,header2.b3len);\r
1267               3: LZSS_decompress(buf1,old_hash_buffer,header2.b3len);\r
1268               2: LZW_decompress(buf1,old_hash_buffer);\r
1269               1: SIXPACK_decompress(buf1,old_hash_buffer,header2.b3len);\r
1270             end;\r
1271             import_old_a2m_patterns1(SUCC(temp2),16);\r
1272           end;\r
1273 \r
1274       replace_old_adsr(header2.patts);\r
1275       import_old_songdata(Addr(old_songdata));\r
1276     end;\r
1277 \r
1278   If (header.ffver in [5..8]) then\r
1279     begin\r
1280       ResetF(f);\r
1281       BlockReadF(f,header3,SizeOf(header3),temp);\r
1282       If NOT ((temp = SizeOf(header3)) and (header3.ident = id)) then\r
1283         begin\r
1284           CloseF(f);\r
1285           EXIT;\r
1286         end;\r
1287 \r
1288       xlen[0] := header3.b3len;\r
1289       xlen[1] := header3.b4len;\r
1290       xlen[2] := header3.b5len;\r
1291       xlen[3] := header3.b6len;\r
1292       xlen[4] := header3.b7len;\r
1293       xlen[5] := header3.b8len;\r
1294       xlen[6] := header3.b9len;\r
1295 \r
1296       crc := DWORD_NULL;\r
1297       BlockReadF(f,buf1,header3.b0len,temp);\r
1298       If NOT (temp = header3.b0len) then\r
1299         begin\r
1300           CloseF(f);\r
1301           EXIT;\r
1302         end;\r
1303 \r
1304       crc := Update32(buf1,temp,crc);\r
1305       BlockReadF(f,buf1,header3.b1len,temp);\r
1306       If NOT (temp = header3.b1len) then\r
1307         begin\r
1308           CloseF(f);\r
1309           EXIT;\r
1310         end;\r
1311 \r
1312       crc := Update32(buf1,temp,crc);\r
1313       BlockReadF(f,buf1,header3.b2len,temp);\r
1314       If NOT (temp = header3.b2len) then\r
1315         begin\r
1316           CloseF(f);\r
1317           EXIT;\r
1318         end;\r
1319 \r
1320       crc := Update32(buf1,temp,crc);\r
1321       For temp2 := 0 to 6 do\r
1322         If ((header3.patts-1) DIV 8 > temp2) then\r
1323           begin\r
1324             BlockReadF(f,buf1,xlen[temp2],temp);\r
1325             If NOT (temp = xlen[temp2]) then\r
1326               begin\r
1327                 CloseF(f);\r
1328                 EXIT;\r
1329               end;\r
1330             crc := Update32(buf1,temp,crc);\r
1331           end;\r
1332 \r
1333       crc := Update32(header3.b0len,2,crc);\r
1334       crc := Update32(header3.b1len,2,crc);\r
1335       crc := Update32(header3.b2len,2,crc);\r
1336 \r
1337       For temp2 := 0 to 6 do\r
1338         crc := Update32(xlen[temp2],2,crc);\r
1339 \r
1340       If (crc <> header3.crc32) then\r
1341         begin\r
1342           CloseF(f);\r
1343           EXIT;\r
1344         end;\r
1345 \r
1346       init_songdata;\r
1347       load_flag := 0;\r
1348 \r
1349       songdata.patt_len := 64;\r
1350       If adjust_tracks then songdata.nm_tracks := 18\r
1351       else If (songdata.nm_tracks < 18) then songdata.nm_tracks := 18;\r
1352 \r
1353       SeekF(f,SizeOf(header3));\r
1354       If (IOresult <> 0) then\r
1355         begin\r
1356           CloseF(f);\r
1357           EXIT;\r
1358         end;\r
1359 \r
1360       BlockReadF(f,buf1,header3.b0len,temp);\r
1361       If NOT (temp = header3.b0len) then\r
1362         begin\r
1363           CloseF(f);\r
1364           EXIT;\r
1365         end;\r
1366 \r
1367       old_songdata.tempo := header3.tempo;\r
1368       old_songdata.speed := header3.speed;\r
1369       old_songdata.common_flag := header3.cflag;\r
1370 \r
1371       Case header3.ffver of\r
1372         8: Move(buf1,old_songdata.instr_data,header3.b0len);\r
1373         7: LZSS_decompress(buf1,old_songdata.instr_data,header3.b0len);\r
1374         6: LZW_decompress(buf1,old_songdata.instr_data);\r
1375         5: SIXPACK_decompress(buf1,old_songdata.instr_data,header3.b0len);\r
1376       end;\r
1377 \r
1378       BlockReadF(f,buf1,header3.b1len,temp);\r
1379       If NOT (temp = header3.b1len) then\r
1380         begin\r
1381           CloseF(f);\r
1382           EXIT;\r
1383         end;\r
1384 \r
1385       Case header3.ffver of\r
1386         8: Move(buf1,old_songdata.pattern_order,header3.b1len);\r
1387         7: LZSS_decompress(buf1,old_songdata.pattern_order,header3.b1len);\r
1388         6: LZW_decompress(buf1,old_songdata.pattern_order);\r
1389         5: SIXPACK_decompress(buf1,old_songdata.pattern_order,header3.b1len);\r
1390       end;\r
1391 \r
1392       BlockReadF(f,buf1,header3.b2len,temp);\r
1393       If NOT (temp = header3.b2len) then\r
1394         begin\r
1395           CloseF(f);\r
1396           EXIT;\r
1397         end;\r
1398 \r
1399       FillChar(hash_buffer,SizeOf(hash_buffer),0);\r
1400       Case header3.ffver of\r
1401         8: Move(buf1,hash_buffer,header3.b2len);\r
1402         7: LZSS_decompress(buf1,hash_buffer,header3.b2len);\r
1403         6: LZW_decompress(buf1,hash_buffer);\r
1404         5: SIXPACK_decompress(buf1,hash_buffer,header3.b2len);\r
1405       end;\r
1406       import_old_a2m_patterns2(0,8);\r
1407 \r
1408       For temp2 := 0 to 6 do\r
1409         If ((header3.patts-1) DIV 8 > temp2) then\r
1410           begin\r
1411             BlockReadF(f,buf1,xlen[temp2],temp);\r
1412             If NOT (temp = xlen[temp2]) then\r
1413               begin\r
1414                 CloseF(f);\r
1415                 EXIT;\r
1416               end;\r
1417 \r
1418             FillChar(hash_buffer,SizeOf(hash_buffer),0);\r
1419             Case header3.ffver of\r
1420               8: Move(buf1,hash_buffer,header3.b3len);\r
1421               7: LZSS_decompress(buf1,hash_buffer,header3.b3len);\r
1422               6: LZW_decompress(buf1,hash_buffer);\r
1423               5: SIXPACK_decompress(buf1,hash_buffer,header3.b3len);\r
1424             end;\r
1425             import_old_a2m_patterns2(SUCC(temp2),8);\r
1426           end;\r
1427       import_old_songdata(Addr(old_songdata));\r
1428     end;\r
1429 \r
1430   If (header.ffver = 9) then\r
1431     begin\r
1432       ResetF(f);\r
1433       BlockReadF(f,header4,SizeOf(header4),temp);\r
1434       If NOT ((temp = SizeOf(header4)) and (header4.ident = id)) then\r
1435         begin\r
1436           CloseF(f);\r
1437           EXIT;\r
1438         end;\r
1439 \r
1440       crc := DWORD_NULL;\r
1441       BlockReadF(f,buf1,header4.b0len,temp);\r
1442       If NOT (temp = header4.b0len) then\r
1443         begin\r
1444           CloseF(f);\r
1445           EXIT;\r
1446         end;\r
1447 \r
1448       crc := Update32(buf1,temp,crc);\r
1449       BlockReadF(f,buf1,header4.b1len,temp);\r
1450       If NOT (temp = header4.b1len) then\r
1451         begin\r
1452           CloseF(f);\r
1453           EXIT;\r
1454         end;\r
1455 \r
1456       crc := Update32(buf1,temp,crc);\r
1457       BlockReadF(f,buf1,header4.b2len,temp);\r
1458       If NOT (temp = header4.b2len) then\r
1459         begin\r
1460           CloseF(f);\r
1461           EXIT;\r
1462         end;\r
1463 \r
1464       crc := Update32(buf1,temp,crc);\r
1465       BlockReadF(f,buf1,header4.b3len,temp);\r
1466       If NOT (temp = header4.b3len) then\r
1467         begin\r
1468           CloseF(f);\r
1469           EXIT;\r
1470         end;\r
1471 \r
1472       crc := Update32(buf1,temp,crc);\r
1473       BlockReadF(f,buf1,header4.b4len[0],temp);\r
1474       If NOT (temp = header4.b4len[0]) then\r
1475         begin\r
1476           CloseF(f);\r
1477           EXIT;\r
1478         end;\r
1479 \r
1480       crc := Update32(buf1,temp,crc);\r
1481       For temp2 := 1 to 15 do\r
1482         If ((header4.patts-1) DIV 8 > PRED(temp2)) then\r
1483           begin\r
1484             BlockReadF(f,buf1,header4.b4len[temp2],temp);\r
1485             If NOT (temp = header4.b4len[temp2]) then\r
1486               begin\r
1487                 CloseF(f);\r
1488                 EXIT;\r
1489               end;\r
1490             crc := Update32(buf1,temp,crc);\r
1491           end;\r
1492 \r
1493       crc := Update32(header4.b0len,2,crc);\r
1494       crc := Update32(header4.b1len,2,crc);\r
1495       crc := Update32(header4.b2len,2,crc);\r
1496       crc := Update32(header4.b3len,2,crc);\r
1497 \r
1498       For temp2 := 0 to 15 do\r
1499         crc := Update32(header4.b4len[temp2],2,crc);\r
1500 \r
1501       If (crc <> header4.crc32) then\r
1502         begin\r
1503           CloseF(f);\r
1504           EXIT;\r
1505         end;\r
1506 \r
1507       init_songdata;\r
1508       load_flag := 0;\r
1509 \r
1510       SeekF(f,SizeOf(header4));\r
1511       If (IOresult <> 0) then\r
1512         begin\r
1513           CloseF(f);\r
1514           EXIT;\r
1515         end;\r
1516 \r
1517       BlockReadF(f,buf1,header4.b0len,temp);\r
1518       If NOT (temp = header4.b0len) then\r
1519         begin\r
1520           CloseF(f);\r
1521           EXIT;\r
1522         end;\r
1523 \r
1524       APACK_decompress(buf1,songdata.instr_data);\r
1525       BlockReadF(f,buf1,header4.b1len,temp);\r
1526       If NOT (temp = header4.b1len) then\r
1527         begin\r
1528           CloseF(f);\r
1529           EXIT;\r
1530         end;\r
1531 \r
1532       APACK_decompress(buf1,songdata.instr_macros);\r
1533       BlockReadF(f,buf1,header4.b2len,temp);\r
1534       If NOT (temp = header4.b2len) then\r
1535         begin\r
1536           CloseF(f);\r
1537           EXIT;\r
1538         end;\r
1539 \r
1540       APACK_decompress(buf1,songdata.macro_table);\r
1541       BlockReadF(f,buf1,header4.b3len,temp);\r
1542       If NOT (temp = header4.b3len) then\r
1543         begin\r
1544           CloseF(f);\r
1545           EXIT;\r
1546         end;\r
1547 \r
1548       songdata.tempo := header4.tempo;\r
1549       songdata.speed := header4.speed;\r
1550       songdata.common_flag := header4.cflag;\r
1551       songdata.patt_len := header4.patln;\r
1552       songdata.nm_tracks := header4.nmtrk;\r
1553       songdata.macro_speedup := header4.mcspd;\r
1554       import_old_flags;\r
1555 \r
1556       APACK_decompress(buf1,songdata.pattern_order);\r
1557       BlockReadF(f,buf1,header4.b4len[0],temp);\r
1558       If NOT (temp = header4.b4len[0]) then\r
1559         begin\r
1560           CloseF(f);\r
1561           EXIT;\r
1562         end;\r
1563 \r
1564       APACK_decompress(buf1,pattdata^[0]);\r
1565       For temp2 := 1 to 15 do\r
1566         If ((header4.patts-1) DIV 8 > PRED(temp2)) then\r
1567           begin\r
1568             BlockReadF(f,buf1,header4.b4len[temp2],temp);\r
1569             If NOT (temp = header4.b4len[temp2]) then\r
1570               begin\r
1571                 CloseF(f);\r
1572                 EXIT;\r
1573               end;\r
1574 \r
1575             If (temp2*8+8 <= max_patterns) then\r
1576               APACK_decompress(buf1,pattdata^[temp2])\r
1577             else limit_exceeded := TRUE;\r
1578           end;\r
1579     end;\r
1580 \r
1581   If (header.ffver = 10) then\r
1582     begin\r
1583       ResetF(f);\r
1584       BlockReadF(f,header5,SizeOf(header5),temp);\r
1585       If NOT ((temp = SizeOf(header5)) and (header5.ident = id)) then\r
1586         begin\r
1587           CloseF(f);\r
1588           EXIT;\r
1589         end;\r
1590 \r
1591       crc := DWORD_NULL;\r
1592       BlockReadF(f,buf1,header5.b0len,temp);\r
1593       If NOT (temp = header5.b0len) then\r
1594         begin\r
1595           CloseF(f);\r
1596           EXIT;\r
1597         end;\r
1598 \r
1599       crc := Update32(buf1,temp,crc);\r
1600       BlockReadF(f,buf1,header5.b1len,temp);\r
1601       If NOT (temp = header5.b1len) then\r
1602         begin\r
1603           CloseF(f);\r
1604           EXIT;\r
1605         end;\r
1606 \r
1607       crc := Update32(buf1,temp,crc);\r
1608       BlockReadF(f,buf1,header5.b2len,temp);\r
1609       If NOT (temp = header5.b2len) then\r
1610         begin\r
1611           CloseF(f);\r
1612           EXIT;\r
1613         end;\r
1614 \r
1615       crc := Update32(buf1,temp,crc);\r
1616       BlockReadF(f,buf1,header5.b3len,temp);\r
1617       If NOT (temp = header5.b3len) then\r
1618         begin\r
1619           CloseF(f);\r
1620           EXIT;\r
1621         end;\r
1622 \r
1623       crc := Update32(buf1,temp,crc);\r
1624       BlockReadF(f,buf1,header5.b4len[0],temp);\r
1625       If NOT (temp = header5.b4len[0]) then\r
1626         begin\r
1627           CloseF(f);\r
1628           EXIT;\r
1629         end;\r
1630 \r
1631       crc := Update32(buf1,temp,crc);\r
1632       For temp2 := 1 to 15 do\r
1633         If ((header5.patts-1) DIV 8 > PRED(temp2)) then\r
1634           begin\r
1635             BlockReadF(f,buf1,header5.b4len[temp2],temp);\r
1636             If NOT (temp = header5.b4len[temp2]) then\r
1637               begin\r
1638                 CloseF(f);\r
1639                 EXIT;\r
1640               end;\r
1641             crc := Update32(buf1,temp,crc);\r
1642           end;\r
1643 \r
1644       crc := Update32(header5.b0len,2,crc);\r
1645       crc := Update32(header5.b1len,2,crc);\r
1646       crc := Update32(header5.b2len,2,crc);\r
1647       crc := Update32(header5.b3len,2,crc);\r
1648 \r
1649       For temp2 := 0 to 15 do\r
1650         crc := Update32(header5.b4len[temp2],2,crc);\r
1651 \r
1652       If (crc <> header5.crc32) then\r
1653         begin\r
1654           CloseF(f);\r
1655           EXIT;\r
1656         end;\r
1657 \r
1658       init_songdata;\r
1659       load_flag := 0;\r
1660 \r
1661       SeekF(f,SizeOf(header5));\r
1662       If (IOresult <> 0) then\r
1663         begin\r
1664           CloseF(f);\r
1665           EXIT;\r
1666         end;\r
1667 \r
1668       BlockReadF(f,buf1,header5.b0len,temp);\r
1669       If NOT (temp = header5.b0len) then\r
1670         begin\r
1671           CloseF(f);\r
1672           EXIT;\r
1673         end;\r
1674 \r
1675       APACK_decompress(buf1,songdata.instr_data);\r
1676       BlockReadF(f,buf1,header5.b1len,temp);\r
1677       If NOT (temp = header5.b1len) then\r
1678         begin\r
1679           CloseF(f);\r
1680           EXIT;\r
1681         end;\r
1682 \r
1683       APACK_decompress(buf1,songdata.instr_macros);\r
1684       BlockReadF(f,buf1,header5.b2len,temp);\r
1685       If NOT (temp = header5.b2len) then\r
1686         begin\r
1687           CloseF(f);\r
1688           EXIT;\r
1689         end;\r
1690 \r
1691       APACK_decompress(buf1,songdata.macro_table);\r
1692       BlockReadF(f,buf1,header5.b3len,temp);\r
1693       If NOT (temp = header5.b3len) then\r
1694         begin\r
1695           CloseF(f);\r
1696           EXIT;\r
1697         end;\r
1698 \r
1699       songdata.tempo := header5.tempo;\r
1700       songdata.speed := header5.speed;\r
1701       songdata.common_flag := header5.cflag;\r
1702       songdata.patt_len := header5.patln;\r
1703       songdata.nm_tracks := header5.nmtrk;\r
1704       songdata.macro_speedup := header5.mcspd;\r
1705       songdata.flag_4op := header5.is4op;\r
1706       Move(header5.locks,songdata.lock_flags,SizeOf(songdata.lock_flags));\r
1707 \r
1708       APACK_decompress(buf1,songdata.pattern_order);\r
1709       BlockReadF(f,buf1,header5.b4len[0],temp);\r
1710       If NOT (temp = header5.b4len[0]) then\r
1711         begin\r
1712           CloseF(f);\r
1713           EXIT;\r
1714         end;\r
1715 \r
1716       APACK_decompress(buf1,pattdata^[0]);\r
1717       For temp2 := 1 to 15 do\r
1718         If ((header5.patts-1) DIV 8 > PRED(temp2)) then\r
1719           begin\r
1720             BlockReadF(f,buf1,header5.b4len[temp2],temp);\r
1721             If NOT (temp = header5.b4len[temp2]) then\r
1722               begin\r
1723                 CloseF(f);\r
1724                 EXIT;\r
1725               end;\r
1726 \r
1727             If (temp2*8+8 <= max_patterns) then\r
1728               APACK_decompress(buf1,pattdata^[temp2])\r
1729             else limit_exceeded := TRUE;\r
1730           end;\r
1731     end;\r
1732 \r
1733   If (header.ffver = 11) then\r
1734     begin\r
1735       crc := DWORD_NULL;\r
1736       BlockReadF(f,buf1,header.b0len,temp);\r
1737       If NOT (temp = header.b0len) then\r
1738         begin\r
1739           CloseF(f);\r
1740           EXIT;\r
1741         end;\r
1742 \r
1743       crc := Update32(buf1,temp,crc);\r
1744       BlockReadF(f,buf1,header.b1len,temp);\r
1745       If NOT (temp = header.b1len) then\r
1746         begin\r
1747           CloseF(f);\r
1748           EXIT;\r
1749         end;\r
1750 \r
1751       crc := Update32(buf1,temp,crc);\r
1752       BlockReadF(f,buf1,header.b2len,temp);\r
1753       If NOT (temp = header.b2len) then\r
1754         begin\r
1755           CloseF(f);\r
1756           EXIT;\r
1757         end;\r
1758 \r
1759       crc := Update32(buf1,temp,crc);\r
1760       BlockReadF(f,buf1,header.b3len,temp);\r
1761       If NOT (temp = header.b3len) then\r
1762         begin\r
1763           CloseF(f);\r
1764           EXIT;\r
1765         end;\r
1766 \r
1767       crc := Update32(buf1,temp,crc);\r
1768       BlockReadF(f,buf1,header.b4len,temp);\r
1769       If NOT (temp = header.b4len) then\r
1770         begin\r
1771           CloseF(f);\r
1772           EXIT;\r
1773         end;\r
1774 \r
1775       crc := Update32(buf1,temp,crc);\r
1776       BlockReadF(f,buf1,header.b5len[0],temp);\r
1777       If NOT (temp = header.b5len[0]) then\r
1778         begin\r
1779           CloseF(f);\r
1780           EXIT;\r
1781         end;\r
1782 \r
1783       crc := Update32(buf1,temp,crc);\r
1784       For temp2 := 1 to 15 do\r
1785         If ((header.patts-1) DIV 8 > PRED(temp2)) then\r
1786           begin\r
1787             BlockReadF(f,buf1,header.b5len[temp2],temp);\r
1788             If NOT (temp = header.b5len[temp2]) then\r
1789               begin\r
1790                 CloseF(f);\r
1791                 EXIT;\r
1792               end;\r
1793             crc := Update32(buf1,temp,crc);\r
1794           end;\r
1795 \r
1796       crc := Update32(header.b0len,2,crc);\r
1797       crc := Update32(header.b1len,2,crc);\r
1798       crc := Update32(header.b2len,2,crc);\r
1799       crc := Update32(header.b3len,2,crc);\r
1800       crc := Update32(header.b4len,2,crc);\r
1801 \r
1802       For temp2 := 0 to 15 do\r
1803         crc := Update32(header.b5len[temp2],2,crc);\r
1804 \r
1805       If (crc <> header.crc32) then\r
1806         begin\r
1807           CloseF(f);\r
1808           EXIT;\r
1809         end;\r
1810 \r
1811       init_songdata;\r
1812       load_flag := 0;\r
1813 \r
1814       SeekF(f,SizeOf(header));\r
1815       If (IOresult <> 0) then\r
1816         begin\r
1817           CloseF(f);\r
1818           EXIT;\r
1819         end;\r
1820 \r
1821       BlockReadF(f,buf1,header.b0len,temp);\r
1822       If NOT (temp = header.b0len) then\r
1823         begin\r
1824           CloseF(f);\r
1825           EXIT;\r
1826         end;\r
1827 \r
1828       APACK_decompress(buf1,songdata.instr_data);\r
1829       BlockReadF(f,buf1,header.b1len,temp);\r
1830       If NOT (temp = header.b1len) then\r
1831         begin\r
1832           CloseF(f);\r
1833           EXIT;\r
1834         end;\r
1835 \r
1836       APACK_decompress(buf1,songdata.instr_macros);\r
1837       BlockReadF(f,buf1,header.b2len,temp);\r
1838       If NOT (temp = header.b2len) then\r
1839         begin\r
1840           CloseF(f);\r
1841           EXIT;\r
1842         end;\r
1843 \r
1844       APACK_decompress(buf1,songdata.macro_table);\r
1845       BlockReadF(f,buf1,header.b3len,temp);\r
1846       If NOT (temp = header.b3len) then\r
1847         begin\r
1848           CloseF(f);\r
1849           EXIT;\r
1850         end;\r
1851 \r
1852       APACK_decompress(buf1,songdata.dis_fmreg_col);\r
1853       BlockReadF(f,buf1,header.b4len,temp);\r
1854       If NOT (temp = header.b4len) then\r
1855         begin\r
1856           CloseF(f);\r
1857           EXIT;\r
1858         end;\r
1859 \r
1860       songdata.tempo := header.tempo;\r
1861       songdata.speed := header.speed;\r
1862       songdata.common_flag := header.cflag;\r
1863       songdata.patt_len := header.patln;\r
1864       songdata.nm_tracks := header.nmtrk;\r
1865       songdata.macro_speedup := header.mcspd;\r
1866       songdata.flag_4op := header.is4op;\r
1867       Move(header.locks,songdata.lock_flags,SizeOf(songdata.lock_flags));\r
1868 \r
1869       APACK_decompress(buf1,songdata.pattern_order);\r
1870       BlockReadF(f,buf1,header.b5len[0],temp);\r
1871       If NOT (temp = header.b5len[0]) then\r
1872         begin\r
1873           CloseF(f);\r
1874           EXIT;\r
1875         end;\r
1876 \r
1877       APACK_decompress(buf1,pattdata^[0]);\r
1878       For temp2 := 1 to 15 do\r
1879         If ((header.patts-1) DIV 8 > PRED(temp2)) then\r
1880           begin\r
1881             BlockReadF(f,buf1,header.b5len[temp2],temp);\r
1882             If NOT (temp = header.b5len[temp2]) then\r
1883               begin\r
1884                 CloseF(f);\r
1885                 EXIT;\r
1886               end;\r
1887 \r
1888             If (temp2*8+8 <= max_patterns) then\r
1889               APACK_decompress(buf1,pattdata^[temp2])\r
1890             else limit_exceeded := TRUE;\r
1891           end;\r
1892     end;\r
1893 \r
1894   speed := songdata.speed;\r
1895   tempo := songdata.tempo;\r
1896 \r
1897   CloseF(f);\r
1898   songdata_title := NameOnly(songdata_source);\r
1899   Case header.ffver of\r
1900     1..4: load_flag := 3;\r
1901     else  load_flag := 4;\r
1902   end;\r
1903 end;\r
1904 \r
1905 \r
1906 function dec2hex(dec: Byte): Byte;\r
1907 begin dec2hex := (dec DIV 10)*16 +(dec MOD 10); end;\r
1908 \r
1909 function truncate_string(str: String): String;\r
1910 begin\r
1911   While (Length(str) > 0) and (str[Length(str)] in [#0,#32,#255]) do\r
1912     Delete(str,Length(str),1);\r
1913   truncate_string := str;\r
1914 end;\r
1915 \r
1916 procedure amd_file_loader;\r
1917 \r
1918 type\r
1919   tPATDAT = array[0..$24] of\r
1920             array[0..$3f] of array[1..9] of\r
1921                              array[0..2] of Byte;\r
1922 type\r
1923   tINSDAT = Record\r
1924               iName: array[1..23] of Char;     { Instrument name }\r
1925               iData: array[0..10] of Byte;     { Instrument data }\r
1926             end;\r
1927 type\r
1928   tHEADER = Record\r
1929               sname: array[1..24]  of Char;    { Name of song [ASCIIZ] }\r
1930               aname: array[1..24]  of Char;    { Name of author [ASCIIZ] }\r
1931               instr: array[0..25]  of tINSDAT; { 26 instruments }\r
1932               snlen: Byte;                     { Song length }\r
1933               nopat: Byte;                     { Number of patterns -1 }\r
1934               order: array[0..$7f] of Byte;    { Pattern table }\r
1935               ident: array[1..9]   of Char;    { ID }\r
1936               versn: Byte;                     { Version 10h=normal module }\r
1937                                                {         11h=packed module }\r
1938             end;\r
1939 const\r
1940   id_amd = '<oïQUîRoR';\r
1941   id_xms = 'MaDoKaN96';\r
1942 \r
1943 var\r
1944   f: File;\r
1945   header: tHEADER;\r
1946   temp,tmp2,temp2,temp3,temp4: Longint;\r
1947   byte1,byte2,byte3: Byte;\r
1948 \r
1949 procedure import_amd_instrument(inst: Byte; var data);\r
1950 begin\r
1951   With songdata.instr_data[inst] do\r
1952     begin\r
1953       fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[0];\r
1954       fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[1];\r
1955       fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[2];\r
1956       fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[3];\r
1957       fm_data.WAVEFORM_modulator  := tDUMMY_BUFF(data)[4]  AND 3;\r
1958       fm_data.AM_VIB_EG_carrier   := tDUMMY_BUFF(data)[5];\r
1959       fm_data.KSL_VOLUM_carrier   := tDUMMY_BUFF(data)[6];\r
1960       fm_data.ATTCK_DEC_carrier   := tDUMMY_BUFF(data)[7];\r
1961       fm_data.SUSTN_REL_carrier   := tDUMMY_BUFF(data)[8];\r
1962       fm_data.WAVEFORM_carrier    := tDUMMY_BUFF(data)[9]  AND 3;\r
1963       fm_data.FEEDBACK_FM         := tDUMMY_BUFF(data)[10] AND $0f;\r
1964     end;\r
1965 \r
1966   songdata.instr_data[inst].panning := 0;\r
1967   songdata.instr_data[inst].fine_tune := 0;\r
1968 end;\r
1969 \r
1970 procedure import_amd_event(pattern,line,channel,byte1,byte2,byte3: Byte);\r
1971 \r
1972 var\r
1973   chunk: tCHUNK;\r
1974   param: Byte;\r
1975 \r
1976 begin\r
1977   FillChar(chunk,SizeOf(chunk),0);\r
1978   If ((byte2 SHR 4)+(byte1 AND 1) SHL 4 <> 0) then\r
1979     chunk.instr_def := (byte2 SHR 4)+(byte1 AND 1) SHL 4;\r
1980 \r
1981   If (byte1 SHR 4 in [1..12]) and ((byte1 SHR 1) AND 7 in [0..7]) then\r
1982     chunk.note := 12*((byte1 SHR 1) AND 7)+(byte1 SHR 4);\r
1983 \r
1984   param := byte3 AND $7f;\r
1985   Case byte2 AND $0f of\r
1986   { ARPEGGIO }\r
1987     $00: begin\r
1988            chunk.effect_def := ef_Arpeggio;\r
1989            chunk.effect := dec2hex(param);\r
1990          end;\r
1991 \r
1992   { SLIDE FREQUENCY UP }\r
1993     $01: begin\r
1994            chunk.effect_def := ef_FSlideUp;\r
1995            chunk.effect := param;\r
1996          end;\r
1997 \r
1998   { SLIDE FREQUENCY DOWN }\r
1999     $02: begin\r
2000            chunk.effect_def := ef_FSlideDown;\r
2001            chunk.effect := param;\r
2002          end;\r
2003 \r
2004   { SET CARRIER/MODULATOR INTENSITY }\r
2005     $03: If (param DIV 10 in [1..9]) then\r
2006            begin\r
2007              chunk.effect_def := ef_SetCarrierVol;\r
2008              chunk.effect := (param DIV 10)*7;\r
2009            end\r
2010          else If (param MOD 10 in [1..9]) then\r
2011                 begin\r
2012                   chunk.effect_def := ef_SetModulatorVol;\r
2013                   chunk.effect := (param MOD 10)*7;\r
2014                 end;\r
2015 \r
2016   { SET THE VOLUME }\r
2017     $04: begin\r
2018            chunk.effect_def := ef_SetInsVolume;\r
2019            If (param < 64) then chunk.effect := param\r
2020            else chunk.effect := 63;\r
2021          end;\r
2022 \r
2023   { JUMP INTO PATTERN }\r
2024     $05: begin\r
2025            chunk.effect_def := ef_PositionJump;\r
2026            If (param < 100) then chunk.effect := param\r
2027            else chunk.effect := 99;\r
2028          end;\r
2029 \r
2030   { PATTERNBREAK }\r
2031     $06: begin\r
2032            chunk.effect_def := ef_PatternBreak;\r
2033            If (param < 64) then chunk.effect := param\r
2034            else chunk.effect := 63;\r
2035          end;\r
2036 \r
2037   { SET SONGSPEED }\r
2038     $07: If (param < 99) then\r
2039            If (param in [1..31]) then\r
2040              begin\r
2041                chunk.effect_def := ef_SetSpeed;\r
2042                chunk.effect := param;\r
2043              end\r
2044            else begin\r
2045                   chunk.effect_def := ef_SetTempo;\r
2046                   If (param = 0) then chunk.effect := 18\r
2047                   else chunk.effect := param;\r
2048                 end;\r
2049 \r
2050   { TONEPORTAMENTO }\r
2051     $08: begin\r
2052            chunk.effect_def := ef_TonePortamento;\r
2053            chunk.effect := param;\r
2054          end;\r
2055 \r
2056   { EXTENDED COMMAND }\r
2057     $09: If (param < 60) then\r
2058            Case param DIV 10 of\r
2059            { DEFINE CELL-TREMOLO }\r
2060              0: If (param MOD 10 < 2) then\r
2061                   begin\r
2062                     chunk.effect_def := ef_Extended;\r
2063                     chunk.effect := dec2hex(param);\r
2064                   end;\r
2065 \r
2066            { DEFINE CELL-VIBRATO }\r
2067              1: If (param MOD 10 < 2) then\r
2068                   begin\r
2069                     chunk.effect_def := ef_Extended;\r
2070                     chunk.effect := $10+dec2hex(param);\r
2071                   end;\r
2072 \r
2073            { INCREASE VOLUME FAST }\r
2074              2: begin\r
2075                   chunk.effect_def := ef_VolSlide;\r
2076                   chunk.effect := (param MOD 10)*16;\r
2077                 end;\r
2078 \r
2079            { DECREASE VOLUME FAST }\r
2080              3: begin\r
2081                   chunk.effect_def := ef_VolSlide;\r
2082                   chunk.effect := param MOD 10;\r
2083                 end;\r
2084 \r
2085            { INCREASE VOLUME FINE }\r
2086              4: begin\r
2087                   chunk.effect_def := ef_Extended2;\r
2088                   chunk.effect := ef_ex2_VolSlideUpXF*16+(param MOD 10);\r
2089                 end;\r
2090 \r
2091            { DECREASE VOLUME FINE }\r
2092              5: begin\r
2093                   chunk.effect_def := ef_Extended2;\r
2094                   chunk.effect := ef_ex2_VolSlideDnXF*16+(param MOD 10);\r
2095                 end;\r
2096            end;\r
2097   end;\r
2098 \r
2099 // specific corrections for Amusic event\r
2100   If (chunk.note = 0) then chunk.instr_def := 0;\r
2101   put_chunk(pattern,line,channel,chunk);\r
2102 end;\r
2103 \r
2104 procedure import_amd_packed_patterns(var data; patterns: Byte);\r
2105 \r
2106 var\r
2107   temp,temp2,temp3,temp4,temp5: Word;\r
2108   count: Byte;\r
2109 \r
2110 var\r
2111   tracks: Word;\r
2112   track_order: array[0..$3f] of array[1..9] of Word;\r
2113   track: array[0..$3f] of tCHUNK;\r
2114 \r
2115 begin\r
2116   temp := (patterns+1)*9*SizeOf(WORD);\r
2117   Move(data,track_order,temp);\r
2118 \r
2119   tracks := tDUMMY_BUFF(data)[temp]+(tDUMMY_BUFF(data)[temp+1]) SHL 8;\r
2120   Inc(temp,2);\r
2121 \r
2122   temp3 := 0;\r
2123   temp4 := 0;\r
2124   count := 0;\r
2125 \r
2126   Repeat\r
2127     If (count = 0) then\r
2128       begin\r
2129         If (temp3 = 0) then\r
2130           begin\r
2131             temp2 := tDUMMY_BUFF(data)[temp]+(tDUMMY_BUFF(data)[temp+1]) SHL 8;\r
2132             Inc(temp,2);\r
2133           end;\r
2134 \r
2135         If (tDUMMY_BUFF(data)[temp] OR $80 <> tDUMMY_BUFF(data)[temp]) then\r
2136           begin\r
2137             If (temp2 DIV 9 <= $3f) and (temp2 MOD 9 < 9) then\r
2138               import_amd_event(temp2 DIV 9,temp3,temp2 MOD 9 +1,\r
2139                                tDUMMY_BUFF(data)[temp+2],\r
2140                                tDUMMY_BUFF(data)[temp+1],\r
2141                                tDUMMY_BUFF(data)[temp+0]);\r
2142             Inc(temp,3);\r
2143           end\r
2144         else\r
2145           begin\r
2146             count := (tDUMMY_BUFF(data)[temp] AND $7f)-1;\r
2147             Inc(temp);\r
2148           end;\r
2149       end\r
2150     else Dec(count);\r
2151 \r
2152     Inc(temp3);\r
2153     If (temp3 > $3f) then\r
2154       begin\r
2155         temp3 := 0;\r
2156         count := 0;\r
2157         Inc(temp4);\r
2158       end;\r
2159   until NOT (temp4 < tracks);\r
2160 \r
2161   For temp := 0 to patterns do\r
2162     For temp2 := 1 to 9 do\r
2163       begin\r
2164         temp3 := track_order[temp][temp2];\r
2165         temp4 := temp3 DIV 9;\r
2166 \r
2167         If (temp3 < 64*9) then\r
2168           begin\r
2169             For temp5 := 0 to $3f do\r
2170               get_chunk(temp4,temp5,temp3 MOD 9 +1,track[temp5]);\r
2171             For temp5 := 0 to $3f do\r
2172               put_chunk( temp,temp5,temp2,track[temp5]);\r
2173           end;\r
2174       end;\r
2175 end;\r
2176 \r
2177 function get_byte(var pos: Longint): Byte;\r
2178 begin\r
2179   If (pos = SizeOf(buf1)) then\r
2180     begin\r
2181       Move(buf3,buf1,SizeOf(buf3));\r
2182       pos := 0;\r
2183     end;\r
2184   get_byte := buf1[pos];\r
2185   Inc(pos);\r
2186 end;\r
2187 \r
2188 begin\r
2189   {$i-}\r
2190   Assign(f,songdata_source);\r
2191   ResetF(f);\r
2192   {$i+}\r
2193   If (IOresult <> 0) then\r
2194     begin\r
2195       CloseF(f);\r
2196       EXIT;\r
2197     end;\r
2198 \r
2199   BlockReadF(f,header,SizeOf(header),temp);\r
2200   If NOT ((temp = SizeOf(header)) and\r
2201          ((header.ident = id_amd) or (header.ident = id_xms))) then\r
2202     begin\r
2203       CloseF(f);\r
2204       EXIT;\r
2205     end;\r
2206 \r
2207   load_flag := $7f;\r
2208   If NOT (header.versn in [$10,$11]) then\r
2209     begin\r
2210       CloseF(f);\r
2211       EXIT;\r
2212     end;\r
2213 \r
2214   FillChar(buf1,SizeOf(buf1),0);\r
2215   BlockReadF(f,buf1,SizeOf(buf1),temp);\r
2216   If (IOresult <> 0) then\r
2217     begin\r
2218       CloseF(f);\r
2219       EXIT;\r
2220     end;\r
2221 \r
2222   tmp2 := WORD_NULL;\r
2223   If (temp = SizeOf(buf1)) then\r
2224     begin\r
2225       FillChar(buf3,SizeOf(buf3),0);\r
2226       BlockReadF(f,buf3,SizeOf(buf3),tmp2);\r
2227       If (IOresult <> 0) then\r
2228         begin\r
2229           CloseF(f);\r
2230           EXIT;\r
2231         end;\r
2232     end;\r
2233 \r
2234   init_songdata;\r
2235   load_flag := 0;\r
2236 \r
2237   songdata.patt_len := 64;\r
2238   If adjust_tracks then songdata.nm_tracks := 9\r
2239   else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
2240 \r
2241   tempo := 50;\r
2242   speed := 6;\r
2243 \r
2244   songdata.tempo := tempo;\r
2245   songdata.speed := speed;\r
2246 \r
2247   For temp2 := 0 to header.snlen-1 do\r
2248     If (temp2 < 128) and (header.order[temp2] in [0..header.nopat]) then\r
2249       songdata.pattern_order[temp2] := header.order[temp2];\r
2250 \r
2251   For temp2 := 0 to 25 do\r
2252     begin\r
2253       import_amd_instrument(temp2+1,header.instr[temp2].iData);\r
2254       songdata.instr_names[temp2+1] :=\r
2255         Copy(songdata.instr_names[temp2+1],1,9)+\r
2256         truncate_string(header.instr[temp2].iName);\r
2257     end;\r
2258 \r
2259   temp := 0;\r
2260   If (header.versn = $10) then\r
2261     For temp2 := 0 to header.nopat do\r
2262       For temp3 := 0 to $3f do\r
2263         For temp4 := 1 to 9 do\r
2264           begin\r
2265             byte3 := get_byte(temp);\r
2266             byte2 := get_byte(temp);\r
2267             byte1 := get_byte(temp);\r
2268             import_amd_event(temp2,temp3,temp4,byte1,byte2,byte3);\r
2269           end\r
2270   else\r
2271     import_amd_packed_patterns(buf1,header.nopat);\r
2272 \r
2273   songdata.common_flag := songdata.common_flag OR $80;\r
2274   songdata.songname := CutStr(asciiz_string(header.sname));\r
2275   songdata.composer := CutStr(asciiz_string(header.aname));\r
2276   import_old_flags;\r
2277 \r
2278   CloseF(f);\r
2279   songdata_title := NameOnly(songdata_source);\r
2280   If (header.ident = id_amd) then load_flag := 5\r
2281   else load_flag := 6;\r
2282 end;\r
2283 \r
2284 procedure import_hsc_instrument(inst: Byte; var data); forward;\r
2285 \r
2286 procedure import_cff_event(patt,line,chan,byte0,byte1,byte2: Byte);\r
2287 \r
2288 var\r
2289   chunk: tCHUNK;\r
2290   temp1,temp2,temp3,temp4: Byte;\r
2291 \r
2292 begin\r
2293   FillChar(chunk,SizeOf(chunk),0);\r
2294   temp1 := byte2;\r
2295   temp2 := temp1 DIV 16;\r
2296   temp3 := temp1 MOD 16;\r
2297 \r
2298   Case CHAR(byte1) of\r
2299   { SET SPEED }\r
2300     'A': If (temp1 > 0) then\r
2301            begin\r
2302              chunk.effect_def := ef_SetSpeed;\r
2303              chunk.effect := temp1;\r
2304            end;\r
2305 \r
2306   { SET CARRIER WAVEFORM }\r
2307     'B': If (temp1 < 4) then\r
2308            begin\r
2309              chunk.effect_def := ef_SetWaveform;\r
2310              chunk.effect := temp1*16;\r
2311            end;\r
2312 \r
2313   { SET MODULATOR VOLUME }\r
2314     'C': begin\r
2315            chunk.effect_def := ef_SetModulatorVol;\r
2316            If (temp1 < 64) then chunk.effect := 63-temp1\r
2317            else chunk.effect := 0;\r
2318          end;\r
2319 \r
2320   { VOLUME SLIDE UP/DOWN }\r
2321     'D': begin\r
2322            chunk.effect_def := ef_VolSlide;\r
2323            chunk.effect := temp1;\r
2324          end;\r
2325 \r
2326   { SLIDE DOWN }\r
2327     'E': If (temp1 <> 0) then\r
2328            begin\r
2329              chunk.effect_def := ef_FSlideDown;\r
2330              chunk.effect := temp1;\r
2331            end;\r
2332 \r
2333   { SLIDE UP }\r
2334     'F': If (temp1 <> 0) then\r
2335            begin\r
2336              chunk.effect_def := ef_FSlideUp;\r
2337              chunk.effect := temp1;\r
2338            end;\r
2339 \r
2340   { SET CARRIER VOLUME }\r
2341     'G': begin\r
2342            chunk.effect_def := ef_SetCarrierVol;\r
2343            If (temp1 < 64) then chunk.effect := 63-temp1\r
2344            else chunk.effect := 0;\r
2345          end;\r
2346 \r
2347   { SET TEMPO }\r
2348     'H': If (temp1 > 0) then\r
2349            begin\r
2350              chunk.effect_def := ef_SetTempo;\r
2351              If NOT (temp1 > 21) then temp1 := 125;\r
2352              temp4 := 1412926 DIV LONGINT(temp1 SHR 1);\r
2353              chunk.effect := 1;\r
2354              While (1193180 DIV chunk.effect > temp4) and\r
2355                    (chunk.effect < 255) do\r
2356                Inc(chunk.effect);\r
2357            end;\r
2358 \r
2359   { SET INSTRUMENT }\r
2360     'I': If (temp1 < 47) then\r
2361            begin\r
2362              chunk.effect_def := ef_Extended;\r
2363              chunk.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol;\r
2364              chunk.instr_def := temp1+1;\r
2365            end;\r
2366 \r
2367   { ARPEGGIO }\r
2368     'J': begin\r
2369            chunk.effect_def := ef_Arpeggio;\r
2370            chunk.effect := temp1;\r
2371          end;\r
2372 \r
2373   { JUMP TO ORDER }\r
2374     'K': If (temp1 < 128) then\r
2375            begin\r
2376              chunk.effect_def := ef_PositionJump;\r
2377              chunk.effect := temp1;\r
2378            end;\r
2379 \r
2380   { JUMP TO NEXT PATTERN IN ORDER }\r
2381     'L': chunk.effect_def := ef_PatternBreak;\r
2382 \r
2383   { SET TREMOLO HIGHER / SET VIBRATO DEEPER }\r
2384     'M': begin\r
2385            chunk.effect_def := ef_Extended;\r
2386            If (temp2 = 1) and (temp3 = 0) then chunk.effect := dec2hex(01);\r
2387            If (temp2 = 0) and (temp3 = 1) then chunk.effect := dec2hex(10);\r
2388            If (temp2 = 1) and (temp3 = 1) then chunk.effect := dec2hex(11);\r
2389          end;\r
2390   end;\r
2391 \r
2392   Case byte0 of\r
2393   { REGULAR NOTE }\r
2394     1..12*8+1: begin\r
2395                 If NOT fix_c_note_bug then chunk.note := byte0\r
2396                 else begin\r
2397                        chunk.note := byte0+1;\r
2398                        If (chunk.note > 12*8+1) then\r
2399                          chunk.note := 12*8+1;\r
2400                      end;\r
2401                end;\r
2402   { PAUSE }\r
2403     $6d: chunk.note := BYTE_NULL;\r
2404   end;\r
2405 \r
2406   put_chunk(patt,line,chan,chunk);\r
2407 end;\r
2408 \r
2409 procedure import_cff_patterns(var data; patterns: Byte);\r
2410 \r
2411 type\r
2412   tPATDAT = array[0..$24] of\r
2413             array[0..$3f] of array[1..9] of\r
2414                              array[0..2] of Byte;\r
2415 \r
2416 var\r
2417   voice: array[1..9] of Byte;\r
2418   arpgg: array[1..9] of Byte;\r
2419   chunk: tCHUNK;\r
2420   temp,temp2,temp3,temp4: Byte;\r
2421   order,patt: Byte;\r
2422   patt_break: Byte;\r
2423   patts: String;\r
2424 \r
2425 function _empty_event(var data): Boolean;\r
2426 begin\r
2427   _empty_event := (tDUMMY_BUFF(data)[0] = 0) and\r
2428                   (tDUMMY_BUFF(data)[1] = 0) and\r
2429                   (tDUMMY_BUFF(data)[2] = 0);\r
2430 end;\r
2431 \r
2432 begin\r
2433   patts := '';\r
2434   FillChar(arpgg,SizeOf(arpgg),0);\r
2435   If NOT accurate_conv then\r
2436        For temp := 1 to 9 do voice[temp] := temp\r
2437   else For temp := 1 to 9 do voice[temp] := 0;\r
2438 \r
2439   For temp := 0 to $24 do\r
2440     For temp2 := 0 to $3f do\r
2441       For temp3 := 1 to 9 do\r
2442         If NOT _empty_event(tPATDAT(data)[temp][temp2][temp3]) then\r
2443           import_cff_event(temp,temp2,temp3,tPATDAT(data)[temp][temp2][temp3][0],\r
2444                                             tPATDAT(data)[temp][temp2][temp3][1],\r
2445                                             tPATDAT(data)[temp][temp2][temp3][2]);\r
2446   order := 0;\r
2447   patt := BYTE_NULL;\r
2448 \r
2449   Repeat\r
2450     If (songdata.pattern_order[order] > $24) then Inc(order)\r
2451     else\r
2452       begin\r
2453         patt := songdata.pattern_order[order];\r
2454         patt_break := BYTE_NULL;\r
2455         For temp2 := 0 to $3f do\r
2456           For temp3 := 1 to 9 do\r
2457              begin\r
2458                get_chunk(patt,temp2,temp3,chunk);\r
2459                temp4 := tPATDAT(data)[patt][temp2][temp3][2];\r
2460 \r
2461                Case CHAR(tPATDAT(data)[patt][temp2][temp3][1]) of\r
2462                { SET MODULATOR VOLUME }\r
2463                  'C': If (chunk.instr_def = 0) and NOT accurate_conv then\r
2464                         chunk.instr_def := voice[temp3]\r
2465                       else If (chunk.instr_def = 0) and\r
2466                               (voice[temp3] = 0) then chunk.instr_def := temp3;\r
2467 \r
2468                { SET CARRIER VOLUME }\r
2469                  'G': If (chunk.instr_def = 0) and NOT accurate_conv then\r
2470                         chunk.instr_def := voice[temp3]\r
2471                       else If (chunk.instr_def = 0) and\r
2472                               (voice[temp3] = 0) then chunk.instr_def := temp3;\r
2473 \r
2474                { SET INSTRUMENT }\r
2475                  'I': If (temp4 < 47) then\r
2476                         If (temp2 <> patt_break) then\r
2477                           begin\r
2478                             voice[temp3] := temp4+1;\r
2479                             If NOT accurate_conv then\r
2480                               chunk.instr_def := voice[temp3];\r
2481                           end;\r
2482 \r
2483                { ARPEGGIO }\r
2484                  'J': begin\r
2485                         chunk.effect_def := ef_Arpeggio;\r
2486                         If (temp4 <> 0) then\r
2487                           begin\r
2488                             chunk.effect := temp4;\r
2489                             arpgg[temp3] := temp4;\r
2490                           end\r
2491                         else chunk.effect := arpgg[temp3];\r
2492                       end;\r
2493 \r
2494                { JUMP TO ORDER }\r
2495                  'K': If (temp4 < 128) then\r
2496                         patt_break := temp2+1;\r
2497 \r
2498                { JUMP TO NEXT PATTERN IN ORDER }\r
2499                  'L': patt_break := temp2+1;\r
2500                end;\r
2501 \r
2502                Case tPATDAT(data)[patt][temp2][temp3][0] of\r
2503                { REGULAR NOTE }\r
2504                  1..12*8+1: begin\r
2505                              If accurate_conv then\r
2506                                If (voice[temp3] = 0) then\r
2507                                  begin\r
2508                                    voice[temp3] := temp3;\r
2509                                    chunk.instr_def := voice[temp3];\r
2510                                  end;\r
2511 \r
2512                               If NOT accurate_conv then\r
2513                                 chunk.instr_def := voice[temp3];\r
2514                             end;\r
2515                end;\r
2516 \r
2517                If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then\r
2518                  put_chunk(patt,temp2,temp3,chunk);\r
2519              end;\r
2520         Inc(order);\r
2521         patts := patts+CHR(patt);\r
2522       end;\r
2523   until (patt >= patterns) or (order > $40);\r
2524 end;\r
2525 \r
2526 procedure cff_file_loader;\r
2527 \r
2528 type\r
2529   tHEADER = Record\r
2530               ident: array[1..16] of Char;    { Identification }\r
2531               versn: Byte;                    { Format version }\r
2532               fsize: Word;                    { Filesize -32 }\r
2533               cflag: Byte;                    { Flag 1=compressed data }\r
2534               resrv: array[0..11] of Byte;    { Reserved }\r
2535             end;\r
2536 type\r
2537   tINSDAT = Record\r
2538               iData: array[0..11] of Byte;    { Instrument data }\r
2539               iName: array[1..20] of Char;    { Instrument name }\r
2540             end;\r
2541 type\r
2542   tHEADR2 = Record\r
2543               instr: array[0..46] of tINSDAT; { 47 instruments }\r
2544               nopat: Byte;                    { Number of patterns }\r
2545               ascii: array[1..31] of Char;    { ASCII blab }\r
2546               writr: array[1..20] of Char;    { Song writer }\r
2547               sname: array[1..20] of Char;    { Song name }\r
2548               order: array[0..64] of Byte;    { Pattern order }\r
2549             end;\r
2550 const\r
2551   _PRE_ASCII_BLAB_SIZE = $5e1; // SizeOf(tHEADR2.instr)+SizeOf(tHEADR2.nopat)\r
2552 \r
2553 const\r
2554   id = '<CUD-FM-File>'+#26+CHR($de)+CHR($e0);\r
2555   ascii_blab = 'CUD-FM-File - SEND A POSTCARD -';\r
2556 \r
2557 var\r
2558   f: File;\r
2559   header: tHEADER;\r
2560   headr2: tHEADR2;\r
2561   temp,temp2: Longint;\r
2562   offs,out_size: Longint;\r
2563 \r
2564 function LZTYR_decompress(var input,output): Longint;\r
2565 \r
2566 type\r
2567   tSTRING = array[0..255] of Byte;\r
2568 \r
2569 var\r
2570   input_idx: Longint;\r
2571 \r
2572   the_string,\r
2573   temp_string: tSTRING;\r
2574 \r
2575   old_code_length: Byte;\r
2576   repeat_length: Byte;\r
2577   repeat_counter: Longint;\r
2578   output_length: Longint;\r
2579   code_length: Byte;\r
2580   bits_buffer: Longint;\r
2581   bits_left: Word;\r
2582   old_code: Longint;\r
2583   new_code: Longint;\r
2584   idx: Word;\r
2585 \r
2586   _cff_heap_length: Word;\r
2587   _cff_dictionary_length: Word;\r
2588   _cff_dictionary: array[0..32767] of Pointer;\r
2589 \r
2590 function get_code: Longint;\r
2591 \r
2592 var\r
2593   code: Longint;\r
2594 \r
2595 begin\r
2596   While (bits_left < code_length) do\r
2597     begin\r
2598       bits_buffer := bits_buffer OR (tDUMMY_BUFF(input)[input_idx] SHL\r
2599                                      bits_left);\r
2600       Inc(input_idx);\r
2601       Inc(bits_left,8);\r
2602     end;\r
2603 \r
2604   code := bits_buffer AND ((1 SHL code_length)-1);\r
2605   bits_buffer := bits_buffer SHR code_length;\r
2606   Dec(bits_left,code_length);\r
2607   get_code := code;\r
2608 end;\r
2609 \r
2610 procedure translate_code(code: Longint; var str: tSTRING);\r
2611 \r
2612 var\r
2613   translated_string: tSTRING;\r
2614 \r
2615 begin\r
2616   If (code >= $104) then\r
2617     Move(_cff_dictionary[code-$104]^,translated_string,\r
2618          BYTE(_cff_dictionary[code-$104]^)+1)\r
2619   else begin\r
2620          translated_string[0] := 1;\r
2621          translated_string[1] := (code-4) AND $0ff;\r
2622         end;\r
2623 \r
2624   Move(translated_string,str,256);\r
2625 end;\r
2626 \r
2627 procedure startup;\r
2628 \r
2629 var\r
2630   idx: Longint;\r
2631 \r
2632 begin\r
2633   old_code := get_code;\r
2634   translate_code(old_code,the_string);\r
2635 \r
2636   If (the_string[0] > 0) then\r
2637     For idx := 0 to the_string[0]-1 do\r
2638       begin\r
2639         tDUMMY_BUFF(output)[output_length] := the_string[idx+1];\r
2640         Inc(output_length);\r
2641       end;\r
2642 end;\r
2643 \r
2644 procedure cleanup;\r
2645 begin\r
2646   code_length := 9;\r
2647   bits_buffer := 0;\r
2648   bits_left := 0;\r
2649   _cff_heap_length := 0;\r
2650   _cff_dictionary_length := 0;\r
2651 end;\r
2652 \r
2653 procedure expand__cff_dictionary(str: tSTRING);\r
2654 begin\r
2655   If (str[0] >= $0f0) then EXIT;\r
2656   Move(str,buf3[_cff_heap_length],str[0]+1);\r
2657   _cff_dictionary[_cff_dictionary_length] := Addr(buf3[_cff_heap_length]);\r
2658   Inc(_cff_dictionary_length);\r
2659   Inc(_cff_heap_length,str[0]+1);\r
2660 end;\r
2661 \r
2662 begin\r
2663   input_idx := 0;\r
2664   output_length := 0;\r
2665   cleanup;\r
2666   startup;\r
2667 \r
2668   Repeat\r
2669     new_code := get_code;\r
2670 \r
2671     // $00: end of data\r
2672     If (new_code = 0) then BREAK;\r
2673 \r
2674     // $01: end of block\r
2675     If (new_code = 1) then\r
2676       begin\r
2677         cleanup;\r
2678         startup;\r
2679         CONTINUE;\r
2680       end;\r
2681 \r
2682     // $02: expand code length\r
2683     If (new_code = 2) then\r
2684       begin\r
2685         Inc(code_length);\r
2686         CONTINUE;\r
2687       end;\r
2688 \r
2689     // $03: RLE\r
2690     If (new_code = 3) then\r
2691       begin\r
2692         old_code_length := code_length;\r
2693         code_length := 2;\r
2694         repeat_length := get_code+1;\r
2695         code_length := 4 SHL get_code;\r
2696         repeat_counter := get_code;\r
2697 \r
2698         For idx := 0 to PRED(repeat_counter*repeat_length) do\r
2699           begin\r
2700             tDUMMY_BUFF(output)[output_length] :=\r
2701               tDUMMY_BUFF(output)[output_length-repeat_length];\r
2702             Inc(output_length);\r
2703           end;\r
2704 \r
2705         code_length := old_code_length;\r
2706         startup;\r
2707         CONTINUE;\r
2708       end;\r
2709 \r
2710     If (new_code >= $104+_cff_dictionary_length) then\r
2711       begin\r
2712         Inc(the_string[0]);\r
2713         the_string[the_string[0]] := the_string[1];\r
2714       end\r
2715     else begin\r
2716            translate_code(new_code,temp_string);\r
2717            Inc(the_string[0]);\r
2718            the_string[the_string[0]] := temp_string[1];\r
2719          end;\r
2720 \r
2721     expand__cff_dictionary(the_string);\r
2722     translate_code(new_code,the_string);\r
2723 \r
2724     For idx := 0 to PRED(the_string[0]) do\r
2725       begin\r
2726         tDUMMY_BUFF(output)[output_length] := the_string[idx+1];\r
2727         Inc(output_length);\r
2728       end;\r
2729 \r
2730     old_code := new_code;\r
2731   until FALSE;\r
2732 \r
2733   LZTYR_decompress := output_length;\r
2734 end;\r
2735 \r
2736 begin\r
2737   {$i-}\r
2738   Assign(f,songdata_source);\r
2739   ResetF(f);\r
2740   {$i+}\r
2741   If (IOresult <> 0) then\r
2742     begin\r
2743       CloseF(f);\r
2744       EXIT;\r
2745     end;\r
2746 \r
2747   BlockReadF(f,header,SizeOf(header),temp);\r
2748   If NOT ((temp = SizeOf(header)) and (header.ident = id)) or\r
2749      (FileSize(f) > SizeOf(buf1)) then\r
2750     begin\r
2751       CloseF(f);\r
2752       EXIT;\r
2753     end;\r
2754 \r
2755   load_flag := $7f;\r
2756   If (header.cflag = 1) then\r
2757     begin\r
2758       FillChar(buf1,SizeOf(buf1),0);\r
2759       ResetF(f);\r
2760       BlockReadF(f,buf1,SizeOf(buf1),temp);\r
2761       If (IOresult <> 0) then\r
2762         begin\r
2763           CloseF(f);\r
2764           EXIT;\r
2765         end;\r
2766 \r
2767       CloseF(f);\r
2768       temp := LZTYR_decompress(buf1[$30],hash_buffer);\r
2769       out_size := temp;\r
2770 \r
2771       offs := SensitiveScan(hash_buffer,0,temp,ascii_blab);\r
2772       If (offs <> _PRE_ASCII_BLAB_SIZE) then\r
2773         begin\r
2774           EXIT;\r
2775         end;\r
2776 \r
2777       FillChar(buf1,SizeOf(buf1),0);\r
2778       Move(hash_buffer,headr2,SizeOf(headr2));\r
2779       Move(POINTER(Ofs(hash_buffer)+SizeOf(headr2))^,buf1,out_size-SizeOf(headr2));\r
2780     end\r
2781   else\r
2782     begin\r
2783       BlockReadF(f,headr2,SizeOf(headr2),temp);\r
2784       If NOT ((temp = SizeOf(headr2)) and (headr2.ascii = ascii_blab)) then\r
2785         begin\r
2786           CloseF(f);\r
2787           EXIT;\r
2788         end;\r
2789 \r
2790       FillChar(buf1,SizeOf(buf1),0);\r
2791       BlockReadF(f,buf1,SizeOf(buf1),temp);\r
2792       If (IOresult <> 0) then\r
2793         begin\r
2794           CloseF(f);\r
2795           EXIT;\r
2796         end;\r
2797       CloseF(f);\r
2798     end;\r
2799 \r
2800   init_songdata;\r
2801   load_flag := 0;\r
2802 \r
2803   songdata.patt_len := 64;\r
2804   If adjust_tracks then songdata.nm_tracks := 9\r
2805   else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
2806 \r
2807   tempo := 51;\r
2808   speed := 6;\r
2809 \r
2810   songdata.tempo := tempo;\r
2811   songdata.speed := speed;\r
2812 \r
2813   For temp2 := 0 to 64 do\r
2814     If (headr2.order[temp2] in [0..headr2.nopat]) then\r
2815       songdata.pattern_order[temp2] := headr2.order[temp2];\r
2816 \r
2817   For temp2 := 0 to 46 do\r
2818     begin\r
2819       import_hsc_instrument(temp2+1,headr2.instr[temp2].iData);\r
2820       songdata.instr_data[temp2+1].fine_tune := 0;\r
2821       songdata.instr_names[temp2+1] :=\r
2822         Copy(songdata.instr_names[temp2+1],1,9)+\r
2823         truncate_string(headr2.instr[temp2].iName);\r
2824     end;\r
2825 \r
2826   songdata.common_flag := songdata.common_flag OR 2;\r
2827   songdata.songname := CutStr(headr2.sname);\r
2828   songdata.composer := CutStr(headr2.writr);\r
2829   import_old_flags;\r
2830 \r
2831   import_cff_patterns(buf1,headr2.nopat);\r
2832   songdata_title := NameOnly(songdata_source);\r
2833   load_flag := 7;\r
2834 end;\r
2835 \r
2836 procedure import_standard_instrument(inst: Byte; var data);\r
2837 begin\r
2838   With songdata.instr_data[inst] do\r
2839     begin\r
2840       fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[0];\r
2841       fm_data.AM_VIB_EG_carrier   := tDUMMY_BUFF(data)[1];\r
2842       fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[2];\r
2843       fm_data.KSL_VOLUM_carrier   := tDUMMY_BUFF(data)[3];\r
2844       fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[4];\r
2845       fm_data.ATTCK_DEC_carrier   := tDUMMY_BUFF(data)[5];\r
2846       fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[6];\r
2847       fm_data.SUSTN_REL_carrier   := tDUMMY_BUFF(data)[7];\r
2848       fm_data.WAVEFORM_modulator  := tDUMMY_BUFF(data)[8]  AND 3;\r
2849       fm_data.WAVEFORM_carrier    := tDUMMY_BUFF(data)[9]  AND 3;\r
2850       fm_data.FEEDBACK_FM         := tDUMMY_BUFF(data)[10] AND $0f;\r
2851     end;\r
2852 \r
2853   songdata.instr_data[inst].panning := 0;\r
2854   songdata.instr_data[inst].fine_tune := 0;\r
2855 end;\r
2856 \r
2857 procedure dfm_file_loader;\r
2858 \r
2859 const\r
2860   id = 'DFM'+#26;\r
2861 \r
2862 var\r
2863   header: Record\r
2864             ident: array[1..4] of Char;\r
2865             versn: Word;\r
2866             sname: String[32];\r
2867             tempo: Byte;\r
2868             instn: array[1..32] of String[11];\r
2869             instd: array[1..32] of tFM_INST_DATA;\r
2870             order: array[1..128] of Byte;\r
2871             patts: Byte;\r
2872           end;\r
2873 \r
2874 var\r
2875   f: File;\r
2876   temp,temp2,temp3: Longint;\r
2877   pattern,line,channel,byte1,byte2: Byte;\r
2878 \r
2879 procedure import_dfm_event(patt,line,chan,byte1,byte2: Byte);\r
2880 \r
2881 var\r
2882   chunk: tCHUNK;\r
2883 \r
2884 begin\r
2885   FillChar(chunk,SizeOf(chunk),0);\r
2886   If (byte1 AND $0f in [1..12,15]) and ((byte1 SHR 4) AND 7 in [0..7]) then\r
2887     If (byte1 AND $0f <> 15) then\r
2888       chunk.note := SUCC(PRED(byte1 AND $0f)+((byte1 SHR 4) AND 7)*12)\r
2889     else chunk.note := BYTE_NULL;\r
2890 \r
2891   Case byte2 SHR 5 of\r
2892    { INSTRUMENT CHANGE }\r
2893     1: chunk.instr_def := SUCC(byte2 AND $1f);\r
2894 \r
2895    { SET INSTRUMENT VOLUME }\r
2896     2: begin\r
2897          chunk.effect_def := ef_SetInsVolume;\r
2898          chunk.effect := (byte2 AND $1f)*2;\r
2899        end;\r
2900 \r
2901    { TEMPO CHANGE }\r
2902     3: begin\r
2903          chunk.effect_def := ef_SetSpeed;\r
2904          chunk.effect := SUCC(byte2 AND $1f);\r
2905        end;\r
2906 \r
2907    { SLIDE UP }\r
2908     4: begin\r
2909          chunk.effect_def := ef_FSlideUpFine;\r
2910          chunk.effect := byte2 AND $1f;\r
2911        end;\r
2912 \r
2913    { SLIDE DOWN }\r
2914     5: begin\r
2915          chunk.effect_def := ef_FSlideDownFine;\r
2916          chunk.effect := byte2 AND $1f;\r
2917        end;\r
2918 \r
2919    { END OF PATTERN }\r
2920     7: chunk.effect_def := ef_PatternBreak;\r
2921   end;\r
2922 \r
2923   put_chunk(patt,line,chan,chunk);\r
2924 end;\r
2925 \r
2926 procedure process_dfm_patterns(patterns: Byte);\r
2927 \r
2928 var\r
2929   chunk: tCHUNK;\r
2930   temp2,temp3: Byte;\r
2931   order,patt: Byte;\r
2932   patts: String;\r
2933   instr_cache: array[1..18] of Byte;\r
2934 \r
2935 begin\r
2936   patts := '';\r
2937   FillChar(instr_cache,SizeOf(instr_cache),0);\r
2938   order := 0;\r
2939   patt := BYTE_NULL;\r
2940 \r
2941   Repeat\r
2942     If (songdata.pattern_order[order] >= $80) then Inc(order)\r
2943     else\r
2944       begin\r
2945         patt := songdata.pattern_order[order];\r
2946         For temp2 := 0 to $3f do\r
2947           For temp3 := 1 to 9 do\r
2948             begin\r
2949               get_chunk(patt,temp2,temp3,chunk);\r
2950               If (chunk.instr_def <> 0) then\r
2951                 begin\r
2952                   chunk.effect_def := ef_Extended;\r
2953                   chunk.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol;\r
2954                   instr_cache[temp3] := chunk.instr_def;\r
2955                   If NOT (chunk.note in [1..12*8+1]) and\r
2956                      NOT accurate_conv then\r
2957                     chunk.instr_def := 0;\r
2958                 end\r
2959               else If (chunk.note in [1..12*8+1]) and\r
2960                       (chunk.instr_def = 0) and NOT accurate_conv then\r
2961                      chunk.instr_def := instr_cache[temp3];\r
2962 \r
2963               If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then\r
2964                 put_chunk(patt,temp2,temp3,chunk);\r
2965             end;\r
2966         Inc(order);\r
2967         patts := patts+CHR(patt);\r
2968       end;\r
2969   until (patt >= patterns) or (order > $7f);\r
2970 end;\r
2971 \r
2972 begin\r
2973   {$i-}\r
2974   Assign(f,songdata_source);\r
2975   ResetF(f);\r
2976   {$i+}\r
2977   If (IOresult <> 0) then\r
2978     begin\r
2979       CloseF(f);\r
2980       EXIT;\r
2981     end;\r
2982 \r
2983   BlockReadF(f,header,SizeOf(header),temp);\r
2984   If NOT ((temp = SizeOf(header)) and (header.ident = id)) then\r
2985     begin\r
2986       CloseF(f);\r
2987       EXIT;\r
2988     end;\r
2989 \r
2990   load_flag := $7f;\r
2991   FillChar(buf1,SizeOf(buf1),0);\r
2992   BlockReadF(f,buf1,SizeOf(buf1),temp);\r
2993   If (IOresult <> 0) then\r
2994     begin\r
2995       CloseF(f);\r
2996       EXIT;\r
2997     end;\r
2998 \r
2999   init_songdata;\r
3000   load_flag := 0;\r
3001 \r
3002   songdata.patt_len := 64;\r
3003   If adjust_tracks then songdata.nm_tracks := 9\r
3004   else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
3005 \r
3006   tempo := 135;\r
3007   speed := SUCC(header.tempo);\r
3008 \r
3009   songdata.songname := CutStr(header.sname);\r
3010   songdata.tempo := tempo;\r
3011   songdata.speed := speed;\r
3012   songdata.common_flag := songdata.common_flag OR 1;\r
3013   songdata.common_flag := songdata.common_flag OR 2;\r
3014   songdata.common_flag := songdata.common_flag OR 8;\r
3015   songdata.common_flag := songdata.common_flag OR $10;\r
3016   import_old_flags;\r
3017 \r
3018   For temp2 := 1 to 128 do\r
3019     If (header.order[temp2] in [0..$7f]) then\r
3020       songdata.pattern_order[temp2-1] := header.order[temp2]\r
3021     else If (header.order[temp2] = $80) then BREAK\r
3022          else songdata.pattern_order[temp2-1] := $80+temp2;\r
3023 \r
3024   For temp2 := 1 to 32 do\r
3025     begin\r
3026       songdata.instr_names[temp2] :=\r
3027         Copy(songdata.instr_names[temp2],1,9)+\r
3028         CutStr(header.instn[temp2]);\r
3029       While (BYTE(songdata.instr_names[temp2][\r
3030                     Length(songdata.instr_names[temp2])]) < 32) and\r
3031             (Length(songdata.instr_names[temp2]) <> 0) do\r
3032         Delete(songdata.instr_names[temp2],\r
3033                Length(songdata.instr_names[temp2]),1);\r
3034       import_standard_instrument(temp2,header.instd[temp2]);\r
3035     end;\r
3036 \r
3037   temp2 := 0;\r
3038   temp3 := 0;\r
3039   Repeat\r
3040     pattern := buf1[temp2];\r
3041     If (pattern > 127) then\r
3042       begin\r
3043         CloseF(f);\r
3044         EXIT;\r
3045       end;\r
3046 \r
3047     Inc(temp2);\r
3048     Inc(temp3);\r
3049 \r
3050     For line := 0 to $3f do\r
3051       For channel := 1 to 9 do\r
3052         begin\r
3053           byte1 := buf1[temp2];\r
3054           If (temp2 >= temp) then\r
3055             begin\r
3056               CloseF(f);\r
3057               EXIT;\r
3058             end\r
3059           else Inc(temp2);\r
3060 \r
3061           If (byte1 OR $80 <> byte1) then byte2 := 0\r
3062           else begin\r
3063                  byte2 := buf1[temp2];\r
3064                  Inc(temp2);\r
3065                end;\r
3066           import_dfm_event(pattern,line,channel,byte1,byte2);\r
3067         end;\r
3068   until (temp2 >= temp);\r
3069 \r
3070   process_dfm_patterns(temp3);\r
3071   CloseF(f);\r
3072 \r
3073   songdata_title := NameOnly(songdata_source);\r
3074   load_flag := 8;\r
3075 end;\r
3076 \r
3077 type\r
3078   tHSC_PATTERNS = array[0..$31] of\r
3079                   array[0..$3f] of array[1..9] of Word;\r
3080 type\r
3081   tHSC_DATA = Record\r
3082                 instr: array[0..$7f] of array[0..$0b] of Byte;\r
3083                 order: array[0..$31] of Byte;\r
3084                 patts: tHSC_PATTERNS;\r
3085               end;\r
3086 \r
3087 procedure import_hsc_event(patt,line,chan: Byte; event: Word);\r
3088 \r
3089 var\r
3090   chunk: tCHUNK;\r
3091 \r
3092 begin\r
3093   FillChar(chunk,SizeOf(chunk),0);\r
3094   Case HI(event) of\r
3095   { REGULAR NOTE }\r
3096     1..12*8+1: If NOT fix_c_note_bug then chunk.note := HI(event)\r
3097                else begin\r
3098                       chunk.note := HI(event)+1;\r
3099                       If (chunk.note > 12*8+1) then\r
3100                         chunk.note := 12*8+1;\r
3101                     end;\r
3102   { PAUSE }\r
3103     $7f: chunk.note := BYTE_NULL;\r
3104 \r
3105   { INSTRUMENT }\r
3106     $80: begin\r
3107            chunk.effect_def := ef_Extended;\r
3108            chunk.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol;\r
3109            chunk.instr_def := LO(event)+1;\r
3110            chunk.note := BYTE_NULL;\r
3111          end;\r
3112   end;\r
3113 \r
3114   If (HI(event) <> $80) then\r
3115     Case (LO(event) AND $0f0) of\r
3116     { PATTERNBREAK }\r
3117       $00: If (LO(event) AND $0f = 1) then\r
3118              chunk.effect_def := ef_PatternBreak;\r
3119 \r
3120     { MANUAL SLIDE UP }\r
3121       $10: begin\r
3122              chunk.effect_def := ef_Extended2;\r
3123              chunk.effect := ef_ex2_FineTuneUp*16+\r
3124                              max(LO(event) AND $0f +1,15);\r
3125            end;\r
3126 \r
3127     { MANUAL SLIDE DOWN }\r
3128       $20: begin\r
3129              chunk.effect_def := ef_Extended2;\r
3130              chunk.effect := ef_ex2_FineTuneDown*16+\r
3131                              max(LO(event) AND $0f +1,15);\r
3132            end;\r
3133 \r
3134     { SET CARRIER VOLUME }\r
3135       $a0: begin\r
3136              chunk.effect_def := ef_SetCarrierVol;\r
3137              chunk.effect := 63-(LO(event) AND $0f)*4;\r
3138              chunk.instr_def := LO(event)+1;\r
3139            end;\r
3140 \r
3141     { SET MODULATOR VOLUME }\r
3142       $b0: begin\r
3143              chunk.effect_def := ef_SetModulatorVol;\r
3144              chunk.effect := 63-(LO(event) AND $0f)*4;\r
3145            end;\r
3146 \r
3147     { SET INSTRUMENT VOLUME }\r
3148       $c0: begin\r
3149              chunk.effect_def := ef_SetInsVolume;\r
3150              chunk.effect := 63-(LO(event) AND $0f)*4;\r
3151            end;\r
3152 \r
3153     { SET SPEED }\r
3154       $f0: begin\r
3155              chunk.effect_def := ef_SetSpeed;\r
3156              chunk.effect := (LO(event) AND $0f)+1;\r
3157            end;\r
3158     end;\r
3159   put_chunk(patt,line,chan,chunk);\r
3160 end;\r
3161 \r
3162 procedure import_hsc_patterns(var data; patterns: Byte);\r
3163 \r
3164 var\r
3165   voice: array[1..9] of Byte;\r
3166   event: Word;\r
3167   chunk: tCHUNK;\r
3168   temp,temp2,temp3: Byte;\r
3169   order,patt: Byte;\r
3170   patt_break: Byte;\r
3171   patts: String;\r
3172 \r
3173 function _hsc_event(patt,line,chan: Byte): Word;\r
3174 begin\r
3175   _hsc_event := LO(tHSC_PATTERNS(data)[patt][line][chan+1])+\r
3176                 HI(tHSC_PATTERNS(data)[patt][line][chan]) SHL 8;\r
3177 end;\r
3178 \r
3179 begin { import_hsc_patterns }\r
3180   patts := '';\r
3181   If NOT accurate_conv then\r
3182        For temp := 1 to 9 do voice[temp] := temp\r
3183   else For temp := 1 to 9 do voice[temp] := 0;\r
3184 \r
3185   For temp := 0 to $31 do\r
3186     For temp2 := 0 to $3f do\r
3187       For temp3 := 1 to 9 do\r
3188         If (_hsc_event(temp,temp2,temp3) <> 0) then\r
3189           import_hsc_event(temp,temp2,temp3,_hsc_event(temp,temp2,temp3));\r
3190 \r
3191   order := 0;\r
3192   patt := BYTE_NULL;\r
3193 \r
3194   Repeat\r
3195     If (songdata.pattern_order[order] > $31) then Inc(order)\r
3196     else\r
3197       begin\r
3198         patt := songdata.pattern_order[order];\r
3199         patt_break := BYTE_NULL;\r
3200         For temp2 := 0 to $3f do\r
3201           For temp3 := 1 to 9 do\r
3202             begin\r
3203               get_chunk(patt,temp2,temp3,chunk);\r
3204               event := _hsc_event(patt,temp2,temp3);\r
3205 \r
3206               Case HI(event) of\r
3207               { REGULAR NOTE }\r
3208                 1..12*8+1: begin\r
3209                              If accurate_conv then\r
3210                                If (voice[temp3] = 0) then\r
3211                                  begin\r
3212                                    voice[temp3] := temp3;\r
3213                                    chunk.instr_def := voice[temp3];\r
3214                                  end;\r
3215 \r
3216                              If NOT accurate_conv then\r
3217                                chunk.instr_def := voice[temp3];\r
3218                            end;\r
3219 \r
3220               { INSTRUMENT }\r
3221                 $80: If (temp2 <> patt_break) then\r
3222                        begin\r
3223                          voice[temp3] := LO(event)+1;\r
3224                          If NOT accurate_conv then\r
3225                            begin\r
3226                              chunk.instr_def := voice[temp3];\r
3227                              chunk.note := BYTE_NULL;\r
3228                            end;\r
3229                        end;\r
3230               end;\r
3231 \r
3232               If (HI(event) <> $80) then\r
3233                 Case (LO(event) AND $0f0) of\r
3234                 { PATTERNBREAK }\r
3235                   $00: If (LO(event) AND $0f = 1) then\r
3236                          patt_break := temp2+1;\r
3237 \r
3238                 { SET CARRIER VOLUME }\r
3239                   $a0: If (chunk.instr_def = 0) and NOT accurate_conv then\r
3240                          chunk.instr_def := voice[temp3]\r
3241                        else If (chunk.instr_def = 0) and\r
3242                                (voice[temp3] = 0) then chunk.instr_def := temp3;\r
3243 \r
3244                 { SET MODULATOR VOLUME }\r
3245                   $b0: If (chunk.instr_def = 0) and NOT accurate_conv then\r
3246                          chunk.instr_def := voice[temp3]\r
3247                        else If (chunk.instr_def = 0) and\r
3248                                (voice[temp3] = 0) then chunk.instr_def := temp3;\r
3249 \r
3250                 { SET INSTRUMENT VOLUME }\r
3251                   $c0: If (chunk.instr_def = 0) and NOT accurate_conv then\r
3252                          chunk.instr_def := voice[temp3]\r
3253                        else If (chunk.instr_def = 0) and\r
3254                                (voice[temp3] = 0) then chunk.instr_def := temp3;\r
3255                 end;\r
3256 \r
3257               If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then\r
3258                 put_chunk(patt,temp2,temp3,chunk);\r
3259             end;\r
3260         Inc(order);\r
3261         patts := patts+CHR(patt);\r
3262       end;\r
3263   until (patt >= patterns) or (order > $7f);\r
3264 end;\r
3265 \r
3266 procedure import_hsc_instrument(inst: Byte; var data);\r
3267 begin\r
3268   With songdata.instr_data[inst] do\r
3269     begin\r
3270       fm_data.AM_VIB_EG_carrier   := tDUMMY_BUFF(data)[0];\r
3271       fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[1];\r
3272       fm_data.KSL_VOLUM_carrier   := tDUMMY_BUFF(data)[2];\r
3273       fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[3];\r
3274       fm_data.ATTCK_DEC_carrier   := tDUMMY_BUFF(data)[4];\r
3275       fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[5];\r
3276       fm_data.SUSTN_REL_carrier   := tDUMMY_BUFF(data)[6];\r
3277       fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[7];\r
3278       fm_data.FEEDBACK_FM         := tDUMMY_BUFF(data)[8]  AND $0f;\r
3279       fm_data.WAVEFORM_carrier    := tDUMMY_BUFF(data)[9]  AND 3;\r
3280       fm_data.WAVEFORM_modulator  := tDUMMY_BUFF(data)[10] AND 3;\r
3281     end;\r
3282 \r
3283   songdata.instr_data[inst].panning := 0;\r
3284   songdata.instr_data[inst].fine_tune := tDUMMY_BUFF(data)[11] SHR 4;\r
3285 end;\r
3286 \r
3287 var\r
3288   hscbuf: tHSC_DATA;\r
3289 \r
3290 procedure hsc_file_loader;\r
3291 \r
3292 const\r
3293   HSC_KSL: array[0..3] of Byte = (0,3,2,1);\r
3294 \r
3295 var\r
3296   f: File;\r
3297   temp,temp2,temp3: Longint;\r
3298 \r
3299 begin\r
3300   If (Lower(ExtOnly(songdata_source)) <> 'hsc') then\r
3301     begin\r
3302       load_flag := $7f;\r
3303       EXIT;\r
3304     end;\r
3305 \r
3306   {$i-}\r
3307   Assign(f,songdata_source);\r
3308   ResetF(f);\r
3309   {$i+}\r
3310   If (IOresult <> 0) then\r
3311     begin\r
3312       CloseF(f);\r
3313       EXIT;\r
3314     end;\r
3315 \r
3316   FillChar(hscbuf,SizeOf(hscbuf),0);\r
3317   BlockReadF(f,hscbuf,SizeOf(hscbuf),temp);\r
3318   If (temp < SizeOf(hscbuf.instr)+SizeOf(hscbuf.order)) then\r
3319     begin\r
3320       CloseF(f);\r
3321       EXIT;\r
3322     end;\r
3323 \r
3324   For temp2 := 0 to $31 do\r
3325     If (hscbuf.order[temp2] > $b0) then hscbuf.order[temp2] := $080;\r
3326 \r
3327   temp3 := 0;\r
3328   While (temp3 < temp-SizeOf(hscbuf.instr)-SizeOf(hscbuf.order)) do\r
3329     begin\r
3330       If NOT (tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3+1] in\r
3331              [1..12*8+1,$00,$7f,$80]) or\r
3332          NOT (tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3] AND $0f0 in\r
3333              [$00,$10,$20,$a0,$b0,$c0,$f0]) then\r
3334         begin\r
3335           If NOT (tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3+1] in\r
3336                  [1..12*8+1,$00,$7f,$80]) then\r
3337             tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3+1] := $00;\r
3338 \r
3339           If NOT (tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3] AND $0f0 in\r
3340                  [$00,$10,$20,$a0,$b0,$c0,$f0]) then\r
3341             tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3] := 0;\r
3342         end;\r
3343       Inc(temp3,2);\r
3344     end;\r
3345 \r
3346   init_songdata;\r
3347   load_flag := 0;\r
3348 \r
3349   songdata.patt_len := 64;\r
3350   If adjust_tracks then songdata.nm_tracks := 9\r
3351   else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
3352 \r
3353   tempo := 18;\r
3354   speed := 2;\r
3355 \r
3356   songdata.common_flag := songdata.common_flag OR 2;\r
3357   songdata.tempo := tempo;\r
3358   songdata.speed := speed;\r
3359   import_old_flags;\r
3360 \r
3361   For temp2 := 0 to $31 do\r
3362     songdata.pattern_order[temp2] := hscbuf.order[temp2];\r
3363 \r
3364   import_hsc_patterns(hscbuf.patts,(temp-SizeOf(hscbuf.instr)\r
3365                                         -SizeOf(hscbuf.order)-1) DIV $480);\r
3366 \r
3367 // specific corrections for HSC-Tracker instrument\r
3368   For temp2 := 0 to $7f do\r
3369     begin\r
3370       import_hsc_instrument(temp2+1,hscbuf.instr[temp2]);\r
3371       With songdata.instr_data[temp2+1].fm_data do\r
3372         begin\r
3373           KSL_VOLUM_modulator := KSL_VOLUM_modulator AND $3f+\r
3374                                  HSC_KSL[KSL_VOLUM_modulator SHR 6] SHL 6;\r
3375           KSL_VOLUM_carrier   := KSL_VOLUM_carrier AND $3f+\r
3376                                  HSC_KSL[KSL_VOLUM_carrier SHR 6] SHL 6;\r
3377         end;\r
3378     end;\r
3379 \r
3380   CloseF(f);\r
3381   songdata_title := NameOnly(songdata_source);\r
3382   load_flag := 9;\r
3383 end;\r
3384 \r
3385 type\r
3386   tMTK_DATA = Record\r
3387                 sname: String[33];\r
3388                 compo: String[33];\r
3389                 instn: array[0..$7f] of String[33];\r
3390                 instt: array[0..$7f] of array[0..$0b] of Byte;\r
3391                 order: array[0..$7f] of Byte;\r
3392                 patts: tHSC_PATTERNS;\r
3393                 dummy: Byte;\r
3394               end;\r
3395 \r
3396 var\r
3397   buffer2: tMTK_DATA;\r
3398 \r
3399 procedure mtk_file_loader;\r
3400 \r
3401 var\r
3402   f: File;\r
3403   temp,temp2: Longint;\r
3404   crc: Word;\r
3405   old_c_fix: Boolean;\r
3406 \r
3407 const\r
3408   id = 'mpu401tr\92kkîr@data';\r
3409 \r
3410 var\r
3411   header: Record\r
3412             id_string: array[1..18] of Char;\r
3413             crc_16bit: Word;\r
3414             data_size: Word;\r
3415           end;\r
3416 begin\r
3417   {$i-}\r
3418   Assign(f,songdata_source);\r
3419   ResetF(f);\r
3420   {$i+}\r
3421   If (IOresult <> 0) then\r
3422     begin\r
3423       CloseF(f);\r
3424       EXIT;\r
3425     end;\r
3426 \r
3427   BlockReadF(f,header,SizeOf(header),temp);\r
3428   If NOT ((temp = SizeOf(header)) and (header.id_string = id)) then\r
3429     begin\r
3430       CloseF(f);\r
3431       EXIT;\r
3432     end;\r
3433 \r
3434   load_flag := $7f;\r
3435   FillChar(buf1,SizeOf(buf1),0);\r
3436   BlockReadF(f,buf1,SizeOf(buf1),temp);\r
3437 \r
3438   crc := 0;\r
3439   crc := Update16(buf1,temp,crc);\r
3440   If (crc <> header.crc_16bit) then\r
3441     begin\r
3442       CloseF(f);\r
3443       EXIT;\r
3444     end;\r
3445 \r
3446   FillChar(buffer2,SizeOf(buffer2),0);\r
3447   temp2 := RDC_decompress(buf1,buffer2,temp);\r
3448   If NOT (temp2 = header.data_size) then\r
3449     begin\r
3450       CloseF(f);\r
3451       EXIT;\r
3452     end;\r
3453 \r
3454   init_songdata;\r
3455   load_flag := 0;\r
3456 \r
3457   songdata.patt_len := 64;\r
3458   If adjust_tracks then songdata.nm_tracks := 9\r
3459   else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
3460 \r
3461   tempo := 18;\r
3462   speed := 2;\r
3463 \r
3464   songdata.common_flag := songdata.common_flag OR 2;\r
3465   songdata.tempo := tempo;\r
3466   songdata.speed := speed;\r
3467   import_old_flags;\r
3468 \r
3469   For temp2 := 0 to $31 do\r
3470     If (buffer2.order[temp2] <> $ff) then songdata.pattern_order[temp2] := buffer2.order[temp2]\r
3471     else songdata.pattern_order[temp2] := $080;\r
3472 \r
3473   old_c_fix := fix_c_note_bug;\r
3474   fix_c_note_bug := FALSE;\r
3475   import_hsc_patterns(buffer2.patts,\r
3476                      (header.data_size-SizeOf(buffer2.sname)\r
3477                                       -SizeOf(buffer2.compo)\r
3478                                       -SizeOf(buffer2.instn)\r
3479                                       -SizeOf(buffer2.instt)\r
3480                                       -SizeOf(buffer2.order)-1) DIV $480);\r
3481   fix_c_note_bug := old_c_fix;\r
3482 \r
3483 // specific corrections for MPU-401 TR\92KKîR instrument\r
3484   For temp2 := 0 to $7f do\r
3485     begin\r
3486       import_hsc_instrument(temp2+1,buffer2.instt[temp2]);\r
3487       With songdata.instr_data[temp2+1].fm_data do\r
3488         begin\r
3489           If (KSL_VOLUM_modulator > 128) then\r
3490             KSL_VOLUM_modulator := KSL_VOLUM_modulator DIV 3;\r
3491           If (KSL_VOLUM_carrier > 128) then\r
3492             KSL_VOLUM_carrier := KSL_VOLUM_carrier DIV 3;\r
3493         end;\r
3494 \r
3495       songdata.instr_names[temp2+1] :=\r
3496         Copy(songdata.instr_names[temp2+1],1,9)+\r
3497         truncate_string(Copy(buffer2.instn[temp2],10,32));\r
3498     end;\r
3499 \r
3500   songdata.songname := CutStr(buffer2.sname);\r
3501   songdata.composer := CutStr(buffer2.compo);\r
3502 \r
3503   CloseF(f);\r
3504   songdata_title := NameOnly(songdata_source);\r
3505   load_flag := 10;\r
3506 end;\r
3507 \r
3508 procedure rad_file_loader;\r
3509 \r
3510 const\r
3511   id = 'RAD by REALiTY!!';\r
3512 \r
3513 var\r
3514   header: Record\r
3515             ident: array[1..16] of Char; { Use this to recognize a RAD tune }\r
3516             rmver: Byte;                 { Version of RAD file (10h) }\r
3517             xbyte: Byte;       { bit7      Set if a description follows }\r
3518           end;                 { bit6      Set if it's a "slow-timer" tune }\r
3519                                { bit[4..0] The initial speed of the tune }\r
3520 var\r
3521   f: File;\r
3522   dscbuf: array[0..PRED(80*22)] of Char;\r
3523   pattoffs: array[0..$1f] of Word;\r
3524   temp,temp2,temp3,temp4,temp5,offs0: Longint;\r
3525 \r
3526 procedure import_rad_event(pattern,line,channel,byte1,byte2,byte3: Byte);\r
3527 \r
3528 var\r
3529   chunk: tCHUNK;\r
3530 \r
3531 begin\r
3532   FillChar(chunk,SizeOf(chunk),0);\r
3533   If ((byte2 SHR 4)+(byte1 SHR 7) SHL 4 <> 0) then\r
3534     chunk.instr_def := (byte2 SHR 4)+(byte1 SHR 7) SHL 4;\r
3535 \r
3536   If (byte1 AND $0f in [1..12]) then chunk.note := 12*((byte1 SHR 4) AND 7)+(byte1 AND $0f)+1\r
3537   else If (byte1 AND $0f = $0f) then chunk.note := BYTE_NULL;\r
3538 \r
3539   Case byte2 AND $0f of\r
3540   { PORTAMENTO (FREQUENCY SLIDE) UP }\r
3541     $01: begin\r
3542            chunk.effect_def := ef_FSlideUp;\r
3543            chunk.effect := byte3;\r
3544          end;\r
3545 \r
3546   { PORTAMENTO (FREQUENCY SLIDE) DOWN }\r
3547     $02: begin\r
3548            chunk.effect_def := ef_FSlideDown;\r
3549            chunk.effect := byte3;\r
3550          end;\r
3551 \r
3552   { PORTAMENTO TO NOTE }\r
3553     $03: begin\r
3554            chunk.effect_def := ef_TonePortamento;\r
3555            chunk.effect := byte3;\r
3556          end;\r
3557 \r
3558   { PORTAMENTO TO NOTE WITH VOLUME SLIDE }\r
3559     $05: If (byte3 in [1..49]) then\r
3560            begin\r
3561              chunk.effect_def := ef_TPortamVolSlide;\r
3562              chunk.effect := max(byte3,15);\r
3563 \r
3564              If (byte3 > 15) then\r
3565                begin\r
3566                  chunk.effect_def2 := ef_TPortamVolSlide;\r
3567                  chunk.effect2 := max(byte3-15,15);\r
3568                end;\r
3569            end\r
3570          else If (byte3 in [51..99]) then\r
3571                 begin\r
3572                   chunk.effect_def := ef_TPortamVolSlide;\r
3573                   chunk.effect := max(byte3-50,15)*16;\r
3574 \r
3575                   If (byte3-50 > 15) then\r
3576                     begin\r
3577                       chunk.effect_def2 := ef_TPortamVolSlide;\r
3578                       chunk.effect2 := max(byte3-50-15,15);\r
3579                     end;\r
3580                 end;\r
3581 \r
3582   { VOLUME SLIDE }\r
3583     $0a: If (byte3 in [1..49]) then\r
3584            begin\r
3585              chunk.effect_def := ef_VolSlide;\r
3586              chunk.effect := max(byte3,15);\r
3587 \r
3588              If (byte3 > 15) then\r
3589                begin\r
3590                  chunk.effect_def2 := ef_VolSlide;\r
3591                  chunk.effect2 := max(byte3-15,15);\r
3592                end;\r
3593            end\r
3594          else If (byte3 in [51..99]) then\r
3595                 begin\r
3596                   chunk.effect_def := ef_VolSlide;\r
3597                   chunk.effect := max(byte3-50,15)*16;\r
3598 \r
3599                   If (byte3-50 > 15) then\r
3600                     begin\r
3601                       chunk.effect_def2 := ef_VolSlide;\r
3602                       chunk.effect2 := max(byte3-50-15,15);\r
3603                     end;\r
3604                 end;\r
3605 \r
3606   { SET VOLUME }\r
3607     $0c: begin\r
3608            chunk.effect_def := ef_SetInsVolume;\r
3609            If (byte3 < 64) then chunk.effect := byte3\r
3610            else chunk.effect := 63;\r
3611          end;\r
3612 \r
3613   { JUMP TO NEXT PATTERN IN ORDER LIST }\r
3614     $0d: begin\r
3615            chunk.effect_def := ef_PatternBreak;\r
3616            If (byte3 < 64) then chunk.effect := byte3\r
3617            else chunk.effect := 63;\r
3618          end;\r
3619 \r
3620   { SET SPEED }\r
3621     $0f: begin\r
3622            chunk.effect_def := ef_SetSpeed;\r
3623            chunk.effect := byte3;\r
3624          end;\r
3625   end;\r
3626 \r
3627 // specific corrections for RAd-Tracker event\r
3628   If (chunk.effect_def in [ef_TonePortamento,\r
3629                            ef_TPortamVolSlide]) and\r
3630      (chunk.note = BYTE_NULL) then chunk.note := 0;\r
3631   If (chunk.effect_def in [ef_TonePortamento,\r
3632                            ef_TPortamVolSlide]) then chunk.instr_def := 0;\r
3633   If (chunk.note = 0) then chunk.instr_def := 0;\r
3634   put_chunk(pattern,line,channel+1,chunk);\r
3635 end;\r
3636 \r
3637 \r
3638 begin\r
3639   {$i-}\r
3640   Assign(f,songdata_source);\r
3641   ResetF(f);\r
3642   {$i+}\r
3643   If (IOresult <> 0) then\r
3644     begin\r
3645       CloseF(f);\r
3646       EXIT;\r
3647     end;\r
3648 \r
3649   BlockReadF(f,header,SizeOf(header),temp);\r
3650   If NOT ((temp = SizeOf(header)) and (header.ident = id)) then\r
3651     begin\r
3652       CloseF(f);\r
3653       EXIT;\r
3654     end;\r
3655 \r
3656   load_flag := $7f;\r
3657   FillChar(buf1,SizeOf(buf1),0);\r
3658   BlockReadF(f,buf1,SizeOf(buf1),temp);\r
3659   If (IOresult <> 0) then\r
3660     begin\r
3661       CloseF(f);\r
3662       EXIT;\r
3663     end;\r
3664 \r
3665   temp2 := 0;\r
3666   offs0 := SizeOf(header);\r
3667 \r
3668   If (header.xbyte OR $80 = header.xbyte) then\r
3669     begin\r
3670       While (temp2 < temp) and (buf1[temp2] <> 0) do Inc(temp2);\r
3671       If (temp2 >= temp) then\r
3672         begin\r
3673           CloseF(f);\r
3674           EXIT;\r
3675         end;\r
3676 \r
3677       Inc(offs0,temp2+1);\r
3678       Dec(temp,temp2+1);\r
3679       Move(buf1,dscbuf,temp2+1);\r
3680       Move(buf1[temp2+1],buf1,temp);\r
3681     end;\r
3682 \r
3683 \r
3684   init_songdata;\r
3685   load_flag := 0;\r
3686 \r
3687   songdata.patt_len := 64;\r
3688   If adjust_tracks then songdata.nm_tracks := 9\r
3689   else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
3690 \r
3691   If (header.xbyte OR $40 = header.xbyte) then tempo := 18\r
3692   else tempo := 50;\r
3693 \r
3694   If (header.xbyte AND $1f in [1..31]) then speed := header.xbyte AND $1f\r
3695   else speed := 2;\r
3696 \r
3697   songdata.tempo := tempo;\r
3698   songdata.speed := speed;\r
3699 \r
3700   temp2 := 0;\r
3701   Repeat\r
3702     temp3 := buf1[temp2];\r
3703     Inc(temp2);\r
3704     If (temp3 <> 0) and (temp2+11 < temp) then\r
3705       begin\r
3706         import_hsc_instrument(temp3,buf1[temp2]);\r
3707         songdata.instr_data[temp3].fine_tune := 0;\r
3708         Inc(temp2,11);\r
3709       end;\r
3710   until (temp3 = 0) or (temp3 >= temp);\r
3711 \r
3712   Inc(offs0,temp2);\r
3713   Dec(temp,temp2);\r
3714   Move(buf1[temp2],buf1,temp);\r
3715 \r
3716   Inc(offs0,buf1[0]+1);\r
3717   If (buf1[0] <> 0) then\r
3718     Move(buf1[1],songdata.pattern_order,buf1[0]);\r
3719 \r
3720   Inc(offs0,32*SizeOf(WORD));\r
3721   Dec(temp,buf1[0]+1+32*SizeOf(WORD));\r
3722 \r
3723   Move(buf1[buf1[0]+1],pattoffs,32*SizeOf(WORD));\r
3724   Move(buf1[buf1[0]+32*SizeOf(WORD)+1],buf1,temp);\r
3725 \r
3726   temp5 := temp;\r
3727   For temp := 0 to 31 do\r
3728     begin\r
3729       temp2 := 0;\r
3730       temp3 := 0;\r
3731       If (pattoffs[temp] <> 0) and\r
3732          (pattoffs[temp] <= FileSize(f)) then\r
3733         Repeat\r
3734           temp2 := buf1[pattoffs[temp]-offs0+temp3];\r
3735           Repeat\r
3736             Inc(temp3);\r
3737             temp4 := buf1[pattoffs[temp]-offs0+temp3];\r
3738             If (buf1[pattoffs[temp]-offs0+temp3+2] AND $0f <> 0) then\r
3739               begin\r
3740                 If (temp4 AND $0f in [0..8]) then\r
3741                   import_rad_event(temp,temp2 AND $3f,temp4 AND $0f,\r
3742                                    buf1[pattoffs[temp]-offs0+temp3+1],\r
3743                                    buf1[pattoffs[temp]-offs0+temp3+2],\r
3744                                    buf1[pattoffs[temp]-offs0+temp3+3]);\r
3745                 Inc(temp3,3);\r
3746               end\r
3747             else begin\r
3748                    If (temp4 AND $0f in [0..8]) then\r
3749                      import_rad_event(temp,temp2 AND $3f,temp4 AND $0f,\r
3750                                       buf1[pattoffs[temp]-offs0+temp3+1],\r
3751                                       buf1[pattoffs[temp]-offs0+temp3+2],\r
3752                                       0);\r
3753                    Inc(temp3,2);\r
3754                  end;\r
3755           until (temp4 OR $80 = temp4) or (temp3 > temp5);\r
3756           Inc(temp3);\r
3757         until (temp2 OR $80 = temp2) or (temp3 > temp5);\r
3758     end;\r
3759 \r
3760   CloseF(f);\r
3761   songdata_title := NameOnly(songdata_source);\r
3762   load_flag := 11;\r
3763 end;\r
3764 \r
3765 const\r
3766   temp_ef_Arpeggio = $0f0;\r
3767   temp_ef_rep      = $0f1;\r
3768   temp_ef_XFVSlide = $0f2;\r
3769 \r
3770 var\r
3771   ins_c4factor: array[1..99] of Shortint;\r
3772 \r
3773 procedure fix_s3m_commands(patterns: Byte);\r
3774 \r
3775 var\r
3776   chunk,chunk2: tCHUNK;\r
3777   temp,temp4: Byte;\r
3778   patt_break: Byte;\r
3779   order,patt: Byte;\r
3780   patts: String;\r
3781   ins_cache,\r
3782   misc_cache,\r
3783   arpg_cache,\r
3784   volsld_cache,\r
3785   slide_cache,\r
3786   note_cache,\r
3787   patloop_cache: array[1..20] of Byte;\r
3788   prev_cache: array[1..20] of Record\r
3789                                 effect_def,\r
3790                                 effect,\r
3791                                 effect_def2,\r
3792                                 effect2: Byte;\r
3793                               end;\r
3794 \r
3795 procedure fix_single_pattern(patt: Byte);\r
3796 \r
3797 var\r
3798   temp2,temp3: Byte;\r
3799 \r
3800 begin\r
3801   FillChar(prev_cache,SizeOf(prev_cache),0);\r
3802   FillChar(patloop_cache,SizeOf(patloop_cache),BYTE_NULL);\r
3803   patt_break := BYTE_NULL;\r
3804 \r
3805   For temp2 := 0 to $3f do\r
3806     For temp3 := 1 to 20 do\r
3807       begin\r
3808         get_chunk(patt,temp2,temp3,chunk);\r
3809         If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) then\r
3810           patt_break := temp2;\r
3811 \r
3812         If (chunk.instr_def <> 0) and (temp2 <= patt_break) then\r
3813           ins_cache[temp3] := chunk.instr_def;\r
3814 \r
3815         If (chunk.note in [1..12*8+1]) and (temp2 <= patt_break) then\r
3816           note_cache[temp3] := chunk.note;\r
3817 \r
3818         If (chunk.instr_def <> 0) or ((chunk.instr_def = 0) and\r
3819                                       (chunk.note in [1..12*8+1]) and\r
3820                                       (ins_cache[temp3] <> 0)) then\r
3821           begin\r
3822             If (chunk.instr_def <> 0) then temp4 := chunk.instr_def\r
3823             else temp4 := ins_cache[temp3];\r
3824             If (ins_c4factor[temp4] <> 0) and\r
3825                NOT (Pos(CHR(songdata.pattern_order[order]),patts) <> 0) then\r
3826               begin\r
3827                 If (ins_c4factor[temp4] <> -127) then\r
3828                   chunk.note := min(max(chunk.note+ins_c4factor[temp4],12*8+1),1)\r
3829                 else chunk.note := 1;\r
3830                 put_chunk(patt,temp2,temp3,chunk);\r
3831               end;\r
3832           end;\r
3833 \r
3834         If (chunk.effect_def = ef_Extended) and\r
3835            (chunk.effect DIV 16 = ef_ex_PatternLoop) and\r
3836            (chunk.effect MOD 16 <> 0) then\r
3837           If NOT (patloop_cache[temp3] in [0,BYTE_NULL]) and (temp2 <> 0) then\r
3838             begin\r
3839               If (prev_cache[temp3].effect_def = 0) and\r
3840                  (prev_cache[temp3].effect = 0) then\r
3841                 begin\r
3842                   get_chunk(patt,PRED(temp2),temp3,chunk2);\r
3843                   chunk2.effect_def := ef_Extended;\r
3844                   chunk2.effect := ef_ex_PatternLoop*16;\r
3845                   If NOT ((chunk2.effect_def = chunk2.effect_def2) and\r
3846                           (chunk2.effect = chunk2.effect2)) then\r
3847                     begin\r
3848                       put_chunk(patt,PRED(temp2),temp3,chunk2);\r
3849                       prev_cache[temp3].effect_def := chunk.effect_def;\r
3850                       prev_cache[temp3].effect := chunk.effect;\r
3851                     end;\r
3852                 end\r
3853               else If (prev_cache[temp3].effect_def2 = 0) and\r
3854                       (prev_cache[temp3].effect2 = 0) then\r
3855                      begin\r
3856                        get_chunk(patt,PRED(temp2),temp3,chunk2);\r
3857                        chunk2.effect_def2 := ef_Extended;\r
3858                        chunk2.effect2 := ef_ex_PatternLoop*16;\r
3859                        If NOT ((chunk2.effect_def2 = chunk2.effect_def) and\r
3860                                (chunk2.effect2 = chunk2.effect)) then\r
3861                          begin\r
3862                            put_chunk(patt,PRED(temp2),temp3,chunk2);\r
3863                            prev_cache[temp3].effect_def2 := chunk.effect_def2;\r
3864                            prev_cache[temp3].effect2 := chunk.effect2;\r
3865                          end;\r
3866                      end;\r
3867             end\r
3868           else If (patloop_cache[temp3] <> 0) and (temp2 <> 0) then\r
3869                  begin\r
3870                    get_chunk(patt,0,temp3,chunk2);\r
3871                    If (chunk2.effect_def = 0) and\r
3872                       (chunk2.effect = 0) then\r
3873                      begin\r
3874                        chunk2.effect_def := ef_Extended;\r
3875                        chunk2.effect := ef_ex_PatternLoop*16;\r
3876                        If NOT ((chunk2.effect_def = chunk2.effect_def2) and\r
3877                                (chunk2.effect = chunk2.effect2)) then\r
3878                          put_chunk(patt,0,temp3,chunk2);\r
3879                      end\r
3880                    else If (chunk2.effect_def2 = 0) and\r
3881                            (chunk2.effect2 = 0) then\r
3882                           begin\r
3883                             chunk2.effect_def2 := ef_Extended;\r
3884                             chunk2.effect2 := ef_ex_PatternLoop*16;\r
3885                             If NOT ((chunk2.effect_def2 = chunk2.effect_def) and\r
3886                                     (chunk2.effect2 = chunk2.effect)) then\r
3887                               put_chunk(patt,0,temp3,chunk2);\r
3888                           end;\r
3889                  end;\r
3890 \r
3891         If (temp2 <= patt_break) then\r
3892           begin\r
3893             If (chunk.effect DIV 16 <> 0) then\r
3894               misc_cache[temp3] := chunk.effect AND $0f0+\r
3895                                    misc_cache[temp3] AND $0f\r
3896             else If (chunk.effect_def in [ef_Vibrato,\r
3897                                           ef_ExtraFineVibrato,\r
3898                                           ef_Tremolo,\r
3899                                           ef_Tremor,\r
3900                                           ef_MultiRetrigNote]) then\r
3901                    begin\r
3902                      chunk.effect := misc_cache[temp3] AND $0f0+\r
3903                                      chunk.effect AND $0f;\r
3904                      put_chunk(patt,temp2,temp3,chunk);\r
3905                    end;\r
3906 \r
3907             If (chunk.effect MOD 16 <> 0) then\r
3908               misc_cache[temp3] := misc_cache[temp3] AND $0f0+\r
3909                                    chunk.effect AND $0f\r
3910             else If (chunk.effect_def in [ef_Vibrato,\r
3911                                           ef_ExtraFineVibrato,\r
3912                                           ef_Tremolo,\r
3913                                           ef_Tremor,\r
3914                                           ef_MultiRetrigNote]) then\r
3915                    begin\r
3916                      chunk.effect := chunk.effect AND $0f0+\r
3917                                      misc_cache[temp3] AND $0f;\r
3918                      put_chunk(patt,temp2,temp3,chunk);\r
3919                    end;\r
3920 \r
3921             If (chunk.effect_def = temp_ef_Arpeggio) then\r
3922               If (chunk.effect <> 0) then arpg_cache[temp3] := chunk.effect\r
3923               else begin\r
3924                      chunk.effect := arpg_cache[temp3];\r
3925                      put_chunk(patt,temp2,temp3,chunk);\r
3926                    end;\r
3927 \r
3928             If (chunk.effect_def in [ef_FSlideDown,ef_FSlideDownFine,\r
3929                                      ef_FSlideUp,ef_FSlideUpFine,\r
3930                                      ef_TonePortamento]) then\r
3931               If (chunk.effect <> 0) then slide_cache[temp3] := chunk.effect\r
3932               else begin\r
3933                      chunk.effect := slide_cache[temp3];\r
3934                      put_chunk(patt,temp2,temp3,chunk);\r
3935                    end;\r
3936 \r
3937          // experimental method to fix up frequency slide\r
3938             If (chunk.effect_def in [ef_FSlideDown,ef_FSlideDownFine,\r
3939                                      ef_FSlideUp,ef_FSlideUpFine,\r
3940                                      ef_Vibrato,\r
3941                                      ef_ExtraFineVibrato,\r
3942                                      ef_TonePortamento]) then\r
3943               If (note_cache[temp3] <> 0) then\r
3944                 begin\r
3945                   If (chunk.effect_def in [ef_Vibrato,ef_ExtraFineVibrato]) then\r
3946                     begin\r
3947                       temp := chunk.effect AND $0f0;\r
3948                       chunk.effect := chunk.effect MOD 16;\r
3949                     end;\r
3950 \r
3951                   Case SUCC(PRED(note_cache[temp3]) DIV 12) of\r
3952                     1: chunk.effect := max(Round(chunk.effect*0.55),255);\r
3953                     2: chunk.effect := max(Round(chunk.effect*0.75),255);\r
3954                     3: chunk.effect := max(Round(chunk.effect*0.95),255);\r
3955                     4: chunk.effect := max(Round(chunk.effect*1.15),255);\r
3956                     5: chunk.effect := max(Round(chunk.effect*1.35),255);\r
3957                     6: chunk.effect := max(Round(chunk.effect*1.55),255);\r
3958                     7: chunk.effect := max(Round(chunk.effect*1.75),255);\r
3959                     8: chunk.effect := max(Round(chunk.effect*1.95),255);\r
3960                   end;\r
3961 \r
3962                   If (chunk.effect_def in [ef_Vibrato,ef_ExtraFineVibrato]) then\r
3963                     chunk.effect := max(chunk.effect,15)+temp;\r
3964 \r
3965                   put_chunk(patt,temp2,temp3,chunk);\r
3966                 end;\r
3967 \r
3968             If (chunk.effect_def = ef_Extended2) and\r
3969                (chunk.effect DIV 16 in [ef_ex2_FreqSlideDnXF,ef_ex2_FreqSlideUpXF]) then\r
3970               If (chunk.effect MOD 16 <> 0) then slide_cache[temp3] := chunk.effect MOD 16\r
3971               else begin\r
3972                      chunk.effect := chunk.effect AND $0f0+slide_cache[temp3] AND $0f;\r
3973                      put_chunk(patt,temp2,temp3,chunk);\r
3974                    end;\r
3975 \r
3976             If (chunk.effect_def in [ef_TPortamVolSlide,ef_VibratoVolSlide,\r
3977                                      ef_VolSlide,ef_VolSlideFine]) and\r
3978                (temp2 <= patt_break) then\r
3979               begin\r
3980                 If (chunk.effect <> 0) then volsld_cache[temp3] := chunk.effect\r
3981                 else begin\r
3982                        chunk.effect := volsld_cache[temp3];;\r
3983                        put_chunk(patt,temp2,temp3,chunk);\r
3984                      end;\r
3985               end;\r
3986 \r
3987             If (chunk.effect_def = ef_Extended2) and\r
3988                (chunk.effect DIV 16 in [ef_ex2_VolSlideDnXF,ef_ex2_VolSlideUpXF]) then\r
3989               If (chunk.effect MOD 16 <> 0) then\r
3990                 Case chunk.effect DIV 16 of\r
3991                   ef_ex2_VolSlideDnXF:\r
3992                     volsld_cache[temp3] := chunk.effect MOD 16;\r
3993                   ef_ex2_VolSlideUpXF:\r
3994                     volsld_cache[temp3] := chunk.effect MOD 16 SHL 4;\r
3995                 end\r
3996               else begin\r
3997                      Case chunk.effect DIV 16 of\r
3998                        ef_ex2_VolSlideDnXF:\r
3999                          chunk.effect := chunk.effect AND $0f0+volsld_cache[temp3] AND $0f;\r
4000                        ef_ex2_VolSlideUpXF:\r
4001                          chunk.effect := volsld_cache[temp3] AND $0f0+chunk.effect AND $0f;\r
4002                      end;\r
4003                      put_chunk(patt,temp2,temp3,chunk);\r
4004                    end;\r
4005           end;\r
4006 \r
4007         If (prev_cache[temp3].effect_def in [ef_Vibrato,ef_ExtraFineVibrato,ef_VibratoVolSlide]) and\r
4008            NOT (chunk.effect_def in [ef_Vibrato,ef_ExtraFineVibrato,ef_VibratoVolSlide]) then\r
4009           If (chunk.effect_def = 0) and (chunk.effect = 0) then\r
4010             begin\r
4011               chunk2 := chunk;\r
4012               chunk2.effect_def := ef_Extended;\r
4013               chunk2.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_VibrOff;\r
4014               If NOT ((chunk2.effect_def = chunk2.effect_def2) and\r
4015                       (chunk2.effect = chunk2.effect2)) then\r
4016                 begin\r
4017                   put_chunk(patt,temp2,temp3,chunk2);\r
4018                   chunk := chunk2;\r
4019                 end;\r
4020             end\r
4021           else If (chunk.effect_def2 = 0) and (chunk.effect2 = 0) then\r
4022                  begin\r
4023                    chunk2 := chunk;\r
4024                    chunk2.effect_def2 := ef_Extended;\r
4025                    chunk2.effect2 := ef_ex_ExtendedCmd*16+ef_ex_cmd_VibrOff;\r
4026                    If NOT ((chunk2.effect_def2 = chunk2.effect_def) and\r
4027                            (chunk2.effect2 = chunk2.effect)) then\r
4028                      begin\r
4029                        put_chunk(patt,temp2,temp3,chunk2);\r
4030                        chunk := chunk2;\r
4031                      end;\r
4032                  end;\r
4033 \r
4034         If (chunk.effect_def = ef_Extended) and\r
4035            (chunk.effect DIV 16 = ef_ex_PatternLoop) then\r
4036           patloop_cache[temp3] := chunk.effect MOD 16;\r
4037 \r
4038         prev_cache[temp3].effect_def := chunk.effect_def;\r
4039         prev_cache[temp3].effect := chunk.effect;\r
4040         prev_cache[temp3].effect_def2 := chunk.effect_def2;\r
4041         prev_cache[temp3].effect2 := chunk.effect2;\r
4042 \r
4043         If (chunk.effect_def = temp_ef_Arpeggio) then\r
4044           begin\r
4045             chunk2 := chunk;\r
4046             chunk2.effect_def := ef_Arpeggio;\r
4047             put_chunk(patt,temp2,temp3,chunk2);\r
4048           end;\r
4049       end;\r
4050 end;\r
4051 \r
4052 begin { fix_s3m_commands }\r
4053   FillChar(ins_cache,SizeOf(ins_cache),0);\r
4054   FillChar(note_cache,SizeOf(note_cache),0);\r
4055   FillChar(volsld_cache,SizeOf(volsld_cache),0);\r
4056   FillChar(slide_cache,SizeOf(slide_cache),0);\r
4057   FillChar(misc_cache,SizeOf(misc_cache),0);\r
4058   FillChar(arpg_cache,SizeOf(arpg_cache),0);\r
4059 \r
4060   patts := '';\r
4061   order := 0; patt := BYTE_NULL;\r
4062 \r
4063   Repeat\r
4064     If (songdata.pattern_order[order] >= $80) then Inc(order)\r
4065     else\r
4066       begin\r
4067         patt := songdata.pattern_order[order];\r
4068         If NOT (Pos(CHR(patt),patts) <> 0) then\r
4069           fix_single_pattern(patt);\r
4070         Inc(order);\r
4071         patts := patts+CHR(patt);\r
4072       end;\r
4073   until (patt >= patterns) or (order > $7f);\r
4074 \r
4075   For patt := 0 to PRED(patterns) do\r
4076     If NOT (Pos(CHR(patt),patts) <> 0) then\r
4077       fix_single_pattern(patt);\r
4078 end;\r
4079 \r
4080 procedure s3m_file_loader;\r
4081 \r
4082 type\r
4083   tS3M_HEADER = Record\r
4084                   songname: array[1..28] of Char; { ASCIIZ }\r
4085                   byte1a:   Byte; { 1Ah }\r
4086                   ftype:    Byte; { File type: 16=ST3 module }\r
4087                   resrvd1:  array[0..1] of Byte;\r
4088                   ordnum:   Word; { Number of orders in file (should be even!) }\r
4089                   insnum:   Word; { Number of instruments in file }\r
4090                   patnum:   Word; { Number of patterns in file }\r
4091                   flags:    Word; {  [ These are old flags for Ffv1. Not supported in ST3.01 }\r
4092                                   {  |  +1:st2vibrato }\r
4093                                   {  |  +2:st2tempo }\r
4094                                   {  |  +4:amigaslides }\r
4095                                   {  | +32:enable filter/sfx with sb }\r
4096                                   {  ] }\r
4097                                   {   +8: 0vol optimizations }\r
4098                                   {         Automatically turn off looping notes whose volume }\r
4099                                   {         is zero for >2 note rows. }\r
4100                                   {  +16: amiga limits }\r
4101                                   {         Disallow any notes that go beyond the amiga hardware }\r
4102                                   {         limits (like amiga does). This means that sliding }\r
4103                                   {         up stops at B#5 etc. Also affects some minor amiga }\r
4104                                   {         compatibility issues. }\r
4105                                   {  +64: st3.00 volumeslides }\r
4106                                   {         Normally volumeslide is NOT performed on first }\r
4107                                   {         frame of each row (this is according to amiga }\r
4108                                   {         playing). If this is set, volumeslide is performed }\r
4109                                   {         ALSO on the first row. This is set by default }\r
4110                                   {         if the Cwt/v files is 0x1300 }\r
4111                                   { +128: special custom data in file (see below) }\r
4112                   cwt_v:    Word; { Created with tracker / version: &0xfff=version, >>12=tracker }\r
4113                                   {     ST3.00:0x1300 (NOTE: volumeslides on EVERY frame) }\r
4114                                   {     ST3.01:0x1301 }\r
4115                                   {     ST3.03:0x1303 }\r
4116                                   {     ST3.20:0x1320 }\r
4117                   ffi:      Word; { File format information }\r
4118                                   {   1=[VERY OLD] signed samples }\r
4119                                   {   2=unsigned samples }\r
4120                   id:       array[1..4] of Char; { "SCRM" }\r
4121                   g_v:      Byte; { global volume (see next section) }\r
4122                   i_s:      Byte; { initial speed (command A) }\r
4123 \r
4124                   i_t:      Byte; { initial tempo (command T) }\r
4125                   m_v:      Byte; { master volume (see next section) 7 lower bits }\r
4126                                   {   bit 8: stereo(1) / mono(0) }\r
4127                   u_c:      Byte; { ultra click removal }\r
4128                   d_p:      Byte; { 252 when default channel pan positions are present }\r
4129                                   { in the end of the header (xxx3). If !=252 ST3 doesn't }\r
4130                                   { try to load channel pan settings. }\r
4131                   resrvd2:  array[0..7] of Byte;\r
4132                   special:  Word;\r
4133                   chan_set: array[1..32] of Byte;\r
4134                 end;\r
4135 type\r
4136   tS3M_ADLINS = Record\r
4137                   itype:   Byte; { 2:amel 3:abd 4:asnare 5:atom 6:acym 7:ahihat }\r
4138                   dosname: array[1..12] of Char;\r
4139                   id0:     array[0..2]  of Char;\r
4140                   fmdata:  array[0..11] of Byte; { D00..D0B contains the adlib instrument specs packed like this: }\r
4141                                                  { modulator:                                              carrier: }\r
4142                                                  { D00=[freq.muliplier]+[?scale env.]*16+[?sustain]*32+    =D01 }\r
4143                                                  {         [?pitch vib]*64+[?vol.vib]*128 }\r
4144                                                  { D02=[63-volume]+[levelscale&1]*128+[l.s.&2]*64          =D03 }\r
4145                                                  { D04=[attack]*16+[decay]                                 =D05 }\r
4146                                                  { D06=[15-sustain]*16+[release]                           =D07 }\r
4147                                                  { D08=[wave select]                                       =D09 }\r
4148                                                  { D0A=[modulation feedback]*2+[?additive synthesis] }\r
4149                                                  { D0B=unused }\r
4150                   vol:     Byte; { Default volume 0..64 }\r
4151                   dsk:     Byte;\r
4152                   resrvd1: array[0..1] of Byte;\r
4153                   c2spd:   Word; { 'Herz' for middle C. ST3 only uses lower 16 bits. }\r
4154                                  { Actually this is a modifier since there is no }\r
4155                                  { clear frequency for adlib instruments. It scales }\r
4156                                  { the note freq sent to adlib. }\r
4157                   hi_c2sp: Word;\r
4158                   resrvd2: array[0..11] of Byte;\r
4159                   smpname: array[1..28] of Char; { ASCIIZ }\r
4160                   id:      array[1..4]  of Char; { "SCRI" or "SCRS" }\r
4161                 end;\r
4162 const\r
4163   id_mod = 'SCRM';\r
4164   id_ins_adl = 'SCRI';\r
4165   id_ins_smp = 'SCRS';\r
4166 \r
4167 var\r
4168   f: File;\r
4169   header: tS3M_HEADER;\r
4170   order_list: array[0..254] of Byte;\r
4171   paraptr_ins: array[1..99] of Word;\r
4172   default_vol: array[1..99] of Byte;\r
4173   paraptr_pat: array[0..99] of Word;\r
4174   temp,temp2: Longint;\r
4175   insdata: tS3M_ADLINS;\r
4176   pat,row,chan: Byte;\r
4177   note,ins,vol,cmd,info: Byte;\r
4178   patlen,index: Word;\r
4179 \r
4180 procedure import_s3m_event(pattern,line,channel,note,ins,vol,cmd,info: Byte);\r
4181 \r
4182 var\r
4183   chunk: tCHUNK;\r
4184 \r
4185 function scale_slide(slide: Byte): Byte;\r
4186 begin\r
4187   If (slide > 16) then scale_slide := Round(16+slide/8)\r
4188   else scale_slide := Round(slide*(2-slide/16));\r
4189 end;\r
4190 \r
4191 begin\r
4192   FillChar(chunk,SizeOf(chunk),0);\r
4193   chunk.instr_def := ins;\r
4194 \r
4195   Case note of\r
4196     254: chunk.note := BYTE_NULL;\r
4197     255: chunk.note := 0;\r
4198     else If (note AND $0f in [0..11]) then\r
4199            chunk.note := 12*((note SHR 4) AND 7)+(note AND $0f)+1\r
4200   end;\r
4201 \r
4202   If (vol <> BYTE_NULL) then\r
4203     begin\r
4204       chunk.effect_def2 := ef_SetInsVolume;\r
4205       chunk.effect2 := max(vol,63);\r
4206     end\r
4207   else\r
4208     If NOT (note in [254,255]) and\r
4209        (ins <> 0) and\r
4210        (max(default_vol[ins],63) <> 63) then\r
4211       begin\r
4212         chunk.effect_def2 := ef_SetInsVolume;\r
4213         chunk.effect2 := max(default_vol[ins],63);\r
4214       end;\r
4215 \r
4216   Case CHR(cmd+ORD('A')-1) of\r
4217   { NONE }\r
4218     '@': chunk.effect := info;\r
4219 \r
4220   { SET SPEED }\r
4221     'A': If (info <> 0) then\r
4222            begin\r
4223              chunk.effect_def := ef_SetSpeed;\r
4224              chunk.effect := info;\r
4225            end;\r
4226 \r
4227   { JUMP TO ORDER }\r
4228     'B': If (info <= 254) then\r
4229            begin\r
4230              chunk.effect_def := ef_PositionJump;\r
4231              chunk.effect := info;\r
4232            end;\r
4233 \r
4234   { BREAK PATTERN }\r
4235     'C': If (info < 64) then\r
4236            begin\r
4237              chunk.effect_def := ef_PatternBreak;\r
4238              chunk.effect := Str2num(Num2str(info,16),10);\r
4239            end;\r
4240 \r
4241   { VOLUME SLIDE }\r
4242     'D': { VOLUME SLIDE DOWN }\r
4243          Case info DIV 16 of\r
4244          { NORMAL }\r
4245            0: begin\r
4246                 chunk.effect_def := ef_VolSlide;\r
4247                 chunk.effect := info MOD 16;\r
4248               end;\r
4249 \r
4250          { FINE }\r
4251           15: begin\r
4252                 chunk.effect_def := ef_VolSlideFine;\r
4253                 chunk.effect := info MOD 16;\r
4254               end;\r
4255          else\r
4256            { VOLUME SLIDE UP }\r
4257            Case info MOD 16 of\r
4258            { NORMAL }\r
4259              0: begin\r
4260                   chunk.effect_def := ef_VolSlide;\r
4261                   chunk.effect := info AND $0f0;\r
4262                 end;\r
4263 \r
4264            { FINE }\r
4265             15: begin\r
4266                   chunk.effect_def := ef_VolSlideFine;\r
4267                   chunk.effect := info AND $0f0;\r
4268                 end;\r
4269            end;\r
4270          end;\r
4271 \r
4272   { SLIDE DOWN }\r
4273     'E': Case info DIV 16 of\r
4274          { NORMAL }\r
4275            0..13: begin\r
4276                     chunk.effect_def := ef_FSlideDown;\r
4277                     chunk.effect := scale_slide(info);\r
4278                   end;\r
4279 \r
4280          { EXTRA FINE }\r
4281            14: begin\r
4282                  chunk.effect_def := ef_Extended2;\r
4283                  If (info <> 0) then\r
4284                    chunk.effect := ef_ex2_FreqSlideDnXF*16+min((info AND $0f) DIV 4,1)\r
4285                  else chunk.effect := ef_ex2_FreqSlideDnXF*16;\r
4286                end;\r
4287 \r
4288          { FINE }\r
4289            15: begin\r
4290                  chunk.effect_def := ef_FSlideDownFine;\r
4291                  chunk.effect := info AND $0f;\r
4292                end;\r
4293          end;\r
4294 \r
4295   { SLIDE UP }\r
4296     'F': Case info DIV 16 of\r
4297          { NORMAL }\r
4298            0..13: begin\r
4299                     chunk.effect_def := ef_FSlideUp;\r
4300                     chunk.effect := scale_slide(info);\r
4301                   end;\r
4302 \r
4303          { EXTRA FINE }\r
4304            14: begin\r
4305                  chunk.effect_def := ef_Extended2;\r
4306                  If (info <> 0) then\r
4307                    chunk.effect := ef_ex2_FreqSlideUpXF*16+min((info AND $0f) DIV 4,1)\r
4308                  else chunk.effect := ef_ex2_FreqSlideUpXF*16;\r
4309                end;\r
4310 \r
4311          { FINE }\r
4312            15: begin\r
4313                  chunk.effect_def := ef_FSlideUpFine;\r
4314                  chunk.effect := info AND $0f;\r
4315                end;\r
4316          end;\r
4317 \r
4318   { TONE PORTAMENTO }\r
4319     'G': begin\r
4320            chunk.effect_def := ef_TonePortamento;\r
4321            chunk.effect := scale_slide(info);\r
4322          end;\r
4323 \r
4324   { VIBRATO }\r
4325     'H': begin\r
4326            chunk.effect_def := ef_Vibrato;\r
4327            chunk.effect := info;\r
4328          end;\r
4329 \r
4330   { FINE VIBRATO }\r
4331     'U': begin\r
4332            chunk.effect_def := ef_ExtraFineVibrato;\r
4333            chunk.effect := info;\r
4334          end;\r
4335 \r
4336   { TREMOR }\r
4337     'I': begin\r
4338            chunk.effect_def := ef_Tremor;\r
4339            chunk.effect := info;\r
4340          end;\r
4341 \r
4342   { ARPEGGIO }\r
4343     'J': begin\r
4344            chunk.effect_def := temp_ef_Arpeggio;\r
4345            chunk.effect := info;\r
4346          end;\r
4347 \r
4348   { VIBRATO + VOLUME SLIDE }\r
4349     'K': begin\r
4350            chunk.effect_def := ef_VibratoVolSlide;\r
4351            chunk.effect := info;\r
4352          end;\r
4353 \r
4354   { TONE PORTAMENTO + VOLUME SLIDE }\r
4355     'L': begin\r
4356            chunk.effect_def := ef_TPortamVolSlide;\r
4357            chunk.effect := info;\r
4358          end;\r
4359 \r
4360   { RETRIG NOTE + VOLUME SLIDE }\r
4361     'Q': begin\r
4362            chunk.effect_def := ef_MultiRetrigNote;\r
4363            chunk.effect := (info MOD 16)*16+info DIV 16;\r
4364          end;\r
4365 \r
4366   { TREMOLO }\r
4367     'R': begin\r
4368            chunk.effect_def := ef_Tremolo;\r
4369            chunk.effect := info;\r
4370          end;\r
4371 \r
4372   { SPECIAL COMMAND }\r
4373     'S': Case info DIV 16 of\r
4374          { PATTERN LOOP }\r
4375            $0b: begin\r
4376                   chunk.effect_def := ef_Extended;\r
4377                   chunk.effect := ef_ex_PatternLoop*16+info MOD 16;\r
4378                 end;\r
4379 \r
4380          { NOTE CUT }\r
4381            $0c: begin\r
4382                   chunk.effect_def := ef_Extended2;\r
4383                   chunk.effect := ef_ex2_NoteCut*16+info MOD 16;\r
4384                 end;\r
4385 \r
4386          { NOTE DELAY }\r
4387            $0d: begin\r
4388                   chunk.effect_def := ef_Extended2;\r
4389                   chunk.effect := ef_ex2_NoteDelay*16+info MOD 16;\r
4390                 end;\r
4391 \r
4392          { PATTERN DELAY }\r
4393            $0e: begin\r
4394                   chunk.effect_def := ef_Extended2;\r
4395                   chunk.effect := ef_ex2_PatDelayRow*16+info MOD 16;\r
4396                 end;\r
4397          end;\r
4398 \r
4399   { TEMPO }\r
4400     'T': If (info >= 32) then\r
4401            begin\r
4402              chunk.effect_def := ef_SetTempo;\r
4403              chunk.effect := Round(info/2.5);\r
4404            end;\r
4405 \r
4406   { SET GLOBAL VOLUME }\r
4407     'V': begin\r
4408            chunk.effect_def := ef_SetGlobalVolume;\r
4409            chunk.effect := max(info,63);\r
4410          end;\r
4411   end;\r
4412 \r
4413   If (chunk.effect_def = 0) and (chunk.effect <> 0) then\r
4414     chunk.effect := 0;\r
4415   put_chunk(pattern,line,channel,chunk);\r
4416 end;\r
4417 \r
4418 // experimental method to fix up note fine-tuning\r
4419 function find_scale_factor(freq: Longint; var fine_tune: Shortint): Shortint;\r
4420 \r
4421 const\r
4422   _factor: array[-3..3+1] of Real = (1/8,1/4,1/2,1,2,4,8,16);\r
4423 \r
4424 const\r
4425   _freq: array[1..12+1] of Word =\r
4426     { C-2         C#2         D-2 }\r
4427     ( 33453 DIV 4,35441 DIV 4,37679 DIV 4,\r
4428     { D#2         E-2         F-2 }\r
4429       39772 DIV 4,42441 DIV 4,44744 DIV 4,\r
4430     { F#2         G-2         G#2 }\r
4431       47727 DIV 4,50416 DIV 4,53426 DIV 4,\r
4432     { A-2         A#2         B-2 }\r
4433       56370 DIV 4,59658 DIV 4,63354 DIV 4,\r
4434     { C-3 }\r
4435       33453 DIV 2);\r
4436 \r
4437 const\r
4438   _fm_freq: array[1..12+1] of Word =\r
4439     ($156, $16b, $181, $198, $1b0, $1ca,\r
4440      $1e5, $202, $220, $241, $263, $287,\r
4441      $2ae);\r
4442 \r
4443 var\r
4444   factor: Real;\r
4445   temp,scaler: Shortint;\r
4446 \r
4447 begin\r
4448   scaler := -3;\r
4449   fine_tune := 0;\r
4450 \r
4451   For scaler := -3 to 3+1 do\r
4452     For temp := 1 to 12 do\r
4453       begin\r
4454         factor := _factor[scaler];\r
4455         If (freq >= Round(_freq[temp]*factor)) and\r
4456            (freq <= Round(_freq[SUCC(temp)]*factor)) then\r
4457           If (freq-Round(_freq[temp]*factor) < Round(_freq[SUCC(temp)]*factor)-freq) then\r
4458             begin\r
4459               fine_tune := Round((_fm_freq[SUCC(temp)]-_fm_freq[temp])/\r
4460                                  (_freq[SUCC(temp)]-_freq[temp])*\r
4461                                  (freq-Round(_freq[temp]*factor)));\r
4462               find_scale_factor := scaler*12+PRED(temp);\r
4463               EXIT;\r
4464             end\r
4465           else\r
4466             begin\r
4467               fine_tune := Round((_fm_freq[SUCC(temp)]-_fm_freq[temp])/\r
4468                                  (_freq[SUCC(temp)]-_freq[temp])*\r
4469                                  (freq-Round(_freq[SUCC(temp)]*factor)));\r
4470               If (temp <> 12) then find_scale_factor := scaler*12+temp\r
4471               else find_scale_factor := SUCC(scaler)*12;\r
4472               EXIT;\r
4473             end;\r
4474       end;\r
4475 \r
4476   find_scale_factor := -127;\r
4477   fine_tune := 0;\r
4478 end;\r
4479 \r
4480 (*  // another method -- it's hard to say whether more or less accurate :)\r
4481 function find_scale_factor(freq: Longint; var fine_tune: Shortint): Shortint;\r
4482 \r
4483 const\r
4484   _factor: array[-3..3+1] of Real = (1/8,1/4,1/2,1,2,4,8,16);\r
4485   _finetune_factor: array[-3..3+1] of Real = (8,4,2,1,1/2,1/4,1/8,1/16);\r
4486 \r
4487 const\r
4488   _freq: array[1..12+1] of Word =\r
4489     { C-2         C#2         D-2 }\r
4490     ( 33453 DIV 4,35441 DIV 4,37679 DIV 4,\r
4491     { D#2         E-2         F-2 }\r
4492       39772 DIV 4,42441 DIV 4,44744 DIV 4,\r
4493     { F#2         G-2         G#2 }\r
4494       47727 DIV 4,50416 DIV 4,53426 DIV 4,\r
4495     { A-2         A#2         B-2 }\r
4496       56370 DIV 4,59658 DIV 4,63354 DIV 4,\r
4497     { C-3 }\r
4498       33453 DIV 2);\r
4499 \r
4500 var\r
4501   factor: Real;\r
4502   temp,scaler: Shortint;\r
4503 \r
4504 begin\r
4505   scaler := -3;\r
4506   fine_tune := 0;\r
4507 \r
4508   For scaler := -3 to 3+1 do\r
4509     For temp := 1 to 12 do\r
4510       begin\r
4511         factor := _factor[scaler];\r
4512         If (freq >= Round(_freq[temp]*factor)) and\r
4513            (freq <= Round(_freq[SUCC(temp)]*factor)) then\r
4514           If (freq-Round(_freq[temp]*factor) < Round(_freq[SUCC(temp)]*factor)-freq) then\r
4515             begin\r
4516               fine_tune := Round((freq-Round(_freq[temp]*factor))/\r
4517                                   Round(16/_finetune_factor[scaler]));\r
4518               find_scale_factor := scaler*12+PRED(temp);\r
4519               EXIT;\r
4520             end\r
4521           else\r
4522             begin\r
4523               If (temp = 12) then Inc(scaler);\r
4524               fine_tune := Round((freq-Round(_freq[SUCC(temp)]*factor))/\r
4525                                   Round(16/_finetune_factor[scaler]));\r
4526               If (temp = 12) then temp := 0;\r
4527               find_scale_factor := scaler*12+temp;\r
4528               EXIT;\r
4529             end;\r
4530       end;\r
4531 \r
4532   find_scale_factor := -127;\r
4533   fine_tune := 0;\r
4534 end;\r
4535 *)\r
4536 \r
4537 begin\r
4538   {$i-}\r
4539   Assign(f,songdata_source);\r
4540   ResetF(f);\r
4541   {$i+}\r
4542   If (IOresult <> 0) then\r
4543     begin\r
4544       CloseF(f);\r
4545       EXIT;\r
4546     end;\r
4547 \r
4548   BlockReadF(f,header,SizeOf(header),temp);\r
4549   If NOT ((temp = SizeOf(header)) and (header.id = id_mod)) then\r
4550     begin\r
4551       CloseF(f);\r
4552       EXIT;\r
4553     end;\r
4554 \r
4555   load_flag := $7f;\r
4556   If (header.byte1a <> $1a) or (header.ftype <> $10) then\r
4557     begin\r
4558       CloseF(f);\r
4559       EXIT;\r
4560     end;\r
4561 \r
4562   BlockReadF(f,order_list,header.ordnum,temp);\r
4563   If (IOresult <> 0) or (temp <> header.ordnum) then\r
4564     begin\r
4565       CloseF(f);\r
4566       EXIT;\r
4567     end;\r
4568 \r
4569   BlockReadF(f,paraptr_ins,header.insnum*2,temp);\r
4570   If (IOresult <> 0) or (temp <> header.insnum*2) then\r
4571     begin\r
4572       CloseF(f);\r
4573       EXIT;\r
4574     end;\r
4575 \r
4576   BlockReadF(f,paraptr_pat,header.patnum*2,temp);\r
4577   If (IOresult <> 0) or (temp <> header.patnum*2) then\r
4578     begin\r
4579       CloseF(f);\r
4580       EXIT;\r
4581     end;\r
4582 \r
4583   init_songdata;\r
4584   load_flag := 0;\r
4585 \r
4586   If (header.i_s <> 0) then speed := header.i_s\r
4587   else speed := 1;\r
4588 \r
4589   If (Round(header.i_t/2.5) < 255) then tempo := Round(header.i_t/2.5)\r
4590   else tempo := 255;\r
4591 \r
4592   songdata.tempo := tempo;\r
4593   songdata.speed := speed;\r
4594   songdata.songname := truncate_string(asciiz_string(header.songname));\r
4595   songdata.common_flag := songdata.common_flag OR $80;\r
4596   import_old_flags;\r
4597 \r
4598   For temp := 32 downto 1 do\r
4599     If (header.chan_set[temp] <> 255) then BREAK;\r
4600 \r
4601 \r
4602   songdata.patt_len := 64;\r
4603   If adjust_tracks then songdata.nm_tracks := max(temp,18)\r
4604   else If (songdata.nm_tracks < 18) then songdata.nm_tracks := 18;\r
4605 \r
4606   For temp := 1 to max(header.ordnum,128) do\r
4607     Case order_list[temp-1] of\r
4608       254: songdata.pattern_order[temp-1] := $80+temp;\r
4609       255: songdata.pattern_order[temp-1] := $80;\r
4610       else songdata.pattern_order[temp-1] := order_list[temp-1];\r
4611     end;\r
4612 \r
4613   FillChar(ins_c4factor,SizeOf(ins_c4factor),0);\r
4614   For temp := 1 to header.insnum do\r
4615     begin\r
4616       SeekF(f,paraptr_ins[temp]*16);\r
4617       If (IOresult <> 0) then\r
4618         begin\r
4619           CloseF(f);\r
4620           EXIT;\r
4621         end;\r
4622 \r
4623       BlockReadF(f,insdata,SizeOf(insdata),temp2);\r
4624       If (IOresult <> 0) or (temp2 <> SizeOf(insdata)) then\r
4625         begin\r
4626           CloseF(f);\r
4627           EXIT;\r
4628         end;\r
4629 \r
4630       If (truncate_string(insdata.smpname) <> '') then\r
4631         songdata.instr_names[temp] :=\r
4632           Copy(songdata.instr_names[temp],1,9)+\r
4633           Copy(truncate_string(asciiz_string(insdata.smpname)),1,32)\r
4634       else\r
4635         songdata.instr_names[temp] :=\r
4636           Copy(songdata.instr_names[temp],1,9)+\r
4637           truncate_string(insdata.dosname);\r
4638 \r
4639       If (insdata.itype in [2..7]) then\r
4640         begin\r
4641           If (insdata.id <> id_ins_adl) and (insdata.id <> id_ins_smp) then\r
4642             begin\r
4643               CloseF(f);\r
4644               EXIT;\r
4645             end;\r
4646 \r
4647           import_standard_instrument(temp,insdata.fmdata);\r
4648         end;\r
4649 \r
4650       default_vol[temp] := insdata.vol;\r
4651       If (insdata.c2spd <> 0) and\r
4652          (insdata.c2spd <> 8363) then\r
4653         ins_c4factor[temp] := find_scale_factor(insdata.c2spd,songdata.instr_data[temp].fine_tune);\r
4654     end;\r
4655 \r
4656   For pat := 0 to PRED(header.patnum) do\r
4657     begin\r
4658       SeekF(f,paraptr_pat[pat]*16);\r
4659       If (IOresult <> 0) then\r
4660         begin\r
4661           CloseF(f);\r
4662           EXIT;\r
4663         end;\r
4664 \r
4665       BlockReadF(f,patlen,SizeOf(patlen),temp2);\r
4666       If (temp2 <> SizeOf(patlen)) then\r
4667         begin\r
4668           CloseF(f);\r
4669           EXIT;\r
4670         end;\r
4671 \r
4672       If (patlen = 0) then CONTINUE;\r
4673       FillChar(buf1,SizeOf(buf1),0);\r
4674       BlockReadF(f,buf1,patlen-2,temp2);\r
4675 \r
4676       index := 0;\r
4677       row := 0;\r
4678 \r
4679       Repeat\r
4680         If (buf1[index] <> 0) then\r
4681           begin\r
4682             note := BYTE_NULL;\r
4683             ins  := 0;\r
4684             vol  := BYTE_NULL;\r
4685             cmd  := 0;\r
4686             info := 0;\r
4687             temp := buf1[index];\r
4688             Inc(index);\r
4689 \r
4690             chan := SUCC(temp AND 31);\r
4691             If (temp OR $20 = temp) then\r
4692               begin\r
4693                 note := buf1[index];\r
4694                 Inc(index);\r
4695                 ins := buf1[index];\r
4696                 Inc(index);\r
4697               end;\r
4698 \r
4699             If (temp OR $40 = temp) then\r
4700               begin\r
4701                 vol := buf1[index];\r
4702                 Inc(index);\r
4703               end;\r
4704 \r
4705             If (temp OR $80 = temp) then\r
4706               begin\r
4707                 cmd := buf1[index];\r
4708                 Inc(index);\r
4709                 info := buf1[index];\r
4710                 Inc(index);\r
4711               end;\r
4712 \r
4713             If (chan > songdata.nm_tracks) then songdata.nm_tracks := max(chan,18);\r
4714             If (chan in [1..songdata.nm_tracks]) then\r
4715               import_s3m_event(pat,row,chan,note,ins,vol,cmd,info);\r
4716           end\r
4717         else\r
4718           begin\r
4719             Inc(row);\r
4720             Inc(index);\r
4721           end;\r
4722       until (row = 64);\r
4723     end;\r
4724 \r
4725   fix_s3m_commands(header.patnum);\r
4726   CloseF(f);\r
4727   songdata_title := NameOnly(songdata_source);\r
4728   load_flag := 12;\r
4729 end;\r
4730 \r
4731 procedure fix_fmk_commands(patterns: Byte);\r
4732 \r
4733 var\r
4734   chunk,chunk2,\r
4735   chunk3: tCHUNK;\r
4736   patt_break: Byte;\r
4737   order,patt: Byte;\r
4738   patts: String;\r
4739   ins_cache,\r
4740   misc_cache,\r
4741   arpg_cache,\r
4742   forcevol_cache,\r
4743   volsld_cache,\r
4744   xfvolsld_cache,\r
4745   slide_cache: array[1..20] of Byte;\r
4746   _1st_ins_load: array[1..20] of Boolean;\r
4747   _speed_table_fixed: array[0..$7f] of Boolean;\r
4748   prev_cache: array[1..20] of Record\r
4749                                 effect_def,\r
4750                                 effect,\r
4751                                 effect_def2,\r
4752                                 effect2: Byte;\r
4753                               end;\r
4754 \r
4755 procedure fix_single_pattern(patt: Byte);\r
4756 \r
4757 var\r
4758   temp2,temp3: Byte;\r
4759 \r
4760 begin\r
4761   FillChar(prev_cache,SizeOf(prev_cache),0);\r
4762   patt_break := BYTE_NULL;\r
4763 \r
4764   If NOT _speed_table_fixed[patt] then\r
4765     For temp2 := 0 to $3f do\r
4766       begin\r
4767         For temp3 := 1 to 20 do\r
4768           begin\r
4769             get_chunk(patt,temp2,temp3,chunk);\r
4770             If (chunk.effect_def = 0) then\r
4771               begin\r
4772                 chunk.effect_def := ef_SetCustomSpeedTab;\r
4773                 chunk.effect := $0fa;\r
4774                 put_chunk(patt,temp2,temp3,chunk);\r
4775                 _speed_table_fixed[patt] := TRUE;\r
4776               end\r
4777             else If (chunk.effect_def2 = 0) then\r
4778                    begin\r
4779                      chunk.effect_def2 := ef_SetCustomSpeedTab;\r
4780                      chunk.effect2 := $0fa;\r
4781                      put_chunk(patt,temp2,temp3,chunk);\r
4782                      _speed_table_fixed[patt] := TRUE;\r
4783                    end;\r
4784             If _speed_table_fixed[patt] then BREAK;\r
4785           end;\r
4786         If _speed_table_fixed[patt] then BREAK;\r
4787       end;\r
4788 \r
4789   For temp2 := 0 to $3f do\r
4790     For temp3 := 1 to 20 do\r
4791       begin\r
4792         get_chunk(patt,temp2,temp3,chunk);\r
4793         If (chunk.effect_def = temp_ef_rep) then\r
4794           begin\r
4795             chunk.effect_def := prev_cache[temp3].effect_def;\r
4796             put_chunk(patt,temp2,temp3,chunk);\r
4797           end;\r
4798 \r
4799         If (chunk.effect_def = temp_ef_XFVSlide) then\r
4800           begin\r
4801             chunk.effect_def := ef_Extended2;\r
4802             If (xfvolsld_cache[temp3] <> 0) then\r
4803               chunk.effect := ef_ex2_VolSlideUpXF*16+volsld_cache[temp3] DIV 16\r
4804             else chunk.effect := ef_ex2_VolSlideDnXF*16+volsld_cache[temp3] MOD 16;\r
4805             put_chunk(patt,temp2,temp3,chunk);\r
4806           end;\r
4807 \r
4808         If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) then\r
4809           patt_break := temp2;\r
4810 \r
4811         If (temp2 <= patt_break) and\r
4812            (chunk.instr_def <> ins_cache[temp3]) and\r
4813            (chunk.effect_def2 <> ef_ForceInsVolume) then\r
4814           If (chunk.instr_def <> 0) then\r
4815             forcevol_cache[temp3] := 0;\r
4816 \r
4817         If ((chunk.effect_def = ef_Extended) and\r
4818             (chunk.effect = ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol)) or\r
4819            ((chunk.effect_def2 = ef_Extended) and\r
4820             (chunk.effect2 = ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol)) then\r
4821           forcevol_cache[temp3] := 0;\r
4822 \r
4823         If (chunk.effect_def2 = ef_ForceInsVolume) and\r
4824            (temp2 <= patt_break) then\r
4825           forcevol_cache[temp3] := 1;\r
4826 \r
4827         If (chunk.instr_def <> 0) and (temp2 <= patt_break) then\r
4828           ins_cache[temp3] := chunk.instr_def;\r
4829 \r
4830         If (chunk.instr_def <> 0) or ((chunk.instr_def = 0) and\r
4831                                       (chunk.note in [1..12*8+1]) and\r
4832                                       (ins_cache[temp3] <> 0)) then\r
4833           put_chunk(patt,temp2,temp3,chunk);\r
4834 \r
4835         If (temp2 <= patt_break) then\r
4836           begin\r
4837             If (chunk.effect DIV 16 <> 0) then\r
4838               misc_cache[temp3] := chunk.effect AND $0f0+\r
4839                                    misc_cache[temp3] AND $0f\r
4840             else If (chunk.effect_def in [ef_Vibrato,\r
4841                                           ef_Tremolo]) then\r
4842                    begin\r
4843                      chunk.effect := misc_cache[temp3] AND $0f0+\r
4844                                      chunk.effect AND $0f;\r
4845                      put_chunk(patt,temp2,temp3,chunk);\r
4846                    end;\r
4847 \r
4848             If (chunk.effect MOD 16 <> 0) then\r
4849               misc_cache[temp3] := misc_cache[temp3] AND $0f0+\r
4850                                    chunk.effect AND $0f\r
4851             else If (chunk.effect_def in [ef_Vibrato,\r
4852                                           ef_Tremolo]) then\r
4853                    begin\r
4854                      chunk.effect := chunk.effect AND $0f0+\r
4855                                      misc_cache[temp3] AND $0f;\r
4856                      put_chunk(patt,temp2,temp3,chunk);\r
4857                    end;\r
4858 \r
4859             If (chunk.effect_def = ef_RetrigNote) then\r
4860               If (chunk.effect <> 0) then misc_cache[temp3] := chunk.effect\r
4861               else begin\r
4862                      chunk.effect := misc_cache[temp3];\r
4863                      put_chunk(patt,temp2,temp3,chunk);\r
4864                    end;\r
4865 \r
4866             If (chunk.effect_def = temp_ef_Arpeggio) then\r
4867               If (chunk.effect <> 0) then arpg_cache[temp3] := chunk.effect\r
4868               else begin\r
4869                      chunk.effect := arpg_cache[temp3];\r
4870                      put_chunk(patt,temp2,temp3,chunk);\r
4871                    end;\r
4872 \r
4873             If (chunk.effect_def in [ef_FSlideDown,ef_FSlideDownFine,\r
4874                                      ef_FSlideUp,ef_FSlideUpFine,\r
4875                                      ef_TonePortamento]) then\r
4876               If (chunk.effect <> 0) then slide_cache[temp3] := chunk.effect\r
4877               else begin\r
4878                      chunk.effect := slide_cache[temp3];\r
4879                      put_chunk(patt,temp2,temp3,chunk);\r
4880                    end;\r
4881 \r
4882             If (chunk.effect_def = ef_Extended2) and\r
4883                (chunk.effect DIV 16 in [ef_ex2_FreqSlideDnXF,ef_ex2_FreqSlideUpXF]) then\r
4884               If (chunk.effect MOD 16 <> 0) then slide_cache[temp3] := chunk.effect MOD 16\r
4885               else begin\r
4886                      chunk.effect := chunk.effect AND $0f0+slide_cache[temp3] AND $0f;\r
4887                      put_chunk(patt,temp2,temp3,chunk);\r
4888                    end;\r
4889 \r
4890             If (chunk.effect_def in [ef_TPortamVolSlide,ef_VibratoVolSlide,\r
4891                                      ef_VolSlide,ef_VolSlideFine]) and\r
4892                (temp2 <= patt_break) then\r
4893               begin\r
4894                 If (chunk.effect <> 0) then volsld_cache[temp3] := chunk.effect\r
4895                 else begin\r
4896                        chunk.effect := volsld_cache[temp3];;\r
4897                        put_chunk(patt,temp2,temp3,chunk);\r
4898                      end;\r
4899               end;\r
4900 \r
4901             If (chunk.effect_def = ef_Extended2) and\r
4902                (chunk.effect DIV 16 in [ef_ex2_VolSlideDnXF,ef_ex2_VolSlideUpXF]) then\r
4903               If (chunk.effect MOD 16 <> 0) then\r
4904                 Case chunk.effect DIV 16 of\r
4905                   ef_ex2_VolSlideDnXF:\r
4906                     begin\r
4907                       volsld_cache[temp3] := chunk.effect MOD 16;\r
4908                       xfvolsld_cache[temp3] := 0;\r
4909                     end;\r
4910 \r
4911                   ef_ex2_VolSlideUpXF:\r
4912                     begin\r
4913                       volsld_cache[temp3] := chunk.effect MOD 16*16;\r
4914                       xfvolsld_cache[temp3] := 1;\r
4915                     end;\r
4916                 end;\r
4917           end;\r
4918 \r
4919         If (prev_cache[temp3].effect_def in [ef_Vibrato,ef_VibratoVolSlide]) and\r
4920            NOT (chunk.effect_def in [ef_Vibrato,ef_VibratoVolSlide]) then\r
4921           If (chunk.effect_def = 0) and (chunk.effect = 0) then\r
4922             begin\r
4923               chunk2 := chunk;\r
4924               chunk2.effect_def := ef_Extended;\r
4925               chunk2.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_VibrOff;\r
4926               If NOT ((chunk2.effect_def = chunk2.effect_def2) and\r
4927                       (chunk2.effect = chunk2.effect2)) then\r
4928                 begin\r
4929                   put_chunk(patt,temp2,temp3,chunk2);\r
4930                   chunk := chunk2;\r
4931                 end;\r
4932             end\r
4933           else If (chunk.effect_def2 = 0) and (chunk.effect2 = 0) then\r
4934                  begin\r
4935                    chunk2 := chunk;\r
4936                    chunk2.effect_def2 := ef_Extended;\r
4937                    chunk2.effect2 := ef_ex_ExtendedCmd*16+ef_ex_cmd_VibrOff;\r
4938                    If NOT ((chunk2.effect_def2 = chunk2.effect_def) and\r
4939                            (chunk2.effect2 = chunk2.effect)) then\r
4940                      begin\r
4941                        put_chunk(patt,temp2,temp3,chunk2);\r
4942                        chunk := chunk2;\r
4943                      end;\r
4944                  end;\r
4945 \r
4946         If (_1st_ins_load[temp3] and (chunk.instr_def <> 0)) or\r
4947            (forcevol_cache[temp3] <> 0) and\r
4948            (temp2 <= patt_break) and\r
4949            (chunk.instr_def <> 0) then\r
4950           If (chunk.effect_def2+chunk.effect2 = 0) then\r
4951             If NOT (chunk.effect_def in [ef_SetModulatorVol,ef_SetCarrierVol]) then\r
4952               begin\r
4953                 chunk.effect_def2 := ef_Extended;\r
4954                 chunk.effect2 := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol;\r
4955                 put_chunk(patt,temp2,temp3,chunk);\r
4956                 forcevol_cache[temp3] := 0;\r
4957                 _1st_ins_load[temp3] := FALSE;\r
4958               end\r
4959             else begin\r
4960                   chunk.effect_def2 := chunk.effect_def;\r
4961                   chunk.effect2 := chunk.effect;\r
4962                   chunk.effect_def := ef_Extended;\r
4963                   chunk.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol;\r
4964                   put_chunk(patt,temp2,temp3,chunk);\r
4965                   forcevol_cache[temp3] := 0;\r
4966                   _1st_ins_load[temp3] := FALSE;\r
4967                 end;\r
4968 \r
4969         prev_cache[temp3].effect_def := chunk.effect_def;\r
4970         prev_cache[temp3].effect := chunk.effect;\r
4971         prev_cache[temp3].effect_def2 := chunk.effect_def2;\r
4972         prev_cache[temp3].effect2 := chunk.effect2;\r
4973 \r
4974         If is_4op_chan(temp3) and\r
4975            (temp3 in [1,3,5,10,12,14]) then\r
4976           begin\r
4977             get_chunk(patt,temp2,SUCC(temp3),chunk3);\r
4978             If (chunk.instr_def = 0) and (chunk3.instr_def <> 0) then\r
4979               begin\r
4980                 If (ins_cache[temp3] <> 0) then\r
4981                   chunk.instr_def := ins_cache[temp3]\r
4982                 else chunk.instr_def := chunk3.instr_def;\r
4983                 put_chunk(patt,temp2,temp3,chunk);\r
4984               end;\r
4985           end;\r
4986 \r
4987         If (chunk.effect_def = temp_ef_Arpeggio) then\r
4988           begin\r
4989             chunk2 := chunk;\r
4990             chunk2.effect_def := ef_Arpeggio;\r
4991             put_chunk(patt,temp2,temp3,chunk2);\r
4992           end;\r
4993 \r
4994         If (chunk.effect_def in [ef_SetModulatorVol,ef_SetCarrierVol]) and\r
4995            (chunk.effect_def2 = ef_ForceInsVolume) then\r
4996           begin\r
4997             chunk2 := chunk;\r
4998             chunk2.effect_def := chunk.effect_def2;\r
4999             chunk2.effect := chunk.effect2;\r
5000             chunk2.effect_def2 := chunk.effect_def;\r
5001             chunk2.effect2 := chunk.effect;\r
5002             put_chunk(patt,temp2,temp3,chunk2);\r
5003           end;\r
5004       end;\r
5005 end;\r
5006 \r
5007 begin { fix_fmk_commands }\r
5008   FillChar(ins_cache,SizeOf(ins_cache),0);\r
5009   FillChar(_1st_ins_load,SizeOf(_1st_ins_load),TRUE);\r
5010   FillChar(_speed_table_fixed,SizeOf(_speed_table_fixed),FALSE);\r
5011   FillChar(xfvolsld_cache,SizeOf(volsld_cache),0);\r
5012   FillChar(volsld_cache,SizeOf(volsld_cache),0);\r
5013   FillChar(slide_cache,SizeOf(slide_cache),0);\r
5014   FillChar(misc_cache,SizeOf(misc_cache),0);\r
5015   FillChar(arpg_cache,SizeOf(arpg_cache),0);\r
5016   FillChar(forcevol_cache,SizeOf(forcevol_cache),0);\r
5017 \r
5018   patts := '';\r
5019   order := 0; patt := BYTE_NULL;\r
5020 \r
5021   Repeat\r
5022     If (songdata.pattern_order[order] >= $80) then Inc(order)\r
5023     else\r
5024       begin\r
5025         patt := songdata.pattern_order[order];\r
5026         fix_single_pattern(patt);\r
5027         Inc(order);\r
5028         patts := patts+CHR(patt);\r
5029       end;\r
5030   until (patt >= patterns) or (order > $7f);\r
5031 \r
5032   For patt := 0 to PRED(patterns) do\r
5033     If NOT (Pos(CHR(patt),patts) <> 0) then\r
5034       fix_single_pattern(patt);\r
5035 end;\r
5036 \r
5037 procedure import_fin_instrument(inst: Byte; var data);\r
5038 begin\r
5039   With songdata.instr_data[inst] do\r
5040     begin\r
5041       fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[0];\r
5042       fm_data.AM_VIB_EG_carrier   := tDUMMY_BUFF(data)[1];\r
5043       fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[2];\r
5044       fm_data.KSL_VOLUM_carrier   := tDUMMY_BUFF(data)[3];\r
5045       fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[4];\r
5046       fm_data.ATTCK_DEC_carrier   := tDUMMY_BUFF(data)[5];\r
5047       fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[6];\r
5048       fm_data.SUSTN_REL_carrier   := tDUMMY_BUFF(data)[7];\r
5049       fm_data.WAVEFORM_modulator  := tDUMMY_BUFF(data)[8]  AND 7;\r
5050       fm_data.WAVEFORM_carrier    := tDUMMY_BUFF(data)[9]  AND 7;\r
5051       fm_data.FEEDBACK_FM         := tDUMMY_BUFF(data)[10] AND $0f;\r
5052     end;\r
5053 \r
5054   songdata.instr_data[inst].panning := 0;\r
5055   songdata.instr_data[inst].fine_tune := 0;\r
5056 end;\r
5057 \r
5058 procedure fmk_file_loader;\r
5059 \r
5060 type\r
5061   tFMK_HEADER = Record\r
5062                   id:       array[1..4] of Char; { FMK! }\r
5063                   songname: array[1..28] of Char; { Song name (28) }\r
5064                   composer: array[1..28] of Char; { Composer name (28) }\r
5065                   bytef4:   Byte; { Value 244 (f4h), just for check. }\r
5066                   ftype:    Byte; { File type {1=evolution 1, 2=evolution 2 }\r
5067                   glob_var: Byte; { Global variables, bits : 0 = stereo, 1 = opl3, 2 = rhythm }\r
5068                                   { 3 = 4.8 db tremolo  4 = 14 cent vibrato. }\r
5069                   base_spd: Byte; { Song basespeed, ticks / second. this version : fixed 50. }\r
5070                   init_spd: Byte; { Song initial speed. }\r
5071                   reserved: array[0..8] of Byte; { Reserved }\r
5072                   ordnum:   Byte; { Length of song (order). }\r
5073                   insnum:   Byte; { Number of instruments. }\r
5074                   patnum:   Byte; { Number of patterns. }\r
5075                   trk_pan:  array[1..5] of Byte; { Track stereo pan positions, bits 0-1, 2-3, 4-5, 6-7. }\r
5076                                                  { value 0 = left 1 = both 2 = right, from track 1 to 18. }\r
5077                   trk_set:  array[1..20] of Byte; { Track initial settings, 255=unused, bits : }\r
5078                                                   { 0-2, type value: 0 = normal 1=hihat 2=cymbal 3=tom tom 4=snare 5=bass }\r
5079                                                   {                  6 = 4op    7=unused }\r
5080                                                   { 3-7, OPL-channel number (1-18), 21 = none. }\r
5081 { ### if ftype=2 --> trk_set: 1..18; type_value: 0 = normal  6 = 4op  7=unused }\r
5082                 end;\r
5083 const\r
5084   id = 'FMK!';\r
5085 \r
5086 const\r
5087   _conv_fmk_pan: array[0..2] of Byte = (1,0,2);\r
5088 \r
5089 type\r
5090   tFIN_DATA = Record\r
5091                 dname: array[1..12] of Char;\r
5092                 iname: array[1..27] of Char;\r
5093                 idata: tFM_INST_DATA;\r
5094               end;\r
5095 var\r
5096   f: File;\r
5097   header: tFMK_HEADER;\r
5098   order_list: array[0..254] of Byte;\r
5099   paraptr_ins: array[1..99] of Word;\r
5100   paraptr_pat: array[0..63] of Longint;\r
5101   paraptr_msg: Word;\r
5102   insdata: tFIN_DATA;\r
5103   temp,temp2,fpos_bak: Longint;\r
5104   pat,row,chan,\r
5105   desc_rows: Byte;\r
5106   note,ins,vol,cmd,info: Byte;\r
5107   patlen,index: Word;\r
5108   dscbuf: array[0..PRED(20*24)] of Char;\r
5109 \r
5110 \r
5111 procedure import_fmk_event(pattern,line,channel,note,ins,vol,cmd,info: Byte);\r
5112 \r
5113 var\r
5114   chunk: tCHUNK;\r
5115 \r
5116 begin\r
5117   FillChar(chunk,SizeOf(chunk),0);\r
5118   If (ins in [1..99]) then chunk.instr_def := ins;\r
5119 \r
5120   Case note of\r
5121     254: chunk.note := BYTE_NULL;\r
5122     255: chunk.note := 0;\r
5123     else If (note AND $0f in [1..12]) then\r
5124            chunk.note := 12*(note SHR 4)+(note AND $0f)\r
5125   end;\r
5126 \r
5127   If (vol <> BYTE_NULL) then\r
5128     begin\r
5129       chunk.effect_def2 := ef_ForceInsVolume;\r
5130       chunk.effect2 := 63-max(vol,63)\r
5131     end;\r
5132 \r
5133   Case CHR(cmd+ORD('A')-1) of\r
5134   { SET SPEED }\r
5135     'A': If (info <> 0) then\r
5136            begin\r
5137              chunk.effect_def := ef_SetSpeed;\r
5138              chunk.effect := info;\r
5139            end;\r
5140 \r
5141   { JUMP TO ORDER }\r
5142     'B': If (info <= 254) then\r
5143            begin\r
5144              chunk.effect_def := ef_PositionJump;\r
5145              chunk.effect := info;\r
5146            end;\r
5147 \r
5148   { CARRIER PARAM }\r
5149     'C': Case info DIV 16 of\r
5150            1: begin\r
5151                 chunk.effect_def := ef_Extended3;\r
5152                 chunk.effect := ef_ex3_SetMultipC*16+info MOD 16;\r
5153               end;\r
5154 \r
5155            2: begin\r
5156                 chunk.effect_def := ef_Extended3;\r
5157                 chunk.effect := ef_ex3_SetKslC*16+(info MOD 16) AND 3;\r
5158               end;\r
5159 \r
5160            3: begin\r
5161                 chunk.effect_def := ef_Extended;\r
5162                 chunk.effect := ef_ex_SetAttckRateC*16+info MOD 16;\r
5163               end;\r
5164 \r
5165            4: begin\r
5166                 chunk.effect_def := ef_Extended;\r
5167                 chunk.effect := ef_ex_SetDecayRateC*16+info MOD 16;\r
5168               end;\r
5169 \r
5170            5: begin\r
5171                 chunk.effect_def := ef_Extended;\r
5172                 chunk.effect := ef_ex_SetSustnLevelC*16+info MOD 16;\r
5173               end;\r
5174 \r
5175            6: begin\r
5176                 chunk.effect_def := ef_Extended;\r
5177                 chunk.effect := ef_ex_SetRelRateC*16+info MOD 16;\r
5178               end;\r
5179 \r
5180            7: begin\r
5181                 chunk.effect_def := ef_SetWaveform;\r
5182                 chunk.effect := info AND 7 SHL 4+$0f;\r
5183               end;\r
5184 \r
5185            8: begin\r
5186                 chunk.effect_def := ef_Extended;\r
5187                 chunk.effect := ef_ex_SetFeedback*16+info AND 7;\r
5188               end;\r
5189          end;\r
5190 \r
5191   { VOLUME SLIDE }\r
5192     'D': { VOLUME SLIDE DOWN }\r
5193          Case info DIV 16 of\r
5194          { NORMAL }\r
5195            0: If (info MOD 16 = 0) then chunk.effect_def := temp_ef_XFVSlide\r
5196               else begin\r
5197                      chunk.effect_def := ef_Extended2;\r
5198                      chunk.effect := ef_ex2_VolSlideDnXF*16+info MOD 16\r
5199                    end;\r
5200          { FINE }\r
5201           15: begin\r
5202                 chunk.effect_def := ef_VolSlideFine;\r
5203                 chunk.effect := info MOD 16;\r
5204               end;\r
5205          else\r
5206            { VOLUME SLIDE UP }\r
5207            Case info MOD 16 of\r
5208            { NORMAL }\r
5209              0: If (info DIV 16 = 0) then chunk.effect_def := temp_ef_XFVSlide\r
5210                 else begin\r
5211                        chunk.effect_def := ef_Extended2;\r
5212                        chunk.effect := ef_ex2_VolSlideUpXF*16+info DIV 16;\r
5213                      end;\r
5214            { FINE }\r
5215             15: begin\r
5216                   chunk.effect_def := ef_VolSlideFine;\r
5217                   chunk.effect := info AND $0f0;\r
5218                 end;\r
5219            end;\r
5220          end;\r
5221 \r
5222   { SLIDE DOWN }\r
5223     'E': Case info DIV 16 of\r
5224          { NORMAL }\r
5225            0..14: begin\r
5226                     chunk.effect_def := ef_FSlideDown;\r
5227                     chunk.effect := info;\r
5228                end;\r
5229 \r
5230          { FINE }\r
5231            15: begin\r
5232                  chunk.effect_def := ef_FSlideDownFine;\r
5233                  chunk.effect := info AND $0f;\r
5234                end;\r
5235          end;\r
5236 \r
5237   { SLIDE UP }\r
5238     'F': Case info DIV 16 of\r
5239          { NORMAL }\r
5240            0..14: begin\r
5241                     chunk.effect_def := ef_FSlideUp;\r
5242                     chunk.effect := info;\r
5243                   end;\r
5244 \r
5245          { FINE }\r
5246            15: begin\r
5247                  chunk.effect_def := ef_FSlideUpFine;\r
5248                  chunk.effect := info AND $0f;\r
5249                end;\r
5250          end;\r
5251 \r
5252   { TONE PORTAMENTO }\r
5253     'G': begin\r
5254            chunk.effect_def := ef_TonePortamento;\r
5255            chunk.effect := info;\r
5256          end;\r
5257 \r
5258   { VIBRATO }\r
5259     'H': begin\r
5260            chunk.effect_def := ef_Vibrato;\r
5261            If (info <> 0) and (info DIV 16 = 0) then\r
5262              chunk.effect := $10+info AND $0f\r
5263            else If (info <> 0) and (info MOD 16 = 0) then\r
5264                   chunk.effect := info AND $0f0+1\r
5265                 else chunk.effect := info;\r
5266          end;\r
5267 \r
5268   { RETRIG NOTE }\r
5269     'I': begin\r
5270            chunk.effect_def := ef_RetrigNote;\r
5271            If (info <> 0) then chunk.effect := max(info*2,255);\r
5272          end;\r
5273 \r
5274   { ARPEGGIO }\r
5275     'J': begin\r
5276            chunk.effect_def := temp_ef_Arpeggio;\r
5277            chunk.effect := info;\r
5278          end;\r
5279 \r
5280   { MODLATOR PARAM }\r
5281     'M': Case info DIV 16 of\r
5282            1: begin\r
5283                 chunk.effect_def := ef_Extended3;\r
5284                 chunk.effect := ef_ex3_SetMultipM*16+info MOD 16;\r
5285               end;\r
5286 \r
5287            2: begin\r
5288                 chunk.effect_def := ef_Extended3;\r
5289                 chunk.effect := ef_ex3_SetKslM*16+(info MOD 16) AND 3;\r
5290               end;\r
5291 \r
5292            3: begin\r
5293                 chunk.effect_def := ef_Extended;\r
5294                 chunk.effect := ef_ex_SetAttckRateM*16+info MOD 16;\r
5295               end;\r
5296 \r
5297            4: begin\r
5298                 chunk.effect_def := ef_Extended;\r
5299                 chunk.effect := ef_ex_SetDecayRateM*16+info MOD 16;\r
5300               end;\r
5301 \r
5302            5: begin\r
5303                 chunk.effect_def := ef_Extended;\r
5304                 chunk.effect := ef_ex_SetSustnLevelM*16+info MOD 16;\r
5305               end;\r
5306 \r
5307            6: begin\r
5308                 chunk.effect_def := ef_Extended;\r
5309                 chunk.effect := ef_ex_SetRelRateM*16+info MOD 16;\r
5310               end;\r
5311 \r
5312            7: begin\r
5313                 chunk.effect_def := ef_SetWaveform;\r
5314                 chunk.effect := $0f0+info AND 7;\r
5315               end;\r
5316 \r
5317            8: begin\r
5318                 chunk.effect_def := ef_Extended;\r
5319                 chunk.effect := ef_ex_SetFeedback*16+info AND 7;\r
5320               end;\r
5321          end;\r
5322 \r
5323   { SET VIBRATO/TREMOLO WAVEFORM }\r
5324     'N': ;\r
5325 \r
5326   { BREAK PATTERN }\r
5327     'P': If (info < 64) then\r
5328            begin\r
5329              chunk.effect_def := ef_PatternBreak;\r
5330              chunk.effect := Str2num(Num2str(info,16),10);\r
5331            end;\r
5332 \r
5333   { TREMOLO }\r
5334     'R': begin\r
5335            chunk.effect_def := ef_Tremolo;\r
5336            If (info <> 0) and (info DIV 16 = 0) then\r
5337              chunk.effect := $10+info AND $0f\r
5338            else If (info <> 0) and (info MOD 16 = 0) then\r
5339                   chunk.effect := info AND $0f0+1\r
5340                 else chunk.effect := info;\r
5341          end;\r
5342 \r
5343   { STEREO CONTROL }\r
5344     'S': If (header.glob_var AND 1 = 1) then\r
5345            begin\r
5346              chunk.effect_def := ef_Extended;\r
5347              Case info of\r
5348                1: chunk.effect := ef_ex_SetPanningPos*16+1;\r
5349                2: chunk.effect := ef_ex_SetPanningPos*16+0;\r
5350                3: chunk.effect := ef_ex_SetPanningPos*16+2;\r
5351              end;\r
5352            end;\r
5353 \r
5354   { MODULATOR VOLUME }\r
5355     'T': begin\r
5356            chunk.effect_def := ef_SetModulatorVol;\r
5357            chunk.effect := info AND $3f;\r
5358          end;\r
5359 \r
5360   { CARRIER VOLUME }\r
5361     'U': begin\r
5362            chunk.effect_def := ef_SetCarrierVol;\r
5363            chunk.effect := info AND $3f;\r
5364          end;\r
5365   end;\r
5366 \r
5367   If (chunk.effect_def = 0) and (chunk.effect <> 0) then\r
5368     chunk.effect := 0;\r
5369   put_chunk(pattern,line,channel,chunk);\r
5370 end;\r
5371 \r
5372 begin\r
5373   {$i-}\r
5374   Assign(f,songdata_source);\r
5375   ResetF(f);\r
5376   {$i+}\r
5377   If (IOresult <> 0) then\r
5378     begin\r
5379       CloseF(f);\r
5380       EXIT;\r
5381     end;\r
5382 \r
5383   BlockReadF(f,header,SizeOf(header),temp);\r
5384   If NOT ((temp = SizeOf(header)) and (header.id = id)) then\r
5385     begin\r
5386       CloseF(f);\r
5387       EXIT;\r
5388     end;\r
5389 \r
5390   load_flag := $7f;\r
5391   If (header.bytef4 <> $f4) or NOT (header.ftype in [1,2]) then\r
5392     begin\r
5393       CloseF(f);\r
5394       EXIT;\r
5395     end;\r
5396 \r
5397   If (header.ftype = 2) then\r
5398     begin\r
5399       SeekF(f,SizeOf(header)-2);\r
5400       If (IOresult <> 0) then\r
5401         begin\r
5402           CloseF(f);\r
5403           EXIT;\r
5404         end;\r
5405     end;\r
5406 \r
5407   If (header.ordnum <> 0) then\r
5408     begin\r
5409       BlockReadF(f,order_list,header.ordnum,temp);\r
5410       If (IOresult <> 0) or (temp <> header.ordnum) then\r
5411         begin\r
5412           CloseF(f);\r
5413           EXIT;\r
5414         end;\r
5415     end;\r
5416 \r
5417   BlockReadF(f,paraptr_msg,SizeOf(paraptr_msg),temp);\r
5418   If (IOresult <> 0) or (temp <> SizeOf(paraptr_msg)) then\r
5419     begin\r
5420       CloseF(f);\r
5421       EXIT;\r
5422     end;\r
5423 \r
5424   fpos_bak := FilePos(f);\r
5425   If (paraptr_msg <> 0) then\r
5426     begin\r
5427       SeekF(f,paraptr_msg);\r
5428       If (IOresult <> 0) then\r
5429         begin\r
5430           CloseF(f);\r
5431           EXIT;\r
5432         end;\r
5433 \r
5434       BlockReadF(f,desc_rows,SizeOf(desc_rows),temp);\r
5435       If (IOresult <> 0) or (temp <> SizeOf(desc_rows)) then\r
5436         begin\r
5437           CloseF(f);\r
5438           EXIT;\r
5439         end;\r
5440 \r
5441       If (desc_rows <> 0) then\r
5442         begin\r
5443           BlockReadF(f,dscbuf,desc_rows*20,temp);\r
5444           If (IOresult <> 0) or (temp <> desc_rows*20) then\r
5445             begin\r
5446               CloseF(f);\r
5447               EXIT;\r
5448             end;\r
5449         end;\r
5450 \r
5451     end;\r
5452 \r
5453   SeekF(f,fpos_bak);\r
5454   If (IOresult <> 0) then\r
5455     begin\r
5456       CloseF(f);\r
5457       EXIT;\r
5458     end;\r
5459 \r
5460   If (header.insnum <> 0) then\r
5461     begin\r
5462       BlockReadF(f,paraptr_ins,header.insnum*2,temp);\r
5463       If (IOresult <> 0) or (temp <> header.insnum*2) then\r
5464         begin\r
5465           CloseF(f);\r
5466           EXIT;\r
5467         end;\r
5468     end;\r
5469 \r
5470   If (header.patnum <> 0) then\r
5471     begin\r
5472       BlockReadF(f,paraptr_pat,header.patnum*4,temp);\r
5473       If (IOresult <> 0) or (temp <> header.patnum*4) then\r
5474         begin\r
5475           CloseF(f);\r
5476           EXIT;\r
5477         end;\r
5478     end;\r
5479 \r
5480   init_songdata;\r
5481   load_flag := 0;\r
5482 \r
5483   If (header.init_spd <> 0) then speed := header.init_spd\r
5484   else speed := 1;\r
5485 \r
5486   If (header.base_spd <> 0) then tempo := header.base_spd\r
5487   else tempo := 50;\r
5488 \r
5489   songdata.tempo := tempo;\r
5490   songdata.speed := speed;\r
5491   songdata.songname := truncate_string(header.songname);\r
5492   songdata.composer := truncate_string(header.composer);\r
5493   songdata.common_flag := songdata.common_flag OR 1;\r
5494   songdata.common_flag := songdata.common_flag OR 2;\r
5495   songdata.common_flag := songdata.common_flag OR $80;\r
5496 \r
5497   For temp := 18 downto 1 do\r
5498     If NOT (header.trk_set[temp] AND 7 = 7) then BREAK;\r
5499 \r
5500   songdata.patt_len := 64;\r
5501   If adjust_tracks then songdata.nm_tracks := temp\r
5502   else If (songdata.nm_tracks < 18) then songdata.nm_tracks := 18;\r
5503 \r
5504   For temp2 := 1 to temp do\r
5505     If (header.trk_set[temp2] AND 7 = 6) then\r
5506       Case temp2 of\r
5507         1,2:   songdata.flag_4op := songdata.flag_4op OR 1;\r
5508         3,4:   songdata.flag_4op := songdata.flag_4op OR 2;\r
5509         5,6:   songdata.flag_4op := songdata.flag_4op OR 4;\r
5510         10,11: songdata.flag_4op := songdata.flag_4op OR 8;\r
5511         12,13: songdata.flag_4op := songdata.flag_4op OR $10;\r
5512         14,15: songdata.flag_4op := songdata.flag_4op OR $20;\r
5513       end;\r
5514 \r
5515   If (header.glob_var AND 1 = 1) then\r
5516     songdata.common_flag := songdata.common_flag OR $20;\r
5517 \r
5518   If (header.glob_var SHR 3 AND 1 = 1) then\r
5519     songdata.common_flag := songdata.common_flag OR 8;\r
5520 \r
5521   If (header.glob_var SHR 4 AND 1 = 1) then\r
5522     songdata.common_flag := songdata.common_flag OR $10;\r
5523 \r
5524   import_old_flags;\r
5525   If (header.glob_var AND 1 = 1) then\r
5526     begin\r
5527       Inc(songdata.lock_flags[1], _conv_fmk_pan[header.trk_pan[1] AND 3]);\r
5528       Inc(songdata.lock_flags[2], _conv_fmk_pan[header.trk_pan[1] SHR 2 AND 3]);\r
5529       Inc(songdata.lock_flags[3], _conv_fmk_pan[header.trk_pan[1] SHR 4 AND 3]);\r
5530       Inc(songdata.lock_flags[4], _conv_fmk_pan[header.trk_pan[1] SHR 6 AND 3]);\r
5531       Inc(songdata.lock_flags[5], _conv_fmk_pan[header.trk_pan[2] AND 3]);\r
5532       Inc(songdata.lock_flags[6], _conv_fmk_pan[header.trk_pan[2] SHR 2 AND 3]);\r
5533       Inc(songdata.lock_flags[7], _conv_fmk_pan[header.trk_pan[2] SHR 4 AND 3]);\r
5534       Inc(songdata.lock_flags[8], _conv_fmk_pan[header.trk_pan[2] SHR 6 AND 3]);\r
5535       Inc(songdata.lock_flags[9], _conv_fmk_pan[header.trk_pan[3] AND 3]);\r
5536       Inc(songdata.lock_flags[10],_conv_fmk_pan[header.trk_pan[3] SHR 2 AND 3]);\r
5537       Inc(songdata.lock_flags[11],_conv_fmk_pan[header.trk_pan[3] SHR 4 AND 3]);\r
5538       Inc(songdata.lock_flags[12],_conv_fmk_pan[header.trk_pan[3] SHR 6 AND 3]);\r
5539       Inc(songdata.lock_flags[13],_conv_fmk_pan[header.trk_pan[4] AND 3]);\r
5540       Inc(songdata.lock_flags[14],_conv_fmk_pan[header.trk_pan[4] SHR 2 AND 3]);\r
5541       Inc(songdata.lock_flags[15],_conv_fmk_pan[header.trk_pan[4] SHR 4 AND 3]);\r
5542       Inc(songdata.lock_flags[16],_conv_fmk_pan[header.trk_pan[4] SHR 6 AND 3]);\r
5543       Inc(songdata.lock_flags[17],_conv_fmk_pan[header.trk_pan[5] AND 3]);\r
5544       Inc(songdata.lock_flags[18],_conv_fmk_pan[header.trk_pan[5] SHR 2 AND 3]);\r
5545     end;\r
5546 \r
5547   For temp := 1 to max(header.ordnum,128) do\r
5548     Case order_list[temp-1] of\r
5549       255: songdata.pattern_order[temp-1] := $80;\r
5550       else songdata.pattern_order[temp-1] := order_list[temp-1];\r
5551     end;\r
5552 \r
5553   For temp := 1 to header.insnum do\r
5554     begin\r
5555       SeekF(f,paraptr_ins[temp]);\r
5556       If (IOresult <> 0) then\r
5557         begin\r
5558           CloseF(f);\r
5559           EXIT;\r
5560         end;\r
5561 \r
5562       BlockReadF(f,insdata,SizeOf(insdata),temp2);\r
5563       If (IOresult <> 0) or (temp2 <> SizeOf(insdata)) then\r
5564         begin\r
5565           CloseF(f);\r
5566           EXIT;\r
5567         end;\r
5568 \r
5569       If (truncate_string(insdata.iname) <> '') then\r
5570         songdata.instr_names[temp] :=\r
5571           Copy(songdata.instr_names[temp],1,9)+\r
5572           Copy(truncate_string(insdata.iname),1,32)\r
5573       else\r
5574         songdata.instr_names[temp] :=\r
5575           Copy(songdata.instr_names[temp],1,9)+\r
5576           truncate_string(insdata.dname);\r
5577 \r
5578       import_fin_instrument(temp,insdata.idata);\r
5579     end;\r
5580 \r
5581   For pat := 0 to PRED(header.patnum) do\r
5582     begin\r
5583       SeekF(f,paraptr_pat[pat]);\r
5584       If (IOresult <> 0) then\r
5585         begin\r
5586           CloseF(f);\r
5587           EXIT;\r
5588         end;\r
5589 \r
5590       If (paraptr_pat[pat] = 0) then CONTINUE;\r
5591       BlockReadF(f,patlen,SizeOf(patlen),temp2);\r
5592       If (temp2 <> SizeOf(patlen)) then\r
5593         begin\r
5594           CloseF(f);\r
5595           EXIT;\r
5596         end;\r
5597 \r
5598       If (patlen = 0) then CONTINUE;\r
5599       FillChar(buf1,SizeOf(buf1),0);\r
5600       BlockReadF(f,buf1,patlen,temp2);\r
5601 \r
5602       index := 0;\r
5603       row := 0;\r
5604 \r
5605       Repeat\r
5606         If (buf1[index] <> 0) then\r
5607           begin\r
5608             note := BYTE_NULL;\r
5609             ins  := 0;\r
5610             vol  := BYTE_NULL;\r
5611             cmd  := 0;\r
5612             info := 0;\r
5613             temp := buf1[index];\r
5614             Inc(index);\r
5615 \r
5616             chan := SUCC(temp AND 31);\r
5617             If (temp OR $20 = temp) then\r
5618               begin\r
5619                 note := buf1[index];\r
5620                 Inc(index);\r
5621                 ins := buf1[index];\r
5622                 Inc(index);\r
5623               end;\r
5624 \r
5625             If (temp OR $40 = temp) then\r
5626               begin\r
5627                 vol := buf1[index];\r
5628                 Inc(index);\r
5629               end;\r
5630 \r
5631             If (temp OR $80 = temp) then\r
5632               begin\r
5633                 cmd := buf1[index];\r
5634                 Inc(index);\r
5635                 info := buf1[index];\r
5636                 Inc(index);\r
5637               end;\r
5638 \r
5639             If (PRED(chan) in [1..18]) then\r
5640               import_fmk_event(pat,row,PRED(chan),note,ins,vol,cmd,info);\r
5641           end\r
5642         else\r
5643           begin\r
5644             Inc(row);\r
5645             Inc(index);\r
5646           end;\r
5647       until (row = 64);\r
5648     end;\r
5649 \r
5650   fix_fmk_commands(header.patnum);\r
5651   CloseF(f);\r
5652   songdata_title := NameOnly(songdata_source);\r
5653   load_flag := 13;\r
5654 end;\r
5655 \r
5656 procedure import_sat_instrument(inst: Byte; var data);\r
5657 begin\r
5658   With songdata.instr_data[inst] do\r
5659     begin\r
5660       fm_data.FEEDBACK_FM         := tDUMMY_BUFF(data)[0] AND $0f;\r
5661       fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[1];\r
5662       fm_data.AM_VIB_EG_carrier   := tDUMMY_BUFF(data)[2];\r
5663       fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[3];\r
5664       fm_data.ATTCK_DEC_carrier   := tDUMMY_BUFF(data)[4];\r
5665       fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[5];\r
5666       fm_data.SUSTN_REL_carrier   := tDUMMY_BUFF(data)[6];\r
5667       fm_data.WAVEFORM_modulator  := tDUMMY_BUFF(data)[7] AND 3;\r
5668       fm_data.WAVEFORM_carrier    := tDUMMY_BUFF(data)[8] AND 3;\r
5669       fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[9];\r
5670       fm_data.KSL_VOLUM_carrier   := tDUMMY_BUFF(data)[10];\r
5671     end;\r
5672 \r
5673   songdata.instr_data[inst].panning := 0;\r
5674   songdata.instr_data[inst].fine_tune := 0;\r
5675 end;\r
5676 \r
5677 function import_sat_instrument_name(var data; inst: Byte): String;\r
5678 \r
5679 var\r
5680   temp1: Word;\r
5681   temp2: Byte;\r
5682   temp3: String;\r
5683 \r
5684 begin\r
5685   temp1 := 0;\r
5686   temp2 := 0;\r
5687   temp3 := '';\r
5688 \r
5689   While (temp1 < 496) do\r
5690     begin\r
5691       If (tDUMMY_BUFF(data)[temp1] = BYTE('\10')) then Inc(temp2);\r
5692       Inc(temp1);\r
5693       If (temp2 = inst+1) then\r
5694         begin\r
5695           While (tDUMMY_BUFF(data)[temp1] in [$20..$0ff]) and\r
5696                 (Length(temp3) < 22) do\r
5697             begin\r
5698               temp3 := temp3+CHR(tDUMMY_BUFF(data)[temp1]);\r
5699               Inc(temp1);\r
5700             end;\r
5701           BREAK;\r
5702         end;\r
5703     end;\r
5704 \r
5705   import_sat_instrument_name := temp3;\r
5706 end;\r
5707 \r
5708 procedure import_sa2_effect(effect,def1,def2: Byte;\r
5709                             var out1,out2: Byte); forward;\r
5710 procedure sat_file_loader;\r
5711 \r
5712 type\r
5713   tHEADER = Record { version 1 }\r
5714               ident: array[1..4]   of Char; { ident_string }\r
5715               vernm: Byte;                  { version_number (1) }\r
5716               instt: array[0..$1e] of       { 31_instruments }\r
5717                      array[0..$0a] of Byte;\r
5718               instn: array[0..495] of Byte; { 31_instrument_names }\r
5719               order: array[0..254] of Byte; { pattern_order }\r
5720               nopat: Word;                  { number of patterns }\r
5721               snlen: Byte;                  { song_length }\r
5722               rspos: Byte;                  { restart_position }\r
5723               calls: Word;                  { calls_per_second }\r
5724             end;\r
5725 type\r
5726   tHEADR2 = Record { version 6 }\r
5727               ident: array[1..4]   of Char; { ident_string }\r
5728               vernm: Byte;                  { version_number (1) }\r
5729               instt: array[0..$1e] of       { 31_instruments }\r
5730                      array[0..$0e] of Byte;\r
5731               instn: array[0..495] of Byte; { 31_instrument_names }\r
5732               order: array[0..$7f] of Byte; { pattern_order }\r
5733               nopat: Word;                  { number of patterns }\r
5734               snlen: Byte;                  { song_length }\r
5735               rspos: Byte;                  { restart_position }\r
5736               calls: Word;                  { calls_per_second }\r
5737               arpgd: array[1..512] of Byte; { arpeggio_data }\r
5738             end;\r
5739 const\r
5740   id = 'SAdT';\r
5741 \r
5742 var\r
5743   f: File;\r
5744   header: tHEADER;\r
5745   headr2: tHEADR2;\r
5746   SATver: Byte;\r
5747   temp,tmp2,tmp3,temp2,temp3,\r
5748   temp4,temp5: Longint;\r
5749   byte1,byte2,byte3,byte4,byte5,note_inc: Byte;\r
5750 \r
5751 procedure import_sat_event(pattern,line,channel,\r
5752                            byte1,byte2,byte3,byte4,byte5: Byte);\r
5753 var\r
5754   chunk: tCHUNK;\r
5755 \r
5756 begin\r
5757   FillChar(chunk,SizeOf(chunk),0);\r
5758   If (byte2 in [1..31]) then chunk.instr_def := byte2;\r
5759   If (byte1 in [1..12*8+1]) then chunk.note := byte1+note_inc;\r
5760 \r
5761   import_sa2_effect(byte3,byte4,byte5,chunk.effect_def,chunk.effect);\r
5762   If (chunk.effect_def = ef_Extended) and\r
5763      (chunk.effect = ef_ex_ExtendedCmd*16) and (chunk.note = 0) then\r
5764     begin\r
5765       chunk.note := BYTE_NULL;\r
5766       chunk.effect_def := 0;\r
5767       chunk.effect := 0;\r
5768     end;\r
5769 \r
5770   put_chunk(pattern,line,channel,chunk);\r
5771 end;\r
5772 \r
5773 var\r
5774   absolute: Longint;\r
5775 \r
5776 function get_byte(var pos: Longint): Byte;\r
5777 begin\r
5778   If (pos = SizeOf(buf1)-5) then\r
5779     begin\r
5780       If NOT (absolute > SizeOf(buf1)-5) then Move(buf3,buf1,SizeOf(buf3)-5)\r
5781       else Move(buf4,buf1,SizeOf(buf4)-5);\r
5782       pos := 0;\r
5783     end;\r
5784   get_byte := buf1[pos];\r
5785   Inc(pos);\r
5786   Inc(absolute);\r
5787 end;\r
5788 \r
5789 begin\r
5790   {$i-}\r
5791   Assign(f,songdata_source);\r
5792   ResetF(f);\r
5793   {$i+}\r
5794   If (IOresult <> 0) then\r
5795     begin\r
5796       CloseF(f);\r
5797       EXIT;\r
5798     end;\r
5799 \r
5800   BlockReadF(f,header,SizeOf(header),temp);\r
5801   If NOT ((temp = SizeOf(header)) and (header.ident = id)) then\r
5802     begin\r
5803       CloseF(f);\r
5804       EXIT;\r
5805     end;\r
5806 \r
5807   If NOT (header.vernm in [1,5,6]) then\r
5808     begin\r
5809       CloseF(f);\r
5810       EXIT;\r
5811     end;\r
5812 \r
5813   load_flag := $7f;\r
5814   SATver := header.vernm;\r
5815   If (SATver in [5,6]) then\r
5816     begin\r
5817       SeekF(f,0);\r
5818       If (IOresult <> 0) then\r
5819         begin\r
5820           CloseF(f);\r
5821           EXIT;\r
5822         end;\r
5823 \r
5824       BlockReadF(f,headr2,SizeOf(headr2),temp);\r
5825       If (temp <> SizeOf(headr2)) then\r
5826         begin\r
5827           CloseF(f);\r
5828           EXIT;\r
5829         end;\r
5830     end;\r
5831 \r
5832   temp5 := (FileSize(f)-temp) DIV (64*9*5);\r
5833   FillChar(buf1,SizeOf(buf1),0);\r
5834   BlockReadF(f,buf1,SizeOf(buf1)-5,temp);\r
5835   If (IOresult <> 0) then\r
5836     begin\r
5837       CloseF(f);\r
5838       EXIT;\r
5839     end;\r
5840 \r
5841   tmp2 := WORD_NULL;\r
5842   If (temp = SizeOf(buf1)-5) then\r
5843     begin\r
5844       FillChar(buf3,SizeOf(buf3),0);\r
5845       BlockReadF(f,buf3,SizeOf(buf3)-5,tmp2);\r
5846       If (IOresult <> 0) then\r
5847         begin\r
5848           CloseF(f);\r
5849           EXIT;\r
5850         end;\r
5851     end;\r
5852 \r
5853   tmp3 := WORD_NULL;\r
5854   If (tmp2 = SizeOf(buf3)-5) then\r
5855     begin\r
5856       FillChar(buf4,SizeOf(buf4),0);\r
5857       BlockReadF(f,buf4,SizeOf(buf4)-5,tmp3);\r
5858       If (IOresult <> 0) then\r
5859         begin\r
5860           CloseF(f);\r
5861           EXIT;\r
5862         end;\r
5863     end;\r
5864 \r
5865   init_songdata;\r
5866   load_flag := 0;\r
5867 \r
5868   songdata.common_flag := songdata.common_flag OR 8;\r
5869   songdata.common_flag := songdata.common_flag OR $10;\r
5870   import_old_flags;\r
5871 \r
5872   songdata.patt_len := 64;\r
5873   If adjust_tracks then songdata.nm_tracks := 9\r
5874   else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
5875 \r
5876   For temp := 1 to 20 do\r
5877     songdata.lock_flags[temp] := songdata.lock_flags[temp] OR 4 OR 8;\r
5878 \r
5879   If (SATver = 1) then\r
5880     begin\r
5881       speed := 6;\r
5882       If (header.calls < 255) then tempo := header.calls\r
5883       else tempo := 255;\r
5884 \r
5885       songdata.tempo := tempo;\r
5886       songdata.speed := speed;\r
5887 \r
5888       For temp := 0 to max(header.snlen-1,127) do\r
5889         If (temp < 128) and (header.order[temp] in [0..63]) then\r
5890           songdata.pattern_order[temp] := header.order[temp];\r
5891       If (header.rspos < 128) and (SUCC(temp) < 128) then\r
5892         songdata.pattern_order[SUCC(temp)] := $80+header.rspos;\r
5893 \r
5894       temp5 := max(temp5,header.nopat);\r
5895       For temp := 0 to $1e do\r
5896         begin\r
5897           import_sat_instrument(temp+1,header.instt[temp]);\r
5898           songdata.instr_names[temp+1] :=\r
5899             Copy(songdata.instr_names[temp+1],1,9)+\r
5900             truncate_string(import_sat_instrument_name(header.instn,temp));\r
5901         end;\r
5902     end\r
5903   else\r
5904     begin\r
5905       speed := 6;\r
5906       If (headr2.calls < 255) then tempo := headr2.calls\r
5907       else tempo := 255;\r
5908 \r
5909       songdata.tempo := tempo;\r
5910       songdata.speed := speed;\r
5911 \r
5912       For temp := 0 to headr2.snlen-1 do\r
5913         If (temp < 128) and (headr2.order[temp] in [0..63]) then\r
5914           songdata.pattern_order[temp] := headr2.order[temp];\r
5915       If (headr2.rspos < 128) and (SUCC(temp) < 128) then\r
5916         songdata.pattern_order[SUCC(temp)] := $80+headr2.rspos;\r
5917 \r
5918       temp5 := max(temp5,headr2.nopat);\r
5919       For temp := 0 to $1e do\r
5920         begin\r
5921           import_sat_instrument(temp+1,headr2.instt[temp]);\r
5922           songdata.instr_names[temp+1] :=\r
5923             Copy(songdata.instr_names[temp+1],1,9)+\r
5924             truncate_string(import_sat_instrument_name(headr2.instn,temp));\r
5925         end;\r
5926     end;\r
5927 \r
5928   temp := 0;\r
5929   absolute := 0;\r
5930 \r
5931   Case SATver of\r
5932     1: note_inc := 24;\r
5933     5: note_inc := 12;\r
5934     6: note_inc := 0;\r
5935   end;\r
5936 \r
5937   For temp2 := 0 to temp5-1 do\r
5938     For temp3 := 0 to 63 do\r
5939       For temp4 := 1 to 9 do\r
5940         begin\r
5941           byte1 := get_byte(temp);\r
5942           byte2 := get_byte(temp);\r
5943           byte3 := get_byte(temp);\r
5944           byte4 := get_byte(temp);\r
5945           byte5 := get_byte(temp);\r
5946           import_sat_event(temp2,temp3,temp4,byte1,byte2,byte3,byte4,byte5);\r
5947         end;\r
5948 \r
5949   CloseF(f);\r
5950   songdata_title := NameOnly(songdata_source);\r
5951   load_flag := 14;\r
5952 end;\r
5953 \r
5954 function _sal(op1,op2: Word): Byte;\r
5955 \r
5956 var\r
5957   result: Byte;\r
5958 \r
5959 begin\r
5960   asm\r
5961         mov     ax,op1\r
5962         mov     cx,op2\r
5963         sal     ax,cl\r
5964         mov     result,al\r
5965   end;\r
5966   _sal := result;\r
5967 end;\r
5968 \r
5969 function _sar(op1,op2: Word): Byte;\r
5970 \r
5971 var\r
5972   result: Byte;\r
5973 \r
5974 begin\r
5975   asm\r
5976         mov     ax,op1\r
5977         mov     cx,op2\r
5978         sar     ax,cl\r
5979         mov     result,al\r
5980   end;\r
5981   _sar := result;\r
5982 end;\r
5983 \r
5984 procedure import_sa2_effect(effect,def1,def2: Byte;\r
5985                             var out1,out2: Byte);\r
5986 begin\r
5987   Case effect of\r
5988   { NORMAL PLAY OR ARPEGGIO }\r
5989     $00: begin\r
5990            out1 := ef_Arpeggio;\r
5991            out2 := def1*16+def2;\r
5992          end;\r
5993 \r
5994   { SLIDE UP }\r
5995     $01: begin\r
5996            out1 := ef_FSlideUp;\r
5997            out2 := def1*16+def2;\r
5998          end;\r
5999 \r
6000   { SLIDE DOWN }\r
6001     $02: begin\r
6002            out1 := ef_FSlideDown;\r
6003            out2 := def1*16+def2;\r
6004          end;\r
6005 \r
6006   { TONE PORTAMENTO }\r
6007     $03: begin\r
6008            out1 := ef_TonePortamento;\r
6009            out2 := def1*16+def2;\r
6010          end;\r
6011 \r
6012   { VIBRATO }\r
6013     $04: begin\r
6014            out1 := ef_Vibrato;\r
6015            out2 := def1*16+def2;\r
6016          end;\r
6017 \r
6018   { TONE PORTAMENTO + VOLUME SLIDE }\r
6019     $05: If (def1+def2 <> 0) then\r
6020            If (def1 in [1..15]) then\r
6021              begin\r
6022                out1 := ef_TPortamVolSlide;\r
6023                out2 := min(_sar(def1,2),1)*16;\r
6024              end\r
6025            else begin\r
6026                   out1 := ef_TPortamVolSlide;\r
6027                   out2 := min(_sar(def2,2),1);\r
6028                 end\r
6029          else\r
6030            begin\r
6031              out1 := ef_TPortamVolSlide;\r
6032              out2 := def1*16+def2;\r
6033            end;\r
6034 \r
6035   { VIBRATO + VOLUME SLIDE }\r
6036     $06: If (def1+def2 <> 0) then\r
6037            If (def1 in [1..15]) then\r
6038              begin\r
6039                out1 := ef_VibratoVolSlide;\r
6040                out2 := min(_sar(def1,2),1)*16;\r
6041              end\r
6042            else begin\r
6043                   out1 := ef_VibratoVolSlide;\r
6044                   out2 := min(_sar(def2,2),1);\r
6045                 end\r
6046          else\r
6047            begin\r
6048              out1 := ef_VibratoVolSlide;\r
6049              out2 := def1*16+def2;\r
6050            end;\r
6051 \r
6052   { RELEASE SUSTAINING SOUND }\r
6053     $08: begin\r
6054            out1 := ef_Extended;\r
6055            out2 := ef_ex_ExtendedCmd*16+0;\r
6056          end;\r
6057 \r
6058   { VOLUME SLIDE }\r
6059     $0a: If (def1+def2 <> 0) then\r
6060            If (def1 in [1..15]) then\r
6061              begin\r
6062                out1 := ef_VolSlide;\r
6063                out2 := min(_sar(def1,2),1)*16;\r
6064              end\r
6065            else begin\r
6066                   out1 := ef_VolSlide;\r
6067                   out2 := min(_sar(def2,2),1);\r
6068                 end\r
6069          else\r
6070            begin\r
6071              out1 := ef_VolSlide;\r
6072              out2 := def1*16+def2;\r
6073            end;\r
6074 \r
6075   { POSITION JUMP }\r
6076     $0b: If (def1*16+def2 < 128) then\r
6077            begin\r
6078              out1 := ef_PositionJump;\r
6079              out2 := def1*16+def2;\r
6080            end;\r
6081 \r
6082   { SET VOLUME }\r
6083     $0c: begin\r
6084            out1 := ef_SetInsVolume;\r
6085            out2 := def1*16+def2;\r
6086            If (out2 > 63) then out2 := 63;\r
6087          end;\r
6088 \r
6089   { PATTERN BREAK }\r
6090     $0d: If (def1*16+def2 < 64) then\r
6091            begin\r
6092              out1 := ef_PatternBreak;\r
6093              out2 := def1*16+def2;\r
6094            end;\r
6095 \r
6096   { SET SPEED }\r
6097     $0f: If (def1*16+def2 < $20) then\r
6098            begin\r
6099              out1 := ef_SetSpeed;\r
6100              out2 := def1*16+def2;\r
6101            end\r
6102          else If (def1 < 16) and (def2 < 16) then\r
6103                 begin\r
6104                   out1 := ef_SetTempo;\r
6105                   out2 := Round((def1*16+def2)/2.5);\r
6106                 end;\r
6107     else begin\r
6108            out1 := 0;\r
6109            out2 := 0;\r
6110          end;\r
6111   end;\r
6112 end;\r
6113 \r
6114 procedure sa2_file_loader;\r
6115 \r
6116 type\r
6117   tHEADER = Record\r
6118               ident: array[1..4]   of Char; { These bytes mark a song }\r
6119               vernm: Byte;                  { Version number (9) }\r
6120               instt: array[0..$1e] of       { 31 instruments }\r
6121                      array[0..$0e] of Byte;\r
6122               instn: array[0..495] of Byte; { 31_instrument_names }\r
6123               order: array[0..$7f] of Byte; { Pattern order }\r
6124               nopat: Word;                  { Number of patterns }\r
6125               snlen: Byte;                  { Length of song }\r
6126               rspos: Byte;                  { Restart position }\r
6127               snbpm: Word;                  { BPM }\r
6128               arpgd: array[1..512] of Byte; { Arpeggio data (list+commands) }\r
6129               ordr2: array[0..63]  of       { Track order }\r
6130                      array[1..9]   of Byte;\r
6131               chans: Word;                  { Active channels }\r
6132             end;\r
6133 const\r
6134   id = 'SAdT';\r
6135 \r
6136 var\r
6137   f: File;\r
6138   header: tHEADER;\r
6139   temp,temp2,temp3,temp4,temp5: Longint;\r
6140 \r
6141 procedure import_sa2_event(pattern,line,channel,\r
6142                            byte1,byte2,byte3: Byte);\r
6143 var\r
6144   chunk: tCHUNK;\r
6145   temp: Byte;\r
6146 \r
6147 begin\r
6148   FillChar(chunk,SizeOf(chunk),0);\r
6149   temp := (byte1 AND 1) SHL 4 +(byte2 SHR 4);\r
6150   If (temp in [1..31]) then chunk.instr_def := temp;\r
6151   If (byte1 SHR 1 in [1..12*8+1]) then chunk.note := (byte1 SHR 1);\r
6152 \r
6153   import_sa2_effect(byte2 AND $0f,byte3 SHR 4,byte3 AND $0f,\r
6154                     chunk.effect_def,chunk.effect);\r
6155   If (chunk.effect_def = ef_Extended) and\r
6156      (chunk.effect = ef_ex_ExtendedCmd*16) and (chunk.note = 0) then\r
6157     begin\r
6158       chunk.note := BYTE_NULL;\r
6159       chunk.effect_def := 0;\r
6160       chunk.effect := 0;\r
6161     end;\r
6162 \r
6163   put_chunk(pattern,line,channel,chunk);\r
6164 end;\r
6165 \r
6166 begin { sa2_file_loader }\r
6167   {$i-}\r
6168   Assign(f,songdata_source);\r
6169   ResetF(f);\r
6170   {$i+}\r
6171   If (IOresult <> 0) then\r
6172     begin\r
6173       CloseF(f);\r
6174       EXIT;\r
6175     end;\r
6176 \r
6177   BlockReadF(f,header,SizeOf(header),temp);\r
6178   If NOT ((temp = SizeOf(header)) and (header.ident = id)) then\r
6179     begin\r
6180       CloseF(f);\r
6181       EXIT;\r
6182     end;\r
6183 \r
6184   If NOT (header.vernm in [8,9]) then\r
6185     begin\r
6186       CloseF(f);\r
6187       EXIT;\r
6188     end;\r
6189 \r
6190   load_flag := $7f;\r
6191   If (header.vernm = 8) then\r
6192     begin\r
6193       SeekF(f,FilePos(f)-2);\r
6194       If (IOresult <> 0) then\r
6195         begin\r
6196           CloseF(f);\r
6197           EXIT;\r
6198         end;\r
6199     end;\r
6200 \r
6201   FillChar(buf1,SizeOf(buf1),0);\r
6202   BlockReadF(f,buf1,SizeOf(buf1)-3,temp);\r
6203   If (IOresult <> 0) then\r
6204     begin\r
6205       CloseF(f);\r
6206       EXIT;\r
6207     end;\r
6208 \r
6209   init_songdata;\r
6210   load_flag := 0;\r
6211 \r
6212   songdata.common_flag := songdata.common_flag OR 8;\r
6213   songdata.common_flag := songdata.common_flag OR $10;\r
6214   import_old_flags;\r
6215 \r
6216   songdata.patt_len := 64;\r
6217   If adjust_tracks then songdata.nm_tracks := 9\r
6218   else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9;\r
6219 \r
6220   For temp := 1 to 20 do\r
6221     songdata.lock_flags[temp] := songdata.lock_flags[temp] OR 4 OR 8;\r
6222 \r
6223   speed := 6;\r
6224   If (Round(header.snbpm/2.5) < 255) then tempo := Round(header.snbpm/2.5)\r
6225   else tempo := 255;\r
6226 \r
6227   songdata.tempo := tempo;\r
6228   songdata.speed := speed;\r
6229 \r
6230   temp2 := 0;\r
6231   temp3 := 0;\r
6232   temp4 := 1;\r
6233 \r
6234   Repeat\r
6235     While (header.ordr2[temp2][temp4] = 0) and\r
6236           (temp2 <= header.nopat-1) do\r
6237       begin\r
6238         Inc(temp4);\r
6239         If (temp4 > 9) then begin temp4 := 1; Inc(temp2); end;\r
6240       end;\r
6241 \r
6242     If (temp2 <= header.nopat-1) then\r
6243       begin\r
6244         temp5 := 64*3*(header.ordr2[temp2][temp4]-1)+temp3*3;\r
6245         import_sa2_event(temp2,temp3,temp4,buf1[temp5],\r
6246                                            buf1[temp5+1],\r
6247                                            buf1[temp5+2]);\r
6248         Inc(temp3);\r
6249         If (temp3 > $3f) then\r
6250           begin\r
6251             temp3 := 0;\r
6252             If (temp4 < 9) then Inc(temp4)\r
6253             else begin temp4 := 1; Inc(temp2); end;\r
6254           end;\r
6255       end;\r
6256   until (temp2 > header.nopat-1);\r
6257 \r
6258   For temp := 0 to header.snlen-1 do\r
6259     If (temp < 128) and (header.order[temp] in [0..63]) then\r
6260       songdata.pattern_order[temp] := header.order[temp];\r
6261   If (header.rspos < 128) and (SUCC(temp) < 128) then\r
6262     songdata.pattern_order[SUCC(temp)] := $80+header.rspos;\r
6263 \r
6264   For temp := 0 to $1e do\r
6265     begin\r
6266       import_sat_instrument(temp+1,header.instt[temp]);\r
6267       songdata.instr_names[temp+1] := Copy(songdata.instr_names[temp+1],1,9)+\r
6268         truncate_string(import_sat_instrument_name(header.instn,temp));\r
6269     end;\r
6270 \r
6271   CloseF(f);\r
6272   songdata_title := NameOnly(songdata_source);\r
6273   load_flag := 15;\r
6274 end;\r