{$A+,B-,D+,E+,F+,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,250000}

program gusdemo;

uses crt,dos,design,fselect, gus_mod;

type
  Pphun = ^TPhun;
  TPhun = array[0..799] of string[80];

const mod_path = '';

const Program_end : boolean = false;

var phun : Pphun;
    phuncount : integer;
    modify_voice : integer;
    i : integer;
    The_files : Pfileselect_struct;
    curr_modnr : integer;

{
  Linking of Ansi - Screen
}

{$L tcpans}
procedure tcpans; external;
{$L we_are}
procedure we_are; external;
{$L buy_it}
procedure buy_it; external;
{$L call}
procedure call; external;
{$L helptxt}
procedure helptxt; external;


function file_exists(dname : string) : boolean;
{
 Checks whether passed file exists
}
var dumf : file;
begin;
  {$I-}
  assign(dumf,dname);
  reset(dumf,1);
  {$I+}
  if IOResult <> 0 then
    file_exists := false
  else begin;
    file_exists := true;
    close(dumf);
  end;
end;

procedure color_writeln(s : string);
{
 For outputting a string in the TC color combination
}
var colpos,li : integer;
begin;
  colpos := 1;
  for li := 1 to length(s) do begin;
    if s[li] = ' ' then colpos := 0;
    inc(colpos);
    case colpos of
        1..2 : begin;
                 textcolor(8);
               end;
        3..4 : begin;
                textcolor(2);
               end;
      5..$ff : begin;
                 textcolor(10);
               end;
    end;
    write(s[li]);
  end;
end;

