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