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
15 procedure import_single_old_instrument(old_songdata: pOLD_FIXED_SONGDATA;
\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
50 function check_byte(var data; _byte: Byte; size: Longint): Boolean;
\r
65 @@1: mov result,FALSE
\r
68 check_byte := result;
\r
71 procedure insert_command(cmd,cmd2: Word; patterns: Byte; chan: Byte; exceptions: tByteSet);
\r
82 order := 0; patt := BYTE_NULL;
\r
85 If (Pos(CHR(songdata.pattern_order[order]),patts) <> 0) or
\r
86 (songdata.pattern_order[order] >= $80) then Inc(order)
\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
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
99 If (temp3 = chan) and (temp2 <= patt_break) then
\r
101 If (chunk.effect_def+chunk.effect = 0) or
\r
102 (chunk.effect_def in exceptions) then
\r
104 chunk.effect_def := HI(cmd);
\r
105 chunk.effect := LO(cmd);
\r
106 put_chunk(patt,temp2,temp3,chunk);
\r
109 else If (chunk.effect_def2+chunk.effect2 = 0) or
\r
110 (chunk.effect_def2 in exceptions) then
\r
112 chunk.effect_def2 := HI(cmd);
\r
113 chunk.effect2 := LO(cmd);
\r
114 put_chunk(patt,temp2,temp3,chunk);
\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
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
132 patts := patts+CHR(patt);
\r
134 until (patt >= patterns) or (order > $7f);
\r
138 adsr_carrier: array[1..9] of Boolean;
\r
140 procedure import_old_a2m_event1(patt,line,chan: Byte; old_chunk: tOLD_CHUNK;
\r
141 processing_whole_song: Boolean);
\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
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
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
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
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
204 If (old_chunk.effect DIV 16 <> 0) then
\r
206 chunk.effect_def := ef_SetCarrierVol;
\r
207 chunk.effect := 3+(old_chunk.effect DIV 16)*4;
\r
209 else If (old_chunk.effect MOD 16 <> 0) then
\r
211 chunk.effect_def := ef_SetModulatorVol;
\r
212 chunk.effect := 3+(old_chunk.effect MOD 16)*4;
\r
214 else chunk.effect_def := 0;
\r
217 Case old_chunk.effect DIV 16 of
\r
220 chunk.effect_def := ef_Extended;
\r
221 chunk.effect := ef_ex_SetTremDepth*16+old_chunk.effect MOD 16;
\r
226 chunk.effect_def := ef_Extended;
\r
227 chunk.effect := ef_ex_SetVibDepth*16+old_chunk.effect MOD 16;
\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
242 chunk.effect_def := ef_VolSlide;
\r
243 chunk.effect := (old_chunk.effect MOD 16)*16;
\r
248 chunk.effect_def := ef_VolSlide;
\r
249 chunk.effect := old_chunk.effect MOD 16;
\r
252 fx_ex_VSlideUpFine:
\r
254 chunk.effect_def := ef_VolSlideFine;
\r
255 chunk.effect := (old_chunk.effect MOD 16)*16;
\r
258 fx_ex_VSlideDownFine:
\r
260 chunk.effect_def := ef_VolSlideFine;
\r
261 chunk.effect := old_chunk.effect MOD 16;
\r
266 chunk.effect_def := ef_Extended2;
\r
267 chunk.effect := ef_ex2_FineTuneUp*16+old_chunk.effect MOD 16;
\r
270 fx_ex_ManSlideDown:
\r
272 chunk.effect_def := ef_Extended2;
\r
273 chunk.effect := ef_ex2_FineTuneDown*16+old_chunk.effect MOD 16;
\r
278 chunk.effect_def := ef_RetrigNote;
\r
279 chunk.effect := SUCC(old_chunk.effect MOD 16);
\r
282 fx_ex_SetAttckRate:
\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
291 fx_ex_SetDecayRate:
\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
300 fx_ex_SetSustnLevel:
\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
309 fx_ex_SetReleaseRate:
\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
320 chunk.effect_def := ef_Extended;
\r
321 chunk.effect := ef_ex_SetFeedback*16+old_chunk.effect MOD 16;
\r
325 If (old_chunk.effect MOD 16 in [0..9]) then
\r
327 chunk.effect_def := ef_Extended;
\r
328 chunk.effect := ef_ex_ExtendedCmd*16;
\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
338 If processing_whole_song then chunk.effect_def := 255
\r
339 else chunk.effect_def := 0;
\r
341 adsr_carrier[chan] := TRUE;
\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
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
358 chunk.effect_def := 0;
\r
364 put_chunk(patt,line,chan,chunk);
\r
367 procedure replace_old_adsr(patterns: Byte);
\r
370 chunk,chunk2: tCHUNK;
\r
378 FillChar(adsr_carrier,SizeOf(adsr_carrier),0);
\r
380 order := 0; patt := BYTE_NULL;
\r
382 If (songdata.pattern_order[order] >= $80) then Inc(order)
\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
390 get_chunk(patt,temp2,temp3,chunk);
\r
393 If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) then
\r
394 patt_break := temp2;
\r
396 If (chunk.effect_def in [$ff,ef_Extended]) then
\r
398 If (chunk.effect_def = $ff) then
\r
400 chunk2.effect_def := 0;
\r
401 chunk2.effect := 0;
\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
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
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
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
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
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
444 patts := patts+CHR(patt);
\r
446 until (patt >= patterns) or (order > $7f);
\r
449 procedure import_old_a2m_patterns1(block: Byte; count: Byte);
\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
455 patt,line,chan: Byte;
\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
463 get_old_chunk(patt,line,chan,chunk);
\r
464 import_old_a2m_event1(block*16+patt,line,chan,chunk,TRUE);
\r
468 procedure import_old_a2m_event2(patt,line,chan: Byte; old_chunk: tOLD_CHUNK);
\r
471 ef_ManualFSlide = 22;
\r
477 FillChar(chunk,SizeOf(chunk),0);
\r
478 chunk.note := old_chunk.note;
\r
479 chunk.instr_def := old_chunk.instr_def;
\r
481 If (old_chunk.effect_def <> ef_ManualFSlide) then
\r
483 chunk.effect_def := old_chunk.effect_def;
\r
484 chunk.effect := old_chunk.effect;
\r
486 else If (old_chunk.effect DIV 16 <> 0) then
\r
488 chunk.effect_def := ef_Extended2;
\r
489 chunk.effect := ef_ex2_FineTuneUp*16+old_chunk.effect DIV 16;
\r
492 chunk.effect_def := ef_Extended2;
\r
493 chunk.effect := ef_ex2_FineTuneDown*16+old_chunk.effect MOD 16;
\r
496 put_chunk(patt,line,chan,chunk);
\r
499 procedure import_old_a2m_patterns2(block: Byte; count: Byte);
\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
505 patt,line,chan: Byte;
\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
513 get_old_chunk(patt,line,chan,chunk);
\r
514 import_old_a2m_event2(block*8+patt,line,chan,chunk);
\r
518 procedure import_old_flags;
\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
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
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
537 procedure import_old_songdata(old_songdata: pOLD_FIXED_SONGDATA);
\r
543 songdata.songname := old_songdata^.songname;
\r
544 songdata.composer := old_songdata^.composer;
\r
546 For temp := 1 to 250 do
\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
555 Move(old_songdata^.pattern_order,
\r
556 songdata.pattern_order,
\r
557 SizeOf(old_songdata^.pattern_order));
\r
559 songdata.tempo := old_songdata^.tempo;
\r
560 songdata.speed := old_songdata^.speed;
\r
561 songdata.common_flag := old_songdata^.common_flag;
\r
566 procedure a2m_file_loader;
\r
569 tOLD_HEADER = Record
\r
570 ident: array[1..10] of Char;
\r
586 ident: array[1..10] of Char;
\r
591 b1len: array[0..15] of Longint;
\r
598 old_a2m_header_size = 26;
\r
603 header2: tOLD_HEADER;
\r
604 temp,temp2: Longint;
\r
606 xlen: array[0..6] of Word;
\r
610 Assign(f,songdata_source);
\r
613 If (IOresult <> 0) then
\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
628 If NOT (header.ffver in [1..11]) then
\r
635 If (header.ffver in [1..4]) then
\r
637 FillChar(adsr_carrier,SizeOf(adsr_carrier),BYTE(FALSE));
\r
639 BlockReadF(f,header2,SizeOf(header2),temp);
\r
640 If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then
\r
646 xlen[0] := header2.b2len;
\r
647 xlen[1] := header2.b3len;
\r
648 xlen[2] := header2.b4len;
\r
650 SeekF(f,old_a2m_header_size);
\r
651 If (IOresult <> 0) then
\r
658 BlockReadF(f,buf1,header2.b0len,temp);
\r
659 If NOT (temp = header2.b0len) then
\r
665 crc := Update32(buf1,temp,crc);
\r
666 BlockReadF(f,buf1,header2.b1len,temp);
\r
667 If NOT (temp = header2.b1len) then
\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
677 BlockReadF(f,buf1,xlen[temp2],temp);
\r
678 If NOT (temp = xlen[temp2]) then
\r
683 crc := Update32(buf1,temp,crc);
\r
686 crc := Update32(header2.b0len,2,crc);
\r
687 crc := Update32(header2.b1len,2,crc);
\r
689 For temp2 := 0 to 2 do
\r
690 crc := Update32(xlen[temp2],2,crc);
\r
692 If (crc <> header2.crc32) then
\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
705 SeekF(f,old_a2m_header_size);
\r
706 If (IOresult <> 0) then
\r
712 BlockReadF(f,buf1,header2.b0len,temp);
\r
713 If NOT (temp = header2.b0len) then
\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
726 For temp := 1 to 250 do
\r
727 old_songdata.instr_data[temp].panning := 0;
\r
729 BlockReadF(f,buf1,header2.b1len,temp);
\r
730 If NOT (temp = header2.b1len) then
\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
742 import_old_a2m_patterns1(0,16);
\r
744 For temp2 := 0 to 2 do
\r
745 If ((header2.patts-1) DIV 16 > temp2) then
\r
747 BlockReadF(f,buf1,xlen[temp2],temp);
\r
748 If NOT (temp = xlen[temp2]) then
\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
760 import_old_a2m_patterns1(SUCC(temp2),16);
\r
763 replace_old_adsr(header2.patts);
\r
764 import_old_songdata(Addr(old_songdata));
\r
767 If (header.ffver in [5..8]) then
\r
770 BlockReadF(f,header2,SizeOf(header2),temp);
\r
771 If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then
\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
786 BlockReadF(f,buf1,header2.b0len,temp);
\r
787 If NOT (temp = header2.b0len) then
\r
793 crc := Update32(buf1,temp,crc);
\r
794 BlockReadF(f,buf1,header2.b1len,temp);
\r
795 If NOT (temp = header2.b1len) then
\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
805 BlockReadF(f,buf1,xlen[temp2],temp);
\r
806 If NOT (temp = xlen[temp2]) then
\r
811 crc := Update32(buf1,temp,crc);
\r
814 crc := Update32(header2.b0len,2,crc);
\r
815 crc := Update32(header2.b1len,2,crc);
\r
817 For temp2 := 0 to 6 do
\r
818 crc := Update32(xlen[temp2],2,crc);
\r
820 If (crc <> header2.crc32) then
\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
833 SeekF(f,SizeOf(header2));
\r
834 If (IOresult <> 0) then
\r
840 BlockReadF(f,buf1,header2.b0len,temp);
\r
841 If NOT (temp = header2.b0len) then
\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
854 BlockReadF(f,buf1,header2.b1len,temp);
\r
855 If NOT (temp = header2.b1len) then
\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
867 import_old_a2m_patterns2(0,8);
\r
869 For temp2 := 0 to 6 do
\r
870 If ((header2.patts-1) DIV 8 > temp2) then
\r
872 BlockReadF(f,buf1,xlen[temp2],temp);
\r
873 If NOT (temp = xlen[temp2]) then
\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
885 import_old_a2m_patterns2(SUCC(temp2),8);
\r
887 import_old_songdata(Addr(old_songdata));
\r
890 If (header.ffver in [9,10,11]) then
\r
893 BlockReadF(f,buf1,header.b0len,temp);
\r
894 If NOT (temp = header.b0len) then
\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
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
912 BlockReadF(f,buf1,header.b1len[temp2],temp);
\r
913 If NOT (temp = header.b1len[temp2]) then
\r
918 crc := Update32(buf1,temp,crc);
\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
925 If (crc <> header.crc32) then
\r
934 SeekF(f,SizeOf(header));
\r
935 If (IOresult <> 0) then
\r
941 BlockReadF(f,buf1,header.b0len,temp);
\r
942 If NOT (temp = header.b0len) then
\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
956 If (header.ffver = 9) then
\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
964 BlockReadF(f,buf1,header.b1len[temp2],temp);
\r
965 If NOT (temp = header.b1len[temp2]) then
\r
971 If (temp2*8+8 <= max_patterns) then
\r
972 APACK_decompress(buf1,pattdata^[temp2])
\r
973 else limit_exceeded := TRUE;
\r
977 speed := songdata.speed;
\r
978 tempo := songdata.tempo;
\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
988 procedure a2t_file_loader;
\r
991 tOLD_HEADER1 = Record
\r
992 ident: array[1..15] of Char;
\r
1006 tOLD_HEADER2 = Record
\r
1007 ident: array[1..15] of Char;
\r
1026 tOLD_HEADER3 = Record
\r
1027 ident: array[1..15] of Char;
\r
1041 b4len: array[0..15] of Longint;
\r
1044 tOLD_HEADER4 = Record
\r
1045 ident: array[1..15] of Char;
\r
1056 locks: array[1..20] of Byte;
\r
1061 b4len: array[0..15] of Longint;
\r
1065 ident: array[1..15] of Char;
\r
1076 locks: array[1..20] of Byte;
\r
1082 b5len: array[0..15] of Longint;
\r
1085 id = '_A2tiny_module_';
\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
1096 xlen: array[0..6] of Word;
\r
1100 Assign(f,songdata_source);
\r
1103 If (IOresult <> 0) then
\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
1118 If NOT (header.ffver in [1..11]) then
\r
1124 init_old_songdata;
\r
1125 If (header.ffver in [1..4]) then
\r
1127 FillChar(adsr_carrier,SizeOf(adsr_carrier),BYTE(FALSE));
\r
1129 BlockReadF(f,header2,SizeOf(header2),temp);
\r
1130 If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then
\r
1136 xlen[0] := header2.b3len;
\r
1137 xlen[1] := header2.b4len;
\r
1138 xlen[2] := header2.b5len;
\r
1140 crc := DWORD_NULL;
\r
1141 BlockReadF(f,buf1,header2.b0len,temp);
\r
1142 If NOT (temp = header2.b0len) then
\r
1148 crc := Update32(buf1,temp,crc);
\r
1149 BlockReadF(f,buf1,header2.b1len,temp);
\r
1150 If NOT (temp = header2.b1len) then
\r
1156 crc := Update32(buf1,temp,crc);
\r
1157 BlockReadF(f,buf1,header2.b2len,temp);
\r
1158 If NOT (temp = header2.b2len) then
\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
1168 BlockReadF(f,buf1,xlen[temp2],temp);
\r
1169 If NOT (temp = xlen[temp2]) then
\r
1174 crc := Update32(buf1,temp,crc);
\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
1181 For temp2 := 0 to 2 do
\r
1182 crc := Update32(xlen[temp2],2,crc);
\r
1184 If (crc <> header2.crc32) then
\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
1197 SeekF(f,SizeOf(header2));
\r
1198 If (IOresult <> 0) then
\r
1204 BlockReadF(f,buf1,header2.b0len,temp);
\r
1205 If NOT (temp = header2.b0len) then
\r
1211 old_songdata.tempo := header2.tempo;
\r
1212 old_songdata.speed := header2.speed;
\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
1221 For temp := 1 to 250 do
\r
1222 old_songdata.instr_data[temp].panning := 0;
\r
1224 BlockReadF(f,buf1,header2.b1len,temp);
\r
1225 If NOT (temp = header2.b1len) then
\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
1238 BlockReadF(f,buf1,header2.b2len,temp);
\r
1239 If NOT (temp = header2.b2len) then
\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
1252 import_old_a2m_patterns1(0,16);
\r
1254 For temp2 := 0 to 2 do
\r
1255 If ((header2.patts-1) DIV 16 > temp2) then
\r
1257 BlockReadF(f,buf1,xlen[temp2],temp);
\r
1258 If NOT (temp = xlen[temp2]) then
\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
1271 import_old_a2m_patterns1(SUCC(temp2),16);
\r
1274 replace_old_adsr(header2.patts);
\r
1275 import_old_songdata(Addr(old_songdata));
\r
1278 If (header.ffver in [5..8]) then
\r
1281 BlockReadF(f,header3,SizeOf(header3),temp);
\r
1282 If NOT ((temp = SizeOf(header3)) and (header3.ident = id)) then
\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
1296 crc := DWORD_NULL;
\r
1297 BlockReadF(f,buf1,header3.b0len,temp);
\r
1298 If NOT (temp = header3.b0len) then
\r
1304 crc := Update32(buf1,temp,crc);
\r
1305 BlockReadF(f,buf1,header3.b1len,temp);
\r
1306 If NOT (temp = header3.b1len) then
\r
1312 crc := Update32(buf1,temp,crc);
\r
1313 BlockReadF(f,buf1,header3.b2len,temp);
\r
1314 If NOT (temp = header3.b2len) then
\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
1324 BlockReadF(f,buf1,xlen[temp2],temp);
\r
1325 If NOT (temp = xlen[temp2]) then
\r
1330 crc := Update32(buf1,temp,crc);
\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
1337 For temp2 := 0 to 6 do
\r
1338 crc := Update32(xlen[temp2],2,crc);
\r
1340 If (crc <> header3.crc32) then
\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
1353 SeekF(f,SizeOf(header3));
\r
1354 If (IOresult <> 0) then
\r
1360 BlockReadF(f,buf1,header3.b0len,temp);
\r
1361 If NOT (temp = header3.b0len) then
\r
1367 old_songdata.tempo := header3.tempo;
\r
1368 old_songdata.speed := header3.speed;
\r
1369 old_songdata.common_flag := header3.cflag;
\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
1378 BlockReadF(f,buf1,header3.b1len,temp);
\r
1379 If NOT (temp = header3.b1len) then
\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
1392 BlockReadF(f,buf1,header3.b2len,temp);
\r
1393 If NOT (temp = header3.b2len) then
\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
1406 import_old_a2m_patterns2(0,8);
\r
1408 For temp2 := 0 to 6 do
\r
1409 If ((header3.patts-1) DIV 8 > temp2) then
\r
1411 BlockReadF(f,buf1,xlen[temp2],temp);
\r
1412 If NOT (temp = xlen[temp2]) then
\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
1425 import_old_a2m_patterns2(SUCC(temp2),8);
\r
1427 import_old_songdata(Addr(old_songdata));
\r
1430 If (header.ffver = 9) then
\r
1433 BlockReadF(f,header4,SizeOf(header4),temp);
\r
1434 If NOT ((temp = SizeOf(header4)) and (header4.ident = id)) then
\r
1440 crc := DWORD_NULL;
\r
1441 BlockReadF(f,buf1,header4.b0len,temp);
\r
1442 If NOT (temp = header4.b0len) then
\r
1448 crc := Update32(buf1,temp,crc);
\r
1449 BlockReadF(f,buf1,header4.b1len,temp);
\r
1450 If NOT (temp = header4.b1len) then
\r
1456 crc := Update32(buf1,temp,crc);
\r
1457 BlockReadF(f,buf1,header4.b2len,temp);
\r
1458 If NOT (temp = header4.b2len) then
\r
1464 crc := Update32(buf1,temp,crc);
\r
1465 BlockReadF(f,buf1,header4.b3len,temp);
\r
1466 If NOT (temp = header4.b3len) then
\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
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
1484 BlockReadF(f,buf1,header4.b4len[temp2],temp);
\r
1485 If NOT (temp = header4.b4len[temp2]) then
\r
1490 crc := Update32(buf1,temp,crc);
\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
1498 For temp2 := 0 to 15 do
\r
1499 crc := Update32(header4.b4len[temp2],2,crc);
\r
1501 If (crc <> header4.crc32) then
\r
1510 SeekF(f,SizeOf(header4));
\r
1511 If (IOresult <> 0) then
\r
1517 BlockReadF(f,buf1,header4.b0len,temp);
\r
1518 If NOT (temp = header4.b0len) then
\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
1532 APACK_decompress(buf1,songdata.instr_macros);
\r
1533 BlockReadF(f,buf1,header4.b2len,temp);
\r
1534 If NOT (temp = header4.b2len) then
\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
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
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
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
1568 BlockReadF(f,buf1,header4.b4len[temp2],temp);
\r
1569 If NOT (temp = header4.b4len[temp2]) then
\r
1575 If (temp2*8+8 <= max_patterns) then
\r
1576 APACK_decompress(buf1,pattdata^[temp2])
\r
1577 else limit_exceeded := TRUE;
\r
1581 If (header.ffver = 10) then
\r
1584 BlockReadF(f,header5,SizeOf(header5),temp);
\r
1585 If NOT ((temp = SizeOf(header5)) and (header5.ident = id)) then
\r
1591 crc := DWORD_NULL;
\r
1592 BlockReadF(f,buf1,header5.b0len,temp);
\r
1593 If NOT (temp = header5.b0len) then
\r
1599 crc := Update32(buf1,temp,crc);
\r
1600 BlockReadF(f,buf1,header5.b1len,temp);
\r
1601 If NOT (temp = header5.b1len) then
\r
1607 crc := Update32(buf1,temp,crc);
\r
1608 BlockReadF(f,buf1,header5.b2len,temp);
\r
1609 If NOT (temp = header5.b2len) then
\r
1615 crc := Update32(buf1,temp,crc);
\r
1616 BlockReadF(f,buf1,header5.b3len,temp);
\r
1617 If NOT (temp = header5.b3len) then
\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
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
1635 BlockReadF(f,buf1,header5.b4len[temp2],temp);
\r
1636 If NOT (temp = header5.b4len[temp2]) then
\r
1641 crc := Update32(buf1,temp,crc);
\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
1649 For temp2 := 0 to 15 do
\r
1650 crc := Update32(header5.b4len[temp2],2,crc);
\r
1652 If (crc <> header5.crc32) then
\r
1661 SeekF(f,SizeOf(header5));
\r
1662 If (IOresult <> 0) then
\r
1668 BlockReadF(f,buf1,header5.b0len,temp);
\r
1669 If NOT (temp = header5.b0len) then
\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
1683 APACK_decompress(buf1,songdata.instr_macros);
\r
1684 BlockReadF(f,buf1,header5.b2len,temp);
\r
1685 If NOT (temp = header5.b2len) then
\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
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
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
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
1720 BlockReadF(f,buf1,header5.b4len[temp2],temp);
\r
1721 If NOT (temp = header5.b4len[temp2]) then
\r
1727 If (temp2*8+8 <= max_patterns) then
\r
1728 APACK_decompress(buf1,pattdata^[temp2])
\r
1729 else limit_exceeded := TRUE;
\r
1733 If (header.ffver = 11) then
\r
1735 crc := DWORD_NULL;
\r
1736 BlockReadF(f,buf1,header.b0len,temp);
\r
1737 If NOT (temp = header.b0len) then
\r
1743 crc := Update32(buf1,temp,crc);
\r
1744 BlockReadF(f,buf1,header.b1len,temp);
\r
1745 If NOT (temp = header.b1len) then
\r
1751 crc := Update32(buf1,temp,crc);
\r
1752 BlockReadF(f,buf1,header.b2len,temp);
\r
1753 If NOT (temp = header.b2len) then
\r
1759 crc := Update32(buf1,temp,crc);
\r
1760 BlockReadF(f,buf1,header.b3len,temp);
\r
1761 If NOT (temp = header.b3len) then
\r
1767 crc := Update32(buf1,temp,crc);
\r
1768 BlockReadF(f,buf1,header.b4len,temp);
\r
1769 If NOT (temp = header.b4len) then
\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
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
1787 BlockReadF(f,buf1,header.b5len[temp2],temp);
\r
1788 If NOT (temp = header.b5len[temp2]) then
\r
1793 crc := Update32(buf1,temp,crc);
\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
1802 For temp2 := 0 to 15 do
\r
1803 crc := Update32(header.b5len[temp2],2,crc);
\r
1805 If (crc <> header.crc32) then
\r
1814 SeekF(f,SizeOf(header));
\r
1815 If (IOresult <> 0) then
\r
1821 BlockReadF(f,buf1,header.b0len,temp);
\r
1822 If NOT (temp = header.b0len) then
\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
1836 APACK_decompress(buf1,songdata.instr_macros);
\r
1837 BlockReadF(f,buf1,header.b2len,temp);
\r
1838 If NOT (temp = header.b2len) then
\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
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
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
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
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
1881 BlockReadF(f,buf1,header.b5len[temp2],temp);
\r
1882 If NOT (temp = header.b5len[temp2]) then
\r
1888 If (temp2*8+8 <= max_patterns) then
\r
1889 APACK_decompress(buf1,pattdata^[temp2])
\r
1890 else limit_exceeded := TRUE;
\r
1894 speed := songdata.speed;
\r
1895 tempo := songdata.tempo;
\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
1906 function dec2hex(dec: Byte): Byte;
\r
1907 begin dec2hex := (dec DIV 10)*16 +(dec MOD 10); end;
\r
1909 function truncate_string(str: String): String;
\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
1916 procedure amd_file_loader;
\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
1924 iName: array[1..23] of Char; { Instrument name }
\r
1925 iData: array[0..10] of Byte; { Instrument data }
\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
1940 id_amd = '<oïQUîRoR';
\r
1941 id_xms = 'MaDoKaN96';
\r
1946 temp,tmp2,temp2,temp3,temp4: Longint;
\r
1947 byte1,byte2,byte3: Byte;
\r
1949 procedure import_amd_instrument(inst: Byte; var data);
\r
1951 With songdata.instr_data[inst] do
\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
1966 songdata.instr_data[inst].panning := 0;
\r
1967 songdata.instr_data[inst].fine_tune := 0;
\r
1970 procedure import_amd_event(pattern,line,channel,byte1,byte2,byte3: Byte);
\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
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
1984 param := byte3 AND $7f;
\r
1985 Case byte2 AND $0f of
\r
1988 chunk.effect_def := ef_Arpeggio;
\r
1989 chunk.effect := dec2hex(param);
\r
1992 { SLIDE FREQUENCY UP }
\r
1994 chunk.effect_def := ef_FSlideUp;
\r
1995 chunk.effect := param;
\r
1998 { SLIDE FREQUENCY DOWN }
\r
2000 chunk.effect_def := ef_FSlideDown;
\r
2001 chunk.effect := param;
\r
2004 { SET CARRIER/MODULATOR INTENSITY }
\r
2005 $03: If (param DIV 10 in [1..9]) then
\r
2007 chunk.effect_def := ef_SetCarrierVol;
\r
2008 chunk.effect := (param DIV 10)*7;
\r
2010 else If (param MOD 10 in [1..9]) then
\r
2012 chunk.effect_def := ef_SetModulatorVol;
\r
2013 chunk.effect := (param MOD 10)*7;
\r
2016 { SET THE VOLUME }
\r
2018 chunk.effect_def := ef_SetInsVolume;
\r
2019 If (param < 64) then chunk.effect := param
\r
2020 else chunk.effect := 63;
\r
2023 { JUMP INTO PATTERN }
\r
2025 chunk.effect_def := ef_PositionJump;
\r
2026 If (param < 100) then chunk.effect := param
\r
2027 else chunk.effect := 99;
\r
2032 chunk.effect_def := ef_PatternBreak;
\r
2033 If (param < 64) then chunk.effect := param
\r
2034 else chunk.effect := 63;
\r
2038 $07: If (param < 99) then
\r
2039 If (param in [1..31]) then
\r
2041 chunk.effect_def := ef_SetSpeed;
\r
2042 chunk.effect := param;
\r
2045 chunk.effect_def := ef_SetTempo;
\r
2046 If (param = 0) then chunk.effect := 18
\r
2047 else chunk.effect := param;
\r
2050 { TONEPORTAMENTO }
\r
2052 chunk.effect_def := ef_TonePortamento;
\r
2053 chunk.effect := param;
\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
2062 chunk.effect_def := ef_Extended;
\r
2063 chunk.effect := dec2hex(param);
\r
2066 { DEFINE CELL-VIBRATO }
\r
2067 1: If (param MOD 10 < 2) then
\r
2069 chunk.effect_def := ef_Extended;
\r
2070 chunk.effect := $10+dec2hex(param);
\r
2073 { INCREASE VOLUME FAST }
\r
2075 chunk.effect_def := ef_VolSlide;
\r
2076 chunk.effect := (param MOD 10)*16;
\r
2079 { DECREASE VOLUME FAST }
\r
2081 chunk.effect_def := ef_VolSlide;
\r
2082 chunk.effect := param MOD 10;
\r
2085 { INCREASE VOLUME FINE }
\r
2087 chunk.effect_def := ef_Extended2;
\r
2088 chunk.effect := ef_ex2_VolSlideUpXF*16+(param MOD 10);
\r
2091 { DECREASE VOLUME FINE }
\r
2093 chunk.effect_def := ef_Extended2;
\r
2094 chunk.effect := ef_ex2_VolSlideDnXF*16+(param MOD 10);
\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
2104 procedure import_amd_packed_patterns(var data; patterns: Byte);
\r
2107 temp,temp2,temp3,temp4,temp5: Word;
\r
2112 track_order: array[0..$3f] of array[1..9] of Word;
\r
2113 track: array[0..$3f] of tCHUNK;
\r
2116 temp := (patterns+1)*9*SizeOf(WORD);
\r
2117 Move(data,track_order,temp);
\r
2119 tracks := tDUMMY_BUFF(data)[temp]+(tDUMMY_BUFF(data)[temp+1]) SHL 8;
\r
2127 If (count = 0) then
\r
2129 If (temp3 = 0) then
\r
2131 temp2 := tDUMMY_BUFF(data)[temp]+(tDUMMY_BUFF(data)[temp+1]) SHL 8;
\r
2135 If (tDUMMY_BUFF(data)[temp] OR $80 <> tDUMMY_BUFF(data)[temp]) then
\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
2146 count := (tDUMMY_BUFF(data)[temp] AND $7f)-1;
\r
2153 If (temp3 > $3f) then
\r
2159 until NOT (temp4 < tracks);
\r
2161 For temp := 0 to patterns do
\r
2162 For temp2 := 1 to 9 do
\r
2164 temp3 := track_order[temp][temp2];
\r
2165 temp4 := temp3 DIV 9;
\r
2167 If (temp3 < 64*9) then
\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
2177 function get_byte(var pos: Longint): Byte;
\r
2179 If (pos = SizeOf(buf1)) then
\r
2181 Move(buf3,buf1,SizeOf(buf3));
\r
2184 get_byte := buf1[pos];
\r
2190 Assign(f,songdata_source);
\r
2193 If (IOresult <> 0) then
\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
2208 If NOT (header.versn in [$10,$11]) then
\r
2214 FillChar(buf1,SizeOf(buf1),0);
\r
2215 BlockReadF(f,buf1,SizeOf(buf1),temp);
\r
2216 If (IOresult <> 0) then
\r
2222 tmp2 := WORD_NULL;
\r
2223 If (temp = SizeOf(buf1)) then
\r
2225 FillChar(buf3,SizeOf(buf3),0);
\r
2226 BlockReadF(f,buf3,SizeOf(buf3),tmp2);
\r
2227 If (IOresult <> 0) then
\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
2244 songdata.tempo := tempo;
\r
2245 songdata.speed := speed;
\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
2251 For temp2 := 0 to 25 do
\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
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
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
2271 import_amd_packed_patterns(buf1,header.nopat);
\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
2279 songdata_title := NameOnly(songdata_source);
\r
2280 If (header.ident = id_amd) then load_flag := 5
\r
2281 else load_flag := 6;
\r
2284 procedure import_hsc_instrument(inst: Byte; var data); forward;
\r
2286 procedure import_cff_event(patt,line,chan,byte0,byte1,byte2: Byte);
\r
2290 temp1,temp2,temp3,temp4: Byte;
\r
2293 FillChar(chunk,SizeOf(chunk),0);
\r
2295 temp2 := temp1 DIV 16;
\r
2296 temp3 := temp1 MOD 16;
\r
2298 Case CHAR(byte1) of
\r
2300 'A': If (temp1 > 0) then
\r
2302 chunk.effect_def := ef_SetSpeed;
\r
2303 chunk.effect := temp1;
\r
2306 { SET CARRIER WAVEFORM }
\r
2307 'B': If (temp1 < 4) then
\r
2309 chunk.effect_def := ef_SetWaveform;
\r
2310 chunk.effect := temp1*16;
\r
2313 { SET MODULATOR VOLUME }
\r
2315 chunk.effect_def := ef_SetModulatorVol;
\r
2316 If (temp1 < 64) then chunk.effect := 63-temp1
\r
2317 else chunk.effect := 0;
\r
2320 { VOLUME SLIDE UP/DOWN }
\r
2322 chunk.effect_def := ef_VolSlide;
\r
2323 chunk.effect := temp1;
\r
2327 'E': If (temp1 <> 0) then
\r
2329 chunk.effect_def := ef_FSlideDown;
\r
2330 chunk.effect := temp1;
\r
2334 'F': If (temp1 <> 0) then
\r
2336 chunk.effect_def := ef_FSlideUp;
\r
2337 chunk.effect := temp1;
\r
2340 { SET CARRIER VOLUME }
\r
2342 chunk.effect_def := ef_SetCarrierVol;
\r
2343 If (temp1 < 64) then chunk.effect := 63-temp1
\r
2344 else chunk.effect := 0;
\r
2348 'H': If (temp1 > 0) then
\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
2359 { SET INSTRUMENT }
\r
2360 'I': If (temp1 < 47) then
\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
2369 chunk.effect_def := ef_Arpeggio;
\r
2370 chunk.effect := temp1;
\r
2374 'K': If (temp1 < 128) then
\r
2376 chunk.effect_def := ef_PositionJump;
\r
2377 chunk.effect := temp1;
\r
2380 { JUMP TO NEXT PATTERN IN ORDER }
\r
2381 'L': chunk.effect_def := ef_PatternBreak;
\r
2383 { SET TREMOLO HIGHER / SET VIBRATO DEEPER }
\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
2395 If NOT fix_c_note_bug then chunk.note := byte0
\r
2397 chunk.note := byte0+1;
\r
2398 If (chunk.note > 12*8+1) then
\r
2399 chunk.note := 12*8+1;
\r
2403 $6d: chunk.note := BYTE_NULL;
\r
2406 put_chunk(patt,line,chan,chunk);
\r
2409 procedure import_cff_patterns(var data; patterns: Byte);
\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
2417 voice: array[1..9] of Byte;
\r
2418 arpgg: array[1..9] of Byte;
\r
2420 temp,temp2,temp3,temp4: Byte;
\r
2425 function _empty_event(var data): Boolean;
\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
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
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
2447 patt := BYTE_NULL;
\r
2450 If (songdata.pattern_order[order] > $24) then Inc(order)
\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
2458 get_chunk(patt,temp2,temp3,chunk);
\r
2459 temp4 := tPATDAT(data)[patt][temp2][temp3][2];
\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
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
2474 { SET INSTRUMENT }
\r
2475 'I': If (temp4 < 47) then
\r
2476 If (temp2 <> patt_break) then
\r
2478 voice[temp3] := temp4+1;
\r
2479 If NOT accurate_conv then
\r
2480 chunk.instr_def := voice[temp3];
\r
2485 chunk.effect_def := ef_Arpeggio;
\r
2486 If (temp4 <> 0) then
\r
2488 chunk.effect := temp4;
\r
2489 arpgg[temp3] := temp4;
\r
2491 else chunk.effect := arpgg[temp3];
\r
2495 'K': If (temp4 < 128) then
\r
2496 patt_break := temp2+1;
\r
2498 { JUMP TO NEXT PATTERN IN ORDER }
\r
2499 'L': patt_break := temp2+1;
\r
2502 Case tPATDAT(data)[patt][temp2][temp3][0] of
\r
2505 If accurate_conv then
\r
2506 If (voice[temp3] = 0) then
\r
2508 voice[temp3] := temp3;
\r
2509 chunk.instr_def := voice[temp3];
\r
2512 If NOT accurate_conv then
\r
2513 chunk.instr_def := voice[temp3];
\r
2517 If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then
\r
2518 put_chunk(patt,temp2,temp3,chunk);
\r
2521 patts := patts+CHR(patt);
\r
2523 until (patt >= patterns) or (order > $40);
\r
2526 procedure cff_file_loader;
\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
2538 iData: array[0..11] of Byte; { Instrument data }
\r
2539 iName: array[1..20] of Char; { Instrument name }
\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
2551 _PRE_ASCII_BLAB_SIZE = $5e1; // SizeOf(tHEADR2.instr)+SizeOf(tHEADR2.nopat)
\r
2554 id = '<CUD-FM-File>'+#26+CHR($de)+CHR($e0);
\r
2555 ascii_blab = 'CUD-FM-File - SEND A POSTCARD -';
\r
2561 temp,temp2: Longint;
\r
2562 offs,out_size: Longint;
\r
2564 function LZTYR_decompress(var input,output): Longint;
\r
2567 tSTRING = array[0..255] of Byte;
\r
2570 input_idx: Longint;
\r
2573 temp_string: tSTRING;
\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
2582 old_code: Longint;
\r
2583 new_code: Longint;
\r
2586 _cff_heap_length: Word;
\r
2587 _cff_dictionary_length: Word;
\r
2588 _cff_dictionary: array[0..32767] of Pointer;
\r
2590 function get_code: Longint;
\r
2596 While (bits_left < code_length) do
\r
2598 bits_buffer := bits_buffer OR (tDUMMY_BUFF(input)[input_idx] SHL
\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
2610 procedure translate_code(code: Longint; var str: tSTRING);
\r
2613 translated_string: tSTRING;
\r
2616 If (code >= $104) then
\r
2617 Move(_cff_dictionary[code-$104]^,translated_string,
\r
2618 BYTE(_cff_dictionary[code-$104]^)+1)
\r
2620 translated_string[0] := 1;
\r
2621 translated_string[1] := (code-4) AND $0ff;
\r
2624 Move(translated_string,str,256);
\r
2627 procedure startup;
\r
2633 old_code := get_code;
\r
2634 translate_code(old_code,the_string);
\r
2636 If (the_string[0] > 0) then
\r
2637 For idx := 0 to the_string[0]-1 do
\r
2639 tDUMMY_BUFF(output)[output_length] := the_string[idx+1];
\r
2640 Inc(output_length);
\r
2644 procedure cleanup;
\r
2649 _cff_heap_length := 0;
\r
2650 _cff_dictionary_length := 0;
\r
2653 procedure expand__cff_dictionary(str: tSTRING);
\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
2664 output_length := 0;
\r
2669 new_code := get_code;
\r
2671 // $00: end of data
\r
2672 If (new_code = 0) then BREAK;
\r
2674 // $01: end of block
\r
2675 If (new_code = 1) then
\r
2682 // $02: expand code length
\r
2683 If (new_code = 2) then
\r
2690 If (new_code = 3) then
\r
2692 old_code_length := code_length;
\r
2694 repeat_length := get_code+1;
\r
2695 code_length := 4 SHL get_code;
\r
2696 repeat_counter := get_code;
\r
2698 For idx := 0 to PRED(repeat_counter*repeat_length) do
\r
2700 tDUMMY_BUFF(output)[output_length] :=
\r
2701 tDUMMY_BUFF(output)[output_length-repeat_length];
\r
2702 Inc(output_length);
\r
2705 code_length := old_code_length;
\r
2710 If (new_code >= $104+_cff_dictionary_length) then
\r
2712 Inc(the_string[0]);
\r
2713 the_string[the_string[0]] := the_string[1];
\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
2721 expand__cff_dictionary(the_string);
\r
2722 translate_code(new_code,the_string);
\r
2724 For idx := 0 to PRED(the_string[0]) do
\r
2726 tDUMMY_BUFF(output)[output_length] := the_string[idx+1];
\r
2727 Inc(output_length);
\r
2730 old_code := new_code;
\r
2733 LZTYR_decompress := output_length;
\r
2738 Assign(f,songdata_source);
\r
2741 If (IOresult <> 0) then
\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
2756 If (header.cflag = 1) then
\r
2758 FillChar(buf1,SizeOf(buf1),0);
\r
2760 BlockReadF(f,buf1,SizeOf(buf1),temp);
\r
2761 If (IOresult <> 0) then
\r
2768 temp := LZTYR_decompress(buf1[$30],hash_buffer);
\r
2771 offs := SensitiveScan(hash_buffer,0,temp,ascii_blab);
\r
2772 If (offs <> _PRE_ASCII_BLAB_SIZE) then
\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
2783 BlockReadF(f,headr2,SizeOf(headr2),temp);
\r
2784 If NOT ((temp = SizeOf(headr2)) and (headr2.ascii = ascii_blab)) then
\r
2790 FillChar(buf1,SizeOf(buf1),0);
\r
2791 BlockReadF(f,buf1,SizeOf(buf1),temp);
\r
2792 If (IOresult <> 0) then
\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
2810 songdata.tempo := tempo;
\r
2811 songdata.speed := speed;
\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
2817 For temp2 := 0 to 46 do
\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
2826 songdata.common_flag := songdata.common_flag OR 2;
\r
2827 songdata.songname := CutStr(headr2.sname);
\r
2828 songdata.composer := CutStr(headr2.writr);
\r
2831 import_cff_patterns(buf1,headr2.nopat);
\r
2832 songdata_title := NameOnly(songdata_source);
\r
2836 procedure import_standard_instrument(inst: Byte; var data);
\r
2838 With songdata.instr_data[inst] do
\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
2853 songdata.instr_data[inst].panning := 0;
\r
2854 songdata.instr_data[inst].fine_tune := 0;
\r
2857 procedure dfm_file_loader;
\r
2864 ident: array[1..4] of Char;
\r
2866 sname: String[32];
\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
2876 temp,temp2,temp3: Longint;
\r
2877 pattern,line,channel,byte1,byte2: Byte;
\r
2879 procedure import_dfm_event(patt,line,chan,byte1,byte2: Byte);
\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
2891 Case byte2 SHR 5 of
\r
2892 { INSTRUMENT CHANGE }
\r
2893 1: chunk.instr_def := SUCC(byte2 AND $1f);
\r
2895 { SET INSTRUMENT VOLUME }
\r
2897 chunk.effect_def := ef_SetInsVolume;
\r
2898 chunk.effect := (byte2 AND $1f)*2;
\r
2903 chunk.effect_def := ef_SetSpeed;
\r
2904 chunk.effect := SUCC(byte2 AND $1f);
\r
2909 chunk.effect_def := ef_FSlideUpFine;
\r
2910 chunk.effect := byte2 AND $1f;
\r
2915 chunk.effect_def := ef_FSlideDownFine;
\r
2916 chunk.effect := byte2 AND $1f;
\r
2919 { END OF PATTERN }
\r
2920 7: chunk.effect_def := ef_PatternBreak;
\r
2923 put_chunk(patt,line,chan,chunk);
\r
2926 procedure process_dfm_patterns(patterns: Byte);
\r
2930 temp2,temp3: Byte;
\r
2933 instr_cache: array[1..18] of Byte;
\r
2937 FillChar(instr_cache,SizeOf(instr_cache),0);
\r
2939 patt := BYTE_NULL;
\r
2942 If (songdata.pattern_order[order] >= $80) then Inc(order)
\r
2945 patt := songdata.pattern_order[order];
\r
2946 For temp2 := 0 to $3f do
\r
2947 For temp3 := 1 to 9 do
\r
2949 get_chunk(patt,temp2,temp3,chunk);
\r
2950 If (chunk.instr_def <> 0) then
\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
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
2963 If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then
\r
2964 put_chunk(patt,temp2,temp3,chunk);
\r
2967 patts := patts+CHR(patt);
\r
2969 until (patt >= patterns) or (order > $7f);
\r
2974 Assign(f,songdata_source);
\r
2977 If (IOresult <> 0) then
\r
2983 BlockReadF(f,header,SizeOf(header),temp);
\r
2984 If NOT ((temp = SizeOf(header)) and (header.ident = id)) then
\r
2991 FillChar(buf1,SizeOf(buf1),0);
\r
2992 BlockReadF(f,buf1,SizeOf(buf1),temp);
\r
2993 If (IOresult <> 0) then
\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
3007 speed := SUCC(header.tempo);
\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
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
3024 For temp2 := 1 to 32 do
\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
3040 pattern := buf1[temp2];
\r
3041 If (pattern > 127) then
\r
3050 For line := 0 to $3f do
\r
3051 For channel := 1 to 9 do
\r
3053 byte1 := buf1[temp2];
\r
3054 If (temp2 >= temp) then
\r
3061 If (byte1 OR $80 <> byte1) then byte2 := 0
\r
3063 byte2 := buf1[temp2];
\r
3066 import_dfm_event(pattern,line,channel,byte1,byte2);
\r
3068 until (temp2 >= temp);
\r
3070 process_dfm_patterns(temp3);
\r
3073 songdata_title := NameOnly(songdata_source);
\r
3078 tHSC_PATTERNS = array[0..$31] of
\r
3079 array[0..$3f] of array[1..9] of Word;
\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
3087 procedure import_hsc_event(patt,line,chan: Byte; event: Word);
\r
3093 FillChar(chunk,SizeOf(chunk),0);
\r
3096 1..12*8+1: If NOT fix_c_note_bug then chunk.note := HI(event)
\r
3098 chunk.note := HI(event)+1;
\r
3099 If (chunk.note > 12*8+1) then
\r
3100 chunk.note := 12*8+1;
\r
3103 $7f: chunk.note := BYTE_NULL;
\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
3114 If (HI(event) <> $80) then
\r
3115 Case (LO(event) AND $0f0) of
\r
3117 $00: If (LO(event) AND $0f = 1) then
\r
3118 chunk.effect_def := ef_PatternBreak;
\r
3120 { MANUAL SLIDE UP }
\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
3127 { MANUAL SLIDE DOWN }
\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
3134 { SET CARRIER VOLUME }
\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
3141 { SET MODULATOR VOLUME }
\r
3143 chunk.effect_def := ef_SetModulatorVol;
\r
3144 chunk.effect := 63-(LO(event) AND $0f)*4;
\r
3147 { SET INSTRUMENT VOLUME }
\r
3149 chunk.effect_def := ef_SetInsVolume;
\r
3150 chunk.effect := 63-(LO(event) AND $0f)*4;
\r
3155 chunk.effect_def := ef_SetSpeed;
\r
3156 chunk.effect := (LO(event) AND $0f)+1;
\r
3159 put_chunk(patt,line,chan,chunk);
\r
3162 procedure import_hsc_patterns(var data; patterns: Byte);
\r
3165 voice: array[1..9] of Byte;
\r
3168 temp,temp2,temp3: Byte;
\r
3173 function _hsc_event(patt,line,chan: Byte): Word;
\r
3175 _hsc_event := LO(tHSC_PATTERNS(data)[patt][line][chan+1])+
\r
3176 HI(tHSC_PATTERNS(data)[patt][line][chan]) SHL 8;
\r
3179 begin { import_hsc_patterns }
\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
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
3192 patt := BYTE_NULL;
\r
3195 If (songdata.pattern_order[order] > $31) then Inc(order)
\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
3203 get_chunk(patt,temp2,temp3,chunk);
\r
3204 event := _hsc_event(patt,temp2,temp3);
\r
3209 If accurate_conv then
\r
3210 If (voice[temp3] = 0) then
\r
3212 voice[temp3] := temp3;
\r
3213 chunk.instr_def := voice[temp3];
\r
3216 If NOT accurate_conv then
\r
3217 chunk.instr_def := voice[temp3];
\r
3221 $80: If (temp2 <> patt_break) then
\r
3223 voice[temp3] := LO(event)+1;
\r
3224 If NOT accurate_conv then
\r
3226 chunk.instr_def := voice[temp3];
\r
3227 chunk.note := BYTE_NULL;
\r
3232 If (HI(event) <> $80) then
\r
3233 Case (LO(event) AND $0f0) of
\r
3235 $00: If (LO(event) AND $0f = 1) then
\r
3236 patt_break := temp2+1;
\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
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
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
3257 If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then
\r
3258 put_chunk(patt,temp2,temp3,chunk);
\r
3261 patts := patts+CHR(patt);
\r
3263 until (patt >= patterns) or (order > $7f);
\r
3266 procedure import_hsc_instrument(inst: Byte; var data);
\r
3268 With songdata.instr_data[inst] do
\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
3283 songdata.instr_data[inst].panning := 0;
\r
3284 songdata.instr_data[inst].fine_tune := tDUMMY_BUFF(data)[11] SHR 4;
\r
3288 hscbuf: tHSC_DATA;
\r
3290 procedure hsc_file_loader;
\r
3293 HSC_KSL: array[0..3] of Byte = (0,3,2,1);
\r
3297 temp,temp2,temp3: Longint;
\r
3300 If (Lower(ExtOnly(songdata_source)) <> 'hsc') then
\r
3307 Assign(f,songdata_source);
\r
3310 If (IOresult <> 0) then
\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
3324 For temp2 := 0 to $31 do
\r
3325 If (hscbuf.order[temp2] > $b0) then hscbuf.order[temp2] := $080;
\r
3328 While (temp3 < temp-SizeOf(hscbuf.instr)-SizeOf(hscbuf.order)) do
\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
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
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
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
3356 songdata.common_flag := songdata.common_flag OR 2;
\r
3357 songdata.tempo := tempo;
\r
3358 songdata.speed := speed;
\r
3361 For temp2 := 0 to $31 do
\r
3362 songdata.pattern_order[temp2] := hscbuf.order[temp2];
\r
3364 import_hsc_patterns(hscbuf.patts,(temp-SizeOf(hscbuf.instr)
\r
3365 -SizeOf(hscbuf.order)-1) DIV $480);
\r
3367 // specific corrections for HSC-Tracker instrument
\r
3368 For temp2 := 0 to $7f do
\r
3370 import_hsc_instrument(temp2+1,hscbuf.instr[temp2]);
\r
3371 With songdata.instr_data[temp2+1].fm_data do
\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
3381 songdata_title := NameOnly(songdata_source);
\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
3397 buffer2: tMTK_DATA;
\r
3399 procedure mtk_file_loader;
\r
3403 temp,temp2: Longint;
\r
3405 old_c_fix: Boolean;
\r
3408 id = 'mpu401tr
\92kkîr@data';
\r
3412 id_string: array[1..18] of Char;
\r
3418 Assign(f,songdata_source);
\r
3421 If (IOresult <> 0) then
\r
3427 BlockReadF(f,header,SizeOf(header),temp);
\r
3428 If NOT ((temp = SizeOf(header)) and (header.id_string = id)) then
\r
3435 FillChar(buf1,SizeOf(buf1),0);
\r
3436 BlockReadF(f,buf1,SizeOf(buf1),temp);
\r
3439 crc := Update16(buf1,temp,crc);
\r
3440 If (crc <> header.crc_16bit) then
\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
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
3464 songdata.common_flag := songdata.common_flag OR 2;
\r
3465 songdata.tempo := tempo;
\r
3466 songdata.speed := speed;
\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
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
3483 // specific corrections for MPU-401 TR
\92KKîR instrument
\r
3484 For temp2 := 0 to $7f do
\r
3486 import_hsc_instrument(temp2+1,buffer2.instt[temp2]);
\r
3487 With songdata.instr_data[temp2+1].fm_data do
\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
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
3500 songdata.songname := CutStr(buffer2.sname);
\r
3501 songdata.composer := CutStr(buffer2.compo);
\r
3504 songdata_title := NameOnly(songdata_source);
\r
3508 procedure rad_file_loader;
\r
3511 id = 'RAD by REALiTY!!';
\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
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
3526 procedure import_rad_event(pattern,line,channel,byte1,byte2,byte3: Byte);
\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
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
3539 Case byte2 AND $0f of
\r
3540 { PORTAMENTO (FREQUENCY SLIDE) UP }
\r
3542 chunk.effect_def := ef_FSlideUp;
\r
3543 chunk.effect := byte3;
\r
3546 { PORTAMENTO (FREQUENCY SLIDE) DOWN }
\r
3548 chunk.effect_def := ef_FSlideDown;
\r
3549 chunk.effect := byte3;
\r
3552 { PORTAMENTO TO NOTE }
\r
3554 chunk.effect_def := ef_TonePortamento;
\r
3555 chunk.effect := byte3;
\r
3558 { PORTAMENTO TO NOTE WITH VOLUME SLIDE }
\r
3559 $05: If (byte3 in [1..49]) then
\r
3561 chunk.effect_def := ef_TPortamVolSlide;
\r
3562 chunk.effect := max(byte3,15);
\r
3564 If (byte3 > 15) then
\r
3566 chunk.effect_def2 := ef_TPortamVolSlide;
\r
3567 chunk.effect2 := max(byte3-15,15);
\r
3570 else If (byte3 in [51..99]) then
\r
3572 chunk.effect_def := ef_TPortamVolSlide;
\r
3573 chunk.effect := max(byte3-50,15)*16;
\r
3575 If (byte3-50 > 15) then
\r
3577 chunk.effect_def2 := ef_TPortamVolSlide;
\r
3578 chunk.effect2 := max(byte3-50-15,15);
\r
3583 $0a: If (byte3 in [1..49]) then
\r
3585 chunk.effect_def := ef_VolSlide;
\r
3586 chunk.effect := max(byte3,15);
\r
3588 If (byte3 > 15) then
\r
3590 chunk.effect_def2 := ef_VolSlide;
\r
3591 chunk.effect2 := max(byte3-15,15);
\r
3594 else If (byte3 in [51..99]) then
\r
3596 chunk.effect_def := ef_VolSlide;
\r
3597 chunk.effect := max(byte3-50,15)*16;
\r
3599 If (byte3-50 > 15) then
\r
3601 chunk.effect_def2 := ef_VolSlide;
\r
3602 chunk.effect2 := max(byte3-50-15,15);
\r
3608 chunk.effect_def := ef_SetInsVolume;
\r
3609 If (byte3 < 64) then chunk.effect := byte3
\r
3610 else chunk.effect := 63;
\r
3613 { JUMP TO NEXT PATTERN IN ORDER LIST }
\r
3615 chunk.effect_def := ef_PatternBreak;
\r
3616 If (byte3 < 64) then chunk.effect := byte3
\r
3617 else chunk.effect := 63;
\r
3622 chunk.effect_def := ef_SetSpeed;
\r
3623 chunk.effect := byte3;
\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
3640 Assign(f,songdata_source);
\r
3643 If (IOresult <> 0) then
\r
3649 BlockReadF(f,header,SizeOf(header),temp);
\r
3650 If NOT ((temp = SizeOf(header)) and (header.ident = id)) then
\r
3657 FillChar(buf1,SizeOf(buf1),0);
\r
3658 BlockReadF(f,buf1,SizeOf(buf1),temp);
\r
3659 If (IOresult <> 0) then
\r
3666 offs0 := SizeOf(header);
\r
3668 If (header.xbyte OR $80 = header.xbyte) then
\r
3670 While (temp2 < temp) and (buf1[temp2] <> 0) do Inc(temp2);
\r
3671 If (temp2 >= temp) then
\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
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
3691 If (header.xbyte OR $40 = header.xbyte) then tempo := 18
\r
3694 If (header.xbyte AND $1f in [1..31]) then speed := header.xbyte AND $1f
\r
3697 songdata.tempo := tempo;
\r
3698 songdata.speed := speed;
\r
3702 temp3 := buf1[temp2];
\r
3704 If (temp3 <> 0) and (temp2+11 < temp) then
\r
3706 import_hsc_instrument(temp3,buf1[temp2]);
\r
3707 songdata.instr_data[temp3].fine_tune := 0;
\r
3710 until (temp3 = 0) or (temp3 >= temp);
\r
3714 Move(buf1[temp2],buf1,temp);
\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
3720 Inc(offs0,32*SizeOf(WORD));
\r
3721 Dec(temp,buf1[0]+1+32*SizeOf(WORD));
\r
3723 Move(buf1[buf1[0]+1],pattoffs,32*SizeOf(WORD));
\r
3724 Move(buf1[buf1[0]+32*SizeOf(WORD)+1],buf1,temp);
\r
3727 For temp := 0 to 31 do
\r
3731 If (pattoffs[temp] <> 0) and
\r
3732 (pattoffs[temp] <= FileSize(f)) then
\r
3734 temp2 := buf1[pattoffs[temp]-offs0+temp3];
\r
3737 temp4 := buf1[pattoffs[temp]-offs0+temp3];
\r
3738 If (buf1[pattoffs[temp]-offs0+temp3+2] AND $0f <> 0) then
\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
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
3755 until (temp4 OR $80 = temp4) or (temp3 > temp5);
\r
3757 until (temp2 OR $80 = temp2) or (temp3 > temp5);
\r
3761 songdata_title := NameOnly(songdata_source);
\r
3766 temp_ef_Arpeggio = $0f0;
\r
3767 temp_ef_rep = $0f1;
\r
3768 temp_ef_XFVSlide = $0f2;
\r
3771 ins_c4factor: array[1..99] of Shortint;
\r
3773 procedure fix_s3m_commands(patterns: Byte);
\r
3776 chunk,chunk2: tCHUNK;
\r
3787 patloop_cache: array[1..20] of Byte;
\r
3788 prev_cache: array[1..20] of Record
\r
3795 procedure fix_single_pattern(patt: Byte);
\r
3798 temp2,temp3: Byte;
\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
3805 For temp2 := 0 to $3f do
\r
3806 For temp3 := 1 to 20 do
\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
3812 If (chunk.instr_def <> 0) and (temp2 <= patt_break) then
\r
3813 ins_cache[temp3] := chunk.instr_def;
\r
3815 If (chunk.note in [1..12*8+1]) and (temp2 <= patt_break) then
\r
3816 note_cache[temp3] := chunk.note;
\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
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
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
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
3839 If (prev_cache[temp3].effect_def = 0) and
\r
3840 (prev_cache[temp3].effect = 0) then
\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
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
3853 else If (prev_cache[temp3].effect_def2 = 0) and
\r
3854 (prev_cache[temp3].effect2 = 0) then
\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
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
3868 else If (patloop_cache[temp3] <> 0) and (temp2 <> 0) then
\r
3870 get_chunk(patt,0,temp3,chunk2);
\r
3871 If (chunk2.effect_def = 0) and
\r
3872 (chunk2.effect = 0) then
\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
3880 else If (chunk2.effect_def2 = 0) and
\r
3881 (chunk2.effect2 = 0) then
\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
3891 If (temp2 <= patt_break) then
\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
3900 ef_MultiRetrigNote]) then
\r
3902 chunk.effect := misc_cache[temp3] AND $0f0+
\r
3903 chunk.effect AND $0f;
\r
3904 put_chunk(patt,temp2,temp3,chunk);
\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
3914 ef_MultiRetrigNote]) then
\r
3916 chunk.effect := chunk.effect AND $0f0+
\r
3917 misc_cache[temp3] AND $0f;
\r
3918 put_chunk(patt,temp2,temp3,chunk);
\r
3921 If (chunk.effect_def = temp_ef_Arpeggio) then
\r
3922 If (chunk.effect <> 0) then arpg_cache[temp3] := chunk.effect
\r
3924 chunk.effect := arpg_cache[temp3];
\r
3925 put_chunk(patt,temp2,temp3,chunk);
\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
3933 chunk.effect := slide_cache[temp3];
\r
3934 put_chunk(patt,temp2,temp3,chunk);
\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
3941 ef_ExtraFineVibrato,
\r
3942 ef_TonePortamento]) then
\r
3943 If (note_cache[temp3] <> 0) then
\r
3945 If (chunk.effect_def in [ef_Vibrato,ef_ExtraFineVibrato]) then
\r
3947 temp := chunk.effect AND $0f0;
\r
3948 chunk.effect := chunk.effect MOD 16;
\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
3962 If (chunk.effect_def in [ef_Vibrato,ef_ExtraFineVibrato]) then
\r
3963 chunk.effect := max(chunk.effect,15)+temp;
\r
3965 put_chunk(patt,temp2,temp3,chunk);
\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
3972 chunk.effect := chunk.effect AND $0f0+slide_cache[temp3] AND $0f;
\r
3973 put_chunk(patt,temp2,temp3,chunk);
\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
3980 If (chunk.effect <> 0) then volsld_cache[temp3] := chunk.effect
\r
3982 chunk.effect := volsld_cache[temp3];;
\r
3983 put_chunk(patt,temp2,temp3,chunk);
\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
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
4003 put_chunk(patt,temp2,temp3,chunk);
\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
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
4017 put_chunk(patt,temp2,temp3,chunk2);
\r
4021 else If (chunk.effect_def2 = 0) and (chunk.effect2 = 0) then
\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
4029 put_chunk(patt,temp2,temp3,chunk2);
\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
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
4043 If (chunk.effect_def = temp_ef_Arpeggio) then
\r
4046 chunk2.effect_def := ef_Arpeggio;
\r
4047 put_chunk(patt,temp2,temp3,chunk2);
\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
4061 order := 0; patt := BYTE_NULL;
\r
4064 If (songdata.pattern_order[order] >= $80) then Inc(order)
\r
4067 patt := songdata.pattern_order[order];
\r
4068 If NOT (Pos(CHR(patt),patts) <> 0) then
\r
4069 fix_single_pattern(patt);
\r
4071 patts := patts+CHR(patt);
\r
4073 until (patt >= patterns) or (order > $7f);
\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
4080 procedure s3m_file_loader;
\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
4094 { | +4:amigaslides }
\r
4095 { | +32:enable filter/sfx with sb }
\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
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
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
4133 chan_set: array[1..32] of Byte;
\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
4150 vol: Byte; { Default volume 0..64 }
\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
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
4164 id_ins_adl = 'SCRI';
\r
4165 id_ins_smp = 'SCRS';
\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
4180 procedure import_s3m_event(pattern,line,channel,note,ins,vol,cmd,info: Byte);
\r
4185 function scale_slide(slide: Byte): Byte;
\r
4187 If (slide > 16) then scale_slide := Round(16+slide/8)
\r
4188 else scale_slide := Round(slide*(2-slide/16));
\r
4192 FillChar(chunk,SizeOf(chunk),0);
\r
4193 chunk.instr_def := ins;
\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
4202 If (vol <> BYTE_NULL) then
\r
4204 chunk.effect_def2 := ef_SetInsVolume;
\r
4205 chunk.effect2 := max(vol,63);
\r
4208 If NOT (note in [254,255]) and
\r
4210 (max(default_vol[ins],63) <> 63) then
\r
4212 chunk.effect_def2 := ef_SetInsVolume;
\r
4213 chunk.effect2 := max(default_vol[ins],63);
\r
4216 Case CHR(cmd+ORD('A')-1) of
\r
4218 '@': chunk.effect := info;
\r
4221 'A': If (info <> 0) then
\r
4223 chunk.effect_def := ef_SetSpeed;
\r
4224 chunk.effect := info;
\r
4228 'B': If (info <= 254) then
\r
4230 chunk.effect_def := ef_PositionJump;
\r
4231 chunk.effect := info;
\r
4235 'C': If (info < 64) then
\r
4237 chunk.effect_def := ef_PatternBreak;
\r
4238 chunk.effect := Str2num(Num2str(info,16),10);
\r
4242 'D': { VOLUME SLIDE DOWN }
\r
4243 Case info DIV 16 of
\r
4246 chunk.effect_def := ef_VolSlide;
\r
4247 chunk.effect := info MOD 16;
\r
4252 chunk.effect_def := ef_VolSlideFine;
\r
4253 chunk.effect := info MOD 16;
\r
4256 { VOLUME SLIDE UP }
\r
4257 Case info MOD 16 of
\r
4260 chunk.effect_def := ef_VolSlide;
\r
4261 chunk.effect := info AND $0f0;
\r
4266 chunk.effect_def := ef_VolSlideFine;
\r
4267 chunk.effect := info AND $0f0;
\r
4273 'E': Case info DIV 16 of
\r
4276 chunk.effect_def := ef_FSlideDown;
\r
4277 chunk.effect := scale_slide(info);
\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
4290 chunk.effect_def := ef_FSlideDownFine;
\r
4291 chunk.effect := info AND $0f;
\r
4296 'F': Case info DIV 16 of
\r
4299 chunk.effect_def := ef_FSlideUp;
\r
4300 chunk.effect := scale_slide(info);
\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
4313 chunk.effect_def := ef_FSlideUpFine;
\r
4314 chunk.effect := info AND $0f;
\r
4318 { TONE PORTAMENTO }
\r
4320 chunk.effect_def := ef_TonePortamento;
\r
4321 chunk.effect := scale_slide(info);
\r
4326 chunk.effect_def := ef_Vibrato;
\r
4327 chunk.effect := info;
\r
4332 chunk.effect_def := ef_ExtraFineVibrato;
\r
4333 chunk.effect := info;
\r
4338 chunk.effect_def := ef_Tremor;
\r
4339 chunk.effect := info;
\r
4344 chunk.effect_def := temp_ef_Arpeggio;
\r
4345 chunk.effect := info;
\r
4348 { VIBRATO + VOLUME SLIDE }
\r
4350 chunk.effect_def := ef_VibratoVolSlide;
\r
4351 chunk.effect := info;
\r
4354 { TONE PORTAMENTO + VOLUME SLIDE }
\r
4356 chunk.effect_def := ef_TPortamVolSlide;
\r
4357 chunk.effect := info;
\r
4360 { RETRIG NOTE + VOLUME SLIDE }
\r
4362 chunk.effect_def := ef_MultiRetrigNote;
\r
4363 chunk.effect := (info MOD 16)*16+info DIV 16;
\r
4368 chunk.effect_def := ef_Tremolo;
\r
4369 chunk.effect := info;
\r
4372 { SPECIAL COMMAND }
\r
4373 'S': Case info DIV 16 of
\r
4376 chunk.effect_def := ef_Extended;
\r
4377 chunk.effect := ef_ex_PatternLoop*16+info MOD 16;
\r
4382 chunk.effect_def := ef_Extended2;
\r
4383 chunk.effect := ef_ex2_NoteCut*16+info MOD 16;
\r
4388 chunk.effect_def := ef_Extended2;
\r
4389 chunk.effect := ef_ex2_NoteDelay*16+info MOD 16;
\r
4394 chunk.effect_def := ef_Extended2;
\r
4395 chunk.effect := ef_ex2_PatDelayRow*16+info MOD 16;
\r
4400 'T': If (info >= 32) then
\r
4402 chunk.effect_def := ef_SetTempo;
\r
4403 chunk.effect := Round(info/2.5);
\r
4406 { SET GLOBAL VOLUME }
\r
4408 chunk.effect_def := ef_SetGlobalVolume;
\r
4409 chunk.effect := max(info,63);
\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
4418 // experimental method to fix up note fine-tuning
\r
4419 function find_scale_factor(freq: Longint; var fine_tune: Shortint): Shortint;
\r
4422 _factor: array[-3..3+1] of Real = (1/8,1/4,1/2,1,2,4,8,16);
\r
4425 _freq: array[1..12+1] of Word =
\r
4427 ( 33453 DIV 4,35441 DIV 4,37679 DIV 4,
\r
4429 39772 DIV 4,42441 DIV 4,44744 DIV 4,
\r
4431 47727 DIV 4,50416 DIV 4,53426 DIV 4,
\r
4433 56370 DIV 4,59658 DIV 4,63354 DIV 4,
\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
4445 temp,scaler: Shortint;
\r
4451 For scaler := -3 to 3+1 do
\r
4452 For temp := 1 to 12 do
\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
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
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
4476 find_scale_factor := -127;
\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
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
4488 _freq: array[1..12+1] of Word =
\r
4490 ( 33453 DIV 4,35441 DIV 4,37679 DIV 4,
\r
4492 39772 DIV 4,42441 DIV 4,44744 DIV 4,
\r
4494 47727 DIV 4,50416 DIV 4,53426 DIV 4,
\r
4496 56370 DIV 4,59658 DIV 4,63354 DIV 4,
\r
4502 temp,scaler: Shortint;
\r
4508 For scaler := -3 to 3+1 do
\r
4509 For temp := 1 to 12 do
\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
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
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
4532 find_scale_factor := -127;
\r
4539 Assign(f,songdata_source);
\r
4542 If (IOresult <> 0) then
\r
4548 BlockReadF(f,header,SizeOf(header),temp);
\r
4549 If NOT ((temp = SizeOf(header)) and (header.id = id_mod)) then
\r
4556 If (header.byte1a <> $1a) or (header.ftype <> $10) then
\r
4562 BlockReadF(f,order_list,header.ordnum,temp);
\r
4563 If (IOresult <> 0) or (temp <> header.ordnum) then
\r
4569 BlockReadF(f,paraptr_ins,header.insnum*2,temp);
\r
4570 If (IOresult <> 0) or (temp <> header.insnum*2) then
\r
4576 BlockReadF(f,paraptr_pat,header.patnum*2,temp);
\r
4577 If (IOresult <> 0) or (temp <> header.patnum*2) then
\r
4586 If (header.i_s <> 0) then speed := header.i_s
\r
4589 If (Round(header.i_t/2.5) < 255) then tempo := Round(header.i_t/2.5)
\r
4590 else tempo := 255;
\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
4598 For temp := 32 downto 1 do
\r
4599 If (header.chan_set[temp] <> 255) then BREAK;
\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
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
4613 FillChar(ins_c4factor,SizeOf(ins_c4factor),0);
\r
4614 For temp := 1 to header.insnum do
\r
4616 SeekF(f,paraptr_ins[temp]*16);
\r
4617 If (IOresult <> 0) then
\r
4623 BlockReadF(f,insdata,SizeOf(insdata),temp2);
\r
4624 If (IOresult <> 0) or (temp2 <> SizeOf(insdata)) then
\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
4635 songdata.instr_names[temp] :=
\r
4636 Copy(songdata.instr_names[temp],1,9)+
\r
4637 truncate_string(insdata.dosname);
\r
4639 If (insdata.itype in [2..7]) then
\r
4641 If (insdata.id <> id_ins_adl) and (insdata.id <> id_ins_smp) then
\r
4647 import_standard_instrument(temp,insdata.fmdata);
\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
4656 For pat := 0 to PRED(header.patnum) do
\r
4658 SeekF(f,paraptr_pat[pat]*16);
\r
4659 If (IOresult <> 0) then
\r
4665 BlockReadF(f,patlen,SizeOf(patlen),temp2);
\r
4666 If (temp2 <> SizeOf(patlen)) then
\r
4672 If (patlen = 0) then CONTINUE;
\r
4673 FillChar(buf1,SizeOf(buf1),0);
\r
4674 BlockReadF(f,buf1,patlen-2,temp2);
\r
4680 If (buf1[index] <> 0) then
\r
4682 note := BYTE_NULL;
\r
4687 temp := buf1[index];
\r
4690 chan := SUCC(temp AND 31);
\r
4691 If (temp OR $20 = temp) then
\r
4693 note := buf1[index];
\r
4695 ins := buf1[index];
\r
4699 If (temp OR $40 = temp) then
\r
4701 vol := buf1[index];
\r
4705 If (temp OR $80 = temp) then
\r
4707 cmd := buf1[index];
\r
4709 info := buf1[index];
\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
4725 fix_s3m_commands(header.patnum);
\r
4727 songdata_title := NameOnly(songdata_source);
\r
4731 procedure fix_fmk_commands(patterns: Byte);
\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
4755 procedure fix_single_pattern(patt: Byte);
\r
4758 temp2,temp3: Byte;
\r
4761 FillChar(prev_cache,SizeOf(prev_cache),0);
\r
4762 patt_break := BYTE_NULL;
\r
4764 If NOT _speed_table_fixed[patt] then
\r
4765 For temp2 := 0 to $3f do
\r
4767 For temp3 := 1 to 20 do
\r
4769 get_chunk(patt,temp2,temp3,chunk);
\r
4770 If (chunk.effect_def = 0) then
\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
4777 else If (chunk.effect_def2 = 0) then
\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
4784 If _speed_table_fixed[patt] then BREAK;
\r
4786 If _speed_table_fixed[patt] then BREAK;
\r
4789 For temp2 := 0 to $3f do
\r
4790 For temp3 := 1 to 20 do
\r
4792 get_chunk(patt,temp2,temp3,chunk);
\r
4793 If (chunk.effect_def = temp_ef_rep) then
\r
4795 chunk.effect_def := prev_cache[temp3].effect_def;
\r
4796 put_chunk(patt,temp2,temp3,chunk);
\r
4799 If (chunk.effect_def = temp_ef_XFVSlide) then
\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
4808 If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) then
\r
4809 patt_break := temp2;
\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
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
4823 If (chunk.effect_def2 = ef_ForceInsVolume) and
\r
4824 (temp2 <= patt_break) then
\r
4825 forcevol_cache[temp3] := 1;
\r
4827 If (chunk.instr_def <> 0) and (temp2 <= patt_break) then
\r
4828 ins_cache[temp3] := chunk.instr_def;
\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
4835 If (temp2 <= patt_break) then
\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
4843 chunk.effect := misc_cache[temp3] AND $0f0+
\r
4844 chunk.effect AND $0f;
\r
4845 put_chunk(patt,temp2,temp3,chunk);
\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
4854 chunk.effect := chunk.effect AND $0f0+
\r
4855 misc_cache[temp3] AND $0f;
\r
4856 put_chunk(patt,temp2,temp3,chunk);
\r
4859 If (chunk.effect_def = ef_RetrigNote) then
\r
4860 If (chunk.effect <> 0) then misc_cache[temp3] := chunk.effect
\r
4862 chunk.effect := misc_cache[temp3];
\r
4863 put_chunk(patt,temp2,temp3,chunk);
\r
4866 If (chunk.effect_def = temp_ef_Arpeggio) then
\r
4867 If (chunk.effect <> 0) then arpg_cache[temp3] := chunk.effect
\r
4869 chunk.effect := arpg_cache[temp3];
\r
4870 put_chunk(patt,temp2,temp3,chunk);
\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
4878 chunk.effect := slide_cache[temp3];
\r
4879 put_chunk(patt,temp2,temp3,chunk);
\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
4886 chunk.effect := chunk.effect AND $0f0+slide_cache[temp3] AND $0f;
\r
4887 put_chunk(patt,temp2,temp3,chunk);
\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
4894 If (chunk.effect <> 0) then volsld_cache[temp3] := chunk.effect
\r
4896 chunk.effect := volsld_cache[temp3];;
\r
4897 put_chunk(patt,temp2,temp3,chunk);
\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
4907 volsld_cache[temp3] := chunk.effect MOD 16;
\r
4908 xfvolsld_cache[temp3] := 0;
\r
4911 ef_ex2_VolSlideUpXF:
\r
4913 volsld_cache[temp3] := chunk.effect MOD 16*16;
\r
4914 xfvolsld_cache[temp3] := 1;
\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
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
4929 put_chunk(patt,temp2,temp3,chunk2);
\r
4933 else If (chunk.effect_def2 = 0) and (chunk.effect2 = 0) then
\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
4941 put_chunk(patt,temp2,temp3,chunk2);
\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
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
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
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
4974 If is_4op_chan(temp3) and
\r
4975 (temp3 in [1,3,5,10,12,14]) then
\r
4977 get_chunk(patt,temp2,SUCC(temp3),chunk3);
\r
4978 If (chunk.instr_def = 0) and (chunk3.instr_def <> 0) then
\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
4987 If (chunk.effect_def = temp_ef_Arpeggio) then
\r
4990 chunk2.effect_def := ef_Arpeggio;
\r
4991 put_chunk(patt,temp2,temp3,chunk2);
\r
4994 If (chunk.effect_def in [ef_SetModulatorVol,ef_SetCarrierVol]) and
\r
4995 (chunk.effect_def2 = ef_ForceInsVolume) then
\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
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
5019 order := 0; patt := BYTE_NULL;
\r
5022 If (songdata.pattern_order[order] >= $80) then Inc(order)
\r
5025 patt := songdata.pattern_order[order];
\r
5026 fix_single_pattern(patt);
\r
5028 patts := patts+CHR(patt);
\r
5030 until (patt >= patterns) or (order > $7f);
\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
5037 procedure import_fin_instrument(inst: Byte; var data);
\r
5039 With songdata.instr_data[inst] do
\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
5054 songdata.instr_data[inst].panning := 0;
\r
5055 songdata.instr_data[inst].fine_tune := 0;
\r
5058 procedure fmk_file_loader;
\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
5087 _conv_fmk_pan: array[0..2] of Byte = (1,0,2);
\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
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
5106 note,ins,vol,cmd,info: Byte;
\r
5107 patlen,index: Word;
\r
5108 dscbuf: array[0..PRED(20*24)] of Char;
\r
5111 procedure import_fmk_event(pattern,line,channel,note,ins,vol,cmd,info: Byte);
\r
5117 FillChar(chunk,SizeOf(chunk),0);
\r
5118 If (ins in [1..99]) then chunk.instr_def := ins;
\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
5127 If (vol <> BYTE_NULL) then
\r
5129 chunk.effect_def2 := ef_ForceInsVolume;
\r
5130 chunk.effect2 := 63-max(vol,63)
\r
5133 Case CHR(cmd+ORD('A')-1) of
\r
5135 'A': If (info <> 0) then
\r
5137 chunk.effect_def := ef_SetSpeed;
\r
5138 chunk.effect := info;
\r
5142 'B': If (info <= 254) then
\r
5144 chunk.effect_def := ef_PositionJump;
\r
5145 chunk.effect := info;
\r
5149 'C': Case info DIV 16 of
\r
5151 chunk.effect_def := ef_Extended3;
\r
5152 chunk.effect := ef_ex3_SetMultipC*16+info MOD 16;
\r
5156 chunk.effect_def := ef_Extended3;
\r
5157 chunk.effect := ef_ex3_SetKslC*16+(info MOD 16) AND 3;
\r
5161 chunk.effect_def := ef_Extended;
\r
5162 chunk.effect := ef_ex_SetAttckRateC*16+info MOD 16;
\r
5166 chunk.effect_def := ef_Extended;
\r
5167 chunk.effect := ef_ex_SetDecayRateC*16+info MOD 16;
\r
5171 chunk.effect_def := ef_Extended;
\r
5172 chunk.effect := ef_ex_SetSustnLevelC*16+info MOD 16;
\r
5176 chunk.effect_def := ef_Extended;
\r
5177 chunk.effect := ef_ex_SetRelRateC*16+info MOD 16;
\r
5181 chunk.effect_def := ef_SetWaveform;
\r
5182 chunk.effect := info AND 7 SHL 4+$0f;
\r
5186 chunk.effect_def := ef_Extended;
\r
5187 chunk.effect := ef_ex_SetFeedback*16+info AND 7;
\r
5192 'D': { VOLUME SLIDE DOWN }
\r
5193 Case info DIV 16 of
\r
5195 0: If (info MOD 16 = 0) then chunk.effect_def := temp_ef_XFVSlide
\r
5197 chunk.effect_def := ef_Extended2;
\r
5198 chunk.effect := ef_ex2_VolSlideDnXF*16+info MOD 16
\r
5202 chunk.effect_def := ef_VolSlideFine;
\r
5203 chunk.effect := info MOD 16;
\r
5206 { VOLUME SLIDE UP }
\r
5207 Case info MOD 16 of
\r
5209 0: If (info DIV 16 = 0) then chunk.effect_def := temp_ef_XFVSlide
\r
5211 chunk.effect_def := ef_Extended2;
\r
5212 chunk.effect := ef_ex2_VolSlideUpXF*16+info DIV 16;
\r
5216 chunk.effect_def := ef_VolSlideFine;
\r
5217 chunk.effect := info AND $0f0;
\r
5223 'E': Case info DIV 16 of
\r
5226 chunk.effect_def := ef_FSlideDown;
\r
5227 chunk.effect := info;
\r
5232 chunk.effect_def := ef_FSlideDownFine;
\r
5233 chunk.effect := info AND $0f;
\r
5238 'F': Case info DIV 16 of
\r
5241 chunk.effect_def := ef_FSlideUp;
\r
5242 chunk.effect := info;
\r
5247 chunk.effect_def := ef_FSlideUpFine;
\r
5248 chunk.effect := info AND $0f;
\r
5252 { TONE PORTAMENTO }
\r
5254 chunk.effect_def := ef_TonePortamento;
\r
5255 chunk.effect := info;
\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
5270 chunk.effect_def := ef_RetrigNote;
\r
5271 If (info <> 0) then chunk.effect := max(info*2,255);
\r
5276 chunk.effect_def := temp_ef_Arpeggio;
\r
5277 chunk.effect := info;
\r
5280 { MODLATOR PARAM }
\r
5281 'M': Case info DIV 16 of
\r
5283 chunk.effect_def := ef_Extended3;
\r
5284 chunk.effect := ef_ex3_SetMultipM*16+info MOD 16;
\r
5288 chunk.effect_def := ef_Extended3;
\r
5289 chunk.effect := ef_ex3_SetKslM*16+(info MOD 16) AND 3;
\r
5293 chunk.effect_def := ef_Extended;
\r
5294 chunk.effect := ef_ex_SetAttckRateM*16+info MOD 16;
\r
5298 chunk.effect_def := ef_Extended;
\r
5299 chunk.effect := ef_ex_SetDecayRateM*16+info MOD 16;
\r
5303 chunk.effect_def := ef_Extended;
\r
5304 chunk.effect := ef_ex_SetSustnLevelM*16+info MOD 16;
\r
5308 chunk.effect_def := ef_Extended;
\r
5309 chunk.effect := ef_ex_SetRelRateM*16+info MOD 16;
\r
5313 chunk.effect_def := ef_SetWaveform;
\r
5314 chunk.effect := $0f0+info AND 7;
\r
5318 chunk.effect_def := ef_Extended;
\r
5319 chunk.effect := ef_ex_SetFeedback*16+info AND 7;
\r
5323 { SET VIBRATO/TREMOLO WAVEFORM }
\r
5327 'P': If (info < 64) then
\r
5329 chunk.effect_def := ef_PatternBreak;
\r
5330 chunk.effect := Str2num(Num2str(info,16),10);
\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
5343 { STEREO CONTROL }
\r
5344 'S': If (header.glob_var AND 1 = 1) then
\r
5346 chunk.effect_def := ef_Extended;
\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
5354 { MODULATOR VOLUME }
\r
5356 chunk.effect_def := ef_SetModulatorVol;
\r
5357 chunk.effect := info AND $3f;
\r
5360 { CARRIER VOLUME }
\r
5362 chunk.effect_def := ef_SetCarrierVol;
\r
5363 chunk.effect := info AND $3f;
\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
5374 Assign(f,songdata_source);
\r
5377 If (IOresult <> 0) then
\r
5383 BlockReadF(f,header,SizeOf(header),temp);
\r
5384 If NOT ((temp = SizeOf(header)) and (header.id = id)) then
\r
5391 If (header.bytef4 <> $f4) or NOT (header.ftype in [1,2]) then
\r
5397 If (header.ftype = 2) then
\r
5399 SeekF(f,SizeOf(header)-2);
\r
5400 If (IOresult <> 0) then
\r
5407 If (header.ordnum <> 0) then
\r
5409 BlockReadF(f,order_list,header.ordnum,temp);
\r
5410 If (IOresult <> 0) or (temp <> header.ordnum) then
\r
5417 BlockReadF(f,paraptr_msg,SizeOf(paraptr_msg),temp);
\r
5418 If (IOresult <> 0) or (temp <> SizeOf(paraptr_msg)) then
\r
5424 fpos_bak := FilePos(f);
\r
5425 If (paraptr_msg <> 0) then
\r
5427 SeekF(f,paraptr_msg);
\r
5428 If (IOresult <> 0) then
\r
5434 BlockReadF(f,desc_rows,SizeOf(desc_rows),temp);
\r
5435 If (IOresult <> 0) or (temp <> SizeOf(desc_rows)) then
\r
5441 If (desc_rows <> 0) then
\r
5443 BlockReadF(f,dscbuf,desc_rows*20,temp);
\r
5444 If (IOresult <> 0) or (temp <> desc_rows*20) then
\r
5453 SeekF(f,fpos_bak);
\r
5454 If (IOresult <> 0) then
\r
5460 If (header.insnum <> 0) then
\r
5462 BlockReadF(f,paraptr_ins,header.insnum*2,temp);
\r
5463 If (IOresult <> 0) or (temp <> header.insnum*2) then
\r
5470 If (header.patnum <> 0) then
\r
5472 BlockReadF(f,paraptr_pat,header.patnum*4,temp);
\r
5473 If (IOresult <> 0) or (temp <> header.patnum*4) then
\r
5483 If (header.init_spd <> 0) then speed := header.init_spd
\r
5486 If (header.base_spd <> 0) then tempo := header.base_spd
\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
5497 For temp := 18 downto 1 do
\r
5498 If NOT (header.trk_set[temp] AND 7 = 7) then BREAK;
\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
5504 For temp2 := 1 to temp do
\r
5505 If (header.trk_set[temp2] AND 7 = 6) then
\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
5515 If (header.glob_var AND 1 = 1) then
\r
5516 songdata.common_flag := songdata.common_flag OR $20;
\r
5518 If (header.glob_var SHR 3 AND 1 = 1) then
\r
5519 songdata.common_flag := songdata.common_flag OR 8;
\r
5521 If (header.glob_var SHR 4 AND 1 = 1) then
\r
5522 songdata.common_flag := songdata.common_flag OR $10;
\r
5525 If (header.glob_var AND 1 = 1) then
\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
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
5553 For temp := 1 to header.insnum do
\r
5555 SeekF(f,paraptr_ins[temp]);
\r
5556 If (IOresult <> 0) then
\r
5562 BlockReadF(f,insdata,SizeOf(insdata),temp2);
\r
5563 If (IOresult <> 0) or (temp2 <> SizeOf(insdata)) then
\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
5574 songdata.instr_names[temp] :=
\r
5575 Copy(songdata.instr_names[temp],1,9)+
\r
5576 truncate_string(insdata.dname);
\r
5578 import_fin_instrument(temp,insdata.idata);
\r
5581 For pat := 0 to PRED(header.patnum) do
\r
5583 SeekF(f,paraptr_pat[pat]);
\r
5584 If (IOresult <> 0) then
\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
5598 If (patlen = 0) then CONTINUE;
\r
5599 FillChar(buf1,SizeOf(buf1),0);
\r
5600 BlockReadF(f,buf1,patlen,temp2);
\r
5606 If (buf1[index] <> 0) then
\r
5608 note := BYTE_NULL;
\r
5613 temp := buf1[index];
\r
5616 chan := SUCC(temp AND 31);
\r
5617 If (temp OR $20 = temp) then
\r
5619 note := buf1[index];
\r
5621 ins := buf1[index];
\r
5625 If (temp OR $40 = temp) then
\r
5627 vol := buf1[index];
\r
5631 If (temp OR $80 = temp) then
\r
5633 cmd := buf1[index];
\r
5635 info := buf1[index];
\r
5639 If (PRED(chan) in [1..18]) then
\r
5640 import_fmk_event(pat,row,PRED(chan),note,ins,vol,cmd,info);
\r
5650 fix_fmk_commands(header.patnum);
\r
5652 songdata_title := NameOnly(songdata_source);
\r
5656 procedure import_sat_instrument(inst: Byte; var data);
\r
5658 With songdata.instr_data[inst] do
\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
5673 songdata.instr_data[inst].panning := 0;
\r
5674 songdata.instr_data[inst].fine_tune := 0;
\r
5677 function import_sat_instrument_name(var data; inst: Byte): String;
\r
5689 While (temp1 < 496) do
\r
5691 If (tDUMMY_BUFF(data)[temp1] = BYTE('
\10')) then Inc(temp2);
\r
5693 If (temp2 = inst+1) then
\r
5695 While (tDUMMY_BUFF(data)[temp1] in [$20..$0ff]) and
\r
5696 (Length(temp3) < 22) do
\r
5698 temp3 := temp3+CHR(tDUMMY_BUFF(data)[temp1]);
\r
5705 import_sat_instrument_name := temp3;
\r
5708 procedure import_sa2_effect(effect,def1,def2: Byte;
\r
5709 var out1,out2: Byte); forward;
\r
5710 procedure sat_file_loader;
\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
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
5747 temp,tmp2,tmp3,temp2,temp3,
\r
5748 temp4,temp5: Longint;
\r
5749 byte1,byte2,byte3,byte4,byte5,note_inc: Byte;
\r
5751 procedure import_sat_event(pattern,line,channel,
\r
5752 byte1,byte2,byte3,byte4,byte5: Byte);
\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
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
5765 chunk.note := BYTE_NULL;
\r
5766 chunk.effect_def := 0;
\r
5767 chunk.effect := 0;
\r
5770 put_chunk(pattern,line,channel,chunk);
\r
5774 absolute: Longint;
\r
5776 function get_byte(var pos: Longint): Byte;
\r
5778 If (pos = SizeOf(buf1)-5) then
\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
5784 get_byte := buf1[pos];
\r
5791 Assign(f,songdata_source);
\r
5794 If (IOresult <> 0) then
\r
5800 BlockReadF(f,header,SizeOf(header),temp);
\r
5801 If NOT ((temp = SizeOf(header)) and (header.ident = id)) then
\r
5807 If NOT (header.vernm in [1,5,6]) then
\r
5814 SATver := header.vernm;
\r
5815 If (SATver in [5,6]) then
\r
5818 If (IOresult <> 0) then
\r
5824 BlockReadF(f,headr2,SizeOf(headr2),temp);
\r
5825 If (temp <> SizeOf(headr2)) then
\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
5841 tmp2 := WORD_NULL;
\r
5842 If (temp = SizeOf(buf1)-5) then
\r
5844 FillChar(buf3,SizeOf(buf3),0);
\r
5845 BlockReadF(f,buf3,SizeOf(buf3)-5,tmp2);
\r
5846 If (IOresult <> 0) then
\r
5853 tmp3 := WORD_NULL;
\r
5854 If (tmp2 = SizeOf(buf3)-5) then
\r
5856 FillChar(buf4,SizeOf(buf4),0);
\r
5857 BlockReadF(f,buf4,SizeOf(buf4)-5,tmp3);
\r
5858 If (IOresult <> 0) then
\r
5868 songdata.common_flag := songdata.common_flag OR 8;
\r
5869 songdata.common_flag := songdata.common_flag OR $10;
\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
5876 For temp := 1 to 20 do
\r
5877 songdata.lock_flags[temp] := songdata.lock_flags[temp] OR 4 OR 8;
\r
5879 If (SATver = 1) then
\r
5882 If (header.calls < 255) then tempo := header.calls
\r
5883 else tempo := 255;
\r
5885 songdata.tempo := tempo;
\r
5886 songdata.speed := speed;
\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
5894 temp5 := max(temp5,header.nopat);
\r
5895 For temp := 0 to $1e do
\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
5906 If (headr2.calls < 255) then tempo := headr2.calls
\r
5907 else tempo := 255;
\r
5909 songdata.tempo := tempo;
\r
5910 songdata.speed := speed;
\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
5918 temp5 := max(temp5,headr2.nopat);
\r
5919 For temp := 0 to $1e do
\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
5932 1: note_inc := 24;
\r
5933 5: note_inc := 12;
\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
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
5950 songdata_title := NameOnly(songdata_source);
\r
5954 function _sal(op1,op2: Word): Byte;
\r
5969 function _sar(op1,op2: Word): Byte;
\r
5984 procedure import_sa2_effect(effect,def1,def2: Byte;
\r
5985 var out1,out2: Byte);
\r
5988 { NORMAL PLAY OR ARPEGGIO }
\r
5990 out1 := ef_Arpeggio;
\r
5991 out2 := def1*16+def2;
\r
5996 out1 := ef_FSlideUp;
\r
5997 out2 := def1*16+def2;
\r
6002 out1 := ef_FSlideDown;
\r
6003 out2 := def1*16+def2;
\r
6006 { TONE PORTAMENTO }
\r
6008 out1 := ef_TonePortamento;
\r
6009 out2 := def1*16+def2;
\r
6014 out1 := ef_Vibrato;
\r
6015 out2 := def1*16+def2;
\r
6018 { TONE PORTAMENTO + VOLUME SLIDE }
\r
6019 $05: If (def1+def2 <> 0) then
\r
6020 If (def1 in [1..15]) then
\r
6022 out1 := ef_TPortamVolSlide;
\r
6023 out2 := min(_sar(def1,2),1)*16;
\r
6026 out1 := ef_TPortamVolSlide;
\r
6027 out2 := min(_sar(def2,2),1);
\r
6031 out1 := ef_TPortamVolSlide;
\r
6032 out2 := def1*16+def2;
\r
6035 { VIBRATO + VOLUME SLIDE }
\r
6036 $06: If (def1+def2 <> 0) then
\r
6037 If (def1 in [1..15]) then
\r
6039 out1 := ef_VibratoVolSlide;
\r
6040 out2 := min(_sar(def1,2),1)*16;
\r
6043 out1 := ef_VibratoVolSlide;
\r
6044 out2 := min(_sar(def2,2),1);
\r
6048 out1 := ef_VibratoVolSlide;
\r
6049 out2 := def1*16+def2;
\r
6052 { RELEASE SUSTAINING SOUND }
\r
6054 out1 := ef_Extended;
\r
6055 out2 := ef_ex_ExtendedCmd*16+0;
\r
6059 $0a: If (def1+def2 <> 0) then
\r
6060 If (def1 in [1..15]) then
\r
6062 out1 := ef_VolSlide;
\r
6063 out2 := min(_sar(def1,2),1)*16;
\r
6066 out1 := ef_VolSlide;
\r
6067 out2 := min(_sar(def2,2),1);
\r
6071 out1 := ef_VolSlide;
\r
6072 out2 := def1*16+def2;
\r
6076 $0b: If (def1*16+def2 < 128) then
\r
6078 out1 := ef_PositionJump;
\r
6079 out2 := def1*16+def2;
\r
6084 out1 := ef_SetInsVolume;
\r
6085 out2 := def1*16+def2;
\r
6086 If (out2 > 63) then out2 := 63;
\r
6090 $0d: If (def1*16+def2 < 64) then
\r
6092 out1 := ef_PatternBreak;
\r
6093 out2 := def1*16+def2;
\r
6097 $0f: If (def1*16+def2 < $20) then
\r
6099 out1 := ef_SetSpeed;
\r
6100 out2 := def1*16+def2;
\r
6102 else If (def1 < 16) and (def2 < 16) then
\r
6104 out1 := ef_SetTempo;
\r
6105 out2 := Round((def1*16+def2)/2.5);
\r
6114 procedure sa2_file_loader;
\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
6139 temp,temp2,temp3,temp4,temp5: Longint;
\r
6141 procedure import_sa2_event(pattern,line,channel,
\r
6142 byte1,byte2,byte3: Byte);
\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
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
6158 chunk.note := BYTE_NULL;
\r
6159 chunk.effect_def := 0;
\r
6160 chunk.effect := 0;
\r
6163 put_chunk(pattern,line,channel,chunk);
\r
6166 begin { sa2_file_loader }
\r
6168 Assign(f,songdata_source);
\r
6171 If (IOresult <> 0) then
\r
6177 BlockReadF(f,header,SizeOf(header),temp);
\r
6178 If NOT ((temp = SizeOf(header)) and (header.ident = id)) then
\r
6184 If NOT (header.vernm in [8,9]) then
\r
6191 If (header.vernm = 8) then
\r
6193 SeekF(f,FilePos(f)-2);
\r
6194 If (IOresult <> 0) then
\r
6201 FillChar(buf1,SizeOf(buf1),0);
\r
6202 BlockReadF(f,buf1,SizeOf(buf1)-3,temp);
\r
6203 If (IOresult <> 0) then
\r
6212 songdata.common_flag := songdata.common_flag OR 8;
\r
6213 songdata.common_flag := songdata.common_flag OR $10;
\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
6220 For temp := 1 to 20 do
\r
6221 songdata.lock_flags[temp] := songdata.lock_flags[temp] OR 4 OR 8;
\r
6224 If (Round(header.snbpm/2.5) < 255) then tempo := Round(header.snbpm/2.5)
\r
6225 else tempo := 255;
\r
6227 songdata.tempo := tempo;
\r
6228 songdata.speed := speed;
\r
6235 While (header.ordr2[temp2][temp4] = 0) and
\r
6236 (temp2 <= header.nopat-1) do
\r
6239 If (temp4 > 9) then begin temp4 := 1; Inc(temp2); end;
\r
6242 If (temp2 <= header.nopat-1) then
\r
6244 temp5 := 64*3*(header.ordr2[temp2][temp4]-1)+temp3*3;
\r
6245 import_sa2_event(temp2,temp3,temp4,buf1[temp5],
\r
6249 If (temp3 > $3f) then
\r
6252 If (temp4 < 9) then Inc(temp4)
\r
6253 else begin temp4 := 1; Inc(temp2); end;
\r
6256 until (temp2 > header.nopat-1);
\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
6264 For temp := 0 to $1e do
\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
6272 songdata_title := NameOnly(songdata_source);
\r
projects / 16.git / blob