16/ADT2PLAY/adt2play.pas

   1 uses
   2   DOS,DPMI,
   3   A2player,TimerInt,ParserIO,StringIO,TxtScrIO,
   4   UNPK_LIB;
   5
   6 const
   7   _timer_xpos = 198;
   8   _timer_ypos = 5;
   9   _timer_color = 1;
  10   _decay_bar_xpos = 10;
  11   _decay_bar_ypos = 140;
  12   _decay_bar_palette_start = 250;
  13   _progress_xpos = 8;
  14   _progress_ypos = 155;
  15   _progress_color = 251;
  16   _fname_xpos = 8;
  17   _fname_ypos = 170;
  18   _fname_color = 255;
  19   _pos_str_xpos = 8;
  20   _pos_str_ypos = 186;
  21   _pos_str_color = 252;
  22
  23 const
  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;
  29   window_top: Byte = 8;
  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',
  34                                          'Amusic module',
  35                                          'XMS-Tracker module',
  36                                          'BoomTracker 4.0 module',
  37                                          'Digital-FM 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');
  45 var
  46   songdata_source: String;
  47   songdata_title: String;
  48   load_flag: Byte;
  49   fkey: Word;
  50   index,last_order: Byte;
  51   dirinfo: SearchRec;
  52
  53 var
  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;
  59   correction: Integer;
  60   entries,
  61   entries2: Byte;
  62   temp,temp2: Byte;
  63   dos_memavail: Word;
  64   _ParamStr: array[0..255] of String;
  65
  66 const
  67   jukebox: Boolean = FALSE;
  68
  69 const
  70   kBkSPC  = $0e08;
  71   kESC    = $011b;
  72   kENTER  = $1c0d;
  73
  74 procedure ResetF(var f: File);
  75
  76 var
  77   fattr: Word;
  78
  79 begin
  80   _debug_str_:= 'ADT2PLAY.PAS:ResetF_RW';
  81   GetFAttr(f,fattr);
  82   If (fattr AND ReadOnly = ReadOnly) then FileMode := 0;
  83   {$i-}
  84   Reset(f,1);
  85   {$i+}
  86 end;
  87
  88 procedure BlockReadF(var f: File; var data; size: Longint; var bytes_read: Longint);
  89 begin
  90   _debug_str_:= 'ADT2PLAY.PAS:BlockReadF';
  91   {$i-}
  92   BlockRead(f,data,size,bytes_read);
  93   {$i+}
  94   If (IOresult <> 0) then bytes_read := 0;
  95 end;
  96
  97 procedure SeekF(var f: File; fpos: Longint);
  98 begin
  99   _debug_str_:= 'ADT2PLAY.PAS:SeekF';
 100   {$i-}
 101   Seek(f,fpos);
 102   {$i+}
 103 end;
 104
 105 procedure CloseF(var f: File);
 106 begin
 107   _debug_str_:= 'ADT2PLAY.PAS:CloseF';
 108   {$i-}
 109   Close(f);
 110   {$i+}
 111   If (IOresult <> 0) then ;
 112 end;
 113
 114 function min(value: Word; minimum: Word): Word; assembler;
 115 asm
 116         mov     ax,value
 117         cmp     ax,minimum
 118         jae     @@1
 119         mov     ax,minimum
 120 @@1:
 121 end;
 122
 123 function max(value: Word; maximum: Word): Word; assembler;
 124 asm
 125         mov     ax,value
 126         cmp     ax,maximum
 127         jbe     @@1
 128         mov     ax,maximum
 129 @@1:
 130 end;
 131
 132 function concw(lo,hi: Byte): Word; assembler;
 133 asm
 134         mov     al,lo
 135         mov     ah,hi
 136 end;
 137
 138 function keypressed: Boolean; assembler;
 139 asm
 140         mov     ah,01h
 141         int     16h
 142         mov     al,TRUE
 143         jnz     @@1
 144         mov     al,FALSE
 145 @@1:
 146 end;
 147
 148 function is_4op_mode: Boolean; assembler;
 149 asm
 150         mov     al,byte ptr [songdata.flag_4op]
 151         or      al,al
 152         jz      @@1
 153         mov     al,TRUE
 154 @@1:
 155 end;
 156
 157 function is_4op_chan(chan: Byte): Boolean; assembler;
 158 asm
 159         mov     al,byte ptr [songdata.flag_4op]
 160         mov     ah,chan
 161         test    al,1
 162         jz      @@1
 163         cmp     ah,1
 164         jb      @@1
 165         cmp     ah,2
 166         ja      @@1
 167         mov     al,TRUE
 168         jmp     @@7
 169 @@1:    test    al,2
 170         jz      @@2
 171         cmp     ah,3
 172         jb      @@2
 173         cmp     ah,4
 174         ja      @@2
 175         mov     al,TRUE
 176         jmp     @@7
 177 @@2:    test    al,4
 178         jz      @@3
 179         cmp     ah,5
 180         jb      @@3
 181         cmp     ah,6
 182         ja      @@3
 183         mov     al,TRUE
 184         jmp     @@7
 185 @@3:    test    al,8
 186         jz      @@4
 187         cmp     ah,10
 188         jb      @@4
 189         cmp     ah,11
 190         ja      @@4
 191         mov     al,TRUE
 192         jmp     @@7
 193 @@4:    test    al,10h
 194         jz      @@5
 195         cmp     ah,12
 196         jb      @@5
 197         cmp     ah,13
 198         ja      @@5
 199         mov     al,TRUE
 200         jmp     @@7
 201 @@5:    test    al,20h
 202         jz      @@6
 203         cmp     ah,14
 204         jb      @@6
 205         cmp     ah,15
 206         ja      @@6
 207         mov     al,TRUE
 208         jmp     @@7
 209 @@6:    mov     al,FALSE
 210 @@7:
 211 end;
 212
 213 {$i structrs.inc}
 214 {$i iloaders.inc}
 215
 216 const
 217   _picture_mode: Boolean = FALSE;
 218
 219 var
 220   vmem: array[0..PRED(320*200)] of Byte;
 221   fade_buf,fade_buf2: tFADE_BUF;
 222   vstate: tVIDEO_STATE;
 223
 224 procedure _refresh_decay_bar(xpos,ypos: Word; height,width,level: Byte); assembler;
 225 asm
 226         mov     edi,0a0000h
 227         lea     edx,dword ptr [_picture_palette]
 228         add     edx,6
 229         lea     esi,dword ptr [_picture_bitmap]
 230         add     esi,6
 231         movzx   eax,ypos
 232         mov     ebx,320
 233         mul     ebx
 234         movzx   ebx,xpos
 235         add     eax,ebx
 236         add     edi,eax
 237         cmp     level,BYTE_NULL
 238         jnz     @@1
 239         mov     level,0
 240         jmp     @@2
 241 @@1:    cmp     level,2
 242         jae     @@2
 243         mov     level,2
 244 @@2:    movzx   ecx,width
 245         jecxz   @@10
 246 @@3:    push    ecx
 247         push    edi
 248         movzx   ecx,height
 249         jecxz   @@9
 250 @@4:    movzx   ebx,height
 251         sub     ebx,ecx
 252         movzx   eax,level
 253         cmp     ebx,eax
 254         jnae    @@5
 255         mov     ebx,edi
 256         sub     ebx,0a0000h
 257         add     ebx,esi
 258         movzx   eax,byte ptr [ebx]
 259         jmp     @@8
 260 @@5:    movzx   eax,height
 261         push    edx
 262         xor     edx,edx
 263         sub     eax,ecx
 264         mov     ebx,5
 265         div     ebx
 266         mov     eax,edx
 267         pop     edx
 268         cmp     eax,3
 269         jbe     @@6
 270         mov     ebx,edi
 271         sub     ebx,0a0000h
 272         add     ebx,esi
 273         movzx   eax,byte ptr [ebx]
 274         jmp     @@8
 275 @@6:    or      eax,eax
 276         jnz     @@7
 277         xor     eax,eax
 278         jmp     @@8
 279 @@7:    add     eax,_decay_bar_palette_start
 280         cmp     level,2
 281         jnbe    @@8
 282         mov     eax,250
 283 @@8:    mov     byte ptr [edi],al
 284         sub     edi,320
 285         loop    @@4
 286 @@9:    pop     edi
 287         pop     ecx
 288         inc     edi
 289         loop    @@3
 290 @@10:
 291 end;
 292
 293 const
 294   _decay_bars_initialized: Boolean = FALSE;
 295   _decay_bars_nm_tracks: Byte = 0;
 296
 297 var
 298   _old_decay_bar_value: array[1..25] of Byte;
 299
 300 procedure decay_bars_refresh;
 301
 302 var
 303   temp: Byte;
 304
 305 begin
 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;
 310
 311   For temp := 1 to 25 do
 312     begin
 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)
 316       else
 317         decay_bar[temp].lvl := decay_bar[temp].lvl+
 318                  decay_bar[temp].dir*(decay_bar_fall/IRQ_freq*100);
 319
 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
 322         begin
 323           decay_bar[temp].dir := -1;
 324           If (decay_bar[temp].lvl > 63) then
 325             decay_bar[temp].lvl := 63;
 326         end;
 327
 328       If (_old_decay_bar_value[temp] <> Round(decay_bar[temp].lvl*4/3)) then
 329         begin
 330           _refresh_decay_bar(_decay_bar_xpos+PRED(temp)*12,_decay_bar_ypos,
 331                              Round(63*4/3),10,
 332                              Round(decay_bar[temp].lvl*4/3));
 333           _old_decay_bar_value[temp] := Round(decay_bar[temp].lvl*4/3);
 334         end;
 335     end;
 336 end;
 337
 338 procedure toggle_picture_mode;
 339
 340 var
 341   index: Byte;
 342
 343 begin
 344   _debug_str_:= 'ADT2PLAY.PAS:toggle_picture_mode';
 345   If NOT _picture_mode then
 346     begin
 347       _picture_mode := NOT _picture_mode;
 348       GetVideoState(vstate);
 349       fade_speed := 16;
 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;
 354
 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);
 360       fade_speed := 16;
 361       fade_buf.action := first;
 362       VgaFade(fade_buf2,fadeOut,fast);
 363
 364       Move(MEM[Ofs(_picture_bitmap)+6],MEM[$0a0000],320*200);
 365       VgaFade(fade_buf2,fadeIn,delayed);
 366       external_irq_hook := decay_bars_refresh;
 367     end
 368   else begin
 369          external_irq_hook := NIL;
 370          _picture_mode := NOT _picture_mode;
 371          _decay_bars_initialized := FALSE;
 372          VgaFade(fade_buf2,fadeOut,delayed);
 373
 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));
 378
 379          For index := 1 to 20 do WaitRetrace;
 380          VgaFade(fade_buf,fadeIn,delayed);
 381        end;
 382 end;
 383
 384 procedure wtext(xstart,ystart: Word; txt: String; color: Byte);
 385
 386 var
 387   x,y: Word;
 388   temp,i,j,b: Word;
 389
 390 begin
 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);
 394   x := xstart+1;
 395   y := ystart+1;
 396
 397   For temp := 1 to Length(txt) do
 398     begin
 399       For j := 0 to 7 do
 400         begin
 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
 405         end;
 406       Inc(x,8);
 407     end;
 408
 409   x := xstart;
 410   y := ystart;
 411
 412   For temp := 1 to Length(txt) do
 413     begin
 414       For j := 0 to 7 do
 415         begin
 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;
 420         end;
 421       Inc(x,8);
 422     end;
 423
 424   Move(vmem[320*ystart],MEM[$0a0000+320*ystart],(8+1)*320);
 425 end;
 426
 427 procedure wtext2(xstart,ystart: Word; txt: String; color: Byte);
 428
 429 const
 430   _double: array[0..15] of Byte = (0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7);
 431
 432 var
 433   x,y: Word;
 434   temp,i,j,b: Word;
 435
 436 begin
 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);
 440   x := xstart+1;
 441   y := ystart+1;
 442
 443   For temp := 1 to Length(txt) do
 444     begin
 445       For j := 0 to 15 do
 446         begin
 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
 451         end;
 452       Inc(x,16);
 453     end;
 454
 455   x := xstart;
 456   y := ystart;
 457
 458   For temp := 1 to Length(txt) do
 459     begin
 460       For j := 0 to 15 do
 461         begin
 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;
 466         end;
 467       Inc(x,16);
 468     end;
 469
 470   Move(vmem[320*ystart],MEM[$0a0000+320*ystart],(16+1)*320);
 471 end;
 472
 473 procedure C3Write(str: String; atr1,atr2,atr3: Byte);
 474 begin
 475   _debug_str_:= 'ADT2PLAY.PAS:CWrite';
 476   If _picture_mode then EXIT;
 477   ShowC3Str(MEM[$0b8000],WhereX,WhereY,str,atr1,atr2,atr3);
 478   GotoXY(1,WhereY);
 479 end;
 480
 481 procedure C3WriteLn(str: String; atr1,atr2,atr3: Byte);
 482 begin
 483   _debug_str_:= 'ADT2PLAY.PAS:C3WriteLn';
 484   ShowC3Str(Ptr(v_seg,v_ofs)^,WhereX,WhereY,
 485             str,
 486             atr1,atr2,atr3);
 487   WriteLn;
 488 end;
 489
 490 procedure CWriteLn(str: String; atr1,atr2: Byte);
 491
 492 var
 493   temp: Word;
 494   attr,posx,posy: Byte;
 495   color2: Boolean;
 496
 497 begin
 498   _debug_str_:= 'ADT2PLAY.PAS:CWriteLn';
 499   If _picture_mode then EXIT;
 500   color2 := FALSE;
 501   attr := atr1;
 502   posx := WhereX;
 503   posy := WhereY;
 504
 505   For temp := 1 to Length(str) do
 506     If (str[temp] <> '~') then
 507       begin
 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)
 511         else begin
 512                posx := 1;
 513                Inc(posy);
 514                If (posy > MaxLn) then
 515                  begin
 516                    asm
 517                         mov     ah,06h
 518                         mov     al,1
 519                         mov     bh,07h
 520                         mov     ch,window_top
 521                         mov     cl,1
 522                         mov     dh,MaxLn
 523                         mov     dl,MaxCol
 524                         dec     ch
 525                         dec     cl
 526                         dec     dh
 527                         dec     dl
 528                         int     10h
 529                    end;
 530                    Dec(posy);
 531                  end;
 532              end;
 533       end
 534     else begin
 535            color2 := NOT color2;
 536            If color2 then attr := atr2 else attr := atr1;
 537          end;
 538
 539   Inc(posy);
 540   If (posy > MaxLn) then
 541     begin
 542       asm
 543            mov     ah,06h
 544            mov     al,1
 545            mov     bh,07h
 546            mov     ch,window_top
 547            mov     cl,1
 548            mov     dh,MaxLn
 549            mov     dl,MaxCol
 550            dec     ch
 551            dec     cl
 552            dec     dh
 553            dec     dl
 554            int     10h
 555       end;
 556       Dec(posy);
 557     end;
 558
 559   posx := 1;
 560   GotoXY(posx,posy);
 561 end;
 562
 563 function __progress_str(value: Byte): String;
 564
 565 var
 566   result: String;
 567
 568 begin
 569   result := '';
 570   Repeat
 571     If (value > 4) then
 572       begin
 573         result := result+#4;
 574         Dec(value,4);
 575       end;
 576     If (value <= 4) and (value <> 0) then
 577       result := result+CHR(0+value)
 578   until (value <= 4);
 579   __progress_str := result;
 580 end;
 581
 582 function _progress_str: String;
 583 begin
 584   If (songdata.patt_len = 0) then EXIT;
 585   If (entries <> 0) then
 586      _progress_str :=
 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);
 591 end;
 592
 593 function _timer_str: String;
 594 begin
 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);
 598 end;
 599
 600 function _position_str: String;
 601 begin
 602   If (songdata.patt_len = 0) then EXIT;
 603   If (entries <> 0) then
 604     _position_str :=
 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+']'+' ';
 619 end;
 620
 621 function _position_str2: String;
 622 begin
 623   _position_str2 :=
 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')+' ';
 628 end;
 629
 630 procedure fade_out;
 631
 632 var
 633   temp: Byte;
 634
 635 begin
 636   _debug_str_:= 'ADT2PLAY.PAS:fade_out';
 637   For temp := overall_volume downto 0 do
 638     begin
 639       set_overall_volume(temp);
 640       _delay_counter := 0;
 641       While (_delay_counter < overall_volume DIV 10) do
 642         begin
 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];
 648         end;
 649     end;
 650 end;
 651
 652 function _gfx_mode: Boolean;
 653
 654 var
 655   result: Boolean;
 656   temp: Byte;
 657
 658 begin
 659   result := FALSE;
 660   For temp := 1 to ParamCount do
 661     If (Lower(_ParamStr[temp]) = '/gfx') then
 662       begin
 663         result := TRUE;
 664         BREAK;
 665       end;
 666   _gfx_mode := result;
 667 end;
 668
 669 procedure _list_title;
 670 begin
 671   If iVGA then
 672     begin
 673       CWriteLn('',$07,0);
 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);
 678       CWriteLn('',$07,0);
 679     end
 680   else begin
 681          WriteLn;
 682          WriteLn('   subz3ro''s');
 683          WriteLn('       ÄÂÄ       ÄÄ');
 684          WriteLn('  /´DLiB³R/´CK3R ³³ G3 PLAYER');
 685          WriteLn('   ³       ³     ÄÄ      0.43');
 686          WriteLn;
 687        end;
 688 end;
 689
 690 var
 691   old_exit_proc: procedure;
 692
 693 procedure new_exit_proc;
 694 begin
 695   If (ErrorAddr <> NIL) then
 696     begin
 697       stop_playing;
 698       TimerDone;
 699       opl3exp($0004);
 700       opl3exp($0005);
 701       FreeMem(pattdata,PATTERN_SIZE*max_patterns);
 702
 703       asm
 704           mov   ax,03h
 705           xor   bh,bh
 706           int   10h
 707           mov   MaxCol,80
 708           mov   MaxLn,25
 709       end;
 710
 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_);
 716       WriteLn;
 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:');
 720       WriteLn;
 721       WriteLn('subz3ro@hotmail.com');
 722
 723       ErrorAddr := NIL;
 724       HALT(ExitCode);
 725     end
 726   else
 727     ExitProc := @old_exit_proc;
 728 end;
 729
 730 begin
 731   For temp := 0 to 255 do
 732     _ParamStr[temp] := ParamStr(temp);
 733
 734   If NOT _gfx_mode then
 735     begin
 736       If iVGA then CleanScreen(MEM[$0b8000]);
 737       GotoXY(1,1);
 738       _list_title;
 739     end;
 740
 741   asm
 742         mov     bx,0ffffh
 743         mov     ah,48h
 744         int     21h
 745         mov     dos_memavail,bx
 746   end;
 747
 748   If (dos_memavail*16 DIV 1024 < 120) then
 749     begin
 750       If _gfx_mode then _list_title;
 751       WriteLn('ERROR(1) - Insufficient DOS memory!');
 752       HALT(1);
 753     end;
 754
 755   If NOT iVGA then
 756     begin
 757       WriteLn('ERROR(2) - Insufficient video equipment!');
 758       HALT(2);
 759     end;
 760
 761   For temp := 1 to ParamCount do
 762     If (Lower(_ParamStr[temp]) = '/jukebox') then
 763       jukebox := TRUE;
 764
 765   index := 0;
 766   If (ParamCount = 0) then
 767     begin
 768       If _gfx_mode then _list_title;
 769       CWriteLn('Syntax: '+BaseNameOnly(_ParamStr[0])+' files|wildcards [files|wildcards{...}]',$07,0);
 770       CWriteLn('',$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);
 774       HALT;
 775     end;
 776
 777   @old_exit_proc := ExitProc;
 778   ExitProc := @new_exit_proc;
 779
 780   If _gfx_mode then
 781     toggle_picture_mode;
 782
 783   Repeat
 784     If NOT (index <> 0) then
 785       begin
 786         CWriteLn(FilterStr(DietStr('úù-Ä--ùú   úù-ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ--ùú       úù-ÄÄÄ--ùú úù-ÄÄ-Äùú',
 787                                    PRED(MaxCol)),
 788                            '.',' '),$01,0);
 789         CWriteLn(                  '  ~[~SPACE~]~ Fast-Forward ~[~\11Ä~]~ Restart ~[~\11ÄÙ~]~ Next ~[~ESC~]~ Quit',$09,$01);
 790         CWriteLn(FilterStr(DietStr('úù-ÄÄÄÄÄÄÄÄÄÄ--ùú      úù-ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ-Äùú',
 791                                   PRED(MaxCol)),
 792                           '.',' '),$01,0);
 793
 794         CWriteLn('',$07,0);
 795         window_top := WhereY;
 796       end;
 797
 798     Inc(index);
 799     If (_ParamStr[index][1] <> '/') then
 800       begin
 801         FindFirst(_ParamStr[index],AnyFile-VolumeID-Directory,dirinfo);
 802         If (DosError <> 0) then
 803           begin
 804             CWriteLn(DietStr('ERROR(2) - No such file "'+
 805                              Lower(_ParamStr[index])+'"',
 806                      PRED(MaxCol)),$07,0);
 807             CWriteLn('',$07,0);
 808             FindNext(dirinfo);
 809             CONTINUE;
 810           end;
 811
 812         While NOT (DosError <> 0) do
 813           begin
 814             If (PathOnly(_ParamStr[index]) <> '') then
 815               songdata_source := Upper(PathOnly(_ParamStr[index])+dirinfo.name)
 816             else songdata_source := Upper(dirinfo.name);
 817
 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);
 823
 824             C3Write(DietStr('Loading "'+songdata_source+'" (please wait)',
 825                            PRED(MaxCol)),$07,0,0);
 826             For temp := 1 to 10 do WaitRetrace;
 827
 828             limit_exceeded := FALSE;
 829             load_flag := BYTE_NULL;
 830
 831             _decay_bars_initialized := FALSE;
 832             a2m_file_loader;
 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
 846               begin
 847                 CWriteLn(DietStr(ExpStrR('ERROR(3) - Invalid module ('+songdata_source+')',
 848                                          PRED(MaxCol),' '),
 849                                  PRED(MaxCol)),$07,0);
 850                 CWriteLn('',$07,0);
 851                 FindNext(dirinfo);
 852                 CONTINUE;
 853               end;
 854
 855             last_order := 0;
 856             entries := 0;
 857             If limit_exceeded then
 858               begin
 859                 CWriteLn(DietStr(ExpStrR('ERROR(1) - Insufficient memory!',
 860                                          PRED(MaxCol),' '),
 861                          PRED(MaxCol)),$07,0);
 862                 CWriteLn('',$07,0);
 863                 FindNext(dirinfo);
 864                 CONTINUE;
 865               end;
 866
 867             count_order(entries);
 868             correction := calc_following_order(0);
 869             entries2 := entries;
 870             If (correction <> -1) then Dec(entries,correction)
 871             else entries := 0;
 872             CWriteLn(DietStr(ExpStrR('Playing '+modname[load_flag]+' "'+
 873                                      songdata_source+'"',
 874                                      PRED(MaxCol),' '),
 875                              PRED(MaxCol)),$07,0);
 876             temp2 := PRED(WhereY);
 877
 878             If (entries = 0) then
 879               begin
 880                 If NOT _picture_mode then GotoXY(1,temp2);
 881                 CWriteLn(DietStr(ExpStrR('Playing '+modname[load_flag]+' "'+
 882                                          songdata_source+'"',
 883                                          PRED(MaxCol),' '),
 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')+']',
 888                                          PRED(MaxCol),' '),
 889                                  PRED(MaxCol)),$07,0);
 890                 CWriteLn('',$07,0);
 891                 FindNext(dirinfo);
 892                 CONTINUE;
 893               end;
 894
 895             start_playing;
 896             set_overall_volume(63);
 897             _decay_bars_nm_tracks := songdata.nm_tracks;
 898             _decay_bars_initialized := TRUE;
 899
 900             Repeat
 901               If (overall_volume = 63) then
 902                 begin
 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);
 907                 end;
 908
 909               If (PORT[$60] = $39) { SPACE pressed } then
 910                 begin
 911                   If (overall_volume > 32) then
 912                     For temp := 63 downto 32 do
 913                       begin
 914                         set_overall_volume(temp);
 915                         _delay_counter := 0;
 916                         While (_delay_counter < overall_volume DIV 20) do
 917                           begin
 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);
 923                           end;
 924                       end
 925                   else begin
 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];
 931                        end;
 932                   fast_forward := TRUE;
 933                 end
 934               else If (PORT[$60] = $0b9) { SPACE released } then
 935                      begin
 936                        fast_forward := FALSE;
 937                        If (overall_volume < 63) then
 938                          For temp := 32 to 63 do
 939                            begin
 940                              set_overall_volume(temp);
 941                              _delay_counter := 0;
 942                              While (_delay_counter < overall_volume DIV 20) do
 943                                begin
 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];
 949                                end;
 950                            end;
 951                      end;
 952
 953               If keypressed then asm xor ax,ax; int 16h; mov fkey,ax end
 954               else fkey := $0ffff;
 955               MEMW[0:$041c] := MEMW[0:$041a];
 956
 957               If jukebox and (last_order <> current_order) then
 958                 begin
 959                   If (last_order > current_order) and
 960                      (last_order = PRED(entries2)) then BREAK
 961                   else last_order := current_order;
 962                 end;
 963
 964               If (fkey = kBkSPC) then
 965                 begin
 966                   fade_out;
 967                   stop_playing;
 968                   set_overall_volume(63);
 969                   start_playing;
 970                 end;
 971             until (fkey = kENTER) or
 972                   (fkey = kESC);
 973
 974             fade_out;
 975             stop_playing;
 976             If NOT _picture_mode then GotoXY(1,temp2);
 977             CWriteLn(DietStr(ExpStrR('Playing '+modname[load_flag]+' "'+
 978                                      songdata_source+'"',
 979                                      PRED(MaxCol),' '),
 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')+']',
 984                                      PRED(MaxCol),' '),
 985                              PRED(MaxCol)),$07,0);
 986             CWriteLn('',$07,0);
 987             If (fkey = kESC) then BREAK;
 988             FindNext(dirinfo);
 989           end;
 990       end;
 991   until (index = ParamCount);
 992
 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;
 997   HALT(0);
 998 end.