3 A2player,TimerInt,ParserIO,StringIO,TxtScrIO,
11 _decay_bar_ypos = 140;
12 _decay_bar_palette_start = 250;
15 _progress_color = 251;
24 decay_bar_rise: Real = 10.0;
25 decay_bar_fall: Real = 0.50;
26 adjust_tracks: Boolean = TRUE;
27 accurate_conv: Boolean = TRUE;
28 fix_c_note_bug: Boolean = TRUE;
30 modname: array[1..15] of String[39] = ('/´DLiB TR/´CK3R ][ module',
31 '/´DLiB TR/´CK3R ][ G3 module',
32 '/´DLiB TR/´CK3R ][ tiny module',
33 '/´DLiB TR/´CK3R ][ G3 tiny module',
36 'BoomTracker 4.0 module',
38 'HSC AdLib Composer / HSC-Tracker module',
39 'MPU-401 tr
\92kkîr module',
40 'Reality ADlib Tracker module',
41 'Scream Tracker 3.x module',
42 'FM-Kingtracker module',
43 'Surprise! AdLib Tracker module',
44 'Surprise! AdLib Tracker 2.0 module');
46 songdata_source: String;
47 songdata_title: String;
50 index,last_order: Byte;
54 buf1: array[0..PRED(SizeOf(tVARIABLE_DATA))] of Byte;
55 buf2: array[0..PRED(65535)] of Byte;
56 buf3: array[0..PRED(65535)] of Byte;
57 buf4: array[0..PRED(65535)] of Byte;
58 temp_screen: array[0..PRED(8192)] of Byte;
64 _ParamStr: array[0..255] of String;
67 jukebox: Boolean = FALSE;
74 procedure ResetF(var f: File);
80 _debug_str_:= 'ADT2PLAY.PAS:ResetF_RW';
82 If (fattr AND ReadOnly = ReadOnly) then FileMode := 0;
88 procedure BlockReadF(var f: File; var data; size: Longint; var bytes_read: Longint);
90 _debug_str_:= 'ADT2PLAY.PAS:BlockReadF';
92 BlockRead(f,data,size,bytes_read);
94 If (IOresult <> 0) then bytes_read := 0;
97 procedure SeekF(var f: File; fpos: Longint);
99 _debug_str_:= 'ADT2PLAY.PAS:SeekF';
105 procedure CloseF(var f: File);
107 _debug_str_:= 'ADT2PLAY.PAS:CloseF';
111 If (IOresult <> 0) then ;
114 function min(value: Word; minimum: Word): Word; assembler;
123 function max(value: Word; maximum: Word): Word; assembler;
132 function concw(lo,hi: Byte): Word; assembler;
138 function keypressed: Boolean; assembler;
148 function is_4op_mode: Boolean; assembler;
150 mov al,byte ptr [songdata.flag_4op]
157 function is_4op_chan(chan: Byte): Boolean; assembler;
159 mov al,byte ptr [songdata.flag_4op]
217 _picture_mode: Boolean = FALSE;
220 vmem: array[0..PRED(320*200)] of Byte;
221 fade_buf,fade_buf2: tFADE_BUF;
222 vstate: tVIDEO_STATE;
224 procedure _refresh_decay_bar(xpos,ypos: Word; height,width,level: Byte); assembler;
227 lea edx,dword ptr [_picture_palette]
229 lea esi,dword ptr [_picture_bitmap]
250 @@4: movzx ebx,height
258 movzx eax,byte ptr [ebx]
260 @@5: movzx eax,height
273 movzx eax,byte ptr [ebx]
279 @@7: add eax,_decay_bar_palette_start
283 @@8: mov byte ptr [edi],al
294 _decay_bars_initialized: Boolean = FALSE;
295 _decay_bars_nm_tracks: Byte = 0;
298 _old_decay_bar_value: array[1..25] of Byte;
300 procedure decay_bars_refresh;
306 _debug_str_:= 'ADT2PLAY.PAS:decay_bars_refresh';
307 If NOT _decay_bars_initialized then
308 For temp := 1 to 25 do
309 _old_decay_bar_value[temp] := BYTE_NULL;
311 For temp := 1 to 25 do
313 If (decay_bar[temp].dir = 1) then
314 decay_bar[temp].lvl := decay_bar[temp].lvl+
315 decay_bar[temp].dir*(decay_bar_rise/IRQ_freq*100)
317 decay_bar[temp].lvl := decay_bar[temp].lvl+
318 decay_bar[temp].dir*(decay_bar_fall/IRQ_freq*100);
320 If (decay_bar[temp].lvl < 0) then decay_bar[temp].lvl := 0;
321 If (decay_bar[temp].lvl > decay_bar[temp].max_lvl) then
323 decay_bar[temp].dir := -1;
324 If (decay_bar[temp].lvl > 63) then
325 decay_bar[temp].lvl := 63;
328 If (_old_decay_bar_value[temp] <> Round(decay_bar[temp].lvl*4/3)) then
330 _refresh_decay_bar(_decay_bar_xpos+PRED(temp)*12,_decay_bar_ypos,
332 Round(decay_bar[temp].lvl*4/3));
333 _old_decay_bar_value[temp] := Round(decay_bar[temp].lvl*4/3);
338 procedure toggle_picture_mode;
344 _debug_str_:= 'ADT2PLAY.PAS:toggle_picture_mode';
345 If NOT _picture_mode then
347 _picture_mode := NOT _picture_mode;
348 GetVideoState(vstate);
350 fade_buf.action := first;
351 VgaFade(fade_buf,fadeOut,delayed);
352 For index := 1 to 20 do WaitRetrace;
353 asm mov ax,13h; int 10h end;
355 For index := 1 to 20 do WaitRetrace;
356 For index := 0 to 255 do
357 SetRGBitem(index,tRGB_PALETTE(MEM[Ofs(_picture_palette)+6])[index].r,
358 tRGB_PALETTE(MEM[Ofs(_picture_palette)+6])[index].g,
359 tRGB_PALETTE(MEM[Ofs(_picture_palette)+6])[index].b);
361 fade_buf.action := first;
362 VgaFade(fade_buf2,fadeOut,fast);
364 Move(MEM[Ofs(_picture_bitmap)+6],MEM[$0a0000],320*200);
365 VgaFade(fade_buf2,fadeIn,delayed);
366 external_irq_hook := decay_bars_refresh;
369 external_irq_hook := NIL;
370 _picture_mode := NOT _picture_mode;
371 _decay_bars_initialized := FALSE;
372 VgaFade(fade_buf2,fadeOut,delayed);
374 SetVideoState(vstate,FALSE);
375 VgaFade(fade_buf2,fadeOut,fast);
376 For index := 1 to 20 do WaitRetrace;
377 Move(vstate.screen,MEM[$0b8000],SizeOf(vstate.screen));
379 For index := 1 to 20 do WaitRetrace;
380 VgaFade(fade_buf,fadeIn,delayed);
384 procedure wtext(xstart,ystart: Word; txt: String; color: Byte);
391 _debug_str_:= 'ADT2PLAY.PAS:wtext';
392 If NOT _picture_mode then EXIT;
393 Move(MEM[Ofs(_picture_bitmap)+6+320*ystart],vmem[320*ystart],(8+1)*320);
397 For temp := 1 to Length(txt) do
401 b := tCHAR8x8(MEM[Ofs(_font8x8)+6])[txt[temp]][j];
402 For i := 7 downto 0 do
403 If (b OR (1 SHL i) = b) then
404 vmem[x+7-i+(y+j)*320] := 0
412 For temp := 1 to Length(txt) do
416 b := tCHAR8x8(MEM[Ofs(_font8x8)+6])[txt[temp]][j];
417 For i := 7 downto 0 do
418 If (b OR (1 SHL i) = b) then
419 vmem[x+7-i+(y+j)*320] := color;
424 Move(vmem[320*ystart],MEM[$0a0000+320*ystart],(8+1)*320);
427 procedure wtext2(xstart,ystart: Word; txt: String; color: Byte);
430 _double: array[0..15] of Byte = (0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7);
437 _debug_str_:= 'ADT2PLAY.PAS:wtext2';
438 If NOT _picture_mode then EXIT;
439 Move(MEM[Ofs(_picture_bitmap)+6+320*ystart],vmem[320*ystart],(16+1)*320);
443 For temp := 1 to Length(txt) do
447 b := tCHAR8x16(MEM[Ofs(_font8x16)+6])[txt[temp]][j];
448 For i := 15 downto 0 do
449 If (b OR (1 SHL _double[i]) = b) then
450 vmem[x+15-i+(y+j)*320] := 0
458 For temp := 1 to Length(txt) do
462 b := tCHAR8x16(MEM[Ofs(_font8x16)+6])[txt[temp]][j];
463 For i := 15 downto 0 do
464 If (b OR (1 SHL _double[i]) = b) then
465 vmem[x+15-i+(y+j)*320] := color;
470 Move(vmem[320*ystart],MEM[$0a0000+320*ystart],(16+1)*320);
473 procedure C3Write(str: String; atr1,atr2,atr3: Byte);
475 _debug_str_:= 'ADT2PLAY.PAS:CWrite';
476 If _picture_mode then EXIT;
477 ShowC3Str(MEM[$0b8000],WhereX,WhereY,str,atr1,atr2,atr3);
481 procedure C3WriteLn(str: String; atr1,atr2,atr3: Byte);
483 _debug_str_:= 'ADT2PLAY.PAS:C3WriteLn';
484 ShowC3Str(Ptr(v_seg,v_ofs)^,WhereX,WhereY,
490 procedure CWriteLn(str: String; atr1,atr2: Byte);
494 attr,posx,posy: Byte;
498 _debug_str_:= 'ADT2PLAY.PAS:CWriteLn';
499 If _picture_mode then EXIT;
505 For temp := 1 to Length(str) do
506 If (str[temp] <> '~') then
508 MEM[$0b8000+(posx-1+(posy-1)*MaxCol) SHL 1] := BYTE(str[temp]);
509 MEM[$0b8000+(posx-1+(posy-1)*MaxCol) SHL 1+1] := attr;
510 If (posx < MaxCol) then Inc(posx)
514 If (posy > MaxLn) then
535 color2 := NOT color2;
536 If color2 then attr := atr2 else attr := atr1;
540 If (posy > MaxLn) then
563 function __progress_str(value: Byte): String;
576 If (value <= 4) and (value <> 0) then
577 result := result+CHR(0+value)
579 __progress_str := result;
582 function _progress_str: String;
584 If (songdata.patt_len = 0) then EXIT;
585 If (entries <> 0) then
587 ExpStrR(__progress_str(
588 Round(4*38/entries*(current_order-correction+
589 1/songdata.patt_len*(current_line+1)))),38,#0)
590 else _progress_str := ExpStrR('',38,#0);
593 function _timer_str: String;
595 _timer_str := ExpStrL(Num2str(song_timer DIV 60,10),2,'0')+':'+
596 ExpStrL(Num2str(song_timer MOD 60,10),2,'0')+'.'+
597 Num2str(song_timer_tenths DIV 10,10);
600 function _position_str: String;
602 If (songdata.patt_len = 0) then EXIT;
603 If (entries <> 0) then
605 'Order '+ExpStrL(Num2str(current_order,10),3,'0')+'/'+
606 ExpStrL(Num2str(PRED(entries2),10),3,'0')+', '+
607 'pattern '+ExpStrL(Num2str(current_pattern,10),3,'0')+', '+
608 'row '+ExpStrL(Num2str(current_line,10),3,'0')+' '+
609 '['+ExpStrL(Num2str(Round(100/entries*(current_order-correction+
610 1/songdata.patt_len*(current_line+1))),10),3,'0')+'%] '+
611 '['+_timer_str+']'+' '
612 else _position_str :=
613 'Order '+ExpStrL(Num2str(current_order,10),3,'0')+'/'+
614 ExpStrL(Num2str(PRED(entries2),10),3,'0')+', '+
615 'pattern '+ExpStrL(Num2str(current_pattern,10),3,'0')+', '+
616 'row '+ExpStrL(Num2str(current_line,10),3,'0')+' '+
617 '['+ExpStrL('',3,'0')+'%] '+
618 '['+_timer_str+']'+' ';
621 function _position_str2: String;
624 'Order '+ExpStrL(Num2str(current_order,10),3,'0')+'/'+
625 ExpStrL(Num2str(PRED(entries2),10),3,'0')+', '+
626 'pattern '+ExpStrL(Num2str(current_pattern,10),3,'0')+', '+
627 'row '+ExpStrL(Num2str(current_line,10),3,'0')+' ';
636 _debug_str_:= 'ADT2PLAY.PAS:fade_out';
637 For temp := overall_volume downto 0 do
639 set_overall_volume(temp);
641 While (_delay_counter < overall_volume DIV 10) do
643 wtext2(_timer_xpos,_timer_ypos,_timer_str,_timer_color);
644 wtext(_progress_xpos,_progress_ypos,_progress_str,_progress_color);
645 wtext(_pos_str_xpos,_pos_str_ypos,_position_str2+'
\11\10',_pos_str_color);
646 C3Write(DietStr(_position_str+'
\11\10',PRED(MaxCol)),$0f,0,0);
647 MEMW[0:$041c] := MEMW[0:$041a];
652 function _gfx_mode: Boolean;
660 For temp := 1 to ParamCount do
661 If (Lower(_ParamStr[temp]) = '/gfx') then
669 procedure _list_title;
674 CWriteLn(' subz3ro''s',$09,0);
675 CWriteLn(' ÄÂÄ ÄÄ',$09,0);
676 CWriteLn(' /´DLiB³R/´CK3R ³³ G3 PLAYER',$09,0);
677 CWriteLn(' ³ ³ ÄÄ 0.43',$09,0);
682 WriteLn(' subz3ro''s');
684 WriteLn(' /´DLiB³R/´CK3R ³³ G3 PLAYER');
685 WriteLn(' ³ ³ ÄÄ 0.43');
691 old_exit_proc: procedure;
693 procedure new_exit_proc;
695 If (ErrorAddr <> NIL) then
701 FreeMem(pattdata,PATTERN_SIZE*max_patterns);
711 WriteLn('ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ');
712 WriteLn('Û ABNORMAL PROGRAM TERMiNATiON Û');
713 WriteLn('ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß');
714 WriteLn('ERROR_ID #'+Num2str(ExitCode,10)+' at '+ExpStrL(Num2str(LONGINT(ErrorAddr),16),8,'0'));
715 WriteLn(_debug_str_);
717 WriteLn('Please send this information with brief description');
718 WriteLn('what you were doing with the program when this error was encountered');
719 WriteLn('to following email address:');
721 WriteLn('subz3ro@hotmail.com');
727 ExitProc := @old_exit_proc;
731 For temp := 0 to 255 do
732 _ParamStr[temp] := ParamStr(temp);
734 If NOT _gfx_mode then
736 If iVGA then CleanScreen(MEM[$0b8000]);
748 If (dos_memavail*16 DIV 1024 < 120) then
750 If _gfx_mode then _list_title;
751 WriteLn('ERROR(1) - Insufficient DOS memory!');
757 WriteLn('ERROR(2) - Insufficient video equipment!');
761 For temp := 1 to ParamCount do
762 If (Lower(_ParamStr[temp]) = '/jukebox') then
766 If (ParamCount = 0) then
768 If _gfx_mode then _list_title;
769 CWriteLn('Syntax: '+BaseNameOnly(_ParamStr[0])+' files|wildcards [files|wildcards{...}]',$07,0);
771 CWriteLn('Command-line options:',$07,0);
772 CWriteLn(' /jukebox play modules w/ no repeat',$07,0);
773 CWriteLn(' /gfx graphical interface',$07,0);
777 @old_exit_proc := ExitProc;
778 ExitProc := @new_exit_proc;
784 If NOT (index <> 0) then
786 CWriteLn(FilterStr(DietStr('úù-Ä--ùú úù-ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ--ùú úù-ÄÄÄ--ùú úù-ÄÄ-Äùú',
789 CWriteLn( ' ~[~SPACE~]~ Fast-Forward ~[~
\11Ä~]~ Restart ~[~
\11ÄÙ~]~ Next ~[~ESC~]~ Quit',$09,$01);
790 CWriteLn(FilterStr(DietStr('úù-ÄÄÄÄÄÄÄÄÄÄ--ùú úù-ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ-Äùú',
795 window_top := WhereY;
799 If (_ParamStr[index][1] <> '/') then
801 FindFirst(_ParamStr[index],AnyFile-VolumeID-Directory,dirinfo);
802 If (DosError <> 0) then
804 CWriteLn(DietStr('ERROR(2) - No such file "'+
805 Lower(_ParamStr[index])+'"',
806 PRED(MaxCol)),$07,0);
812 While NOT (DosError <> 0) do
814 If (PathOnly(_ParamStr[index]) <> '') then
815 songdata_source := Upper(PathOnly(_ParamStr[index])+dirinfo.name)
816 else songdata_source := Upper(dirinfo.name);
818 wtext2(_timer_xpos,_timer_ypos,_timer_str,_timer_color);
819 wtext(_progress_xpos,_progress_ypos,_progress_str,_progress_color);
820 wtext(_pos_str_xpos,_pos_str_ypos,_position_str2+' ',_pos_str_color);
821 wtext2(_fname_xpos,_fname_ypos,NameOnly(songdata_source),_fname_color);
822 wtext(_pos_str_xpos,_pos_str_ypos,'Loading...',_pos_str_color);
824 C3Write(DietStr('Loading "'+songdata_source+'" (please wait)',
825 PRED(MaxCol)),$07,0,0);
826 For temp := 1 to 10 do WaitRetrace;
828 limit_exceeded := FALSE;
829 load_flag := BYTE_NULL;
831 _decay_bars_initialized := FALSE;
833 If (load_flag = BYTE_NULL) then a2t_file_loader;
834 If (load_flag = BYTE_NULL) then amd_file_loader;
835 If (load_flag = BYTE_NULL) then cff_file_loader;
836 If (load_flag = BYTE_NULL) then dfm_file_loader;
837 If (load_flag = BYTE_NULL) then mtk_file_loader;
838 If (load_flag = BYTE_NULL) then rad_file_loader;
839 If (load_flag = BYTE_NULL) then s3m_file_loader;
840 If (load_flag = BYTE_NULL) then fmk_file_loader;
841 If (load_flag = BYTE_NULL) then sat_file_loader;
842 If (load_flag = BYTE_NULL) then sa2_file_loader;
843 If (load_flag = BYTE_NULL) then hsc_file_loader;
844 If (load_flag = BYTE_NULL) or
845 (load_flag = $7f) then
847 CWriteLn(DietStr(ExpStrR('ERROR(3) - Invalid module ('+songdata_source+')',
849 PRED(MaxCol)),$07,0);
857 If limit_exceeded then
859 CWriteLn(DietStr(ExpStrR('ERROR(1) - Insufficient memory!',
861 PRED(MaxCol)),$07,0);
867 count_order(entries);
868 correction := calc_following_order(0);
870 If (correction <> -1) then Dec(entries,correction)
872 CWriteLn(DietStr(ExpStrR('Playing '+modname[load_flag]+' "'+
875 PRED(MaxCol)),$07,0);
876 temp2 := PRED(WhereY);
878 If (entries = 0) then
880 If NOT _picture_mode then GotoXY(1,temp2);
881 CWriteLn(DietStr(ExpStrR('Playing '+modname[load_flag]+' "'+
884 PRED(MaxCol)),$08,0);
885 CWriteLn(DietStr(ExpStrR(''+NameOnly(songdata_source)+' [stopped] ['+
886 ExpStrL(Num2str(TRUNC(time_playing) DIV 60,10),2,'0')+
887 ':'+ExpStrL(Num2str(TRUNC(time_playing) MOD 60,10),2,'0')+']',
889 PRED(MaxCol)),$07,0);
896 set_overall_volume(63);
897 _decay_bars_nm_tracks := songdata.nm_tracks;
898 _decay_bars_initialized := TRUE;
901 If (overall_volume = 63) then
903 wtext2(_timer_xpos,_timer_ypos,_timer_str,_timer_color);
904 wtext(_progress_xpos,_progress_ypos,_progress_str,_progress_color);
905 wtext(_pos_str_xpos,_pos_str_ypos,_position_str2+' ',_pos_str_color);
906 C3Write(DietStr(_position_str+' ',PRED(MaxCol)),$0f,0,0);
909 If (PORT[$60] = $39) { SPACE pressed } then
911 If (overall_volume > 32) then
912 For temp := 63 downto 32 do
914 set_overall_volume(temp);
916 While (_delay_counter < overall_volume DIV 20) do
918 wtext2(_timer_xpos,_timer_ypos,_timer_str,_timer_color);
919 wtext(_progress_xpos,_progress_ypos,_progress_str,_progress_color);
920 wtext(_pos_str_xpos,_pos_str_ypos,_position_str2+'
\10\10',_pos_str_color);
921 MEMW[0:$041c] := MEMW[0:$041a];
922 C3Write(DietStr(_position_str+'
\10\10',PRED(MaxCol)),$0f,0,0);
926 wtext2(_timer_xpos,_timer_ypos,_timer_str,_timer_color);
927 wtext(_progress_xpos,_progress_ypos,_progress_str,_progress_color);
928 wtext(_pos_str_xpos,_pos_str_ypos,_position_str2+'
\10\10',_pos_str_color);
929 C3Write(DietStr(_position_str+'
\10\10',PRED(MaxCol)),$0f,0,0);
930 MEMW[0:$041c] := MEMW[0:$041a];
932 fast_forward := TRUE;
934 else If (PORT[$60] = $0b9) { SPACE released } then
936 fast_forward := FALSE;
937 If (overall_volume < 63) then
938 For temp := 32 to 63 do
940 set_overall_volume(temp);
942 While (_delay_counter < overall_volume DIV 20) do
944 wtext2(_timer_xpos,_timer_ypos,_timer_str,_timer_color);
945 wtext(_progress_xpos,_progress_ypos,_progress_str,_progress_color);
946 wtext(_pos_str_xpos,_pos_str_ypos,_position_str2+' ',_pos_str_color);
947 C3Write(DietStr(_position_str+' ',PRED(MaxCol)),$0f,0,0);
948 MEMW[0:$041c] := MEMW[0:$041a];
953 If keypressed then asm xor ax,ax; int 16h; mov fkey,ax end
955 MEMW[0:$041c] := MEMW[0:$041a];
957 If jukebox and (last_order <> current_order) then
959 If (last_order > current_order) and
960 (last_order = PRED(entries2)) then BREAK
961 else last_order := current_order;
964 If (fkey = kBkSPC) then
968 set_overall_volume(63);
971 until (fkey = kENTER) or
976 If NOT _picture_mode then GotoXY(1,temp2);
977 CWriteLn(DietStr(ExpStrR('Playing '+modname[load_flag]+' "'+
980 PRED(MaxCol)),$08,0);
981 CWriteLn(DietStr(ExpStrR(''+NameOnly(songdata_source)+' [stopped] ['+
982 ExpStrL(Num2str(TRUNC(time_playing) DIV 60,10),2,'0')+
983 ':'+ExpStrL(Num2str(TRUNC(time_playing) MOD 60,10),2,'0')+']',
985 PRED(MaxCol)),$07,0);
987 If (fkey = kESC) then BREAK;
991 until (index = ParamCount);
993 If _picture_mode then toggle_picture_mode;
994 MEMW[0:$041c] := MEMW[0:$041a];
995 FreeMem(pattdata,PATTERN_SIZE*max_patterns);
996 ExitProc := @old_exit_proc;