X-Git-Url: http://4ch.mooo.com/gitweb/?a=blobdiff_plain;f=16%2FADT2PLAY%2FILOADERS.INC;fp=16%2FADT2PLAY%2FILOADERS.INC;h=18a5e50573a8c7d6d9672997f6b3826ac856d526;hb=47cdc66151d973d975d0e31fb8a786eb639bebdb;hp=0000000000000000000000000000000000000000;hpb=4b23f27092a9470a741e3a18261ad389fd1929db;p=16.git diff --git a/16/ADT2PLAY/ILOADERS.INC b/16/ADT2PLAY/ILOADERS.INC new file mode 100755 index 00000000..18a5e505 --- /dev/null +++ b/16/ADT2PLAY/ILOADERS.INC @@ -0,0 +1,6274 @@ +{ + function check_byte(var data; _byte: Byte; size: Longint): Boolean; + procedure insert_command(cmd,cmd2: Word; patterns: Byte; chan: Byte; exceptions: tByteSet); + procedure import_old_a2m_event1(patt,line,chan: Byte; old_chunk: tOLD_CHUNK; + processing_whole_song: Boolean); + procedure replace_old_adsr(patterns: Byte); + procedure import_old_a2m_patterns1(block: Byte; count: Byte); + procedure import_old_a2m_event2(patt,line,chan: Byte; old_chunk: tOLD_CHUNK); + procedure import_old_a2m_patterns2(block: Byte; count: Byte); + procedure import_old_flags; + procedure import_old_songdata(old_songdata: pOLD_FIXED_SONGDATA); + procedure import_old_instruments(old_songdata: pOLD_FIXED_SONGDATA; + new_songdata: pFIXED_SONGDATA; + instr,count: Byte); + procedure import_single_old_instrument(old_songdata: pOLD_FIXED_SONGDATA; + pos,instr: Byte); + procedure a2m_file_loader; + procedure a2t_file_loader; + procedure a2p_file_loader; + function dec2hex(dec: Byte): Byte; + function truncate_string(str: String): String; + procedure amd_file_loader; + procedure import_cff_event(patt,line,chan,byte0,byte1,byte2: Byte); + procedure import_cff_patterns(var data; patterns: Byte); + procedure cff_file_loader; + procedure import_standard_instrument(inst: Byte; var data); + procedure dfm_file_loader; + procedure import_hsc_event(patt,line,chan: Byte; event: Word); + procedure import_hsc_patterns(var data; patterns: Byte); + procedure import_hsc_instrument(inst: Byte; var data); + procedure hsc_file_loader; + procedure mtk_file_loader; + procedure rad_file_loader; + procedure fix_s3m_commands(patterns: Byte); + procedure fix_single_pattern(patt: Byte); + procedure s3m_file_loader; + procedure fix_fmk_commands(patterns: Byte); + procedure import_fin_instrument(inst: Byte; var data); + procedure fmk_file_loader; + procedure import_sat_instrument(inst: Byte; var data); + function import_sat_instrument_name(var data; inst: Byte): String; + procedure sat_file_loader; + function _sal(op1,op2: Word): Byte; + function _sar(op1,op2: Word): Byte; + procedure import_sa2_effect(effect,def1,def2: Byte; + var out1,out2: Byte); + procedure sa2_file_loader; +} + +function check_byte(var data; _byte: Byte; size: Longint): Boolean; + +var + result: Boolean; + +begin + asm + mov edi,[data] + mov ecx,size + jecxz @@1 + mov al,_byte + repnz scasb + jnz @@1 + mov result,TRUE + jmp @@2 +@@1: mov result,FALSE +@@2: + end; + check_byte := result; +end; + +procedure insert_command(cmd,cmd2: Word; patterns: Byte; chan: Byte; exceptions: tByteSet); + +var + chunk: tCHUNK; + temp2,temp3: Byte; + patt_break: Byte; + order,patt: Byte; + patts: String; + +begin + patts := ''; + order := 0; patt := BYTE_NULL; + + Repeat + If (Pos(CHR(songdata.pattern_order[order]),patts) <> 0) or + (songdata.pattern_order[order] >= $80) then Inc(order) + else + begin + patt := songdata.pattern_order[order]; + patt_break := songdata.patt_len; + For temp3 := 1 to songdata.nm_tracks do + For temp2 := 0 to PRED(songdata.patt_len) do + begin + get_chunk(patt,temp2,temp3,chunk); + If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) or + (chunk.effect_def2 in [ef_PositionJump,ef_PatternBreak]) then + patt_break := temp2; + + If (temp3 = chan) and (temp2 <= patt_break) then + If (cmd2 = 0) then + If (chunk.effect_def+chunk.effect = 0) or + (chunk.effect_def in exceptions) then + begin + chunk.effect_def := HI(cmd); + chunk.effect := LO(cmd); + put_chunk(patt,temp2,temp3,chunk); + EXIT; + end + else If (chunk.effect_def2+chunk.effect2 = 0) or + (chunk.effect_def2 in exceptions) then + begin + chunk.effect_def2 := HI(cmd); + chunk.effect2 := LO(cmd); + put_chunk(patt,temp2,temp3,chunk); + EXIT; + end + else + else If ((chunk.effect_def+chunk.effect = 0) or + (chunk.effect_def in exceptions)) and + ((chunk.effect_def2+chunk.effect2 = 0) or + (chunk.effect_def2 in exceptions)) then + begin + chunk.effect_def := HI(cmd); + chunk.effect := LO(cmd); + chunk.effect_def2 := HI(cmd2); + chunk.effect2 := LO(cmd2); + put_chunk(patt,temp2,temp3,chunk); + EXIT; + end; + end; + Inc(order); + patts := patts+CHR(patt); + end; + until (patt >= patterns) or (order > $7f); +end; + +var + adsr_carrier: array[1..9] of Boolean; + +procedure import_old_a2m_event1(patt,line,chan: Byte; old_chunk: tOLD_CHUNK; + processing_whole_song: Boolean); + +const + fx_Arpeggio = $00; + fx_FSlideUp = $01; + fx_FSlideDown = $02; + fx_FSlideUpFine = $03; + fx_FSlideDownFine = $04; + fx_TonePortamento = $05; + fx_TPortamVolSlide = $06; + fx_Vibrato = $07; + fx_VibratoVolSlide = $08; + fx_SetOpIntensity = $09; + fx_SetInsVolume = $0a; + fx_PatternBreak = $0b; + fx_PatternJump = $0c; + fx_SetTempo = $0d; + fx_SetTimer = $0e; + fx_Extended = $0f; + fx_ex_DefAMdepth = $00; + fx_ex_DefVibDepth = $01; + fx_ex_DefWaveform = $02; + fx_ex_ManSlideUp = $03; + fx_ex_ManSlideDown = $04; + fx_ex_VSlideUp = $05; + fx_ex_VSlideDown = $06; + fx_ex_VSlideUpFine = $07; + fx_ex_VSlideDownFine = $08; + fx_ex_RetrigNote = $09; + fx_ex_SetAttckRate = $0a; + fx_ex_SetDecayRate = $0b; + fx_ex_SetSustnLevel = $0c; + fx_ex_SetReleaseRate = $0d; + fx_ex_SetFeedback = $0e; + fx_ex_ExtendedCmd = $0f; + +var + chunk: tCHUNK; + +begin + FillChar(chunk,SizeOf(chunk),0); + chunk.note := old_chunk.note; + chunk.instr_def := old_chunk.instr_def; + chunk.effect_def := old_chunk.effect_def; + chunk.effect := old_chunk.effect; + + Case old_chunk.effect_def of + fx_Arpeggio: chunk.effect_def := ef_Arpeggio; + fx_FSlideUp: chunk.effect_def := ef_FSlideUp; + fx_FSlideDown: chunk.effect_def := ef_FSlideDown; + fx_FSlideUpFine: chunk.effect_def := ef_FSlideUpFine; + fx_FSlideDownFine: chunk.effect_def := ef_FSlideDownFine; + fx_TonePortamento: chunk.effect_def := ef_TonePortamento; + fx_TPortamVolSlide: chunk.effect_def := ef_TPortamVolSlide; + fx_Vibrato: chunk.effect_def := ef_Vibrato; + fx_VibratoVolSlide: chunk.effect_def := ef_VibratoVolSlide; + fx_SetInsVolume: chunk.effect_def := ef_SetInsVolume; + fx_PatternJump: chunk.effect_def := ef_PositionJump; + fx_PatternBreak: chunk.effect_def := ef_PatternBreak; + fx_SetTempo: chunk.effect_def := ef_SetSpeed; + fx_SetTimer: chunk.effect_def := ef_SetTempo; + + fx_SetOpIntensity: + If (old_chunk.effect DIV 16 <> 0) then + begin + chunk.effect_def := ef_SetCarrierVol; + chunk.effect := 3+(old_chunk.effect DIV 16)*4; + end + else If (old_chunk.effect MOD 16 <> 0) then + begin + chunk.effect_def := ef_SetModulatorVol; + chunk.effect := 3+(old_chunk.effect MOD 16)*4; + end + else chunk.effect_def := 0; + + fx_Extended: + Case old_chunk.effect DIV 16 of + fx_ex_DefAMdepth: + begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetTremDepth*16+old_chunk.effect MOD 16; + end; + + fx_ex_DefVibDepth: + begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetVibDepth*16+old_chunk.effect MOD 16; + end; + + + fx_ex_DefWaveform: + begin + chunk.effect_def := ef_SetWaveform; + Case old_chunk.effect MOD 16 of + 0..3: chunk.effect := (old_chunk.effect MOD 16)*16+$0f; + 4..7: chunk.effect := $0f0+(old_chunk.effect MOD 16)-4; + end; + end; + + fx_ex_VSlideUp: + begin + chunk.effect_def := ef_VolSlide; + chunk.effect := (old_chunk.effect MOD 16)*16; + end; + + fx_ex_VSlideDown: + begin + chunk.effect_def := ef_VolSlide; + chunk.effect := old_chunk.effect MOD 16; + end; + + fx_ex_VSlideUpFine: + begin + chunk.effect_def := ef_VolSlideFine; + chunk.effect := (old_chunk.effect MOD 16)*16; + end; + + fx_ex_VSlideDownFine: + begin + chunk.effect_def := ef_VolSlideFine; + chunk.effect := old_chunk.effect MOD 16; + end; + + fx_ex_ManSlideUp: + begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_FineTuneUp*16+old_chunk.effect MOD 16; + end; + + fx_ex_ManSlideDown: + begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_FineTuneDown*16+old_chunk.effect MOD 16; + end; + + fx_ex_RetrigNote: + begin + chunk.effect_def := ef_RetrigNote; + chunk.effect := SUCC(old_chunk.effect MOD 16); + end; + + fx_ex_SetAttckRate: + begin + chunk.effect_def := ef_Extended; + chunk.effect := old_chunk.effect MOD 16; + If NOT adsr_carrier[chan] then + Inc(chunk.effect,ef_ex_SetAttckRateM*16) + else Inc(chunk.effect,ef_ex_SetAttckRateC*16); + end; + + fx_ex_SetDecayRate: + begin + chunk.effect_def := ef_Extended; + chunk.effect := old_chunk.effect MOD 16; + If NOT adsr_carrier[chan] then + Inc(chunk.effect,ef_ex_SetDecayRateM*16) + else Inc(chunk.effect,ef_ex_SetDecayRateC*16); + end; + + fx_ex_SetSustnLevel: + begin + chunk.effect_def := ef_Extended; + chunk.effect := old_chunk.effect MOD 16; + If NOT adsr_carrier[chan] then + Inc(chunk.effect,ef_ex_SetSustnLevelM*16) + else Inc(chunk.effect,ef_ex_SetSustnLevelC*16); + end; + + fx_ex_SetReleaseRate: + begin + chunk.effect_def := ef_Extended; + chunk.effect := old_chunk.effect MOD 16; + If NOT adsr_carrier[chan] then + Inc(chunk.effect,ef_ex_SetRelRateM*16) + else Inc(chunk.effect,ef_ex_SetRelRateC*16); + end; + + fx_ex_SetFeedback: + begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetFeedback*16+old_chunk.effect MOD 16; + end; + + fx_ex_ExtendedCmd: + If (old_chunk.effect MOD 16 in [0..9]) then + begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_ExtendedCmd*16; + + Case old_chunk.effect MOD 16 of + 0: Inc(chunk.effect,ef_ex_cmd_RSS); + 1: Inc(chunk.effect,ef_ex_cmd_LockVol); + 2: Inc(chunk.effect,ef_ex_cmd_UnlockVol); + 3: Inc(chunk.effect,ef_ex_cmd_LockVP); + 4: Inc(chunk.effect,ef_ex_cmd_UnlockVP); + + 5: begin + If processing_whole_song then chunk.effect_def := 255 + else chunk.effect_def := 0; + chunk.effect := 0; + adsr_carrier[chan] := TRUE; + end; + + 6: begin + If processing_whole_song then chunk.effect_def := 255 + else chunk.effect_def := 0; + If processing_whole_song then chunk.effect := 1 + else chunk.effect := 0; + adsr_carrier[chan] := FALSE; + end; + + 7: Inc(chunk.effect,ef_ex_cmd_VSlide_car); + 8: Inc(chunk.effect,ef_ex_cmd_VSlide_mod); + 9: Inc(chunk.effect,ef_ex_cmd_VSlide_def); + end; + end + else begin + chunk.effect_def := 0; + chunk.effect := 0; + end; + end; + end; + + put_chunk(patt,line,chan,chunk); +end; + +procedure replace_old_adsr(patterns: Byte); + +var + chunk,chunk2: tCHUNK; + temp2,temp3: Byte; + patt_break: Byte; + order,patt: Byte; + patts: String; + +begin + patts := ''; + FillChar(adsr_carrier,SizeOf(adsr_carrier),0); + + order := 0; patt := BYTE_NULL; + Repeat + If (songdata.pattern_order[order] >= $80) then Inc(order) + else + begin + patt := songdata.pattern_order[order]; + patt_break := BYTE_NULL; + For temp2 := 0 to $3f do + For temp3 := 1 to 9 do + begin + get_chunk(patt,temp2,temp3,chunk); + chunk2 := chunk; + + If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) then + patt_break := temp2; + + If (chunk.effect_def in [$ff,ef_Extended]) then + begin + If (chunk.effect_def = $ff) then + begin + chunk2.effect_def := 0; + chunk2.effect := 0; + + If (temp2 <= patt_break) then + Case chunk.effect of + 0: adsr_carrier[temp3] := TRUE; + 1: adsr_carrier[temp3] := FALSE; + end; + end; + + If (chunk.effect_def = ef_Extended) then + Case chunk.effect DIV 16 of + ef_ex_SetAttckRateM, + ef_ex_SetAttckRateC: + If adsr_carrier[temp3] then + chunk2.effect := ef_ex_SetAttckRateC*16+chunk.effect MOD 16 + else chunk2.effect := ef_ex_SetAttckRateM*16+chunk.effect MOD 16; + + ef_ex_SetDecayRateM, + ef_ex_SetDecayRateC: + If adsr_carrier[temp3] then + chunk2.effect := ef_ex_SetDecayRateC*16+chunk.effect MOD 16 + else chunk2.effect := ef_ex_SetDecayRateM*16+chunk.effect MOD 16; + + ef_ex_SetSustnLevelM, + ef_ex_SetSustnLevelC: + If adsr_carrier[temp3] then + chunk2.effect := ef_ex_SetSustnLevelC*16+chunk.effect MOD 16 + else chunk2.effect := ef_ex_SetSustnLevelM*16+chunk.effect MOD 16; + + ef_ex_SetRelRateM, + ef_ex_SetRelRateC: + If adsr_carrier[temp3] then + chunk2.effect := ef_ex_SetRelRateC*16+chunk.effect MOD 16 + else chunk2.effect := ef_ex_SetRelRateM*16+chunk.effect MOD 16; + end; + + If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then + If (chunk.effect_def <> chunk2.effect_def) or + (chunk.effect <> chunk2.effect) then + put_chunk(patt,temp2,temp3,chunk2); + end; + end; + Inc(order); + patts := patts+CHR(patt); + end; + until (patt >= patterns) or (order > $7f); +end; + +procedure import_old_a2m_patterns1(block: Byte; count: Byte); + +procedure get_old_chunk(pattern,line,channel: Byte; var chunk: tOLD_CHUNK); +begin chunk := old_hash_buffer[pattern][line][channel]; end; + +var + patt,line,chan: Byte; + chunk: tOLD_CHUNK; + +begin { import_old_a2m_patterns1 } + For patt := 0 to max(PRED(count),15) do + For line := 0 to $3f do + For chan := 1 to 9 do + begin + get_old_chunk(patt,line,chan,chunk); + import_old_a2m_event1(block*16+patt,line,chan,chunk,TRUE); + end; +end; + +procedure import_old_a2m_event2(patt,line,chan: Byte; old_chunk: tOLD_CHUNK); + +const + ef_ManualFSlide = 22; + +var + chunk: tCHUNK; + +begin + FillChar(chunk,SizeOf(chunk),0); + chunk.note := old_chunk.note; + chunk.instr_def := old_chunk.instr_def; + + If (old_chunk.effect_def <> ef_ManualFSlide) then + begin + chunk.effect_def := old_chunk.effect_def; + chunk.effect := old_chunk.effect; + end + else If (old_chunk.effect DIV 16 <> 0) then + begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_FineTuneUp*16+old_chunk.effect DIV 16; + end + else begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_FineTuneDown*16+old_chunk.effect MOD 16; + end; + + put_chunk(patt,line,chan,chunk); +end; + +procedure import_old_a2m_patterns2(block: Byte; count: Byte); + +procedure get_old_chunk(pattern,line,channel: Byte; var chunk: tOLD_CHUNK); +begin chunk := hash_buffer[pattern][channel][line]; end; + +var + patt,line,chan: Byte; + chunk: tOLD_CHUNK; + +begin { import_old_a2m_patterns2 } + For patt := 0 to max(PRED(count),7) do + For line := 0 to $3f do + For chan := 1 to 18 do + begin + get_old_chunk(patt,line,chan,chunk); + import_old_a2m_event2(block*8+patt,line,chan,chunk); + end; +end; + +procedure import_old_flags; + +var + temp: Byte; + +begin + If (songdata.common_flag OR 2 = songdata.common_flag) then + For temp := 1 to 20 do + songdata.lock_flags[temp] := songdata.lock_flags[temp] OR $10; + + If (songdata.common_flag OR 4 = songdata.common_flag) then + For temp := 1 to 20 do + songdata.lock_flags[temp] := songdata.lock_flags[temp] OR $20; + + If (songdata.common_flag OR $20 = songdata.common_flag) then + For temp := 1 to 20 do + songdata.lock_flags[temp] := songdata.lock_flags[temp] AND NOT 3; +end; + +procedure import_old_songdata(old_songdata: pOLD_FIXED_SONGDATA); + +var + temp: Byte; + +begin + songdata.songname := old_songdata^.songname; + songdata.composer := old_songdata^.composer; + + For temp := 1 to 250 do + begin + songdata.instr_names[temp] := old_songdata^.instr_names[temp]; + songdata.instr_data[temp].fm_data := old_songdata^.instr_data[temp].fm_data; + songdata.instr_data[temp].panning := old_songdata^.instr_data[temp].panning; + songdata.instr_data[temp].fine_tune := old_songdata^.instr_data[temp].fine_tune; + songdata.instr_data[temp].perc_voice := 0; + end; + + Move(old_songdata^.pattern_order, + songdata.pattern_order, + SizeOf(old_songdata^.pattern_order)); + + songdata.tempo := old_songdata^.tempo; + songdata.speed := old_songdata^.speed; + songdata.common_flag := old_songdata^.common_flag; + import_old_flags; +end; + + +procedure a2m_file_loader; + +type + tOLD_HEADER = Record + ident: array[1..10] of Char; + crc32: Longint; + ffver: Byte; + patts: Byte; + b0len: Word; + b1len: Word; + b2len: Word; + b3len: Word; + b4len: Word; + b5len: Word; + b6len: Word; + b7len: Word; + b8len: Word; + end; +type + tHEADER = Record + ident: array[1..10] of Char; + crc32: Longint; + ffver: Byte; + patts: Byte; + b0len: Longint; + b1len: array[0..15] of Longint; + end; + +const + id = '_A2module_'; + +const + old_a2m_header_size = 26; + +var + f: File; + header: tHEADER; + header2: tOLD_HEADER; + temp,temp2: Longint; + crc: Longint; + xlen: array[0..6] of Word; + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + If NOT (header.ffver in [1..11]) then + begin + CloseF(f); + EXIT; + end; + + init_old_songdata; + If (header.ffver in [1..4]) then + begin + FillChar(adsr_carrier,SizeOf(adsr_carrier),BYTE(FALSE)); + ResetF(f); + BlockReadF(f,header2,SizeOf(header2),temp); + If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + xlen[0] := header2.b2len; + xlen[1] := header2.b3len; + xlen[2] := header2.b4len; + + SeekF(f,old_a2m_header_size); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + crc := DWORD_NULL; + BlockReadF(f,buf1,header2.b0len,temp); + If NOT (temp = header2.b0len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header2.b1len,temp); + If NOT (temp = header2.b1len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + For temp2 := 0 to 2 do + If ((header2.patts-1) DIV 16 > temp2) then + begin + BlockReadF(f,buf1,xlen[temp2],temp); + If NOT (temp = xlen[temp2]) then + begin + CloseF(f); + EXIT; + end; + crc := Update32(buf1,temp,crc); + end; + + crc := Update32(header2.b0len,2,crc); + crc := Update32(header2.b1len,2,crc); + + For temp2 := 0 to 2 do + crc := Update32(xlen[temp2],2,crc); + + If (crc <> header2.crc32) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + SeekF(f,old_a2m_header_size); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,buf1,header2.b0len,temp); + If NOT (temp = header2.b0len) then + begin + CloseF(f); + EXIT; + end; + + Case header2.ffver of + 4: Move(buf1,old_songdata,header2.b0len); + 3: LZSS_decompress(buf1,old_songdata,header2.b0len); + 2: LZW_decompress(buf1,old_songdata); + 1: SIXPACK_decompress(buf1,old_songdata,header2.b0len); + end; + + For temp := 1 to 250 do + old_songdata.instr_data[temp].panning := 0; + + BlockReadF(f,buf1,header2.b1len,temp); + If NOT (temp = header2.b1len) then + begin + CloseF(f); + EXIT; + end; + + Case header2.ffver of + 4: Move(buf1,old_hash_buffer,header2.b1len); + 3: LZSS_decompress(buf1,old_hash_buffer,header2.b1len); + 2: LZW_decompress(buf1,old_hash_buffer); + 1: SIXPACK_decompress(buf1,old_hash_buffer,header2.b1len); + end; + import_old_a2m_patterns1(0,16); + + For temp2 := 0 to 2 do + If ((header2.patts-1) DIV 16 > temp2) then + begin + BlockReadF(f,buf1,xlen[temp2],temp); + If NOT (temp = xlen[temp2]) then + begin + CloseF(f); + EXIT; + end; + + Case header2.ffver of + 4: Move(buf1,old_hash_buffer,xlen[temp2]); + 3: LZSS_decompress(buf1,old_hash_buffer,xlen[temp2]); + 2: LZW_decompress(buf1,old_hash_buffer); + 1: SIXPACK_decompress(buf1,old_hash_buffer,xlen[temp2]); + end; + import_old_a2m_patterns1(SUCC(temp2),16); + end; + + replace_old_adsr(header2.patts); + import_old_songdata(Addr(old_songdata)); + end; + + If (header.ffver in [5..8]) then + begin + ResetF(f); + BlockReadF(f,header2,SizeOf(header2),temp); + If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + xlen[0] := header2.b2len; + xlen[1] := header2.b3len; + xlen[2] := header2.b4len; + xlen[3] := header2.b5len; + xlen[4] := header2.b6len; + xlen[5] := header2.b7len; + xlen[6] := header2.b8len; + + crc := DWORD_NULL; + BlockReadF(f,buf1,header2.b0len,temp); + If NOT (temp = header2.b0len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header2.b1len,temp); + If NOT (temp = header2.b1len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + For temp2 := 0 to 6 do + If ((header2.patts-1) DIV 8 > temp2) then + begin + BlockReadF(f,buf1,xlen[temp2],temp); + If NOT (temp = xlen[temp2]) then + begin + CloseF(f); + EXIT; + end; + crc := Update32(buf1,temp,crc); + end; + + crc := Update32(header2.b0len,2,crc); + crc := Update32(header2.b1len,2,crc); + + For temp2 := 0 to 6 do + crc := Update32(xlen[temp2],2,crc); + + If (crc <> header2.crc32) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 18 + else If (songdata.nm_tracks < 18) then songdata.nm_tracks := 18; + + SeekF(f,SizeOf(header2)); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,buf1,header2.b0len,temp); + If NOT (temp = header2.b0len) then + begin + CloseF(f); + EXIT; + end; + + Case header2.ffver of + 8: Move(buf1,old_songdata,header2.b0len); + 7: LZSS_decompress(buf1,old_songdata,header2.b0len); + 6: LZW_decompress(buf1,old_songdata); + 5: SIXPACK_decompress(buf1,old_songdata,header2.b0len); + end; + + BlockReadF(f,buf1,header2.b1len,temp); + If NOT (temp = header2.b1len) then + begin + CloseF(f); + EXIT; + end; + + Case header2.ffver of + 8: Move(buf1,hash_buffer,header2.b1len); + 7: LZSS_decompress(buf1,hash_buffer,header2.b1len); + 6: LZW_decompress(buf1,hash_buffer); + 5: SIXPACK_decompress(buf1,hash_buffer,header2.b1len); + end; + import_old_a2m_patterns2(0,8); + + For temp2 := 0 to 6 do + If ((header2.patts-1) DIV 8 > temp2) then + begin + BlockReadF(f,buf1,xlen[temp2],temp); + If NOT (temp = xlen[temp2]) then + begin + CloseF(f); + EXIT; + end; + + Case header2.ffver of + 8: Move(buf1,hash_buffer,header2.b2len); + 7: LZSS_decompress(buf1,hash_buffer,header2.b2len); + 6: LZW_decompress(buf1,hash_buffer); + 5: SIXPACK_decompress(buf1,hash_buffer,header2.b2len); + end; + import_old_a2m_patterns2(SUCC(temp2),8); + end; + import_old_songdata(Addr(old_songdata)); + end; + + If (header.ffver in [9,10,11]) then + begin + crc := DWORD_NULL; + BlockReadF(f,buf1,header.b0len,temp); + If NOT (temp = header.b0len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header.b1len[0],temp); + If NOT (temp = header.b1len[0]) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + For temp2 := 1 to 15 do + If ((header.patts-1) DIV 8 > PRED(temp2)) then + begin + BlockReadF(f,buf1,header.b1len[temp2],temp); + If NOT (temp = header.b1len[temp2]) then + begin + CloseF(f); + EXIT; + end; + crc := Update32(buf1,temp,crc); + end; + + crc := Update32(header.b0len,2,crc); + For temp2 := 0 to 15 do + crc := Update32(header.b1len[temp2],2,crc); + + If (crc <> header.crc32) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + SeekF(f,SizeOf(header)); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,buf1,header.b0len,temp); + If NOT (temp = header.b0len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata); + BlockReadF(f,buf1,header.b1len[0],temp); + If NOT (temp = header.b1len[0]) then + begin + CloseF(f); + EXIT; + end; + + If (header.ffver = 9) then + import_old_flags; + + + APACK_decompress(buf1,pattdata^[0]); + For temp2 := 1 to 15 do + If ((header.patts-1) DIV 8 > PRED(temp2)) then + begin + BlockReadF(f,buf1,header.b1len[temp2],temp); + If NOT (temp = header.b1len[temp2]) then + begin + CloseF(f); + EXIT; + end; + + If (temp2*8+8 <= max_patterns) then + APACK_decompress(buf1,pattdata^[temp2]) + else limit_exceeded := TRUE; + end; + end; + + speed := songdata.speed; + tempo := songdata.tempo; + + CloseF(f); + songdata_title := NameOnly(songdata_source); + Case header.ffver of + 1..4: load_flag := 1; + else load_flag := 2; + end; +end; + +procedure a2t_file_loader; + +type + tOLD_HEADER1 = Record + ident: array[1..15] of Char; + crc32: Longint; + ffver: Byte; + patts: Byte; + tempo: Byte; + speed: Byte; + b0len: Word; + b1len: Word; + b2len: Word; + b3len: Word; + b4len: Word; + b5len: Word; + end; +type + tOLD_HEADER2 = Record + ident: array[1..15] of Char; + crc32: Longint; + ffver: Byte; + patts: Byte; + tempo: Byte; + speed: Byte; + cflag: Byte; + b0len: Word; + b1len: Word; + b2len: Word; + b3len: Word; + b4len: Word; + b5len: Word; + b6len: Word; + b7len: Word; + b8len: Word; + b9len: Word; + end; +type + tOLD_HEADER3 = Record + ident: array[1..15] of Char; + crc32: Longint; + ffver: Byte; + patts: Byte; + tempo: Byte; + speed: Byte; + cflag: Byte; + patln: Word; + nmtrk: Byte; + mcspd: Word; + b0len: Longint; + b1len: Longint; + b2len: Longint; + b3len: Longint; + b4len: array[0..15] of Longint; + end; +type + tOLD_HEADER4 = Record + ident: array[1..15] of Char; + crc32: Longint; + ffver: Byte; + patts: Byte; + tempo: Byte; + speed: Byte; + cflag: Byte; + patln: Word; + nmtrk: Byte; + mcspd: Word; + is4op: Byte; + locks: array[1..20] of Byte; + b0len: Longint; + b1len: Longint; + b2len: Longint; + b3len: Longint; + b4len: array[0..15] of Longint; + end; +type + tHEADER = Record + ident: array[1..15] of Char; + crc32: Longint; + ffver: Byte; + patts: Byte; + tempo: Byte; + speed: Byte; + cflag: Byte; + patln: Word; + nmtrk: Byte; + mcspd: Word; + is4op: Byte; + locks: array[1..20] of Byte; + b0len: Longint; + b1len: Longint; + b2len: Longint; + b3len: Longint; + b4len: Longint; + b5len: array[0..15] of Longint; + end; +const + id = '_A2tiny_module_'; + +var + f: File; + header: tHEADER; + header2: tOLD_HEADER1; + header3: tOLD_HEADER2; + header4: tOLD_HEADER3; + header5: tOLD_HEADER4; + temp,temp2: Longint; + crc: Longint; + xlen: array[0..6] of Word; + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + If NOT (header.ffver in [1..11]) then + begin + CloseF(f); + EXIT; + end; + + init_old_songdata; + If (header.ffver in [1..4]) then + begin + FillChar(adsr_carrier,SizeOf(adsr_carrier),BYTE(FALSE)); + ResetF(f); + BlockReadF(f,header2,SizeOf(header2),temp); + If NOT ((temp = SizeOf(header2)) and (header2.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + xlen[0] := header2.b3len; + xlen[1] := header2.b4len; + xlen[2] := header2.b5len; + + crc := DWORD_NULL; + BlockReadF(f,buf1,header2.b0len,temp); + If NOT (temp = header2.b0len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header2.b1len,temp); + If NOT (temp = header2.b1len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header2.b2len,temp); + If NOT (temp = header2.b2len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + For temp2 := 0 to 2 do + If ((header2.patts-1) DIV 16 > temp2) then + begin + BlockReadF(f,buf1,xlen[temp2],temp); + If NOT (temp = xlen[temp2]) then + begin + CloseF(f); + EXIT; + end; + crc := Update32(buf1,temp,crc); + end; + + crc := Update32(header2.b0len,2,crc); + crc := Update32(header2.b1len,2,crc); + crc := Update32(header2.b2len,2,crc); + + For temp2 := 0 to 2 do + crc := Update32(xlen[temp2],2,crc); + + If (crc <> header2.crc32) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + SeekF(f,SizeOf(header2)); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,buf1,header2.b0len,temp); + If NOT (temp = header2.b0len) then + begin + CloseF(f); + EXIT; + end; + + old_songdata.tempo := header2.tempo; + old_songdata.speed := header2.speed; + + Case header2.ffver of + 4: Move(buf1,old_songdata.instr_data,header2.b0len); + 3: LZSS_decompress(buf1,old_songdata.instr_data,header2.b0len); + 2: LZW_decompress(buf1,old_songdata.instr_data); + 1: SIXPACK_decompress(buf1,old_songdata.instr_data,header2.b0len); + end; + + For temp := 1 to 250 do + old_songdata.instr_data[temp].panning := 0; + + BlockReadF(f,buf1,header2.b1len,temp); + If NOT (temp = header2.b1len) then + begin + CloseF(f); + EXIT; + end; + + Case header2.ffver of + 4: Move(buf1,old_songdata.pattern_order,header2.b1len); + 3: LZSS_decompress(buf1,old_songdata.pattern_order,header2.b1len); + 2: LZW_decompress(buf1,old_songdata.pattern_order); + 1: SIXPACK_decompress(buf1,old_songdata.pattern_order,header2.b1len); + end; + + BlockReadF(f,buf1,header2.b2len,temp); + If NOT (temp = header2.b2len) then + begin + CloseF(f); + EXIT; + end; + + FillChar(old_hash_buffer,SizeOf(old_hash_buffer),0); + Case header2.ffver of + 4: Move(buf1,old_hash_buffer,header2.b2len); + 3: LZSS_decompress(buf1,old_hash_buffer,header2.b2len); + 2: LZW_decompress(buf1,old_hash_buffer); + 1: SIXPACK_decompress(buf1,old_hash_buffer,header2.b2len); + end; + import_old_a2m_patterns1(0,16); + + For temp2 := 0 to 2 do + If ((header2.patts-1) DIV 16 > temp2) then + begin + BlockReadF(f,buf1,xlen[temp2],temp); + If NOT (temp = xlen[temp2]) then + begin + CloseF(f); + EXIT; + end; + + FillChar(old_hash_buffer,SizeOf(old_hash_buffer),0); + Case header2.ffver of + 4: Move(buf1,old_hash_buffer,header2.b3len); + 3: LZSS_decompress(buf1,old_hash_buffer,header2.b3len); + 2: LZW_decompress(buf1,old_hash_buffer); + 1: SIXPACK_decompress(buf1,old_hash_buffer,header2.b3len); + end; + import_old_a2m_patterns1(SUCC(temp2),16); + end; + + replace_old_adsr(header2.patts); + import_old_songdata(Addr(old_songdata)); + end; + + If (header.ffver in [5..8]) then + begin + ResetF(f); + BlockReadF(f,header3,SizeOf(header3),temp); + If NOT ((temp = SizeOf(header3)) and (header3.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + xlen[0] := header3.b3len; + xlen[1] := header3.b4len; + xlen[2] := header3.b5len; + xlen[3] := header3.b6len; + xlen[4] := header3.b7len; + xlen[5] := header3.b8len; + xlen[6] := header3.b9len; + + crc := DWORD_NULL; + BlockReadF(f,buf1,header3.b0len,temp); + If NOT (temp = header3.b0len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header3.b1len,temp); + If NOT (temp = header3.b1len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header3.b2len,temp); + If NOT (temp = header3.b2len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + For temp2 := 0 to 6 do + If ((header3.patts-1) DIV 8 > temp2) then + begin + BlockReadF(f,buf1,xlen[temp2],temp); + If NOT (temp = xlen[temp2]) then + begin + CloseF(f); + EXIT; + end; + crc := Update32(buf1,temp,crc); + end; + + crc := Update32(header3.b0len,2,crc); + crc := Update32(header3.b1len,2,crc); + crc := Update32(header3.b2len,2,crc); + + For temp2 := 0 to 6 do + crc := Update32(xlen[temp2],2,crc); + + If (crc <> header3.crc32) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 18 + else If (songdata.nm_tracks < 18) then songdata.nm_tracks := 18; + + SeekF(f,SizeOf(header3)); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,buf1,header3.b0len,temp); + If NOT (temp = header3.b0len) then + begin + CloseF(f); + EXIT; + end; + + old_songdata.tempo := header3.tempo; + old_songdata.speed := header3.speed; + old_songdata.common_flag := header3.cflag; + + Case header3.ffver of + 8: Move(buf1,old_songdata.instr_data,header3.b0len); + 7: LZSS_decompress(buf1,old_songdata.instr_data,header3.b0len); + 6: LZW_decompress(buf1,old_songdata.instr_data); + 5: SIXPACK_decompress(buf1,old_songdata.instr_data,header3.b0len); + end; + + BlockReadF(f,buf1,header3.b1len,temp); + If NOT (temp = header3.b1len) then + begin + CloseF(f); + EXIT; + end; + + Case header3.ffver of + 8: Move(buf1,old_songdata.pattern_order,header3.b1len); + 7: LZSS_decompress(buf1,old_songdata.pattern_order,header3.b1len); + 6: LZW_decompress(buf1,old_songdata.pattern_order); + 5: SIXPACK_decompress(buf1,old_songdata.pattern_order,header3.b1len); + end; + + BlockReadF(f,buf1,header3.b2len,temp); + If NOT (temp = header3.b2len) then + begin + CloseF(f); + EXIT; + end; + + FillChar(hash_buffer,SizeOf(hash_buffer),0); + Case header3.ffver of + 8: Move(buf1,hash_buffer,header3.b2len); + 7: LZSS_decompress(buf1,hash_buffer,header3.b2len); + 6: LZW_decompress(buf1,hash_buffer); + 5: SIXPACK_decompress(buf1,hash_buffer,header3.b2len); + end; + import_old_a2m_patterns2(0,8); + + For temp2 := 0 to 6 do + If ((header3.patts-1) DIV 8 > temp2) then + begin + BlockReadF(f,buf1,xlen[temp2],temp); + If NOT (temp = xlen[temp2]) then + begin + CloseF(f); + EXIT; + end; + + FillChar(hash_buffer,SizeOf(hash_buffer),0); + Case header3.ffver of + 8: Move(buf1,hash_buffer,header3.b3len); + 7: LZSS_decompress(buf1,hash_buffer,header3.b3len); + 6: LZW_decompress(buf1,hash_buffer); + 5: SIXPACK_decompress(buf1,hash_buffer,header3.b3len); + end; + import_old_a2m_patterns2(SUCC(temp2),8); + end; + import_old_songdata(Addr(old_songdata)); + end; + + If (header.ffver = 9) then + begin + ResetF(f); + BlockReadF(f,header4,SizeOf(header4),temp); + If NOT ((temp = SizeOf(header4)) and (header4.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + crc := DWORD_NULL; + BlockReadF(f,buf1,header4.b0len,temp); + If NOT (temp = header4.b0len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header4.b1len,temp); + If NOT (temp = header4.b1len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header4.b2len,temp); + If NOT (temp = header4.b2len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header4.b3len,temp); + If NOT (temp = header4.b3len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header4.b4len[0],temp); + If NOT (temp = header4.b4len[0]) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + For temp2 := 1 to 15 do + If ((header4.patts-1) DIV 8 > PRED(temp2)) then + begin + BlockReadF(f,buf1,header4.b4len[temp2],temp); + If NOT (temp = header4.b4len[temp2]) then + begin + CloseF(f); + EXIT; + end; + crc := Update32(buf1,temp,crc); + end; + + crc := Update32(header4.b0len,2,crc); + crc := Update32(header4.b1len,2,crc); + crc := Update32(header4.b2len,2,crc); + crc := Update32(header4.b3len,2,crc); + + For temp2 := 0 to 15 do + crc := Update32(header4.b4len[temp2],2,crc); + + If (crc <> header4.crc32) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + SeekF(f,SizeOf(header4)); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,buf1,header4.b0len,temp); + If NOT (temp = header4.b0len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.instr_data); + BlockReadF(f,buf1,header4.b1len,temp); + If NOT (temp = header4.b1len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.instr_macros); + BlockReadF(f,buf1,header4.b2len,temp); + If NOT (temp = header4.b2len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.macro_table); + BlockReadF(f,buf1,header4.b3len,temp); + If NOT (temp = header4.b3len) then + begin + CloseF(f); + EXIT; + end; + + songdata.tempo := header4.tempo; + songdata.speed := header4.speed; + songdata.common_flag := header4.cflag; + songdata.patt_len := header4.patln; + songdata.nm_tracks := header4.nmtrk; + songdata.macro_speedup := header4.mcspd; + import_old_flags; + + APACK_decompress(buf1,songdata.pattern_order); + BlockReadF(f,buf1,header4.b4len[0],temp); + If NOT (temp = header4.b4len[0]) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,pattdata^[0]); + For temp2 := 1 to 15 do + If ((header4.patts-1) DIV 8 > PRED(temp2)) then + begin + BlockReadF(f,buf1,header4.b4len[temp2],temp); + If NOT (temp = header4.b4len[temp2]) then + begin + CloseF(f); + EXIT; + end; + + If (temp2*8+8 <= max_patterns) then + APACK_decompress(buf1,pattdata^[temp2]) + else limit_exceeded := TRUE; + end; + end; + + If (header.ffver = 10) then + begin + ResetF(f); + BlockReadF(f,header5,SizeOf(header5),temp); + If NOT ((temp = SizeOf(header5)) and (header5.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + crc := DWORD_NULL; + BlockReadF(f,buf1,header5.b0len,temp); + If NOT (temp = header5.b0len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header5.b1len,temp); + If NOT (temp = header5.b1len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header5.b2len,temp); + If NOT (temp = header5.b2len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header5.b3len,temp); + If NOT (temp = header5.b3len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header5.b4len[0],temp); + If NOT (temp = header5.b4len[0]) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + For temp2 := 1 to 15 do + If ((header5.patts-1) DIV 8 > PRED(temp2)) then + begin + BlockReadF(f,buf1,header5.b4len[temp2],temp); + If NOT (temp = header5.b4len[temp2]) then + begin + CloseF(f); + EXIT; + end; + crc := Update32(buf1,temp,crc); + end; + + crc := Update32(header5.b0len,2,crc); + crc := Update32(header5.b1len,2,crc); + crc := Update32(header5.b2len,2,crc); + crc := Update32(header5.b3len,2,crc); + + For temp2 := 0 to 15 do + crc := Update32(header5.b4len[temp2],2,crc); + + If (crc <> header5.crc32) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + SeekF(f,SizeOf(header5)); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,buf1,header5.b0len,temp); + If NOT (temp = header5.b0len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.instr_data); + BlockReadF(f,buf1,header5.b1len,temp); + If NOT (temp = header5.b1len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.instr_macros); + BlockReadF(f,buf1,header5.b2len,temp); + If NOT (temp = header5.b2len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.macro_table); + BlockReadF(f,buf1,header5.b3len,temp); + If NOT (temp = header5.b3len) then + begin + CloseF(f); + EXIT; + end; + + songdata.tempo := header5.tempo; + songdata.speed := header5.speed; + songdata.common_flag := header5.cflag; + songdata.patt_len := header5.patln; + songdata.nm_tracks := header5.nmtrk; + songdata.macro_speedup := header5.mcspd; + songdata.flag_4op := header5.is4op; + Move(header5.locks,songdata.lock_flags,SizeOf(songdata.lock_flags)); + + APACK_decompress(buf1,songdata.pattern_order); + BlockReadF(f,buf1,header5.b4len[0],temp); + If NOT (temp = header5.b4len[0]) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,pattdata^[0]); + For temp2 := 1 to 15 do + If ((header5.patts-1) DIV 8 > PRED(temp2)) then + begin + BlockReadF(f,buf1,header5.b4len[temp2],temp); + If NOT (temp = header5.b4len[temp2]) then + begin + CloseF(f); + EXIT; + end; + + If (temp2*8+8 <= max_patterns) then + APACK_decompress(buf1,pattdata^[temp2]) + else limit_exceeded := TRUE; + end; + end; + + If (header.ffver = 11) then + begin + crc := DWORD_NULL; + BlockReadF(f,buf1,header.b0len,temp); + If NOT (temp = header.b0len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header.b1len,temp); + If NOT (temp = header.b1len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header.b2len,temp); + If NOT (temp = header.b2len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header.b3len,temp); + If NOT (temp = header.b3len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header.b4len,temp); + If NOT (temp = header.b4len) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + BlockReadF(f,buf1,header.b5len[0],temp); + If NOT (temp = header.b5len[0]) then + begin + CloseF(f); + EXIT; + end; + + crc := Update32(buf1,temp,crc); + For temp2 := 1 to 15 do + If ((header.patts-1) DIV 8 > PRED(temp2)) then + begin + BlockReadF(f,buf1,header.b5len[temp2],temp); + If NOT (temp = header.b5len[temp2]) then + begin + CloseF(f); + EXIT; + end; + crc := Update32(buf1,temp,crc); + end; + + crc := Update32(header.b0len,2,crc); + crc := Update32(header.b1len,2,crc); + crc := Update32(header.b2len,2,crc); + crc := Update32(header.b3len,2,crc); + crc := Update32(header.b4len,2,crc); + + For temp2 := 0 to 15 do + crc := Update32(header.b5len[temp2],2,crc); + + If (crc <> header.crc32) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + SeekF(f,SizeOf(header)); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,buf1,header.b0len,temp); + If NOT (temp = header.b0len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.instr_data); + BlockReadF(f,buf1,header.b1len,temp); + If NOT (temp = header.b1len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.instr_macros); + BlockReadF(f,buf1,header.b2len,temp); + If NOT (temp = header.b2len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.macro_table); + BlockReadF(f,buf1,header.b3len,temp); + If NOT (temp = header.b3len) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,songdata.dis_fmreg_col); + BlockReadF(f,buf1,header.b4len,temp); + If NOT (temp = header.b4len) then + begin + CloseF(f); + EXIT; + end; + + songdata.tempo := header.tempo; + songdata.speed := header.speed; + songdata.common_flag := header.cflag; + songdata.patt_len := header.patln; + songdata.nm_tracks := header.nmtrk; + songdata.macro_speedup := header.mcspd; + songdata.flag_4op := header.is4op; + Move(header.locks,songdata.lock_flags,SizeOf(songdata.lock_flags)); + + APACK_decompress(buf1,songdata.pattern_order); + BlockReadF(f,buf1,header.b5len[0],temp); + If NOT (temp = header.b5len[0]) then + begin + CloseF(f); + EXIT; + end; + + APACK_decompress(buf1,pattdata^[0]); + For temp2 := 1 to 15 do + If ((header.patts-1) DIV 8 > PRED(temp2)) then + begin + BlockReadF(f,buf1,header.b5len[temp2],temp); + If NOT (temp = header.b5len[temp2]) then + begin + CloseF(f); + EXIT; + end; + + If (temp2*8+8 <= max_patterns) then + APACK_decompress(buf1,pattdata^[temp2]) + else limit_exceeded := TRUE; + end; + end; + + speed := songdata.speed; + tempo := songdata.tempo; + + CloseF(f); + songdata_title := NameOnly(songdata_source); + Case header.ffver of + 1..4: load_flag := 3; + else load_flag := 4; + end; +end; + + +function dec2hex(dec: Byte): Byte; +begin dec2hex := (dec DIV 10)*16 +(dec MOD 10); end; + +function truncate_string(str: String): String; +begin + While (Length(str) > 0) and (str[Length(str)] in [#0,#32,#255]) do + Delete(str,Length(str),1); + truncate_string := str; +end; + +procedure amd_file_loader; + +type + tPATDAT = array[0..$24] of + array[0..$3f] of array[1..9] of + array[0..2] of Byte; +type + tINSDAT = Record + iName: array[1..23] of Char; { Instrument name } + iData: array[0..10] of Byte; { Instrument data } + end; +type + tHEADER = Record + sname: array[1..24] of Char; { Name of song [ASCIIZ] } + aname: array[1..24] of Char; { Name of author [ASCIIZ] } + instr: array[0..25] of tINSDAT; { 26 instruments } + snlen: Byte; { Song length } + nopat: Byte; { Number of patterns -1 } + order: array[0..$7f] of Byte; { Pattern table } + ident: array[1..9] of Char; { ID } + versn: Byte; { Version 10h=normal module } + { 11h=packed module } + end; +const + id_amd = ' 0) then + chunk.instr_def := (byte2 SHR 4)+(byte1 AND 1) SHL 4; + + If (byte1 SHR 4 in [1..12]) and ((byte1 SHR 1) AND 7 in [0..7]) then + chunk.note := 12*((byte1 SHR 1) AND 7)+(byte1 SHR 4); + + param := byte3 AND $7f; + Case byte2 AND $0f of + { ARPEGGIO } + $00: begin + chunk.effect_def := ef_Arpeggio; + chunk.effect := dec2hex(param); + end; + + { SLIDE FREQUENCY UP } + $01: begin + chunk.effect_def := ef_FSlideUp; + chunk.effect := param; + end; + + { SLIDE FREQUENCY DOWN } + $02: begin + chunk.effect_def := ef_FSlideDown; + chunk.effect := param; + end; + + { SET CARRIER/MODULATOR INTENSITY } + $03: If (param DIV 10 in [1..9]) then + begin + chunk.effect_def := ef_SetCarrierVol; + chunk.effect := (param DIV 10)*7; + end + else If (param MOD 10 in [1..9]) then + begin + chunk.effect_def := ef_SetModulatorVol; + chunk.effect := (param MOD 10)*7; + end; + + { SET THE VOLUME } + $04: begin + chunk.effect_def := ef_SetInsVolume; + If (param < 64) then chunk.effect := param + else chunk.effect := 63; + end; + + { JUMP INTO PATTERN } + $05: begin + chunk.effect_def := ef_PositionJump; + If (param < 100) then chunk.effect := param + else chunk.effect := 99; + end; + + { PATTERNBREAK } + $06: begin + chunk.effect_def := ef_PatternBreak; + If (param < 64) then chunk.effect := param + else chunk.effect := 63; + end; + + { SET SONGSPEED } + $07: If (param < 99) then + If (param in [1..31]) then + begin + chunk.effect_def := ef_SetSpeed; + chunk.effect := param; + end + else begin + chunk.effect_def := ef_SetTempo; + If (param = 0) then chunk.effect := 18 + else chunk.effect := param; + end; + + { TONEPORTAMENTO } + $08: begin + chunk.effect_def := ef_TonePortamento; + chunk.effect := param; + end; + + { EXTENDED COMMAND } + $09: If (param < 60) then + Case param DIV 10 of + { DEFINE CELL-TREMOLO } + 0: If (param MOD 10 < 2) then + begin + chunk.effect_def := ef_Extended; + chunk.effect := dec2hex(param); + end; + + { DEFINE CELL-VIBRATO } + 1: If (param MOD 10 < 2) then + begin + chunk.effect_def := ef_Extended; + chunk.effect := $10+dec2hex(param); + end; + + { INCREASE VOLUME FAST } + 2: begin + chunk.effect_def := ef_VolSlide; + chunk.effect := (param MOD 10)*16; + end; + + { DECREASE VOLUME FAST } + 3: begin + chunk.effect_def := ef_VolSlide; + chunk.effect := param MOD 10; + end; + + { INCREASE VOLUME FINE } + 4: begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_VolSlideUpXF*16+(param MOD 10); + end; + + { DECREASE VOLUME FINE } + 5: begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_VolSlideDnXF*16+(param MOD 10); + end; + end; + end; + +// specific corrections for Amusic event + If (chunk.note = 0) then chunk.instr_def := 0; + put_chunk(pattern,line,channel,chunk); +end; + +procedure import_amd_packed_patterns(var data; patterns: Byte); + +var + temp,temp2,temp3,temp4,temp5: Word; + count: Byte; + +var + tracks: Word; + track_order: array[0..$3f] of array[1..9] of Word; + track: array[0..$3f] of tCHUNK; + +begin + temp := (patterns+1)*9*SizeOf(WORD); + Move(data,track_order,temp); + + tracks := tDUMMY_BUFF(data)[temp]+(tDUMMY_BUFF(data)[temp+1]) SHL 8; + Inc(temp,2); + + temp3 := 0; + temp4 := 0; + count := 0; + + Repeat + If (count = 0) then + begin + If (temp3 = 0) then + begin + temp2 := tDUMMY_BUFF(data)[temp]+(tDUMMY_BUFF(data)[temp+1]) SHL 8; + Inc(temp,2); + end; + + If (tDUMMY_BUFF(data)[temp] OR $80 <> tDUMMY_BUFF(data)[temp]) then + begin + If (temp2 DIV 9 <= $3f) and (temp2 MOD 9 < 9) then + import_amd_event(temp2 DIV 9,temp3,temp2 MOD 9 +1, + tDUMMY_BUFF(data)[temp+2], + tDUMMY_BUFF(data)[temp+1], + tDUMMY_BUFF(data)[temp+0]); + Inc(temp,3); + end + else + begin + count := (tDUMMY_BUFF(data)[temp] AND $7f)-1; + Inc(temp); + end; + end + else Dec(count); + + Inc(temp3); + If (temp3 > $3f) then + begin + temp3 := 0; + count := 0; + Inc(temp4); + end; + until NOT (temp4 < tracks); + + For temp := 0 to patterns do + For temp2 := 1 to 9 do + begin + temp3 := track_order[temp][temp2]; + temp4 := temp3 DIV 9; + + If (temp3 < 64*9) then + begin + For temp5 := 0 to $3f do + get_chunk(temp4,temp5,temp3 MOD 9 +1,track[temp5]); + For temp5 := 0 to $3f do + put_chunk( temp,temp5,temp2,track[temp5]); + end; + end; +end; + +function get_byte(var pos: Longint): Byte; +begin + If (pos = SizeOf(buf1)) then + begin + Move(buf3,buf1,SizeOf(buf3)); + pos := 0; + end; + get_byte := buf1[pos]; + Inc(pos); +end; + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and + ((header.ident = id_amd) or (header.ident = id_xms))) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + If NOT (header.versn in [$10,$11]) then + begin + CloseF(f); + EXIT; + end; + + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,SizeOf(buf1),temp); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + tmp2 := WORD_NULL; + If (temp = SizeOf(buf1)) then + begin + FillChar(buf3,SizeOf(buf3),0); + BlockReadF(f,buf3,SizeOf(buf3),tmp2); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + tempo := 50; + speed := 6; + + songdata.tempo := tempo; + songdata.speed := speed; + + For temp2 := 0 to header.snlen-1 do + If (temp2 < 128) and (header.order[temp2] in [0..header.nopat]) then + songdata.pattern_order[temp2] := header.order[temp2]; + + For temp2 := 0 to 25 do + begin + import_amd_instrument(temp2+1,header.instr[temp2].iData); + songdata.instr_names[temp2+1] := + Copy(songdata.instr_names[temp2+1],1,9)+ + truncate_string(header.instr[temp2].iName); + end; + + temp := 0; + If (header.versn = $10) then + For temp2 := 0 to header.nopat do + For temp3 := 0 to $3f do + For temp4 := 1 to 9 do + begin + byte3 := get_byte(temp); + byte2 := get_byte(temp); + byte1 := get_byte(temp); + import_amd_event(temp2,temp3,temp4,byte1,byte2,byte3); + end + else + import_amd_packed_patterns(buf1,header.nopat); + + songdata.common_flag := songdata.common_flag OR $80; + songdata.songname := CutStr(asciiz_string(header.sname)); + songdata.composer := CutStr(asciiz_string(header.aname)); + import_old_flags; + + CloseF(f); + songdata_title := NameOnly(songdata_source); + If (header.ident = id_amd) then load_flag := 5 + else load_flag := 6; +end; + +procedure import_hsc_instrument(inst: Byte; var data); forward; + +procedure import_cff_event(patt,line,chan,byte0,byte1,byte2: Byte); + +var + chunk: tCHUNK; + temp1,temp2,temp3,temp4: Byte; + +begin + FillChar(chunk,SizeOf(chunk),0); + temp1 := byte2; + temp2 := temp1 DIV 16; + temp3 := temp1 MOD 16; + + Case CHAR(byte1) of + { SET SPEED } + 'A': If (temp1 > 0) then + begin + chunk.effect_def := ef_SetSpeed; + chunk.effect := temp1; + end; + + { SET CARRIER WAVEFORM } + 'B': If (temp1 < 4) then + begin + chunk.effect_def := ef_SetWaveform; + chunk.effect := temp1*16; + end; + + { SET MODULATOR VOLUME } + 'C': begin + chunk.effect_def := ef_SetModulatorVol; + If (temp1 < 64) then chunk.effect := 63-temp1 + else chunk.effect := 0; + end; + + { VOLUME SLIDE UP/DOWN } + 'D': begin + chunk.effect_def := ef_VolSlide; + chunk.effect := temp1; + end; + + { SLIDE DOWN } + 'E': If (temp1 <> 0) then + begin + chunk.effect_def := ef_FSlideDown; + chunk.effect := temp1; + end; + + { SLIDE UP } + 'F': If (temp1 <> 0) then + begin + chunk.effect_def := ef_FSlideUp; + chunk.effect := temp1; + end; + + { SET CARRIER VOLUME } + 'G': begin + chunk.effect_def := ef_SetCarrierVol; + If (temp1 < 64) then chunk.effect := 63-temp1 + else chunk.effect := 0; + end; + + { SET TEMPO } + 'H': If (temp1 > 0) then + begin + chunk.effect_def := ef_SetTempo; + If NOT (temp1 > 21) then temp1 := 125; + temp4 := 1412926 DIV LONGINT(temp1 SHR 1); + chunk.effect := 1; + While (1193180 DIV chunk.effect > temp4) and + (chunk.effect < 255) do + Inc(chunk.effect); + end; + + { SET INSTRUMENT } + 'I': If (temp1 < 47) then + begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol; + chunk.instr_def := temp1+1; + end; + + { ARPEGGIO } + 'J': begin + chunk.effect_def := ef_Arpeggio; + chunk.effect := temp1; + end; + + { JUMP TO ORDER } + 'K': If (temp1 < 128) then + begin + chunk.effect_def := ef_PositionJump; + chunk.effect := temp1; + end; + + { JUMP TO NEXT PATTERN IN ORDER } + 'L': chunk.effect_def := ef_PatternBreak; + + { SET TREMOLO HIGHER / SET VIBRATO DEEPER } + 'M': begin + chunk.effect_def := ef_Extended; + If (temp2 = 1) and (temp3 = 0) then chunk.effect := dec2hex(01); + If (temp2 = 0) and (temp3 = 1) then chunk.effect := dec2hex(10); + If (temp2 = 1) and (temp3 = 1) then chunk.effect := dec2hex(11); + end; + end; + + Case byte0 of + { REGULAR NOTE } + 1..12*8+1: begin + If NOT fix_c_note_bug then chunk.note := byte0 + else begin + chunk.note := byte0+1; + If (chunk.note > 12*8+1) then + chunk.note := 12*8+1; + end; + end; + { PAUSE } + $6d: chunk.note := BYTE_NULL; + end; + + put_chunk(patt,line,chan,chunk); +end; + +procedure import_cff_patterns(var data; patterns: Byte); + +type + tPATDAT = array[0..$24] of + array[0..$3f] of array[1..9] of + array[0..2] of Byte; + +var + voice: array[1..9] of Byte; + arpgg: array[1..9] of Byte; + chunk: tCHUNK; + temp,temp2,temp3,temp4: Byte; + order,patt: Byte; + patt_break: Byte; + patts: String; + +function _empty_event(var data): Boolean; +begin + _empty_event := (tDUMMY_BUFF(data)[0] = 0) and + (tDUMMY_BUFF(data)[1] = 0) and + (tDUMMY_BUFF(data)[2] = 0); +end; + +begin + patts := ''; + FillChar(arpgg,SizeOf(arpgg),0); + If NOT accurate_conv then + For temp := 1 to 9 do voice[temp] := temp + else For temp := 1 to 9 do voice[temp] := 0; + + For temp := 0 to $24 do + For temp2 := 0 to $3f do + For temp3 := 1 to 9 do + If NOT _empty_event(tPATDAT(data)[temp][temp2][temp3]) then + import_cff_event(temp,temp2,temp3,tPATDAT(data)[temp][temp2][temp3][0], + tPATDAT(data)[temp][temp2][temp3][1], + tPATDAT(data)[temp][temp2][temp3][2]); + order := 0; + patt := BYTE_NULL; + + Repeat + If (songdata.pattern_order[order] > $24) then Inc(order) + else + begin + patt := songdata.pattern_order[order]; + patt_break := BYTE_NULL; + For temp2 := 0 to $3f do + For temp3 := 1 to 9 do + begin + get_chunk(patt,temp2,temp3,chunk); + temp4 := tPATDAT(data)[patt][temp2][temp3][2]; + + Case CHAR(tPATDAT(data)[patt][temp2][temp3][1]) of + { SET MODULATOR VOLUME } + 'C': If (chunk.instr_def = 0) and NOT accurate_conv then + chunk.instr_def := voice[temp3] + else If (chunk.instr_def = 0) and + (voice[temp3] = 0) then chunk.instr_def := temp3; + + { SET CARRIER VOLUME } + 'G': If (chunk.instr_def = 0) and NOT accurate_conv then + chunk.instr_def := voice[temp3] + else If (chunk.instr_def = 0) and + (voice[temp3] = 0) then chunk.instr_def := temp3; + + { SET INSTRUMENT } + 'I': If (temp4 < 47) then + If (temp2 <> patt_break) then + begin + voice[temp3] := temp4+1; + If NOT accurate_conv then + chunk.instr_def := voice[temp3]; + end; + + { ARPEGGIO } + 'J': begin + chunk.effect_def := ef_Arpeggio; + If (temp4 <> 0) then + begin + chunk.effect := temp4; + arpgg[temp3] := temp4; + end + else chunk.effect := arpgg[temp3]; + end; + + { JUMP TO ORDER } + 'K': If (temp4 < 128) then + patt_break := temp2+1; + + { JUMP TO NEXT PATTERN IN ORDER } + 'L': patt_break := temp2+1; + end; + + Case tPATDAT(data)[patt][temp2][temp3][0] of + { REGULAR NOTE } + 1..12*8+1: begin + If accurate_conv then + If (voice[temp3] = 0) then + begin + voice[temp3] := temp3; + chunk.instr_def := voice[temp3]; + end; + + If NOT accurate_conv then + chunk.instr_def := voice[temp3]; + end; + end; + + If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then + put_chunk(patt,temp2,temp3,chunk); + end; + Inc(order); + patts := patts+CHR(patt); + end; + until (patt >= patterns) or (order > $40); +end; + +procedure cff_file_loader; + +type + tHEADER = Record + ident: array[1..16] of Char; { Identification } + versn: Byte; { Format version } + fsize: Word; { Filesize -32 } + cflag: Byte; { Flag 1=compressed data } + resrv: array[0..11] of Byte; { Reserved } + end; +type + tINSDAT = Record + iData: array[0..11] of Byte; { Instrument data } + iName: array[1..20] of Char; { Instrument name } + end; +type + tHEADR2 = Record + instr: array[0..46] of tINSDAT; { 47 instruments } + nopat: Byte; { Number of patterns } + ascii: array[1..31] of Char; { ASCII blab } + writr: array[1..20] of Char; { Song writer } + sname: array[1..20] of Char; { Song name } + order: array[0..64] of Byte; { Pattern order } + end; +const + _PRE_ASCII_BLAB_SIZE = $5e1; // SizeOf(tHEADR2.instr)+SizeOf(tHEADR2.nopat) + +const + id = ''+#26+CHR($de)+CHR($e0); + ascii_blab = 'CUD-FM-File - SEND A POSTCARD -'; + +var + f: File; + header: tHEADER; + headr2: tHEADR2; + temp,temp2: Longint; + offs,out_size: Longint; + +function LZTYR_decompress(var input,output): Longint; + +type + tSTRING = array[0..255] of Byte; + +var + input_idx: Longint; + + the_string, + temp_string: tSTRING; + + old_code_length: Byte; + repeat_length: Byte; + repeat_counter: Longint; + output_length: Longint; + code_length: Byte; + bits_buffer: Longint; + bits_left: Word; + old_code: Longint; + new_code: Longint; + idx: Word; + + _cff_heap_length: Word; + _cff_dictionary_length: Word; + _cff_dictionary: array[0..32767] of Pointer; + +function get_code: Longint; + +var + code: Longint; + +begin + While (bits_left < code_length) do + begin + bits_buffer := bits_buffer OR (tDUMMY_BUFF(input)[input_idx] SHL + bits_left); + Inc(input_idx); + Inc(bits_left,8); + end; + + code := bits_buffer AND ((1 SHL code_length)-1); + bits_buffer := bits_buffer SHR code_length; + Dec(bits_left,code_length); + get_code := code; +end; + +procedure translate_code(code: Longint; var str: tSTRING); + +var + translated_string: tSTRING; + +begin + If (code >= $104) then + Move(_cff_dictionary[code-$104]^,translated_string, + BYTE(_cff_dictionary[code-$104]^)+1) + else begin + translated_string[0] := 1; + translated_string[1] := (code-4) AND $0ff; + end; + + Move(translated_string,str,256); +end; + +procedure startup; + +var + idx: Longint; + +begin + old_code := get_code; + translate_code(old_code,the_string); + + If (the_string[0] > 0) then + For idx := 0 to the_string[0]-1 do + begin + tDUMMY_BUFF(output)[output_length] := the_string[idx+1]; + Inc(output_length); + end; +end; + +procedure cleanup; +begin + code_length := 9; + bits_buffer := 0; + bits_left := 0; + _cff_heap_length := 0; + _cff_dictionary_length := 0; +end; + +procedure expand__cff_dictionary(str: tSTRING); +begin + If (str[0] >= $0f0) then EXIT; + Move(str,buf3[_cff_heap_length],str[0]+1); + _cff_dictionary[_cff_dictionary_length] := Addr(buf3[_cff_heap_length]); + Inc(_cff_dictionary_length); + Inc(_cff_heap_length,str[0]+1); +end; + +begin + input_idx := 0; + output_length := 0; + cleanup; + startup; + + Repeat + new_code := get_code; + + // $00: end of data + If (new_code = 0) then BREAK; + + // $01: end of block + If (new_code = 1) then + begin + cleanup; + startup; + CONTINUE; + end; + + // $02: expand code length + If (new_code = 2) then + begin + Inc(code_length); + CONTINUE; + end; + + // $03: RLE + If (new_code = 3) then + begin + old_code_length := code_length; + code_length := 2; + repeat_length := get_code+1; + code_length := 4 SHL get_code; + repeat_counter := get_code; + + For idx := 0 to PRED(repeat_counter*repeat_length) do + begin + tDUMMY_BUFF(output)[output_length] := + tDUMMY_BUFF(output)[output_length-repeat_length]; + Inc(output_length); + end; + + code_length := old_code_length; + startup; + CONTINUE; + end; + + If (new_code >= $104+_cff_dictionary_length) then + begin + Inc(the_string[0]); + the_string[the_string[0]] := the_string[1]; + end + else begin + translate_code(new_code,temp_string); + Inc(the_string[0]); + the_string[the_string[0]] := temp_string[1]; + end; + + expand__cff_dictionary(the_string); + translate_code(new_code,the_string); + + For idx := 0 to PRED(the_string[0]) do + begin + tDUMMY_BUFF(output)[output_length] := the_string[idx+1]; + Inc(output_length); + end; + + old_code := new_code; + until FALSE; + + LZTYR_decompress := output_length; +end; + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.ident = id)) or + (FileSize(f) > SizeOf(buf1)) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + If (header.cflag = 1) then + begin + FillChar(buf1,SizeOf(buf1),0); + ResetF(f); + BlockReadF(f,buf1,SizeOf(buf1),temp); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + CloseF(f); + temp := LZTYR_decompress(buf1[$30],hash_buffer); + out_size := temp; + + offs := SensitiveScan(hash_buffer,0,temp,ascii_blab); + If (offs <> _PRE_ASCII_BLAB_SIZE) then + begin + EXIT; + end; + + FillChar(buf1,SizeOf(buf1),0); + Move(hash_buffer,headr2,SizeOf(headr2)); + Move(POINTER(Ofs(hash_buffer)+SizeOf(headr2))^,buf1,out_size-SizeOf(headr2)); + end + else + begin + BlockReadF(f,headr2,SizeOf(headr2),temp); + If NOT ((temp = SizeOf(headr2)) and (headr2.ascii = ascii_blab)) then + begin + CloseF(f); + EXIT; + end; + + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,SizeOf(buf1),temp); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + CloseF(f); + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + tempo := 51; + speed := 6; + + songdata.tempo := tempo; + songdata.speed := speed; + + For temp2 := 0 to 64 do + If (headr2.order[temp2] in [0..headr2.nopat]) then + songdata.pattern_order[temp2] := headr2.order[temp2]; + + For temp2 := 0 to 46 do + begin + import_hsc_instrument(temp2+1,headr2.instr[temp2].iData); + songdata.instr_data[temp2+1].fine_tune := 0; + songdata.instr_names[temp2+1] := + Copy(songdata.instr_names[temp2+1],1,9)+ + truncate_string(headr2.instr[temp2].iName); + end; + + songdata.common_flag := songdata.common_flag OR 2; + songdata.songname := CutStr(headr2.sname); + songdata.composer := CutStr(headr2.writr); + import_old_flags; + + import_cff_patterns(buf1,headr2.nopat); + songdata_title := NameOnly(songdata_source); + load_flag := 7; +end; + +procedure import_standard_instrument(inst: Byte; var data); +begin + With songdata.instr_data[inst] do + begin + fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[0]; + fm_data.AM_VIB_EG_carrier := tDUMMY_BUFF(data)[1]; + fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[2]; + fm_data.KSL_VOLUM_carrier := tDUMMY_BUFF(data)[3]; + fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[4]; + fm_data.ATTCK_DEC_carrier := tDUMMY_BUFF(data)[5]; + fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[6]; + fm_data.SUSTN_REL_carrier := tDUMMY_BUFF(data)[7]; + fm_data.WAVEFORM_modulator := tDUMMY_BUFF(data)[8] AND 3; + fm_data.WAVEFORM_carrier := tDUMMY_BUFF(data)[9] AND 3; + fm_data.FEEDBACK_FM := tDUMMY_BUFF(data)[10] AND $0f; + end; + + songdata.instr_data[inst].panning := 0; + songdata.instr_data[inst].fine_tune := 0; +end; + +procedure dfm_file_loader; + +const + id = 'DFM'+#26; + +var + header: Record + ident: array[1..4] of Char; + versn: Word; + sname: String[32]; + tempo: Byte; + instn: array[1..32] of String[11]; + instd: array[1..32] of tFM_INST_DATA; + order: array[1..128] of Byte; + patts: Byte; + end; + +var + f: File; + temp,temp2,temp3: Longint; + pattern,line,channel,byte1,byte2: Byte; + +procedure import_dfm_event(patt,line,chan,byte1,byte2: Byte); + +var + chunk: tCHUNK; + +begin + FillChar(chunk,SizeOf(chunk),0); + If (byte1 AND $0f in [1..12,15]) and ((byte1 SHR 4) AND 7 in [0..7]) then + If (byte1 AND $0f <> 15) then + chunk.note := SUCC(PRED(byte1 AND $0f)+((byte1 SHR 4) AND 7)*12) + else chunk.note := BYTE_NULL; + + Case byte2 SHR 5 of + { INSTRUMENT CHANGE } + 1: chunk.instr_def := SUCC(byte2 AND $1f); + + { SET INSTRUMENT VOLUME } + 2: begin + chunk.effect_def := ef_SetInsVolume; + chunk.effect := (byte2 AND $1f)*2; + end; + + { TEMPO CHANGE } + 3: begin + chunk.effect_def := ef_SetSpeed; + chunk.effect := SUCC(byte2 AND $1f); + end; + + { SLIDE UP } + 4: begin + chunk.effect_def := ef_FSlideUpFine; + chunk.effect := byte2 AND $1f; + end; + + { SLIDE DOWN } + 5: begin + chunk.effect_def := ef_FSlideDownFine; + chunk.effect := byte2 AND $1f; + end; + + { END OF PATTERN } + 7: chunk.effect_def := ef_PatternBreak; + end; + + put_chunk(patt,line,chan,chunk); +end; + +procedure process_dfm_patterns(patterns: Byte); + +var + chunk: tCHUNK; + temp2,temp3: Byte; + order,patt: Byte; + patts: String; + instr_cache: array[1..18] of Byte; + +begin + patts := ''; + FillChar(instr_cache,SizeOf(instr_cache),0); + order := 0; + patt := BYTE_NULL; + + Repeat + If (songdata.pattern_order[order] >= $80) then Inc(order) + else + begin + patt := songdata.pattern_order[order]; + For temp2 := 0 to $3f do + For temp3 := 1 to 9 do + begin + get_chunk(patt,temp2,temp3,chunk); + If (chunk.instr_def <> 0) then + begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol; + instr_cache[temp3] := chunk.instr_def; + If NOT (chunk.note in [1..12*8+1]) and + NOT accurate_conv then + chunk.instr_def := 0; + end + else If (chunk.note in [1..12*8+1]) and + (chunk.instr_def = 0) and NOT accurate_conv then + chunk.instr_def := instr_cache[temp3]; + + If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then + put_chunk(patt,temp2,temp3,chunk); + end; + Inc(order); + patts := patts+CHR(patt); + end; + until (patt >= patterns) or (order > $7f); +end; + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,SizeOf(buf1),temp); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + tempo := 135; + speed := SUCC(header.tempo); + + songdata.songname := CutStr(header.sname); + songdata.tempo := tempo; + songdata.speed := speed; + songdata.common_flag := songdata.common_flag OR 1; + songdata.common_flag := songdata.common_flag OR 2; + songdata.common_flag := songdata.common_flag OR 8; + songdata.common_flag := songdata.common_flag OR $10; + import_old_flags; + + For temp2 := 1 to 128 do + If (header.order[temp2] in [0..$7f]) then + songdata.pattern_order[temp2-1] := header.order[temp2] + else If (header.order[temp2] = $80) then BREAK + else songdata.pattern_order[temp2-1] := $80+temp2; + + For temp2 := 1 to 32 do + begin + songdata.instr_names[temp2] := + Copy(songdata.instr_names[temp2],1,9)+ + CutStr(header.instn[temp2]); + While (BYTE(songdata.instr_names[temp2][ + Length(songdata.instr_names[temp2])]) < 32) and + (Length(songdata.instr_names[temp2]) <> 0) do + Delete(songdata.instr_names[temp2], + Length(songdata.instr_names[temp2]),1); + import_standard_instrument(temp2,header.instd[temp2]); + end; + + temp2 := 0; + temp3 := 0; + Repeat + pattern := buf1[temp2]; + If (pattern > 127) then + begin + CloseF(f); + EXIT; + end; + + Inc(temp2); + Inc(temp3); + + For line := 0 to $3f do + For channel := 1 to 9 do + begin + byte1 := buf1[temp2]; + If (temp2 >= temp) then + begin + CloseF(f); + EXIT; + end + else Inc(temp2); + + If (byte1 OR $80 <> byte1) then byte2 := 0 + else begin + byte2 := buf1[temp2]; + Inc(temp2); + end; + import_dfm_event(pattern,line,channel,byte1,byte2); + end; + until (temp2 >= temp); + + process_dfm_patterns(temp3); + CloseF(f); + + songdata_title := NameOnly(songdata_source); + load_flag := 8; +end; + +type + tHSC_PATTERNS = array[0..$31] of + array[0..$3f] of array[1..9] of Word; +type + tHSC_DATA = Record + instr: array[0..$7f] of array[0..$0b] of Byte; + order: array[0..$31] of Byte; + patts: tHSC_PATTERNS; + end; + +procedure import_hsc_event(patt,line,chan: Byte; event: Word); + +var + chunk: tCHUNK; + +begin + FillChar(chunk,SizeOf(chunk),0); + Case HI(event) of + { REGULAR NOTE } + 1..12*8+1: If NOT fix_c_note_bug then chunk.note := HI(event) + else begin + chunk.note := HI(event)+1; + If (chunk.note > 12*8+1) then + chunk.note := 12*8+1; + end; + { PAUSE } + $7f: chunk.note := BYTE_NULL; + + { INSTRUMENT } + $80: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol; + chunk.instr_def := LO(event)+1; + chunk.note := BYTE_NULL; + end; + end; + + If (HI(event) <> $80) then + Case (LO(event) AND $0f0) of + { PATTERNBREAK } + $00: If (LO(event) AND $0f = 1) then + chunk.effect_def := ef_PatternBreak; + + { MANUAL SLIDE UP } + $10: begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_FineTuneUp*16+ + max(LO(event) AND $0f +1,15); + end; + + { MANUAL SLIDE DOWN } + $20: begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_FineTuneDown*16+ + max(LO(event) AND $0f +1,15); + end; + + { SET CARRIER VOLUME } + $a0: begin + chunk.effect_def := ef_SetCarrierVol; + chunk.effect := 63-(LO(event) AND $0f)*4; + chunk.instr_def := LO(event)+1; + end; + + { SET MODULATOR VOLUME } + $b0: begin + chunk.effect_def := ef_SetModulatorVol; + chunk.effect := 63-(LO(event) AND $0f)*4; + end; + + { SET INSTRUMENT VOLUME } + $c0: begin + chunk.effect_def := ef_SetInsVolume; + chunk.effect := 63-(LO(event) AND $0f)*4; + end; + + { SET SPEED } + $f0: begin + chunk.effect_def := ef_SetSpeed; + chunk.effect := (LO(event) AND $0f)+1; + end; + end; + put_chunk(patt,line,chan,chunk); +end; + +procedure import_hsc_patterns(var data; patterns: Byte); + +var + voice: array[1..9] of Byte; + event: Word; + chunk: tCHUNK; + temp,temp2,temp3: Byte; + order,patt: Byte; + patt_break: Byte; + patts: String; + +function _hsc_event(patt,line,chan: Byte): Word; +begin + _hsc_event := LO(tHSC_PATTERNS(data)[patt][line][chan+1])+ + HI(tHSC_PATTERNS(data)[patt][line][chan]) SHL 8; +end; + +begin { import_hsc_patterns } + patts := ''; + If NOT accurate_conv then + For temp := 1 to 9 do voice[temp] := temp + else For temp := 1 to 9 do voice[temp] := 0; + + For temp := 0 to $31 do + For temp2 := 0 to $3f do + For temp3 := 1 to 9 do + If (_hsc_event(temp,temp2,temp3) <> 0) then + import_hsc_event(temp,temp2,temp3,_hsc_event(temp,temp2,temp3)); + + order := 0; + patt := BYTE_NULL; + + Repeat + If (songdata.pattern_order[order] > $31) then Inc(order) + else + begin + patt := songdata.pattern_order[order]; + patt_break := BYTE_NULL; + For temp2 := 0 to $3f do + For temp3 := 1 to 9 do + begin + get_chunk(patt,temp2,temp3,chunk); + event := _hsc_event(patt,temp2,temp3); + + Case HI(event) of + { REGULAR NOTE } + 1..12*8+1: begin + If accurate_conv then + If (voice[temp3] = 0) then + begin + voice[temp3] := temp3; + chunk.instr_def := voice[temp3]; + end; + + If NOT accurate_conv then + chunk.instr_def := voice[temp3]; + end; + + { INSTRUMENT } + $80: If (temp2 <> patt_break) then + begin + voice[temp3] := LO(event)+1; + If NOT accurate_conv then + begin + chunk.instr_def := voice[temp3]; + chunk.note := BYTE_NULL; + end; + end; + end; + + If (HI(event) <> $80) then + Case (LO(event) AND $0f0) of + { PATTERNBREAK } + $00: If (LO(event) AND $0f = 1) then + patt_break := temp2+1; + + { SET CARRIER VOLUME } + $a0: If (chunk.instr_def = 0) and NOT accurate_conv then + chunk.instr_def := voice[temp3] + else If (chunk.instr_def = 0) and + (voice[temp3] = 0) then chunk.instr_def := temp3; + + { SET MODULATOR VOLUME } + $b0: If (chunk.instr_def = 0) and NOT accurate_conv then + chunk.instr_def := voice[temp3] + else If (chunk.instr_def = 0) and + (voice[temp3] = 0) then chunk.instr_def := temp3; + + { SET INSTRUMENT VOLUME } + $c0: If (chunk.instr_def = 0) and NOT accurate_conv then + chunk.instr_def := voice[temp3] + else If (chunk.instr_def = 0) and + (voice[temp3] = 0) then chunk.instr_def := temp3; + end; + + If (Pos(CHR(songdata.pattern_order[order]),patts) = 0) then + put_chunk(patt,temp2,temp3,chunk); + end; + Inc(order); + patts := patts+CHR(patt); + end; + until (patt >= patterns) or (order > $7f); +end; + +procedure import_hsc_instrument(inst: Byte; var data); +begin + With songdata.instr_data[inst] do + begin + fm_data.AM_VIB_EG_carrier := tDUMMY_BUFF(data)[0]; + fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[1]; + fm_data.KSL_VOLUM_carrier := tDUMMY_BUFF(data)[2]; + fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[3]; + fm_data.ATTCK_DEC_carrier := tDUMMY_BUFF(data)[4]; + fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[5]; + fm_data.SUSTN_REL_carrier := tDUMMY_BUFF(data)[6]; + fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[7]; + fm_data.FEEDBACK_FM := tDUMMY_BUFF(data)[8] AND $0f; + fm_data.WAVEFORM_carrier := tDUMMY_BUFF(data)[9] AND 3; + fm_data.WAVEFORM_modulator := tDUMMY_BUFF(data)[10] AND 3; + end; + + songdata.instr_data[inst].panning := 0; + songdata.instr_data[inst].fine_tune := tDUMMY_BUFF(data)[11] SHR 4; +end; + +var + hscbuf: tHSC_DATA; + +procedure hsc_file_loader; + +const + HSC_KSL: array[0..3] of Byte = (0,3,2,1); + +var + f: File; + temp,temp2,temp3: Longint; + +begin + If (Lower(ExtOnly(songdata_source)) <> 'hsc') then + begin + load_flag := $7f; + EXIT; + end; + + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + FillChar(hscbuf,SizeOf(hscbuf),0); + BlockReadF(f,hscbuf,SizeOf(hscbuf),temp); + If (temp < SizeOf(hscbuf.instr)+SizeOf(hscbuf.order)) then + begin + CloseF(f); + EXIT; + end; + + For temp2 := 0 to $31 do + If (hscbuf.order[temp2] > $b0) then hscbuf.order[temp2] := $080; + + temp3 := 0; + While (temp3 < temp-SizeOf(hscbuf.instr)-SizeOf(hscbuf.order)) do + begin + If NOT (tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3+1] in + [1..12*8+1,$00,$7f,$80]) or + NOT (tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3] AND $0f0 in + [$00,$10,$20,$a0,$b0,$c0,$f0]) then + begin + If NOT (tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3+1] in + [1..12*8+1,$00,$7f,$80]) then + tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3+1] := $00; + + If NOT (tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3] AND $0f0 in + [$00,$10,$20,$a0,$b0,$c0,$f0]) then + tDUMMY_BUFF(Addr(hscbuf.patts)^)[temp3] := 0; + end; + Inc(temp3,2); + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + tempo := 18; + speed := 2; + + songdata.common_flag := songdata.common_flag OR 2; + songdata.tempo := tempo; + songdata.speed := speed; + import_old_flags; + + For temp2 := 0 to $31 do + songdata.pattern_order[temp2] := hscbuf.order[temp2]; + + import_hsc_patterns(hscbuf.patts,(temp-SizeOf(hscbuf.instr) + -SizeOf(hscbuf.order)-1) DIV $480); + +// specific corrections for HSC-Tracker instrument + For temp2 := 0 to $7f do + begin + import_hsc_instrument(temp2+1,hscbuf.instr[temp2]); + With songdata.instr_data[temp2+1].fm_data do + begin + KSL_VOLUM_modulator := KSL_VOLUM_modulator AND $3f+ + HSC_KSL[KSL_VOLUM_modulator SHR 6] SHL 6; + KSL_VOLUM_carrier := KSL_VOLUM_carrier AND $3f+ + HSC_KSL[KSL_VOLUM_carrier SHR 6] SHL 6; + end; + end; + + CloseF(f); + songdata_title := NameOnly(songdata_source); + load_flag := 9; +end; + +type + tMTK_DATA = Record + sname: String[33]; + compo: String[33]; + instn: array[0..$7f] of String[33]; + instt: array[0..$7f] of array[0..$0b] of Byte; + order: array[0..$7f] of Byte; + patts: tHSC_PATTERNS; + dummy: Byte; + end; + +var + buffer2: tMTK_DATA; + +procedure mtk_file_loader; + +var + f: File; + temp,temp2: Longint; + crc: Word; + old_c_fix: Boolean; + +const + id = 'mpu401tr’kkîr@data'; + +var + header: Record + id_string: array[1..18] of Char; + crc_16bit: Word; + data_size: Word; + end; +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.id_string = id)) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,SizeOf(buf1),temp); + + crc := 0; + crc := Update16(buf1,temp,crc); + If (crc <> header.crc_16bit) then + begin + CloseF(f); + EXIT; + end; + + FillChar(buffer2,SizeOf(buffer2),0); + temp2 := RDC_decompress(buf1,buffer2,temp); + If NOT (temp2 = header.data_size) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + tempo := 18; + speed := 2; + + songdata.common_flag := songdata.common_flag OR 2; + songdata.tempo := tempo; + songdata.speed := speed; + import_old_flags; + + For temp2 := 0 to $31 do + If (buffer2.order[temp2] <> $ff) then songdata.pattern_order[temp2] := buffer2.order[temp2] + else songdata.pattern_order[temp2] := $080; + + old_c_fix := fix_c_note_bug; + fix_c_note_bug := FALSE; + import_hsc_patterns(buffer2.patts, + (header.data_size-SizeOf(buffer2.sname) + -SizeOf(buffer2.compo) + -SizeOf(buffer2.instn) + -SizeOf(buffer2.instt) + -SizeOf(buffer2.order)-1) DIV $480); + fix_c_note_bug := old_c_fix; + +// specific corrections for MPU-401 TR’KKîR instrument + For temp2 := 0 to $7f do + begin + import_hsc_instrument(temp2+1,buffer2.instt[temp2]); + With songdata.instr_data[temp2+1].fm_data do + begin + If (KSL_VOLUM_modulator > 128) then + KSL_VOLUM_modulator := KSL_VOLUM_modulator DIV 3; + If (KSL_VOLUM_carrier > 128) then + KSL_VOLUM_carrier := KSL_VOLUM_carrier DIV 3; + end; + + songdata.instr_names[temp2+1] := + Copy(songdata.instr_names[temp2+1],1,9)+ + truncate_string(Copy(buffer2.instn[temp2],10,32)); + end; + + songdata.songname := CutStr(buffer2.sname); + songdata.composer := CutStr(buffer2.compo); + + CloseF(f); + songdata_title := NameOnly(songdata_source); + load_flag := 10; +end; + +procedure rad_file_loader; + +const + id = 'RAD by REALiTY!!'; + +var + header: Record + ident: array[1..16] of Char; { Use this to recognize a RAD tune } + rmver: Byte; { Version of RAD file (10h) } + xbyte: Byte; { bit7 Set if a description follows } + end; { bit6 Set if it's a "slow-timer" tune } + { bit[4..0] The initial speed of the tune } +var + f: File; + dscbuf: array[0..PRED(80*22)] of Char; + pattoffs: array[0..$1f] of Word; + temp,temp2,temp3,temp4,temp5,offs0: Longint; + +procedure import_rad_event(pattern,line,channel,byte1,byte2,byte3: Byte); + +var + chunk: tCHUNK; + +begin + FillChar(chunk,SizeOf(chunk),0); + If ((byte2 SHR 4)+(byte1 SHR 7) SHL 4 <> 0) then + chunk.instr_def := (byte2 SHR 4)+(byte1 SHR 7) SHL 4; + + If (byte1 AND $0f in [1..12]) then chunk.note := 12*((byte1 SHR 4) AND 7)+(byte1 AND $0f)+1 + else If (byte1 AND $0f = $0f) then chunk.note := BYTE_NULL; + + Case byte2 AND $0f of + { PORTAMENTO (FREQUENCY SLIDE) UP } + $01: begin + chunk.effect_def := ef_FSlideUp; + chunk.effect := byte3; + end; + + { PORTAMENTO (FREQUENCY SLIDE) DOWN } + $02: begin + chunk.effect_def := ef_FSlideDown; + chunk.effect := byte3; + end; + + { PORTAMENTO TO NOTE } + $03: begin + chunk.effect_def := ef_TonePortamento; + chunk.effect := byte3; + end; + + { PORTAMENTO TO NOTE WITH VOLUME SLIDE } + $05: If (byte3 in [1..49]) then + begin + chunk.effect_def := ef_TPortamVolSlide; + chunk.effect := max(byte3,15); + + If (byte3 > 15) then + begin + chunk.effect_def2 := ef_TPortamVolSlide; + chunk.effect2 := max(byte3-15,15); + end; + end + else If (byte3 in [51..99]) then + begin + chunk.effect_def := ef_TPortamVolSlide; + chunk.effect := max(byte3-50,15)*16; + + If (byte3-50 > 15) then + begin + chunk.effect_def2 := ef_TPortamVolSlide; + chunk.effect2 := max(byte3-50-15,15); + end; + end; + + { VOLUME SLIDE } + $0a: If (byte3 in [1..49]) then + begin + chunk.effect_def := ef_VolSlide; + chunk.effect := max(byte3,15); + + If (byte3 > 15) then + begin + chunk.effect_def2 := ef_VolSlide; + chunk.effect2 := max(byte3-15,15); + end; + end + else If (byte3 in [51..99]) then + begin + chunk.effect_def := ef_VolSlide; + chunk.effect := max(byte3-50,15)*16; + + If (byte3-50 > 15) then + begin + chunk.effect_def2 := ef_VolSlide; + chunk.effect2 := max(byte3-50-15,15); + end; + end; + + { SET VOLUME } + $0c: begin + chunk.effect_def := ef_SetInsVolume; + If (byte3 < 64) then chunk.effect := byte3 + else chunk.effect := 63; + end; + + { JUMP TO NEXT PATTERN IN ORDER LIST } + $0d: begin + chunk.effect_def := ef_PatternBreak; + If (byte3 < 64) then chunk.effect := byte3 + else chunk.effect := 63; + end; + + { SET SPEED } + $0f: begin + chunk.effect_def := ef_SetSpeed; + chunk.effect := byte3; + end; + end; + +// specific corrections for RAd-Tracker event + If (chunk.effect_def in [ef_TonePortamento, + ef_TPortamVolSlide]) and + (chunk.note = BYTE_NULL) then chunk.note := 0; + If (chunk.effect_def in [ef_TonePortamento, + ef_TPortamVolSlide]) then chunk.instr_def := 0; + If (chunk.note = 0) then chunk.instr_def := 0; + put_chunk(pattern,line,channel+1,chunk); +end; + + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,SizeOf(buf1),temp); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + temp2 := 0; + offs0 := SizeOf(header); + + If (header.xbyte OR $80 = header.xbyte) then + begin + While (temp2 < temp) and (buf1[temp2] <> 0) do Inc(temp2); + If (temp2 >= temp) then + begin + CloseF(f); + EXIT; + end; + + Inc(offs0,temp2+1); + Dec(temp,temp2+1); + Move(buf1,dscbuf,temp2+1); + Move(buf1[temp2+1],buf1,temp); + end; + + + init_songdata; + load_flag := 0; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + If (header.xbyte OR $40 = header.xbyte) then tempo := 18 + else tempo := 50; + + If (header.xbyte AND $1f in [1..31]) then speed := header.xbyte AND $1f + else speed := 2; + + songdata.tempo := tempo; + songdata.speed := speed; + + temp2 := 0; + Repeat + temp3 := buf1[temp2]; + Inc(temp2); + If (temp3 <> 0) and (temp2+11 < temp) then + begin + import_hsc_instrument(temp3,buf1[temp2]); + songdata.instr_data[temp3].fine_tune := 0; + Inc(temp2,11); + end; + until (temp3 = 0) or (temp3 >= temp); + + Inc(offs0,temp2); + Dec(temp,temp2); + Move(buf1[temp2],buf1,temp); + + Inc(offs0,buf1[0]+1); + If (buf1[0] <> 0) then + Move(buf1[1],songdata.pattern_order,buf1[0]); + + Inc(offs0,32*SizeOf(WORD)); + Dec(temp,buf1[0]+1+32*SizeOf(WORD)); + + Move(buf1[buf1[0]+1],pattoffs,32*SizeOf(WORD)); + Move(buf1[buf1[0]+32*SizeOf(WORD)+1],buf1,temp); + + temp5 := temp; + For temp := 0 to 31 do + begin + temp2 := 0; + temp3 := 0; + If (pattoffs[temp] <> 0) and + (pattoffs[temp] <= FileSize(f)) then + Repeat + temp2 := buf1[pattoffs[temp]-offs0+temp3]; + Repeat + Inc(temp3); + temp4 := buf1[pattoffs[temp]-offs0+temp3]; + If (buf1[pattoffs[temp]-offs0+temp3+2] AND $0f <> 0) then + begin + If (temp4 AND $0f in [0..8]) then + import_rad_event(temp,temp2 AND $3f,temp4 AND $0f, + buf1[pattoffs[temp]-offs0+temp3+1], + buf1[pattoffs[temp]-offs0+temp3+2], + buf1[pattoffs[temp]-offs0+temp3+3]); + Inc(temp3,3); + end + else begin + If (temp4 AND $0f in [0..8]) then + import_rad_event(temp,temp2 AND $3f,temp4 AND $0f, + buf1[pattoffs[temp]-offs0+temp3+1], + buf1[pattoffs[temp]-offs0+temp3+2], + 0); + Inc(temp3,2); + end; + until (temp4 OR $80 = temp4) or (temp3 > temp5); + Inc(temp3); + until (temp2 OR $80 = temp2) or (temp3 > temp5); + end; + + CloseF(f); + songdata_title := NameOnly(songdata_source); + load_flag := 11; +end; + +const + temp_ef_Arpeggio = $0f0; + temp_ef_rep = $0f1; + temp_ef_XFVSlide = $0f2; + +var + ins_c4factor: array[1..99] of Shortint; + +procedure fix_s3m_commands(patterns: Byte); + +var + chunk,chunk2: tCHUNK; + temp,temp4: Byte; + patt_break: Byte; + order,patt: Byte; + patts: String; + ins_cache, + misc_cache, + arpg_cache, + volsld_cache, + slide_cache, + note_cache, + patloop_cache: array[1..20] of Byte; + prev_cache: array[1..20] of Record + effect_def, + effect, + effect_def2, + effect2: Byte; + end; + +procedure fix_single_pattern(patt: Byte); + +var + temp2,temp3: Byte; + +begin + FillChar(prev_cache,SizeOf(prev_cache),0); + FillChar(patloop_cache,SizeOf(patloop_cache),BYTE_NULL); + patt_break := BYTE_NULL; + + For temp2 := 0 to $3f do + For temp3 := 1 to 20 do + begin + get_chunk(patt,temp2,temp3,chunk); + If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) then + patt_break := temp2; + + If (chunk.instr_def <> 0) and (temp2 <= patt_break) then + ins_cache[temp3] := chunk.instr_def; + + If (chunk.note in [1..12*8+1]) and (temp2 <= patt_break) then + note_cache[temp3] := chunk.note; + + If (chunk.instr_def <> 0) or ((chunk.instr_def = 0) and + (chunk.note in [1..12*8+1]) and + (ins_cache[temp3] <> 0)) then + begin + If (chunk.instr_def <> 0) then temp4 := chunk.instr_def + else temp4 := ins_cache[temp3]; + If (ins_c4factor[temp4] <> 0) and + NOT (Pos(CHR(songdata.pattern_order[order]),patts) <> 0) then + begin + If (ins_c4factor[temp4] <> -127) then + chunk.note := min(max(chunk.note+ins_c4factor[temp4],12*8+1),1) + else chunk.note := 1; + put_chunk(patt,temp2,temp3,chunk); + end; + end; + + If (chunk.effect_def = ef_Extended) and + (chunk.effect DIV 16 = ef_ex_PatternLoop) and + (chunk.effect MOD 16 <> 0) then + If NOT (patloop_cache[temp3] in [0,BYTE_NULL]) and (temp2 <> 0) then + begin + If (prev_cache[temp3].effect_def = 0) and + (prev_cache[temp3].effect = 0) then + begin + get_chunk(patt,PRED(temp2),temp3,chunk2); + chunk2.effect_def := ef_Extended; + chunk2.effect := ef_ex_PatternLoop*16; + If NOT ((chunk2.effect_def = chunk2.effect_def2) and + (chunk2.effect = chunk2.effect2)) then + begin + put_chunk(patt,PRED(temp2),temp3,chunk2); + prev_cache[temp3].effect_def := chunk.effect_def; + prev_cache[temp3].effect := chunk.effect; + end; + end + else If (prev_cache[temp3].effect_def2 = 0) and + (prev_cache[temp3].effect2 = 0) then + begin + get_chunk(patt,PRED(temp2),temp3,chunk2); + chunk2.effect_def2 := ef_Extended; + chunk2.effect2 := ef_ex_PatternLoop*16; + If NOT ((chunk2.effect_def2 = chunk2.effect_def) and + (chunk2.effect2 = chunk2.effect)) then + begin + put_chunk(patt,PRED(temp2),temp3,chunk2); + prev_cache[temp3].effect_def2 := chunk.effect_def2; + prev_cache[temp3].effect2 := chunk.effect2; + end; + end; + end + else If (patloop_cache[temp3] <> 0) and (temp2 <> 0) then + begin + get_chunk(patt,0,temp3,chunk2); + If (chunk2.effect_def = 0) and + (chunk2.effect = 0) then + begin + chunk2.effect_def := ef_Extended; + chunk2.effect := ef_ex_PatternLoop*16; + If NOT ((chunk2.effect_def = chunk2.effect_def2) and + (chunk2.effect = chunk2.effect2)) then + put_chunk(patt,0,temp3,chunk2); + end + else If (chunk2.effect_def2 = 0) and + (chunk2.effect2 = 0) then + begin + chunk2.effect_def2 := ef_Extended; + chunk2.effect2 := ef_ex_PatternLoop*16; + If NOT ((chunk2.effect_def2 = chunk2.effect_def) and + (chunk2.effect2 = chunk2.effect)) then + put_chunk(patt,0,temp3,chunk2); + end; + end; + + If (temp2 <= patt_break) then + begin + If (chunk.effect DIV 16 <> 0) then + misc_cache[temp3] := chunk.effect AND $0f0+ + misc_cache[temp3] AND $0f + else If (chunk.effect_def in [ef_Vibrato, + ef_ExtraFineVibrato, + ef_Tremolo, + ef_Tremor, + ef_MultiRetrigNote]) then + begin + chunk.effect := misc_cache[temp3] AND $0f0+ + chunk.effect AND $0f; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect MOD 16 <> 0) then + misc_cache[temp3] := misc_cache[temp3] AND $0f0+ + chunk.effect AND $0f + else If (chunk.effect_def in [ef_Vibrato, + ef_ExtraFineVibrato, + ef_Tremolo, + ef_Tremor, + ef_MultiRetrigNote]) then + begin + chunk.effect := chunk.effect AND $0f0+ + misc_cache[temp3] AND $0f; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def = temp_ef_Arpeggio) then + If (chunk.effect <> 0) then arpg_cache[temp3] := chunk.effect + else begin + chunk.effect := arpg_cache[temp3]; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def in [ef_FSlideDown,ef_FSlideDownFine, + ef_FSlideUp,ef_FSlideUpFine, + ef_TonePortamento]) then + If (chunk.effect <> 0) then slide_cache[temp3] := chunk.effect + else begin + chunk.effect := slide_cache[temp3]; + put_chunk(patt,temp2,temp3,chunk); + end; + + // experimental method to fix up frequency slide + If (chunk.effect_def in [ef_FSlideDown,ef_FSlideDownFine, + ef_FSlideUp,ef_FSlideUpFine, + ef_Vibrato, + ef_ExtraFineVibrato, + ef_TonePortamento]) then + If (note_cache[temp3] <> 0) then + begin + If (chunk.effect_def in [ef_Vibrato,ef_ExtraFineVibrato]) then + begin + temp := chunk.effect AND $0f0; + chunk.effect := chunk.effect MOD 16; + end; + + Case SUCC(PRED(note_cache[temp3]) DIV 12) of + 1: chunk.effect := max(Round(chunk.effect*0.55),255); + 2: chunk.effect := max(Round(chunk.effect*0.75),255); + 3: chunk.effect := max(Round(chunk.effect*0.95),255); + 4: chunk.effect := max(Round(chunk.effect*1.15),255); + 5: chunk.effect := max(Round(chunk.effect*1.35),255); + 6: chunk.effect := max(Round(chunk.effect*1.55),255); + 7: chunk.effect := max(Round(chunk.effect*1.75),255); + 8: chunk.effect := max(Round(chunk.effect*1.95),255); + end; + + If (chunk.effect_def in [ef_Vibrato,ef_ExtraFineVibrato]) then + chunk.effect := max(chunk.effect,15)+temp; + + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def = ef_Extended2) and + (chunk.effect DIV 16 in [ef_ex2_FreqSlideDnXF,ef_ex2_FreqSlideUpXF]) then + If (chunk.effect MOD 16 <> 0) then slide_cache[temp3] := chunk.effect MOD 16 + else begin + chunk.effect := chunk.effect AND $0f0+slide_cache[temp3] AND $0f; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def in [ef_TPortamVolSlide,ef_VibratoVolSlide, + ef_VolSlide,ef_VolSlideFine]) and + (temp2 <= patt_break) then + begin + If (chunk.effect <> 0) then volsld_cache[temp3] := chunk.effect + else begin + chunk.effect := volsld_cache[temp3];; + put_chunk(patt,temp2,temp3,chunk); + end; + end; + + If (chunk.effect_def = ef_Extended2) and + (chunk.effect DIV 16 in [ef_ex2_VolSlideDnXF,ef_ex2_VolSlideUpXF]) then + If (chunk.effect MOD 16 <> 0) then + Case chunk.effect DIV 16 of + ef_ex2_VolSlideDnXF: + volsld_cache[temp3] := chunk.effect MOD 16; + ef_ex2_VolSlideUpXF: + volsld_cache[temp3] := chunk.effect MOD 16 SHL 4; + end + else begin + Case chunk.effect DIV 16 of + ef_ex2_VolSlideDnXF: + chunk.effect := chunk.effect AND $0f0+volsld_cache[temp3] AND $0f; + ef_ex2_VolSlideUpXF: + chunk.effect := volsld_cache[temp3] AND $0f0+chunk.effect AND $0f; + end; + put_chunk(patt,temp2,temp3,chunk); + end; + end; + + If (prev_cache[temp3].effect_def in [ef_Vibrato,ef_ExtraFineVibrato,ef_VibratoVolSlide]) and + NOT (chunk.effect_def in [ef_Vibrato,ef_ExtraFineVibrato,ef_VibratoVolSlide]) then + If (chunk.effect_def = 0) and (chunk.effect = 0) then + begin + chunk2 := chunk; + chunk2.effect_def := ef_Extended; + chunk2.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_VibrOff; + If NOT ((chunk2.effect_def = chunk2.effect_def2) and + (chunk2.effect = chunk2.effect2)) then + begin + put_chunk(patt,temp2,temp3,chunk2); + chunk := chunk2; + end; + end + else If (chunk.effect_def2 = 0) and (chunk.effect2 = 0) then + begin + chunk2 := chunk; + chunk2.effect_def2 := ef_Extended; + chunk2.effect2 := ef_ex_ExtendedCmd*16+ef_ex_cmd_VibrOff; + If NOT ((chunk2.effect_def2 = chunk2.effect_def) and + (chunk2.effect2 = chunk2.effect)) then + begin + put_chunk(patt,temp2,temp3,chunk2); + chunk := chunk2; + end; + end; + + If (chunk.effect_def = ef_Extended) and + (chunk.effect DIV 16 = ef_ex_PatternLoop) then + patloop_cache[temp3] := chunk.effect MOD 16; + + prev_cache[temp3].effect_def := chunk.effect_def; + prev_cache[temp3].effect := chunk.effect; + prev_cache[temp3].effect_def2 := chunk.effect_def2; + prev_cache[temp3].effect2 := chunk.effect2; + + If (chunk.effect_def = temp_ef_Arpeggio) then + begin + chunk2 := chunk; + chunk2.effect_def := ef_Arpeggio; + put_chunk(patt,temp2,temp3,chunk2); + end; + end; +end; + +begin { fix_s3m_commands } + FillChar(ins_cache,SizeOf(ins_cache),0); + FillChar(note_cache,SizeOf(note_cache),0); + FillChar(volsld_cache,SizeOf(volsld_cache),0); + FillChar(slide_cache,SizeOf(slide_cache),0); + FillChar(misc_cache,SizeOf(misc_cache),0); + FillChar(arpg_cache,SizeOf(arpg_cache),0); + + patts := ''; + order := 0; patt := BYTE_NULL; + + Repeat + If (songdata.pattern_order[order] >= $80) then Inc(order) + else + begin + patt := songdata.pattern_order[order]; + If NOT (Pos(CHR(patt),patts) <> 0) then + fix_single_pattern(patt); + Inc(order); + patts := patts+CHR(patt); + end; + until (patt >= patterns) or (order > $7f); + + For patt := 0 to PRED(patterns) do + If NOT (Pos(CHR(patt),patts) <> 0) then + fix_single_pattern(patt); +end; + +procedure s3m_file_loader; + +type + tS3M_HEADER = Record + songname: array[1..28] of Char; { ASCIIZ } + byte1a: Byte; { 1Ah } + ftype: Byte; { File type: 16=ST3 module } + resrvd1: array[0..1] of Byte; + ordnum: Word; { Number of orders in file (should be even!) } + insnum: Word; { Number of instruments in file } + patnum: Word; { Number of patterns in file } + flags: Word; { [ These are old flags for Ffv1. Not supported in ST3.01 } + { | +1:st2vibrato } + { | +2:st2tempo } + { | +4:amigaslides } + { | +32:enable filter/sfx with sb } + { ] } + { +8: 0vol optimizations } + { Automatically turn off looping notes whose volume } + { is zero for >2 note rows. } + { +16: amiga limits } + { Disallow any notes that go beyond the amiga hardware } + { limits (like amiga does). This means that sliding } + { up stops at B#5 etc. Also affects some minor amiga } + { compatibility issues. } + { +64: st3.00 volumeslides } + { Normally volumeslide is NOT performed on first } + { frame of each row (this is according to amiga } + { playing). If this is set, volumeslide is performed } + { ALSO on the first row. This is set by default } + { if the Cwt/v files is 0x1300 } + { +128: special custom data in file (see below) } + cwt_v: Word; { Created with tracker / version: &0xfff=version, >>12=tracker } + { ST3.00:0x1300 (NOTE: volumeslides on EVERY frame) } + { ST3.01:0x1301 } + { ST3.03:0x1303 } + { ST3.20:0x1320 } + ffi: Word; { File format information } + { 1=[VERY OLD] signed samples } + { 2=unsigned samples } + id: array[1..4] of Char; { "SCRM" } + g_v: Byte; { global volume (see next section) } + i_s: Byte; { initial speed (command A) } + + i_t: Byte; { initial tempo (command T) } + m_v: Byte; { master volume (see next section) 7 lower bits } + { bit 8: stereo(1) / mono(0) } + u_c: Byte; { ultra click removal } + d_p: Byte; { 252 when default channel pan positions are present } + { in the end of the header (xxx3). If !=252 ST3 doesn't } + { try to load channel pan settings. } + resrvd2: array[0..7] of Byte; + special: Word; + chan_set: array[1..32] of Byte; + end; +type + tS3M_ADLINS = Record + itype: Byte; { 2:amel 3:abd 4:asnare 5:atom 6:acym 7:ahihat } + dosname: array[1..12] of Char; + id0: array[0..2] of Char; + fmdata: array[0..11] of Byte; { D00..D0B contains the adlib instrument specs packed like this: } + { modulator: carrier: } + { D00=[freq.muliplier]+[?scale env.]*16+[?sustain]*32+ =D01 } + { [?pitch vib]*64+[?vol.vib]*128 } + { D02=[63-volume]+[levelscale&1]*128+[l.s.&2]*64 =D03 } + { D04=[attack]*16+[decay] =D05 } + { D06=[15-sustain]*16+[release] =D07 } + { D08=[wave select] =D09 } + { D0A=[modulation feedback]*2+[?additive synthesis] } + { D0B=unused } + vol: Byte; { Default volume 0..64 } + dsk: Byte; + resrvd1: array[0..1] of Byte; + c2spd: Word; { 'Herz' for middle C. ST3 only uses lower 16 bits. } + { Actually this is a modifier since there is no } + { clear frequency for adlib instruments. It scales } + { the note freq sent to adlib. } + hi_c2sp: Word; + resrvd2: array[0..11] of Byte; + smpname: array[1..28] of Char; { ASCIIZ } + id: array[1..4] of Char; { "SCRI" or "SCRS" } + end; +const + id_mod = 'SCRM'; + id_ins_adl = 'SCRI'; + id_ins_smp = 'SCRS'; + +var + f: File; + header: tS3M_HEADER; + order_list: array[0..254] of Byte; + paraptr_ins: array[1..99] of Word; + default_vol: array[1..99] of Byte; + paraptr_pat: array[0..99] of Word; + temp,temp2: Longint; + insdata: tS3M_ADLINS; + pat,row,chan: Byte; + note,ins,vol,cmd,info: Byte; + patlen,index: Word; + +procedure import_s3m_event(pattern,line,channel,note,ins,vol,cmd,info: Byte); + +var + chunk: tCHUNK; + +function scale_slide(slide: Byte): Byte; +begin + If (slide > 16) then scale_slide := Round(16+slide/8) + else scale_slide := Round(slide*(2-slide/16)); +end; + +begin + FillChar(chunk,SizeOf(chunk),0); + chunk.instr_def := ins; + + Case note of + 254: chunk.note := BYTE_NULL; + 255: chunk.note := 0; + else If (note AND $0f in [0..11]) then + chunk.note := 12*((note SHR 4) AND 7)+(note AND $0f)+1 + end; + + If (vol <> BYTE_NULL) then + begin + chunk.effect_def2 := ef_SetInsVolume; + chunk.effect2 := max(vol,63); + end + else + If NOT (note in [254,255]) and + (ins <> 0) and + (max(default_vol[ins],63) <> 63) then + begin + chunk.effect_def2 := ef_SetInsVolume; + chunk.effect2 := max(default_vol[ins],63); + end; + + Case CHR(cmd+ORD('A')-1) of + { NONE } + '@': chunk.effect := info; + + { SET SPEED } + 'A': If (info <> 0) then + begin + chunk.effect_def := ef_SetSpeed; + chunk.effect := info; + end; + + { JUMP TO ORDER } + 'B': If (info <= 254) then + begin + chunk.effect_def := ef_PositionJump; + chunk.effect := info; + end; + + { BREAK PATTERN } + 'C': If (info < 64) then + begin + chunk.effect_def := ef_PatternBreak; + chunk.effect := Str2num(Num2str(info,16),10); + end; + + { VOLUME SLIDE } + 'D': { VOLUME SLIDE DOWN } + Case info DIV 16 of + { NORMAL } + 0: begin + chunk.effect_def := ef_VolSlide; + chunk.effect := info MOD 16; + end; + + { FINE } + 15: begin + chunk.effect_def := ef_VolSlideFine; + chunk.effect := info MOD 16; + end; + else + { VOLUME SLIDE UP } + Case info MOD 16 of + { NORMAL } + 0: begin + chunk.effect_def := ef_VolSlide; + chunk.effect := info AND $0f0; + end; + + { FINE } + 15: begin + chunk.effect_def := ef_VolSlideFine; + chunk.effect := info AND $0f0; + end; + end; + end; + + { SLIDE DOWN } + 'E': Case info DIV 16 of + { NORMAL } + 0..13: begin + chunk.effect_def := ef_FSlideDown; + chunk.effect := scale_slide(info); + end; + + { EXTRA FINE } + 14: begin + chunk.effect_def := ef_Extended2; + If (info <> 0) then + chunk.effect := ef_ex2_FreqSlideDnXF*16+min((info AND $0f) DIV 4,1) + else chunk.effect := ef_ex2_FreqSlideDnXF*16; + end; + + { FINE } + 15: begin + chunk.effect_def := ef_FSlideDownFine; + chunk.effect := info AND $0f; + end; + end; + + { SLIDE UP } + 'F': Case info DIV 16 of + { NORMAL } + 0..13: begin + chunk.effect_def := ef_FSlideUp; + chunk.effect := scale_slide(info); + end; + + { EXTRA FINE } + 14: begin + chunk.effect_def := ef_Extended2; + If (info <> 0) then + chunk.effect := ef_ex2_FreqSlideUpXF*16+min((info AND $0f) DIV 4,1) + else chunk.effect := ef_ex2_FreqSlideUpXF*16; + end; + + { FINE } + 15: begin + chunk.effect_def := ef_FSlideUpFine; + chunk.effect := info AND $0f; + end; + end; + + { TONE PORTAMENTO } + 'G': begin + chunk.effect_def := ef_TonePortamento; + chunk.effect := scale_slide(info); + end; + + { VIBRATO } + 'H': begin + chunk.effect_def := ef_Vibrato; + chunk.effect := info; + end; + + { FINE VIBRATO } + 'U': begin + chunk.effect_def := ef_ExtraFineVibrato; + chunk.effect := info; + end; + + { TREMOR } + 'I': begin + chunk.effect_def := ef_Tremor; + chunk.effect := info; + end; + + { ARPEGGIO } + 'J': begin + chunk.effect_def := temp_ef_Arpeggio; + chunk.effect := info; + end; + + { VIBRATO + VOLUME SLIDE } + 'K': begin + chunk.effect_def := ef_VibratoVolSlide; + chunk.effect := info; + end; + + { TONE PORTAMENTO + VOLUME SLIDE } + 'L': begin + chunk.effect_def := ef_TPortamVolSlide; + chunk.effect := info; + end; + + { RETRIG NOTE + VOLUME SLIDE } + 'Q': begin + chunk.effect_def := ef_MultiRetrigNote; + chunk.effect := (info MOD 16)*16+info DIV 16; + end; + + { TREMOLO } + 'R': begin + chunk.effect_def := ef_Tremolo; + chunk.effect := info; + end; + + { SPECIAL COMMAND } + 'S': Case info DIV 16 of + { PATTERN LOOP } + $0b: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_PatternLoop*16+info MOD 16; + end; + + { NOTE CUT } + $0c: begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_NoteCut*16+info MOD 16; + end; + + { NOTE DELAY } + $0d: begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_NoteDelay*16+info MOD 16; + end; + + { PATTERN DELAY } + $0e: begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_PatDelayRow*16+info MOD 16; + end; + end; + + { TEMPO } + 'T': If (info >= 32) then + begin + chunk.effect_def := ef_SetTempo; + chunk.effect := Round(info/2.5); + end; + + { SET GLOBAL VOLUME } + 'V': begin + chunk.effect_def := ef_SetGlobalVolume; + chunk.effect := max(info,63); + end; + end; + + If (chunk.effect_def = 0) and (chunk.effect <> 0) then + chunk.effect := 0; + put_chunk(pattern,line,channel,chunk); +end; + +// experimental method to fix up note fine-tuning +function find_scale_factor(freq: Longint; var fine_tune: Shortint): Shortint; + +const + _factor: array[-3..3+1] of Real = (1/8,1/4,1/2,1,2,4,8,16); + +const + _freq: array[1..12+1] of Word = + { C-2 C#2 D-2 } + ( 33453 DIV 4,35441 DIV 4,37679 DIV 4, + { D#2 E-2 F-2 } + 39772 DIV 4,42441 DIV 4,44744 DIV 4, + { F#2 G-2 G#2 } + 47727 DIV 4,50416 DIV 4,53426 DIV 4, + { A-2 A#2 B-2 } + 56370 DIV 4,59658 DIV 4,63354 DIV 4, + { C-3 } + 33453 DIV 2); + +const + _fm_freq: array[1..12+1] of Word = + ($156, $16b, $181, $198, $1b0, $1ca, + $1e5, $202, $220, $241, $263, $287, + $2ae); + +var + factor: Real; + temp,scaler: Shortint; + +begin + scaler := -3; + fine_tune := 0; + + For scaler := -3 to 3+1 do + For temp := 1 to 12 do + begin + factor := _factor[scaler]; + If (freq >= Round(_freq[temp]*factor)) and + (freq <= Round(_freq[SUCC(temp)]*factor)) then + If (freq-Round(_freq[temp]*factor) < Round(_freq[SUCC(temp)]*factor)-freq) then + begin + fine_tune := Round((_fm_freq[SUCC(temp)]-_fm_freq[temp])/ + (_freq[SUCC(temp)]-_freq[temp])* + (freq-Round(_freq[temp]*factor))); + find_scale_factor := scaler*12+PRED(temp); + EXIT; + end + else + begin + fine_tune := Round((_fm_freq[SUCC(temp)]-_fm_freq[temp])/ + (_freq[SUCC(temp)]-_freq[temp])* + (freq-Round(_freq[SUCC(temp)]*factor))); + If (temp <> 12) then find_scale_factor := scaler*12+temp + else find_scale_factor := SUCC(scaler)*12; + EXIT; + end; + end; + + find_scale_factor := -127; + fine_tune := 0; +end; + +(* // another method -- it's hard to say whether more or less accurate :) +function find_scale_factor(freq: Longint; var fine_tune: Shortint): Shortint; + +const + _factor: array[-3..3+1] of Real = (1/8,1/4,1/2,1,2,4,8,16); + _finetune_factor: array[-3..3+1] of Real = (8,4,2,1,1/2,1/4,1/8,1/16); + +const + _freq: array[1..12+1] of Word = + { C-2 C#2 D-2 } + ( 33453 DIV 4,35441 DIV 4,37679 DIV 4, + { D#2 E-2 F-2 } + 39772 DIV 4,42441 DIV 4,44744 DIV 4, + { F#2 G-2 G#2 } + 47727 DIV 4,50416 DIV 4,53426 DIV 4, + { A-2 A#2 B-2 } + 56370 DIV 4,59658 DIV 4,63354 DIV 4, + { C-3 } + 33453 DIV 2); + +var + factor: Real; + temp,scaler: Shortint; + +begin + scaler := -3; + fine_tune := 0; + + For scaler := -3 to 3+1 do + For temp := 1 to 12 do + begin + factor := _factor[scaler]; + If (freq >= Round(_freq[temp]*factor)) and + (freq <= Round(_freq[SUCC(temp)]*factor)) then + If (freq-Round(_freq[temp]*factor) < Round(_freq[SUCC(temp)]*factor)-freq) then + begin + fine_tune := Round((freq-Round(_freq[temp]*factor))/ + Round(16/_finetune_factor[scaler])); + find_scale_factor := scaler*12+PRED(temp); + EXIT; + end + else + begin + If (temp = 12) then Inc(scaler); + fine_tune := Round((freq-Round(_freq[SUCC(temp)]*factor))/ + Round(16/_finetune_factor[scaler])); + If (temp = 12) then temp := 0; + find_scale_factor := scaler*12+temp; + EXIT; + end; + end; + + find_scale_factor := -127; + fine_tune := 0; +end; +*) + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.id = id_mod)) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + If (header.byte1a <> $1a) or (header.ftype <> $10) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,order_list,header.ordnum,temp); + If (IOresult <> 0) or (temp <> header.ordnum) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,paraptr_ins,header.insnum*2,temp); + If (IOresult <> 0) or (temp <> header.insnum*2) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,paraptr_pat,header.patnum*2,temp); + If (IOresult <> 0) or (temp <> header.patnum*2) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + If (header.i_s <> 0) then speed := header.i_s + else speed := 1; + + If (Round(header.i_t/2.5) < 255) then tempo := Round(header.i_t/2.5) + else tempo := 255; + + songdata.tempo := tempo; + songdata.speed := speed; + songdata.songname := truncate_string(asciiz_string(header.songname)); + songdata.common_flag := songdata.common_flag OR $80; + import_old_flags; + + For temp := 32 downto 1 do + If (header.chan_set[temp] <> 255) then BREAK; + + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := max(temp,18) + else If (songdata.nm_tracks < 18) then songdata.nm_tracks := 18; + + For temp := 1 to max(header.ordnum,128) do + Case order_list[temp-1] of + 254: songdata.pattern_order[temp-1] := $80+temp; + 255: songdata.pattern_order[temp-1] := $80; + else songdata.pattern_order[temp-1] := order_list[temp-1]; + end; + + FillChar(ins_c4factor,SizeOf(ins_c4factor),0); + For temp := 1 to header.insnum do + begin + SeekF(f,paraptr_ins[temp]*16); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,insdata,SizeOf(insdata),temp2); + If (IOresult <> 0) or (temp2 <> SizeOf(insdata)) then + begin + CloseF(f); + EXIT; + end; + + If (truncate_string(insdata.smpname) <> '') then + songdata.instr_names[temp] := + Copy(songdata.instr_names[temp],1,9)+ + Copy(truncate_string(asciiz_string(insdata.smpname)),1,32) + else + songdata.instr_names[temp] := + Copy(songdata.instr_names[temp],1,9)+ + truncate_string(insdata.dosname); + + If (insdata.itype in [2..7]) then + begin + If (insdata.id <> id_ins_adl) and (insdata.id <> id_ins_smp) then + begin + CloseF(f); + EXIT; + end; + + import_standard_instrument(temp,insdata.fmdata); + end; + + default_vol[temp] := insdata.vol; + If (insdata.c2spd <> 0) and + (insdata.c2spd <> 8363) then + ins_c4factor[temp] := find_scale_factor(insdata.c2spd,songdata.instr_data[temp].fine_tune); + end; + + For pat := 0 to PRED(header.patnum) do + begin + SeekF(f,paraptr_pat[pat]*16); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,patlen,SizeOf(patlen),temp2); + If (temp2 <> SizeOf(patlen)) then + begin + CloseF(f); + EXIT; + end; + + If (patlen = 0) then CONTINUE; + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,patlen-2,temp2); + + index := 0; + row := 0; + + Repeat + If (buf1[index] <> 0) then + begin + note := BYTE_NULL; + ins := 0; + vol := BYTE_NULL; + cmd := 0; + info := 0; + temp := buf1[index]; + Inc(index); + + chan := SUCC(temp AND 31); + If (temp OR $20 = temp) then + begin + note := buf1[index]; + Inc(index); + ins := buf1[index]; + Inc(index); + end; + + If (temp OR $40 = temp) then + begin + vol := buf1[index]; + Inc(index); + end; + + If (temp OR $80 = temp) then + begin + cmd := buf1[index]; + Inc(index); + info := buf1[index]; + Inc(index); + end; + + If (chan > songdata.nm_tracks) then songdata.nm_tracks := max(chan,18); + If (chan in [1..songdata.nm_tracks]) then + import_s3m_event(pat,row,chan,note,ins,vol,cmd,info); + end + else + begin + Inc(row); + Inc(index); + end; + until (row = 64); + end; + + fix_s3m_commands(header.patnum); + CloseF(f); + songdata_title := NameOnly(songdata_source); + load_flag := 12; +end; + +procedure fix_fmk_commands(patterns: Byte); + +var + chunk,chunk2, + chunk3: tCHUNK; + patt_break: Byte; + order,patt: Byte; + patts: String; + ins_cache, + misc_cache, + arpg_cache, + forcevol_cache, + volsld_cache, + xfvolsld_cache, + slide_cache: array[1..20] of Byte; + _1st_ins_load: array[1..20] of Boolean; + _speed_table_fixed: array[0..$7f] of Boolean; + prev_cache: array[1..20] of Record + effect_def, + effect, + effect_def2, + effect2: Byte; + end; + +procedure fix_single_pattern(patt: Byte); + +var + temp2,temp3: Byte; + +begin + FillChar(prev_cache,SizeOf(prev_cache),0); + patt_break := BYTE_NULL; + + If NOT _speed_table_fixed[patt] then + For temp2 := 0 to $3f do + begin + For temp3 := 1 to 20 do + begin + get_chunk(patt,temp2,temp3,chunk); + If (chunk.effect_def = 0) then + begin + chunk.effect_def := ef_SetCustomSpeedTab; + chunk.effect := $0fa; + put_chunk(patt,temp2,temp3,chunk); + _speed_table_fixed[patt] := TRUE; + end + else If (chunk.effect_def2 = 0) then + begin + chunk.effect_def2 := ef_SetCustomSpeedTab; + chunk.effect2 := $0fa; + put_chunk(patt,temp2,temp3,chunk); + _speed_table_fixed[patt] := TRUE; + end; + If _speed_table_fixed[patt] then BREAK; + end; + If _speed_table_fixed[patt] then BREAK; + end; + + For temp2 := 0 to $3f do + For temp3 := 1 to 20 do + begin + get_chunk(patt,temp2,temp3,chunk); + If (chunk.effect_def = temp_ef_rep) then + begin + chunk.effect_def := prev_cache[temp3].effect_def; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def = temp_ef_XFVSlide) then + begin + chunk.effect_def := ef_Extended2; + If (xfvolsld_cache[temp3] <> 0) then + chunk.effect := ef_ex2_VolSlideUpXF*16+volsld_cache[temp3] DIV 16 + else chunk.effect := ef_ex2_VolSlideDnXF*16+volsld_cache[temp3] MOD 16; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def in [ef_PositionJump,ef_PatternBreak]) then + patt_break := temp2; + + If (temp2 <= patt_break) and + (chunk.instr_def <> ins_cache[temp3]) and + (chunk.effect_def2 <> ef_ForceInsVolume) then + If (chunk.instr_def <> 0) then + forcevol_cache[temp3] := 0; + + If ((chunk.effect_def = ef_Extended) and + (chunk.effect = ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol)) or + ((chunk.effect_def2 = ef_Extended) and + (chunk.effect2 = ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol)) then + forcevol_cache[temp3] := 0; + + If (chunk.effect_def2 = ef_ForceInsVolume) and + (temp2 <= patt_break) then + forcevol_cache[temp3] := 1; + + If (chunk.instr_def <> 0) and (temp2 <= patt_break) then + ins_cache[temp3] := chunk.instr_def; + + If (chunk.instr_def <> 0) or ((chunk.instr_def = 0) and + (chunk.note in [1..12*8+1]) and + (ins_cache[temp3] <> 0)) then + put_chunk(patt,temp2,temp3,chunk); + + If (temp2 <= patt_break) then + begin + If (chunk.effect DIV 16 <> 0) then + misc_cache[temp3] := chunk.effect AND $0f0+ + misc_cache[temp3] AND $0f + else If (chunk.effect_def in [ef_Vibrato, + ef_Tremolo]) then + begin + chunk.effect := misc_cache[temp3] AND $0f0+ + chunk.effect AND $0f; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect MOD 16 <> 0) then + misc_cache[temp3] := misc_cache[temp3] AND $0f0+ + chunk.effect AND $0f + else If (chunk.effect_def in [ef_Vibrato, + ef_Tremolo]) then + begin + chunk.effect := chunk.effect AND $0f0+ + misc_cache[temp3] AND $0f; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def = ef_RetrigNote) then + If (chunk.effect <> 0) then misc_cache[temp3] := chunk.effect + else begin + chunk.effect := misc_cache[temp3]; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def = temp_ef_Arpeggio) then + If (chunk.effect <> 0) then arpg_cache[temp3] := chunk.effect + else begin + chunk.effect := arpg_cache[temp3]; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def in [ef_FSlideDown,ef_FSlideDownFine, + ef_FSlideUp,ef_FSlideUpFine, + ef_TonePortamento]) then + If (chunk.effect <> 0) then slide_cache[temp3] := chunk.effect + else begin + chunk.effect := slide_cache[temp3]; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def = ef_Extended2) and + (chunk.effect DIV 16 in [ef_ex2_FreqSlideDnXF,ef_ex2_FreqSlideUpXF]) then + If (chunk.effect MOD 16 <> 0) then slide_cache[temp3] := chunk.effect MOD 16 + else begin + chunk.effect := chunk.effect AND $0f0+slide_cache[temp3] AND $0f; + put_chunk(patt,temp2,temp3,chunk); + end; + + If (chunk.effect_def in [ef_TPortamVolSlide,ef_VibratoVolSlide, + ef_VolSlide,ef_VolSlideFine]) and + (temp2 <= patt_break) then + begin + If (chunk.effect <> 0) then volsld_cache[temp3] := chunk.effect + else begin + chunk.effect := volsld_cache[temp3];; + put_chunk(patt,temp2,temp3,chunk); + end; + end; + + If (chunk.effect_def = ef_Extended2) and + (chunk.effect DIV 16 in [ef_ex2_VolSlideDnXF,ef_ex2_VolSlideUpXF]) then + If (chunk.effect MOD 16 <> 0) then + Case chunk.effect DIV 16 of + ef_ex2_VolSlideDnXF: + begin + volsld_cache[temp3] := chunk.effect MOD 16; + xfvolsld_cache[temp3] := 0; + end; + + ef_ex2_VolSlideUpXF: + begin + volsld_cache[temp3] := chunk.effect MOD 16*16; + xfvolsld_cache[temp3] := 1; + end; + end; + end; + + If (prev_cache[temp3].effect_def in [ef_Vibrato,ef_VibratoVolSlide]) and + NOT (chunk.effect_def in [ef_Vibrato,ef_VibratoVolSlide]) then + If (chunk.effect_def = 0) and (chunk.effect = 0) then + begin + chunk2 := chunk; + chunk2.effect_def := ef_Extended; + chunk2.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_VibrOff; + If NOT ((chunk2.effect_def = chunk2.effect_def2) and + (chunk2.effect = chunk2.effect2)) then + begin + put_chunk(patt,temp2,temp3,chunk2); + chunk := chunk2; + end; + end + else If (chunk.effect_def2 = 0) and (chunk.effect2 = 0) then + begin + chunk2 := chunk; + chunk2.effect_def2 := ef_Extended; + chunk2.effect2 := ef_ex_ExtendedCmd*16+ef_ex_cmd_VibrOff; + If NOT ((chunk2.effect_def2 = chunk2.effect_def) and + (chunk2.effect2 = chunk2.effect)) then + begin + put_chunk(patt,temp2,temp3,chunk2); + chunk := chunk2; + end; + end; + + If (_1st_ins_load[temp3] and (chunk.instr_def <> 0)) or + (forcevol_cache[temp3] <> 0) and + (temp2 <= patt_break) and + (chunk.instr_def <> 0) then + If (chunk.effect_def2+chunk.effect2 = 0) then + If NOT (chunk.effect_def in [ef_SetModulatorVol,ef_SetCarrierVol]) then + begin + chunk.effect_def2 := ef_Extended; + chunk.effect2 := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol; + put_chunk(patt,temp2,temp3,chunk); + forcevol_cache[temp3] := 0; + _1st_ins_load[temp3] := FALSE; + end + else begin + chunk.effect_def2 := chunk.effect_def; + chunk.effect2 := chunk.effect; + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_ExtendedCmd*16+ef_ex_cmd_ResetVol; + put_chunk(patt,temp2,temp3,chunk); + forcevol_cache[temp3] := 0; + _1st_ins_load[temp3] := FALSE; + end; + + prev_cache[temp3].effect_def := chunk.effect_def; + prev_cache[temp3].effect := chunk.effect; + prev_cache[temp3].effect_def2 := chunk.effect_def2; + prev_cache[temp3].effect2 := chunk.effect2; + + If is_4op_chan(temp3) and + (temp3 in [1,3,5,10,12,14]) then + begin + get_chunk(patt,temp2,SUCC(temp3),chunk3); + If (chunk.instr_def = 0) and (chunk3.instr_def <> 0) then + begin + If (ins_cache[temp3] <> 0) then + chunk.instr_def := ins_cache[temp3] + else chunk.instr_def := chunk3.instr_def; + put_chunk(patt,temp2,temp3,chunk); + end; + end; + + If (chunk.effect_def = temp_ef_Arpeggio) then + begin + chunk2 := chunk; + chunk2.effect_def := ef_Arpeggio; + put_chunk(patt,temp2,temp3,chunk2); + end; + + If (chunk.effect_def in [ef_SetModulatorVol,ef_SetCarrierVol]) and + (chunk.effect_def2 = ef_ForceInsVolume) then + begin + chunk2 := chunk; + chunk2.effect_def := chunk.effect_def2; + chunk2.effect := chunk.effect2; + chunk2.effect_def2 := chunk.effect_def; + chunk2.effect2 := chunk.effect; + put_chunk(patt,temp2,temp3,chunk2); + end; + end; +end; + +begin { fix_fmk_commands } + FillChar(ins_cache,SizeOf(ins_cache),0); + FillChar(_1st_ins_load,SizeOf(_1st_ins_load),TRUE); + FillChar(_speed_table_fixed,SizeOf(_speed_table_fixed),FALSE); + FillChar(xfvolsld_cache,SizeOf(volsld_cache),0); + FillChar(volsld_cache,SizeOf(volsld_cache),0); + FillChar(slide_cache,SizeOf(slide_cache),0); + FillChar(misc_cache,SizeOf(misc_cache),0); + FillChar(arpg_cache,SizeOf(arpg_cache),0); + FillChar(forcevol_cache,SizeOf(forcevol_cache),0); + + patts := ''; + order := 0; patt := BYTE_NULL; + + Repeat + If (songdata.pattern_order[order] >= $80) then Inc(order) + else + begin + patt := songdata.pattern_order[order]; + fix_single_pattern(patt); + Inc(order); + patts := patts+CHR(patt); + end; + until (patt >= patterns) or (order > $7f); + + For patt := 0 to PRED(patterns) do + If NOT (Pos(CHR(patt),patts) <> 0) then + fix_single_pattern(patt); +end; + +procedure import_fin_instrument(inst: Byte; var data); +begin + With songdata.instr_data[inst] do + begin + fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[0]; + fm_data.AM_VIB_EG_carrier := tDUMMY_BUFF(data)[1]; + fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[2]; + fm_data.KSL_VOLUM_carrier := tDUMMY_BUFF(data)[3]; + fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[4]; + fm_data.ATTCK_DEC_carrier := tDUMMY_BUFF(data)[5]; + fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[6]; + fm_data.SUSTN_REL_carrier := tDUMMY_BUFF(data)[7]; + fm_data.WAVEFORM_modulator := tDUMMY_BUFF(data)[8] AND 7; + fm_data.WAVEFORM_carrier := tDUMMY_BUFF(data)[9] AND 7; + fm_data.FEEDBACK_FM := tDUMMY_BUFF(data)[10] AND $0f; + end; + + songdata.instr_data[inst].panning := 0; + songdata.instr_data[inst].fine_tune := 0; +end; + +procedure fmk_file_loader; + +type + tFMK_HEADER = Record + id: array[1..4] of Char; { FMK! } + songname: array[1..28] of Char; { Song name (28) } + composer: array[1..28] of Char; { Composer name (28) } + bytef4: Byte; { Value 244 (f4h), just for check. } + ftype: Byte; { File type {1=evolution 1, 2=evolution 2 } + glob_var: Byte; { Global variables, bits : 0 = stereo, 1 = opl3, 2 = rhythm } + { 3 = 4.8 db tremolo 4 = 14 cent vibrato. } + base_spd: Byte; { Song basespeed, ticks / second. this version : fixed 50. } + init_spd: Byte; { Song initial speed. } + reserved: array[0..8] of Byte; { Reserved } + ordnum: Byte; { Length of song (order). } + insnum: Byte; { Number of instruments. } + patnum: Byte; { Number of patterns. } + trk_pan: array[1..5] of Byte; { Track stereo pan positions, bits 0-1, 2-3, 4-5, 6-7. } + { value 0 = left 1 = both 2 = right, from track 1 to 18. } + trk_set: array[1..20] of Byte; { Track initial settings, 255=unused, bits : } + { 0-2, type value: 0 = normal 1=hihat 2=cymbal 3=tom tom 4=snare 5=bass } + { 6 = 4op 7=unused } + { 3-7, OPL-channel number (1-18), 21 = none. } +{ ### if ftype=2 --> trk_set: 1..18; type_value: 0 = normal 6 = 4op 7=unused } + end; +const + id = 'FMK!'; + +const + _conv_fmk_pan: array[0..2] of Byte = (1,0,2); + +type + tFIN_DATA = Record + dname: array[1..12] of Char; + iname: array[1..27] of Char; + idata: tFM_INST_DATA; + end; +var + f: File; + header: tFMK_HEADER; + order_list: array[0..254] of Byte; + paraptr_ins: array[1..99] of Word; + paraptr_pat: array[0..63] of Longint; + paraptr_msg: Word; + insdata: tFIN_DATA; + temp,temp2,fpos_bak: Longint; + pat,row,chan, + desc_rows: Byte; + note,ins,vol,cmd,info: Byte; + patlen,index: Word; + dscbuf: array[0..PRED(20*24)] of Char; + + +procedure import_fmk_event(pattern,line,channel,note,ins,vol,cmd,info: Byte); + +var + chunk: tCHUNK; + +begin + FillChar(chunk,SizeOf(chunk),0); + If (ins in [1..99]) then chunk.instr_def := ins; + + Case note of + 254: chunk.note := BYTE_NULL; + 255: chunk.note := 0; + else If (note AND $0f in [1..12]) then + chunk.note := 12*(note SHR 4)+(note AND $0f) + end; + + If (vol <> BYTE_NULL) then + begin + chunk.effect_def2 := ef_ForceInsVolume; + chunk.effect2 := 63-max(vol,63) + end; + + Case CHR(cmd+ORD('A')-1) of + { SET SPEED } + 'A': If (info <> 0) then + begin + chunk.effect_def := ef_SetSpeed; + chunk.effect := info; + end; + + { JUMP TO ORDER } + 'B': If (info <= 254) then + begin + chunk.effect_def := ef_PositionJump; + chunk.effect := info; + end; + + { CARRIER PARAM } + 'C': Case info DIV 16 of + 1: begin + chunk.effect_def := ef_Extended3; + chunk.effect := ef_ex3_SetMultipC*16+info MOD 16; + end; + + 2: begin + chunk.effect_def := ef_Extended3; + chunk.effect := ef_ex3_SetKslC*16+(info MOD 16) AND 3; + end; + + 3: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetAttckRateC*16+info MOD 16; + end; + + 4: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetDecayRateC*16+info MOD 16; + end; + + 5: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetSustnLevelC*16+info MOD 16; + end; + + 6: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetRelRateC*16+info MOD 16; + end; + + 7: begin + chunk.effect_def := ef_SetWaveform; + chunk.effect := info AND 7 SHL 4+$0f; + end; + + 8: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetFeedback*16+info AND 7; + end; + end; + + { VOLUME SLIDE } + 'D': { VOLUME SLIDE DOWN } + Case info DIV 16 of + { NORMAL } + 0: If (info MOD 16 = 0) then chunk.effect_def := temp_ef_XFVSlide + else begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_VolSlideDnXF*16+info MOD 16 + end; + { FINE } + 15: begin + chunk.effect_def := ef_VolSlideFine; + chunk.effect := info MOD 16; + end; + else + { VOLUME SLIDE UP } + Case info MOD 16 of + { NORMAL } + 0: If (info DIV 16 = 0) then chunk.effect_def := temp_ef_XFVSlide + else begin + chunk.effect_def := ef_Extended2; + chunk.effect := ef_ex2_VolSlideUpXF*16+info DIV 16; + end; + { FINE } + 15: begin + chunk.effect_def := ef_VolSlideFine; + chunk.effect := info AND $0f0; + end; + end; + end; + + { SLIDE DOWN } + 'E': Case info DIV 16 of + { NORMAL } + 0..14: begin + chunk.effect_def := ef_FSlideDown; + chunk.effect := info; + end; + + { FINE } + 15: begin + chunk.effect_def := ef_FSlideDownFine; + chunk.effect := info AND $0f; + end; + end; + + { SLIDE UP } + 'F': Case info DIV 16 of + { NORMAL } + 0..14: begin + chunk.effect_def := ef_FSlideUp; + chunk.effect := info; + end; + + { FINE } + 15: begin + chunk.effect_def := ef_FSlideUpFine; + chunk.effect := info AND $0f; + end; + end; + + { TONE PORTAMENTO } + 'G': begin + chunk.effect_def := ef_TonePortamento; + chunk.effect := info; + end; + + { VIBRATO } + 'H': begin + chunk.effect_def := ef_Vibrato; + If (info <> 0) and (info DIV 16 = 0) then + chunk.effect := $10+info AND $0f + else If (info <> 0) and (info MOD 16 = 0) then + chunk.effect := info AND $0f0+1 + else chunk.effect := info; + end; + + { RETRIG NOTE } + 'I': begin + chunk.effect_def := ef_RetrigNote; + If (info <> 0) then chunk.effect := max(info*2,255); + end; + + { ARPEGGIO } + 'J': begin + chunk.effect_def := temp_ef_Arpeggio; + chunk.effect := info; + end; + + { MODLATOR PARAM } + 'M': Case info DIV 16 of + 1: begin + chunk.effect_def := ef_Extended3; + chunk.effect := ef_ex3_SetMultipM*16+info MOD 16; + end; + + 2: begin + chunk.effect_def := ef_Extended3; + chunk.effect := ef_ex3_SetKslM*16+(info MOD 16) AND 3; + end; + + 3: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetAttckRateM*16+info MOD 16; + end; + + 4: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetDecayRateM*16+info MOD 16; + end; + + 5: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetSustnLevelM*16+info MOD 16; + end; + + 6: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetRelRateM*16+info MOD 16; + end; + + 7: begin + chunk.effect_def := ef_SetWaveform; + chunk.effect := $0f0+info AND 7; + end; + + 8: begin + chunk.effect_def := ef_Extended; + chunk.effect := ef_ex_SetFeedback*16+info AND 7; + end; + end; + + { SET VIBRATO/TREMOLO WAVEFORM } + 'N': ; + + { BREAK PATTERN } + 'P': If (info < 64) then + begin + chunk.effect_def := ef_PatternBreak; + chunk.effect := Str2num(Num2str(info,16),10); + end; + + { TREMOLO } + 'R': begin + chunk.effect_def := ef_Tremolo; + If (info <> 0) and (info DIV 16 = 0) then + chunk.effect := $10+info AND $0f + else If (info <> 0) and (info MOD 16 = 0) then + chunk.effect := info AND $0f0+1 + else chunk.effect := info; + end; + + { STEREO CONTROL } + 'S': If (header.glob_var AND 1 = 1) then + begin + chunk.effect_def := ef_Extended; + Case info of + 1: chunk.effect := ef_ex_SetPanningPos*16+1; + 2: chunk.effect := ef_ex_SetPanningPos*16+0; + 3: chunk.effect := ef_ex_SetPanningPos*16+2; + end; + end; + + { MODULATOR VOLUME } + 'T': begin + chunk.effect_def := ef_SetModulatorVol; + chunk.effect := info AND $3f; + end; + + { CARRIER VOLUME } + 'U': begin + chunk.effect_def := ef_SetCarrierVol; + chunk.effect := info AND $3f; + end; + end; + + If (chunk.effect_def = 0) and (chunk.effect <> 0) then + chunk.effect := 0; + put_chunk(pattern,line,channel,chunk); +end; + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.id = id)) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + If (header.bytef4 <> $f4) or NOT (header.ftype in [1,2]) then + begin + CloseF(f); + EXIT; + end; + + If (header.ftype = 2) then + begin + SeekF(f,SizeOf(header)-2); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + end; + + If (header.ordnum <> 0) then + begin + BlockReadF(f,order_list,header.ordnum,temp); + If (IOresult <> 0) or (temp <> header.ordnum) then + begin + CloseF(f); + EXIT; + end; + end; + + BlockReadF(f,paraptr_msg,SizeOf(paraptr_msg),temp); + If (IOresult <> 0) or (temp <> SizeOf(paraptr_msg)) then + begin + CloseF(f); + EXIT; + end; + + fpos_bak := FilePos(f); + If (paraptr_msg <> 0) then + begin + SeekF(f,paraptr_msg); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,desc_rows,SizeOf(desc_rows),temp); + If (IOresult <> 0) or (temp <> SizeOf(desc_rows)) then + begin + CloseF(f); + EXIT; + end; + + If (desc_rows <> 0) then + begin + BlockReadF(f,dscbuf,desc_rows*20,temp); + If (IOresult <> 0) or (temp <> desc_rows*20) then + begin + CloseF(f); + EXIT; + end; + end; + + end; + + SeekF(f,fpos_bak); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + If (header.insnum <> 0) then + begin + BlockReadF(f,paraptr_ins,header.insnum*2,temp); + If (IOresult <> 0) or (temp <> header.insnum*2) then + begin + CloseF(f); + EXIT; + end; + end; + + If (header.patnum <> 0) then + begin + BlockReadF(f,paraptr_pat,header.patnum*4,temp); + If (IOresult <> 0) or (temp <> header.patnum*4) then + begin + CloseF(f); + EXIT; + end; + end; + + init_songdata; + load_flag := 0; + + If (header.init_spd <> 0) then speed := header.init_spd + else speed := 1; + + If (header.base_spd <> 0) then tempo := header.base_spd + else tempo := 50; + + songdata.tempo := tempo; + songdata.speed := speed; + songdata.songname := truncate_string(header.songname); + songdata.composer := truncate_string(header.composer); + songdata.common_flag := songdata.common_flag OR 1; + songdata.common_flag := songdata.common_flag OR 2; + songdata.common_flag := songdata.common_flag OR $80; + + For temp := 18 downto 1 do + If NOT (header.trk_set[temp] AND 7 = 7) then BREAK; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := temp + else If (songdata.nm_tracks < 18) then songdata.nm_tracks := 18; + + For temp2 := 1 to temp do + If (header.trk_set[temp2] AND 7 = 6) then + Case temp2 of + 1,2: songdata.flag_4op := songdata.flag_4op OR 1; + 3,4: songdata.flag_4op := songdata.flag_4op OR 2; + 5,6: songdata.flag_4op := songdata.flag_4op OR 4; + 10,11: songdata.flag_4op := songdata.flag_4op OR 8; + 12,13: songdata.flag_4op := songdata.flag_4op OR $10; + 14,15: songdata.flag_4op := songdata.flag_4op OR $20; + end; + + If (header.glob_var AND 1 = 1) then + songdata.common_flag := songdata.common_flag OR $20; + + If (header.glob_var SHR 3 AND 1 = 1) then + songdata.common_flag := songdata.common_flag OR 8; + + If (header.glob_var SHR 4 AND 1 = 1) then + songdata.common_flag := songdata.common_flag OR $10; + + import_old_flags; + If (header.glob_var AND 1 = 1) then + begin + Inc(songdata.lock_flags[1], _conv_fmk_pan[header.trk_pan[1] AND 3]); + Inc(songdata.lock_flags[2], _conv_fmk_pan[header.trk_pan[1] SHR 2 AND 3]); + Inc(songdata.lock_flags[3], _conv_fmk_pan[header.trk_pan[1] SHR 4 AND 3]); + Inc(songdata.lock_flags[4], _conv_fmk_pan[header.trk_pan[1] SHR 6 AND 3]); + Inc(songdata.lock_flags[5], _conv_fmk_pan[header.trk_pan[2] AND 3]); + Inc(songdata.lock_flags[6], _conv_fmk_pan[header.trk_pan[2] SHR 2 AND 3]); + Inc(songdata.lock_flags[7], _conv_fmk_pan[header.trk_pan[2] SHR 4 AND 3]); + Inc(songdata.lock_flags[8], _conv_fmk_pan[header.trk_pan[2] SHR 6 AND 3]); + Inc(songdata.lock_flags[9], _conv_fmk_pan[header.trk_pan[3] AND 3]); + Inc(songdata.lock_flags[10],_conv_fmk_pan[header.trk_pan[3] SHR 2 AND 3]); + Inc(songdata.lock_flags[11],_conv_fmk_pan[header.trk_pan[3] SHR 4 AND 3]); + Inc(songdata.lock_flags[12],_conv_fmk_pan[header.trk_pan[3] SHR 6 AND 3]); + Inc(songdata.lock_flags[13],_conv_fmk_pan[header.trk_pan[4] AND 3]); + Inc(songdata.lock_flags[14],_conv_fmk_pan[header.trk_pan[4] SHR 2 AND 3]); + Inc(songdata.lock_flags[15],_conv_fmk_pan[header.trk_pan[4] SHR 4 AND 3]); + Inc(songdata.lock_flags[16],_conv_fmk_pan[header.trk_pan[4] SHR 6 AND 3]); + Inc(songdata.lock_flags[17],_conv_fmk_pan[header.trk_pan[5] AND 3]); + Inc(songdata.lock_flags[18],_conv_fmk_pan[header.trk_pan[5] SHR 2 AND 3]); + end; + + For temp := 1 to max(header.ordnum,128) do + Case order_list[temp-1] of + 255: songdata.pattern_order[temp-1] := $80; + else songdata.pattern_order[temp-1] := order_list[temp-1]; + end; + + For temp := 1 to header.insnum do + begin + SeekF(f,paraptr_ins[temp]); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,insdata,SizeOf(insdata),temp2); + If (IOresult <> 0) or (temp2 <> SizeOf(insdata)) then + begin + CloseF(f); + EXIT; + end; + + If (truncate_string(insdata.iname) <> '') then + songdata.instr_names[temp] := + Copy(songdata.instr_names[temp],1,9)+ + Copy(truncate_string(insdata.iname),1,32) + else + songdata.instr_names[temp] := + Copy(songdata.instr_names[temp],1,9)+ + truncate_string(insdata.dname); + + import_fin_instrument(temp,insdata.idata); + end; + + For pat := 0 to PRED(header.patnum) do + begin + SeekF(f,paraptr_pat[pat]); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + If (paraptr_pat[pat] = 0) then CONTINUE; + BlockReadF(f,patlen,SizeOf(patlen),temp2); + If (temp2 <> SizeOf(patlen)) then + begin + CloseF(f); + EXIT; + end; + + If (patlen = 0) then CONTINUE; + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,patlen,temp2); + + index := 0; + row := 0; + + Repeat + If (buf1[index] <> 0) then + begin + note := BYTE_NULL; + ins := 0; + vol := BYTE_NULL; + cmd := 0; + info := 0; + temp := buf1[index]; + Inc(index); + + chan := SUCC(temp AND 31); + If (temp OR $20 = temp) then + begin + note := buf1[index]; + Inc(index); + ins := buf1[index]; + Inc(index); + end; + + If (temp OR $40 = temp) then + begin + vol := buf1[index]; + Inc(index); + end; + + If (temp OR $80 = temp) then + begin + cmd := buf1[index]; + Inc(index); + info := buf1[index]; + Inc(index); + end; + + If (PRED(chan) in [1..18]) then + import_fmk_event(pat,row,PRED(chan),note,ins,vol,cmd,info); + end + else + begin + Inc(row); + Inc(index); + end; + until (row = 64); + end; + + fix_fmk_commands(header.patnum); + CloseF(f); + songdata_title := NameOnly(songdata_source); + load_flag := 13; +end; + +procedure import_sat_instrument(inst: Byte; var data); +begin + With songdata.instr_data[inst] do + begin + fm_data.FEEDBACK_FM := tDUMMY_BUFF(data)[0] AND $0f; + fm_data.AM_VIB_EG_modulator := tDUMMY_BUFF(data)[1]; + fm_data.AM_VIB_EG_carrier := tDUMMY_BUFF(data)[2]; + fm_data.ATTCK_DEC_modulator := tDUMMY_BUFF(data)[3]; + fm_data.ATTCK_DEC_carrier := tDUMMY_BUFF(data)[4]; + fm_data.SUSTN_REL_modulator := tDUMMY_BUFF(data)[5]; + fm_data.SUSTN_REL_carrier := tDUMMY_BUFF(data)[6]; + fm_data.WAVEFORM_modulator := tDUMMY_BUFF(data)[7] AND 3; + fm_data.WAVEFORM_carrier := tDUMMY_BUFF(data)[8] AND 3; + fm_data.KSL_VOLUM_modulator := tDUMMY_BUFF(data)[9]; + fm_data.KSL_VOLUM_carrier := tDUMMY_BUFF(data)[10]; + end; + + songdata.instr_data[inst].panning := 0; + songdata.instr_data[inst].fine_tune := 0; +end; + +function import_sat_instrument_name(var data; inst: Byte): String; + +var + temp1: Word; + temp2: Byte; + temp3: String; + +begin + temp1 := 0; + temp2 := 0; + temp3 := ''; + + While (temp1 < 496) do + begin + If (tDUMMY_BUFF(data)[temp1] = BYTE('')) then Inc(temp2); + Inc(temp1); + If (temp2 = inst+1) then + begin + While (tDUMMY_BUFF(data)[temp1] in [$20..$0ff]) and + (Length(temp3) < 22) do + begin + temp3 := temp3+CHR(tDUMMY_BUFF(data)[temp1]); + Inc(temp1); + end; + BREAK; + end; + end; + + import_sat_instrument_name := temp3; +end; + +procedure import_sa2_effect(effect,def1,def2: Byte; + var out1,out2: Byte); forward; +procedure sat_file_loader; + +type + tHEADER = Record { version 1 } + ident: array[1..4] of Char; { ident_string } + vernm: Byte; { version_number (1) } + instt: array[0..$1e] of { 31_instruments } + array[0..$0a] of Byte; + instn: array[0..495] of Byte; { 31_instrument_names } + order: array[0..254] of Byte; { pattern_order } + nopat: Word; { number of patterns } + snlen: Byte; { song_length } + rspos: Byte; { restart_position } + calls: Word; { calls_per_second } + end; +type + tHEADR2 = Record { version 6 } + ident: array[1..4] of Char; { ident_string } + vernm: Byte; { version_number (1) } + instt: array[0..$1e] of { 31_instruments } + array[0..$0e] of Byte; + instn: array[0..495] of Byte; { 31_instrument_names } + order: array[0..$7f] of Byte; { pattern_order } + nopat: Word; { number of patterns } + snlen: Byte; { song_length } + rspos: Byte; { restart_position } + calls: Word; { calls_per_second } + arpgd: array[1..512] of Byte; { arpeggio_data } + end; +const + id = 'SAdT'; + +var + f: File; + header: tHEADER; + headr2: tHEADR2; + SATver: Byte; + temp,tmp2,tmp3,temp2,temp3, + temp4,temp5: Longint; + byte1,byte2,byte3,byte4,byte5,note_inc: Byte; + +procedure import_sat_event(pattern,line,channel, + byte1,byte2,byte3,byte4,byte5: Byte); +var + chunk: tCHUNK; + +begin + FillChar(chunk,SizeOf(chunk),0); + If (byte2 in [1..31]) then chunk.instr_def := byte2; + If (byte1 in [1..12*8+1]) then chunk.note := byte1+note_inc; + + import_sa2_effect(byte3,byte4,byte5,chunk.effect_def,chunk.effect); + If (chunk.effect_def = ef_Extended) and + (chunk.effect = ef_ex_ExtendedCmd*16) and (chunk.note = 0) then + begin + chunk.note := BYTE_NULL; + chunk.effect_def := 0; + chunk.effect := 0; + end; + + put_chunk(pattern,line,channel,chunk); +end; + +var + absolute: Longint; + +function get_byte(var pos: Longint): Byte; +begin + If (pos = SizeOf(buf1)-5) then + begin + If NOT (absolute > SizeOf(buf1)-5) then Move(buf3,buf1,SizeOf(buf3)-5) + else Move(buf4,buf1,SizeOf(buf4)-5); + pos := 0; + end; + get_byte := buf1[pos]; + Inc(pos); + Inc(absolute); +end; + +begin + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + If NOT (header.vernm in [1,5,6]) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + SATver := header.vernm; + If (SATver in [5,6]) then + begin + SeekF(f,0); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,headr2,SizeOf(headr2),temp); + If (temp <> SizeOf(headr2)) then + begin + CloseF(f); + EXIT; + end; + end; + + temp5 := (FileSize(f)-temp) DIV (64*9*5); + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,SizeOf(buf1)-5,temp); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + tmp2 := WORD_NULL; + If (temp = SizeOf(buf1)-5) then + begin + FillChar(buf3,SizeOf(buf3),0); + BlockReadF(f,buf3,SizeOf(buf3)-5,tmp2); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + end; + + tmp3 := WORD_NULL; + If (tmp2 = SizeOf(buf3)-5) then + begin + FillChar(buf4,SizeOf(buf4),0); + BlockReadF(f,buf4,SizeOf(buf4)-5,tmp3); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + end; + + init_songdata; + load_flag := 0; + + songdata.common_flag := songdata.common_flag OR 8; + songdata.common_flag := songdata.common_flag OR $10; + import_old_flags; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + For temp := 1 to 20 do + songdata.lock_flags[temp] := songdata.lock_flags[temp] OR 4 OR 8; + + If (SATver = 1) then + begin + speed := 6; + If (header.calls < 255) then tempo := header.calls + else tempo := 255; + + songdata.tempo := tempo; + songdata.speed := speed; + + For temp := 0 to max(header.snlen-1,127) do + If (temp < 128) and (header.order[temp] in [0..63]) then + songdata.pattern_order[temp] := header.order[temp]; + If (header.rspos < 128) and (SUCC(temp) < 128) then + songdata.pattern_order[SUCC(temp)] := $80+header.rspos; + + temp5 := max(temp5,header.nopat); + For temp := 0 to $1e do + begin + import_sat_instrument(temp+1,header.instt[temp]); + songdata.instr_names[temp+1] := + Copy(songdata.instr_names[temp+1],1,9)+ + truncate_string(import_sat_instrument_name(header.instn,temp)); + end; + end + else + begin + speed := 6; + If (headr2.calls < 255) then tempo := headr2.calls + else tempo := 255; + + songdata.tempo := tempo; + songdata.speed := speed; + + For temp := 0 to headr2.snlen-1 do + If (temp < 128) and (headr2.order[temp] in [0..63]) then + songdata.pattern_order[temp] := headr2.order[temp]; + If (headr2.rspos < 128) and (SUCC(temp) < 128) then + songdata.pattern_order[SUCC(temp)] := $80+headr2.rspos; + + temp5 := max(temp5,headr2.nopat); + For temp := 0 to $1e do + begin + import_sat_instrument(temp+1,headr2.instt[temp]); + songdata.instr_names[temp+1] := + Copy(songdata.instr_names[temp+1],1,9)+ + truncate_string(import_sat_instrument_name(headr2.instn,temp)); + end; + end; + + temp := 0; + absolute := 0; + + Case SATver of + 1: note_inc := 24; + 5: note_inc := 12; + 6: note_inc := 0; + end; + + For temp2 := 0 to temp5-1 do + For temp3 := 0 to 63 do + For temp4 := 1 to 9 do + begin + byte1 := get_byte(temp); + byte2 := get_byte(temp); + byte3 := get_byte(temp); + byte4 := get_byte(temp); + byte5 := get_byte(temp); + import_sat_event(temp2,temp3,temp4,byte1,byte2,byte3,byte4,byte5); + end; + + CloseF(f); + songdata_title := NameOnly(songdata_source); + load_flag := 14; +end; + +function _sal(op1,op2: Word): Byte; + +var + result: Byte; + +begin + asm + mov ax,op1 + mov cx,op2 + sal ax,cl + mov result,al + end; + _sal := result; +end; + +function _sar(op1,op2: Word): Byte; + +var + result: Byte; + +begin + asm + mov ax,op1 + mov cx,op2 + sar ax,cl + mov result,al + end; + _sar := result; +end; + +procedure import_sa2_effect(effect,def1,def2: Byte; + var out1,out2: Byte); +begin + Case effect of + { NORMAL PLAY OR ARPEGGIO } + $00: begin + out1 := ef_Arpeggio; + out2 := def1*16+def2; + end; + + { SLIDE UP } + $01: begin + out1 := ef_FSlideUp; + out2 := def1*16+def2; + end; + + { SLIDE DOWN } + $02: begin + out1 := ef_FSlideDown; + out2 := def1*16+def2; + end; + + { TONE PORTAMENTO } + $03: begin + out1 := ef_TonePortamento; + out2 := def1*16+def2; + end; + + { VIBRATO } + $04: begin + out1 := ef_Vibrato; + out2 := def1*16+def2; + end; + + { TONE PORTAMENTO + VOLUME SLIDE } + $05: If (def1+def2 <> 0) then + If (def1 in [1..15]) then + begin + out1 := ef_TPortamVolSlide; + out2 := min(_sar(def1,2),1)*16; + end + else begin + out1 := ef_TPortamVolSlide; + out2 := min(_sar(def2,2),1); + end + else + begin + out1 := ef_TPortamVolSlide; + out2 := def1*16+def2; + end; + + { VIBRATO + VOLUME SLIDE } + $06: If (def1+def2 <> 0) then + If (def1 in [1..15]) then + begin + out1 := ef_VibratoVolSlide; + out2 := min(_sar(def1,2),1)*16; + end + else begin + out1 := ef_VibratoVolSlide; + out2 := min(_sar(def2,2),1); + end + else + begin + out1 := ef_VibratoVolSlide; + out2 := def1*16+def2; + end; + + { RELEASE SUSTAINING SOUND } + $08: begin + out1 := ef_Extended; + out2 := ef_ex_ExtendedCmd*16+0; + end; + + { VOLUME SLIDE } + $0a: If (def1+def2 <> 0) then + If (def1 in [1..15]) then + begin + out1 := ef_VolSlide; + out2 := min(_sar(def1,2),1)*16; + end + else begin + out1 := ef_VolSlide; + out2 := min(_sar(def2,2),1); + end + else + begin + out1 := ef_VolSlide; + out2 := def1*16+def2; + end; + + { POSITION JUMP } + $0b: If (def1*16+def2 < 128) then + begin + out1 := ef_PositionJump; + out2 := def1*16+def2; + end; + + { SET VOLUME } + $0c: begin + out1 := ef_SetInsVolume; + out2 := def1*16+def2; + If (out2 > 63) then out2 := 63; + end; + + { PATTERN BREAK } + $0d: If (def1*16+def2 < 64) then + begin + out1 := ef_PatternBreak; + out2 := def1*16+def2; + end; + + { SET SPEED } + $0f: If (def1*16+def2 < $20) then + begin + out1 := ef_SetSpeed; + out2 := def1*16+def2; + end + else If (def1 < 16) and (def2 < 16) then + begin + out1 := ef_SetTempo; + out2 := Round((def1*16+def2)/2.5); + end; + else begin + out1 := 0; + out2 := 0; + end; + end; +end; + +procedure sa2_file_loader; + +type + tHEADER = Record + ident: array[1..4] of Char; { These bytes mark a song } + vernm: Byte; { Version number (9) } + instt: array[0..$1e] of { 31 instruments } + array[0..$0e] of Byte; + instn: array[0..495] of Byte; { 31_instrument_names } + order: array[0..$7f] of Byte; { Pattern order } + nopat: Word; { Number of patterns } + snlen: Byte; { Length of song } + rspos: Byte; { Restart position } + snbpm: Word; { BPM } + arpgd: array[1..512] of Byte; { Arpeggio data (list+commands) } + ordr2: array[0..63] of { Track order } + array[1..9] of Byte; + chans: Word; { Active channels } + end; +const + id = 'SAdT'; + +var + f: File; + header: tHEADER; + temp,temp2,temp3,temp4,temp5: Longint; + +procedure import_sa2_event(pattern,line,channel, + byte1,byte2,byte3: Byte); +var + chunk: tCHUNK; + temp: Byte; + +begin + FillChar(chunk,SizeOf(chunk),0); + temp := (byte1 AND 1) SHL 4 +(byte2 SHR 4); + If (temp in [1..31]) then chunk.instr_def := temp; + If (byte1 SHR 1 in [1..12*8+1]) then chunk.note := (byte1 SHR 1); + + import_sa2_effect(byte2 AND $0f,byte3 SHR 4,byte3 AND $0f, + chunk.effect_def,chunk.effect); + If (chunk.effect_def = ef_Extended) and + (chunk.effect = ef_ex_ExtendedCmd*16) and (chunk.note = 0) then + begin + chunk.note := BYTE_NULL; + chunk.effect_def := 0; + chunk.effect := 0; + end; + + put_chunk(pattern,line,channel,chunk); +end; + +begin { sa2_file_loader } + {$i-} + Assign(f,songdata_source); + ResetF(f); + {$i+} + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + BlockReadF(f,header,SizeOf(header),temp); + If NOT ((temp = SizeOf(header)) and (header.ident = id)) then + begin + CloseF(f); + EXIT; + end; + + If NOT (header.vernm in [8,9]) then + begin + CloseF(f); + EXIT; + end; + + load_flag := $7f; + If (header.vernm = 8) then + begin + SeekF(f,FilePos(f)-2); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + end; + + FillChar(buf1,SizeOf(buf1),0); + BlockReadF(f,buf1,SizeOf(buf1)-3,temp); + If (IOresult <> 0) then + begin + CloseF(f); + EXIT; + end; + + init_songdata; + load_flag := 0; + + songdata.common_flag := songdata.common_flag OR 8; + songdata.common_flag := songdata.common_flag OR $10; + import_old_flags; + + songdata.patt_len := 64; + If adjust_tracks then songdata.nm_tracks := 9 + else If (songdata.nm_tracks < 9) then songdata.nm_tracks := 9; + + For temp := 1 to 20 do + songdata.lock_flags[temp] := songdata.lock_flags[temp] OR 4 OR 8; + + speed := 6; + If (Round(header.snbpm/2.5) < 255) then tempo := Round(header.snbpm/2.5) + else tempo := 255; + + songdata.tempo := tempo; + songdata.speed := speed; + + temp2 := 0; + temp3 := 0; + temp4 := 1; + + Repeat + While (header.ordr2[temp2][temp4] = 0) and + (temp2 <= header.nopat-1) do + begin + Inc(temp4); + If (temp4 > 9) then begin temp4 := 1; Inc(temp2); end; + end; + + If (temp2 <= header.nopat-1) then + begin + temp5 := 64*3*(header.ordr2[temp2][temp4]-1)+temp3*3; + import_sa2_event(temp2,temp3,temp4,buf1[temp5], + buf1[temp5+1], + buf1[temp5+2]); + Inc(temp3); + If (temp3 > $3f) then + begin + temp3 := 0; + If (temp4 < 9) then Inc(temp4) + else begin temp4 := 1; Inc(temp2); end; + end; + end; + until (temp2 > header.nopat-1); + + For temp := 0 to header.snlen-1 do + If (temp < 128) and (header.order[temp] in [0..63]) then + songdata.pattern_order[temp] := header.order[temp]; + If (header.rspos < 128) and (SUCC(temp) < 128) then + songdata.pattern_order[SUCC(temp)] := $80+header.rspos; + + For temp := 0 to $1e do + begin + import_sat_instrument(temp+1,header.instt[temp]); + songdata.instr_names[temp+1] := Copy(songdata.instr_names[temp+1],1,9)+ + truncate_string(import_sat_instrument_name(header.instn,temp)); + end; + + CloseF(f); + songdata_title := NameOnly(songdata_source); + load_flag := 15; +end;