procedure write_filenames(s : string);
{
 Outputs filename of song in centered alignment
}
var li,slen : integer;
begin;
  gotoxy(33,13);
  while pos('\',s) <> 0 do begin;
    delete(s,1,pos('\',s));
  end;
  slen := length(s);
  slen := (15 - slen) div 2;
  for li := 1 to slen do s := ' '+s;
  write(s);
end;

procedure write_phunliners;
{
 Reads out three lines from the file "Phun.txt" and outputs them on
 the screen. "Phun.txt" is a text file that you can change just as you like. 
}
var tf : text;
begin;
  randomize;
  if not file_exists('phun.txt') then exit;
  assign(tf,'phun.txt');
  reset(tf);
  phuncount := 0;
  {$I+}
  if ioresult = 0 then begin;
    while not eof(tf) do begin;
      readln(tf,phun^[phuncount]);
      inc(phuncount);
    end;
    close(tf);
    gotoxy(3,43);
    color_writeln(phun^[random(phuncount)]);
    gotoxy(3,44);
    color_writeln(phun^[random(phuncount)]);
    gotoxy(3,45);
    color_writeln(phun^[random(phuncount)]);
  end;
  {$I-}
end;

procedure display_modinfo;
{
 Outputs the instrument names of the current module
}
var li : integer;
begin;
  textcolor(14);
  textbackground(black);
  for li := 1 to 16 do begin;
    gotoxy(6,17+li);
    color_writeln(Instruments[li]^.name);
    gotoxy(50,17+li);
    color_writeln(Instruments[li+16]^.name);
  end;
end;

procedure exit_program;
{
 Before exiting the program, display a reference to the TC WHQ,
 the Farpoint Station (04202 76145) ...
}
begin;
  display_ansi(@call,co80+font8x8);
  cursor_off;
  repeat until keypressed;
  while keypressed do readkey;
  cursor_on;
  asm mov ax,03; int 10h; end;
  halt;
end;

procedure next_mod;
{
 Begins output of the next selected MOD
}
begin;
  _gus_mod_end;
  inc(curr_modnr);
  if curr_modnr > The_Files^.nofiles then
    curr_modnr := 1;
  if not _gus_modload(The_Files^.fn[curr_modnr]) then begin;
    clrscr;
    gotoxy(10,10);
    write('Sorry dude, Can not handle this MOD file');
    delay(1200);
    exit_program;
  end;
  display_ansi(@tcpans,co80+font8x8);
  cursor_off;
  write_phunliners;
  write_filenames(The_Files^.fn[curr_modnr]);
  display_modinfo;
  fillchar(Play_Chanel,14,1);
  _gus_modstart;
end;

procedure display_we_are;
{
 Outputs an ANSI with information about a group named THE COEXISTENCE 
}
begin;
  display_ansi(@we_are,co80+font8x8);
  cursor_off;
  repeat until keypressed;
  while keypressed do readkey;
  display_ansi(@tcpans,co80+font8x8);
  cursor_off;
  write_phunliners;
  write_filenames(The_Files^.fn[curr_modnr]);
  display_modinfo;
end;

procedure display_buy_it;
{
 Outputs an advertisement for the book PC Underground
}
begin;
  display_ansi(@buy_it,co80+font8x8);
  cursor_off;
  repeat until keypressed;
  while keypressed do readkey;
  display_ansi(@tcpans,co80+font8x8);
  cursor_off;
  write_phunliners;
  write_filenames(The_Files^.fn[curr_modnr]);
  display_modinfo;
end;

procedure handle_keys(key1,key2 : char);
{
 reacts to keyboard input from the user
}
var pchan : byte;
begin;
  case key1 of
    #00 : begin;
            case key2 of
              #45 : begin;
                      Program_end := true;
                    end;
              #72 : begin;
                      if modify_voice > 1 then
                        dec(modify_voice);
                    end;
              #80 : begin;
                      if modify_voice < Modinf.voices then
                        inc(modify_voice);
                    end;
              #75 : begin; { cursor left  }
                      runinf.line := 64;
                      dec(runinf.Pattnr,2);
                      if runinf.Pattnr < -1 then runinf.Pattnr := -1;
                    end;
              #77 : begin; { cursor right  }
                      runinf.line := 64;
                      inc(runinf.Pattnr);
                    end;
            end;
          end;
    #27 : begin;
            Program_end := true;
          end;
    #32,
    'W',
    'w',
    'I',
    'i' : begin;
            display_we_are;
          end;
    'D',
    'd',
    'b',
    'B' : begin;
            display_buy_it;
          end;
    'L',
    'l' : begin;
            chpos[modify_voice] := 1;
            _gus_set_chanelpos;
          end;
    'R',
    'r' : begin;
            chpos[modify_voice] := 15;
            _gus_set_chanelpos;
          end;
    'M',
    'm' : begin;
            chpos[modify_voice] := 7;
            _gus_set_chanelpos;
          end;
    'U',
    'u' : begin;
            if Modinf.voices = 4 then
            begin
              chpos[1] := 2;
              chpos[2] := 5;
              chpos[3] := 9;
              chpos[4] := 12;
            end;
            if Modinf.voices = 8 then
            begin
              chpos[1] := 1;
              chpos[2] := 3;
              chpos[3] := 5;
              chpos[4] := 7;
              chpos[5] := 7;
              chpos[6] := 9;
              chpos[7] := 11;
              chpos[8] := 13;
            end;
            _gus_set_chanelpos;
          end;
    ',' : begin; { to the left }
            if chpos[modify_voice] > 1 then
              dec(chpos[modify_voice]);
            _gus_set_chanelpos;
          end;
    '.' : begin; { to the right }
            if chpos[modify_voice] < 15 then
              inc(chpos[modify_voice]);
            _gus_set_chanelpos;
          end;
    '1'..
    '8' : begin;
            pchan := ord(key1)-48;
            if Play_Chanel[pchan] = 1 then begin;
              Play_Chanel[pchan] := 0;
              textcolor(10);   gotoxy(77,2+pchan);
              write('M');      textcolor(2);
              write('UTE');
            end else begin;
              Play_Chanel[pchan] := 1;
              textcolor(10);   gotoxy(77,2+pchan);
              write('C');      textcolor(2);
              write('H  ');
            end;
          end;
    'n',
    'N' : begin;
            next_mod;
          end;
  end;
end;

procedure screen_update;
const colvals : array[1..35] of byte =
   (08,08,08,08,08,02,02,02,02,10,10,10,10,10,10,10,10,
    10,10,10,10,10,10,10,10,10,10,10,10,10,05,05,05,05,05);
var volstr : string[66];
    li : integer;
    auss : integer;
begin;
  { update volume bars }
  for li := 1 to Modinf.voices do begin;
    for auss := 1 to round(Runinf.Volumes[li] / 1.78) do begin;
      screen[li+2,37+auss].a := colvals[auss];
    end;
    for auss := round(Runinf.Volumes[li] / 1.78)  to 36 do begin;
      screen[li+2,38+auss].a := 7;
    end;
  end;

  { set the right color background for the arrow }
  for li := 1 to 8 do begin;
    if li = modify_voice then begin;
      screen[2+li,34].a := 05;
      screen[2+li,35].a := 05;
      screen[2+li,36].a := 05;
      screen[2+li,37].a := 05;
    end else begin;
      screen[2+li,34].a := 07;
      screen[2+li,35].a := 07;
      screen[2+li,36].a := 07;
      screen[2+li,37].a := 07;
    end;
  end;

  { runtime - output MOD information }
  gotoxy(18,14);
  color_writeln(Modinf.Title);

  textcolor(7);
  gotoxy(18,16);
  write(runinf.pattnr:3);

  gotoxy(64,16);
  write(runinf.line:3);

  gotoxy(64,15);
  write(64:3);

  gotoxy(18,15);
  write(modinf.Patt_num:3);

  gotoxy(60,14);
  write(runinf.speed,' / ',runinf.bpm);
end;

procedure user;
{
 Checks for keyboard input and updates the screen 
}
var ch1,ch2 : char;
begin;
  repeat
    ch1 := #255;
    ch2 := #255;
    if keypressed then begin;
      ch1 := readkey;
      if keypressed then ch2 := readkey;
      handle_keys(ch1,ch2);
    end;
   screen_update;
  until Program_end;
end;


procedure display_help;
{
 Outputs the Help Ansi. Also displayed when no GUS was found
}
begin;
  display_ansi(@helptxt,co80+font8x8);
  cursor_off;
  repeat until keypressed;
  while keypressed do readkey;
  exit_program;
end;


function check_commandline : boolean;
{
 returns true, if a module-name was given
}
var pst : string;
    is_mod : boolean;
    li : integer;
    retval : boolean;
begin;
  retval := false;
  for li := 1 to 9 do begin;
    pst := paramstr(li);
    is_mod := true;

    if (pos('-h',pst) <> 0) or (pos('-H',pst) <> 0) or
       (pos('-?',pst) <> 0) then
    begin;
      is_mod := false;
      display_help;
    end;

    if (pst <> '') and is_mod then begin;
      if pos('.',pst) = 0 then pst := pst + '.mod';
      if file_exists(pst) then  { glt. mod }
      begin
        inc(The_Files^.nofiles);
        The_Files^.fn[The_Files^.nofiles] := pst;
        retval := true;
      end;
    end;
  end;
  check_commandline := retval;
end;

begin;
  cursor_off;
  clrscr;
  if not _gus_init_env then display_help;

  new(The_Files);
  new(phun);
  The_Files^.path := mod_path;
  The_Files^.Mask := '*.mod';
  The_Files^.sx   := 24;
  The_Files^.sy   := 10;
  The_Files^.nofiles := 0;

  The_Files^.Title := 'select MOD file!!';
  modify_voice := 1;

  for i := 1 to 30 do
    The_Files^.fn[i] := '---';
  save_screen;
  if not check_commandline then begin;
    select_packfiles(The_Files);
    repeat
      restore_screen;

      if The_Files^.fn[1] = '---' then exit_program;

        _gus_initialize;

      display_ansi(@tcpans,co80+font8x8);
      cursor_off;
      write_phunliners;

      curr_modnr := 1;
      if not _gus_modload(The_Files^.fn[1]) then begin;
        clrscr;
        gotoxy(10,10);
        write('Sorry dude, Can not handle this MOD file');
        delay(1200);
        exit_program;
      end;
      write_filenames(The_Files^.fn[1]);
      display_modinfo;
      fillchar(Play_Chanel,14,1);
      _gus_modstart;

      user;
      _gus_mod_end;
      dispose(The_Files);
      new(The_Files);
      The_Files^.path := Mod_path;
      The_Files^.Mask := '*.mod';
      The_Files^.sx   := 24;
      The_Files^.sy   := 10;
      The_Files^.nofiles := 0;
      for i := 1 to 30 do
        The_Files^.fn[i] := '---';
      Program_end := false;
      select_packfiles(The_Files);
    until The_Files^.fn[1] = '---';

      dispose(The_Files);
    dispose(phun);
    exit_program;
  end else begin;
  restore_screen;

  if The_Files^.fn[1] = '---' then exit_program;

  _gus_initialize;

  display_ansi(@tcpans,co80+font8x8);
  cursor_off;
  write_phunliners;

  curr_modnr := 1;
  _gus_modload(The_Files^.fn[1]);
  write_filenames(The_Files^.fn[1]);
  display_modinfo;
  fillchar(Play_Chanel,14,1);
  _gus_modstart;

  user;

  _gus_mod_end;
  dispose(The_Files);
  dispose(phun);
  exit_program;

  end;
end.
