{
 TW200 VIDEO, WINDOW AND MENU PROCEDURES AND FUNCTIONS
 TURBO PASCAL VERSION 5.X DEMONSTRATION PROGRAM
 COPYRIGHT (C) 1990, RICHARD D. FOTHERGILL  ALL RIGHTS RESERVED
}

USES
  Dos,
  Crt,
  TW200;

VAR
  mmenu       : hmenurec;
  smenu       : vmenurec;
  emenu       : vmenurec;
  done        : BOOLEAN;
  menunoattr  : INTEGER;
  curattr     : INTEGER;
  x           : INTEGER;
  msg,msg1    : STRING[80];
  ch          : CHAR;

PROCEDURE Initmenus;
BEGIN
  menunoattr := Attr(8,7);
  winspeed := 3500;
  WITH mmenu DO
  BEGIN
    curntpos   := 0;
    item[1]    := 'Frames';
    item[2]    := 'Titles';
    item[3]    := 'Shadows';
    item[4]    := 'Demos';
    item[5]    := 'Quit';
    itemcount  := 5;
    startpos   := 1;
    hlattr     := Attr(7,0);
    flattr     := Attr(15,7);
    flon       := TRUE;
    menuspaces := 8;
    barloc     := 0;
    subitem    :='00110';
  END;
  WITH smenu DO
  BEGIN
    startpos   := 0;
    liveitem   := '11011011';
    curntpos   := 0;
    item[1]    := 'Flat         (   0)';
    item[2]    := 'Reattribute  (1, 2)';
    item[3]    := 'Solid        (3, 4)';
    item[4]    := 'Light Hatch  (5, 6)';
    item[5]    := 'Medium Hatch (7, 8)';
    item[6]    := 'Heavy Hatch  (9,10)';
    item[7]    := 'Activate Items 3,6 ';
    item[8]    := 'Deact. Items   3,6 ';
    itemcount  := 8;
    hlattr     := Attr(7,0);
    flattr     := Attr(15,7);
    noattr     := menunoattr;
    bartype    := 1;
    flon       := TRUE;
  END;
  WITH emenu DO
  BEGIN
    startpos   := 0;
    liveitem   := '11111';
    curntpos   := 0;
    item[1]    := 'Pop Windows       ';
    item[2]    := 'Zoom Windows      ';
    item[3]    := 'List / File Window';
    item[4]    := 'DOS Utilities     ';
    item[5]    := 'Field Input       ';
    itemcount  := 5;
    hlattr     := Attr(7,0);
    flattr     := Attr(15,7);
    noattr     := menunoattr;
    bartype    := 1;
    flon       := TRUE;
  END;
END;

PROCEDURE Continue;
VAR
  ch1,ch2 : CHAR;
BEGIN
  Sprintc(25,1,80,'             Press any key to continue...            ',Attr(15,3));
  REPEAT
    Getkey(ch1,ch2);
  UNTIL ch1 <> #0;
  Sprintc(25,1,80,'Use arrow keys to change selection - Return to select',Attr(0,3));
END;

PROCEDURE Fdemo;
BEGIN
  Openwin(5,15,6,15,Attr(15,2),Attr(15,2),0,0,1,0);
  Titlewin(2,Attr(14,2),'[ Style 0 ]');
  Openwin(5,34,6,15,Attr(15,5),Attr(15,5),1,7,1,0);
  Titlewin(2,Attr(14,5),'[ Style 1 ]');
  Openwin(5,53,6,15,Attr(15,3),Attr(15,3),2,7,1,0);
  Titlewin(2,Attr(14,3),'[ Style 2 ]');
  Openwin(8,5,6,15,Attr(15,4),Attr(15,4),3,7,1,0);
  Titlewin(2,Attr(14,4),'[ Style 3 ]');
  Openwin(8,24,6,15,Attr(15,3),Attr(15,3),4,7,1,0);
  Titlewin(2,Attr(14,3),'[ Style 4 ]');
  Openwin(8,43,6,15,Attr(15,6),Attr(15,6),5,7,1,0);
  Titlewin(2,Attr(14,6),'[ Style 5 ]');
  Openwin(8,62,6,15,Attr(15,5),Attr(15,5),6,7,1,0);
  Titlewin(2,Attr(14,5),'[ Style 6 ]');
  Openwin(11,15,6,15,Attr(15,2),Attr(15,2),7,7,1,0);
  Titlewin(2,Attr(14,2),'[ Style 7 ]');
  Openwin(11,34,6,15,Attr(15,7),Attr(15,7),8,7,1,0);
  Titlewin(2,Attr(14,7),'[ Style 8 ]');
  Openwin(11,53,6,15,Attr(15,4),Attr(15,4),9,7,1,0);
  Titlewin(2,Attr(14,4),'[ Style 9 ]');
  Openwin(14,5,6,15,Attr(15,7),Attr(15,7),10,7,1,0);
  Titlewin(2,Attr(14,7),'[ Style 10]');
  Openwin(14,24,6,15,Attr(15,6),Attr(15,6),11,7,1,0);
  Titlewin(2,Attr(14,6),'[ Style 11]');
  Openwin(14,43,6,15,Attr(15,5),Attr(15,5),12,7,1,0);
  Titlewin(2,Attr(14,5),'[ Style 12]');
  Openwin(14,62,6,15,Attr(15,2),Attr(15,2),13,7,1,0);
  Titlewin(2,Attr(14,2),'[ Style 13]');
  Openwin(17,15,6,15,Attr(15,3),Attr(15,3),14,7,1,0);
  Titlewin(2,Attr(14,3),'[ Style 14]');
  Openwin(17,34,6,15,Attr(15,2),Attr(15,2),15,7,1,0);
  Titlewin(2,Attr(14,2),'[ Style 15]');
  Openwin(17,53,6,15,Attr(15,7),Attr(15,7),16,7,1,0);
  Titlewin(2,Attr(14,7),'[ Style 16]');
  Continue;
  FOR x := 1 TO 17 DO Closewin;
END;

PROCEDURE Tdemo;
BEGIN
  Openwin(8,8,10,68,Attr(15,5),Attr(15,5),2,0,1,0);
  Printcwin(3,'Titles may be placed in any of six different locations');
  Printcwin(4,'and in any color attribute!');
  FOR x:=1 TO 6 DO
  BEGIN
    STR(x,msg);
    msg := '[ LOCATION '+msg+' ]';
    Titlewin(x,Attr(9+x,5),msg);
    DELAY(1000);
  END;
  Continue;
  Closewin;
END;

PROCEDURE Sdemo;
BEGIN
  Openwin(2,32,10,23,Attr(0,7),Attr(0,7),1,8,1,0);
  done := FALSE;
  WITH smenu DO
  BEGIN
    WHILE NOT done DO
    BEGIN
      Makevmenu(smenu);
      CASE curntpos OF
        1 : BEGIN
              Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
              Titlewin(2,Attr(15,5),' FLAT ');
              Openwin(11,8,10,30,Attr(15,3),Attr(0,3),1,0,0,0);
              Openwin(11,43,10,30,Attr(15,7),Attr(1,7),1,0,0,0);
              Continue;
              Closewin;
              Closewin;
              Closewin;
            END;
        2 : BEGIN
              Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
              Titlewin(2,Attr(15,5),' REATTRIBUTE ');
              Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,7,1,0);
              Printcwin(7,'Left Shadow');
              Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,7,2,0);
              Printcwin(7,'Right Shadow');
              Continue;
              Closewin;
              Closewin;
              Closewin;
            END;
        3 : BEGIN
              Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
              Titlewin(2,Attr(15,5),' SOLID ');
              Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,0,3,0);
              Printcwin(7,'Left Shadow');
              Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,0,4,0);
              Printcwin(7,'Right Shadow');
              Continue;
              Closewin;
              Closewin;
              Closewin;
            END;
        4 : BEGIN
              Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
              Titlewin(2,Attr(15,5),' LT. HATCH ');
              Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,Attr(0,7),5,0);
              Printcwin(7,'Left Shadow');
              Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,Attr(0,7),6,0);
              Printcwin(7,'Right Shadow');
              Continue;
              Closewin;
              Closewin;
              Closewin;
            END;
        5 : BEGIN
              Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
              Titlewin(2,Attr(15,5),' MED. HATCH ');
              Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,Attr(0,7),7,0);
              Printcwin(7,'Left Shadow');
              Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,Attr(0,7),8,0);
              Printcwin(7,'Right Shadow');
              Continue;
              Closewin;
              Closewin;
              Closewin;
            END;
        6 : BEGIN
              Openwin(10,4,7,74,Attr(15,5),Attr(15,5),2,0,0,0);
              Titlewin(2,Attr(15,5),' HEAVY HATCH ');
              Openwin(11,8,10,30,Attr(15,3),Attr(0,3),2,Attr(0,7),9,0);
              Printcwin(7,'Left Shadow');
              Openwin(11,43,10,30,Attr(15,7),Attr(1,7),2,Attr(0,7),10,0);
              Printcwin(7,'Right Shadow');
              Continue;
              Closewin;
              Closewin;
              Closewin;
            END;
        7 : BEGIN
              liveitem[3] := '1';
              liveitem[6] := '1';
            END;
        8 : BEGIN
              liveitem[3] := '0';
              liveitem[6] := '0';
            END;
      ELSE
        Closewin;
        done := TRUE;
      END;
    END;
    done := FALSE;
  END;
END;

PROCEDURE Showfile;
VAR
  sourcename  : PATHSTR;
  source      : TEXT;
  txtstr      : STRING;
  txtarray    : Lstarray;
  numoflns    : INTEGER;
  retcode     : INTEGER;

PROCEDURE Addarec(s:STRING);
BEGIN
  Inc(numoflns);
  NEW(txtarray[numoflns]);
  txtarray[numoflns]^ := s;
END;

BEGIN
  numoflns := 0;
  sourcename := '';
  Openwin(10,20,7,41,Attr(0,7),Attr(1,7),2,Attr(7,0),1,0);
  Titlewin(5,Attr(1,7),' Press Enter for Directory ');
  Printcwin(2,'Enter a Text File Name to Display');
  capson := TRUE;
  Cursoron;
  Getfield(4,10,sourcename,'S',20,0,retcode,Attr(15,1),Attr(0,7));
  Cursoroff;
  capson := FALSE;
  Closewin;
  IF retcode <> 0 THEN
  BEGIN
    IF sourcename[1] = #32 THEN
      sourcename := Makefmenu('*.*',5,10,17,Attr(1,7),Attr(1,7),2,Attr(7,0),1,0,Attr(7,1));
    IF sourcename <> '' THEN
    BEGIN
      IF Fexists(sourcename) THEN
      BEGIN
        ASSIGN(source,sourcename);
        RESET(source);
        MARK(heaptop);
        REPEAT
          {$I-} READLN(source,txtstr); {$I+}
          IF IORESULT = 0 THEN
          BEGIN
            IF LENGTH(txtstr) > 76 THEN
            BEGIN
              msg := COPY(txtstr,1,76);
              Addarec(msg);
              msg := COPY(txtstr,77,LENGTH(txtstr)-76);
              Addarec(msg);
            END
            ELSE Addarec(txtstr);
          END;
        UNTIL EOF(source);
        CLOSE(source);
        sourcename := Fexpand(sourcename);
        Openwin(1,1,25,80,Attr(7,0),Attr(15,1),0,0,0,0);
        Titlewin(1,Attr(15,1),'LIST DEMO');
        Titlewin(3,Attr(15,1),sourcename);
        Titlewin(5,Attr(15,1),'Direction Keys to Change Location - Esc or Return to End');
        x := Makelmenu(txtarray,numoflns,1,Attr(0,7));
        Closewin;
        RELEASE(heaptop);
      END
      ELSE
      BEGIN
        Openwin(10,20,5,40,Attr(15,4),Attr(15,4),2,Attr(7,0),1,0);
        Printcwin(2,'FILE NOT FOUND - PROCEDURE ABORTED!');
        Continue;
        Closewin;
      END;
    END;
  END;
END;

PROCEDURE Ddemo;
  VAR
    dirinfo : SEARCHREC;
BEGIN
 Openwin(1,1,24,80,Attr(7,1),Attr(7,1),0,0,0,0);
 WRITELN;
 WRITELN;
 WRITELN;
 WRITELN('      The following is a sampling of the DOS functions available');
 WRITELN('      in TW200.  For a better understanding of how to use the');
 WRITELN('      information returned by these functions consult any of the');
 WRITELN('      reference books on DOS interrupts.  You must have a good');
 WRITELN('      understanding of DOS interrupts to take full advantage of');
 WRITELN('      these utilities.');
 Continue;
 CLRSCR;
 GOTOXY(1,1);
 WRITELN(' THE DEFAULT DRIVE IS ',Curdrive);
 WRITELN;
 WRITELN(' THE CURRENT DIRECTORY PATH IS ',Curdir);
 WRITELN;
 WRITELN(' FILES in THIS DIRECTORY ARE:');
 WRITELN;
 Findfirst('*.*'+#0,$20,dirinfo);
 WRITE(Falign(dirinfo.name),' ');
 WHILE doserror = 0 DO
 BEGIN
   Findnext(dirinfo);
   WRITE(Falign(dirinfo.name),' ');
 END;
 WRITELN;
 WRITELN;
 WRITELN(' THE CURRENT DOS VERSION IS ',LO(Dosversion),'.',HI(Dosversion));
 WRITELN(' CURRENT DISK SIZE    ',Disksize(0):20);
 WRITELN(' DISK SPACE AVAILABLE ',Diskfree(0):20);
 WRITELN(' CONV MEMORY SIZE     ',Maxmem:20);
 WRITELN(' AVAILABLE MEMORY     ',MEMAVAIL:20);
 Continue;
 Closewin;
END;

PROCEDURE Idemo;

CONST
  info : ARRAY[1..3] OF fldtype
         = ('N0221092',
            'N0324062',
            'N0426040');
VAR
  done       : BOOLEAN;
  loandata   : ARRAY[1..3] OF fldstr;
  amount,
  rate,
  payment    : REAL;
  wfield,
  month,
  returncode,
  errcode    : INTEGER;

PROCEDURE Helpmessage(what:INTEGER);
VAR
  ch1,ch2 : CHAR;
BEGIN
  Openwin(6+what,38,8,36,Attr(0,2),Attr(0,2),2,8,1,0);
  Sprint(6+what,38,#17,Attr(0,2));
  CASE what OF
    1 : BEGIN
          Titlewin(2,Attr(15,2),'[ Principal Amount ]');
          Printwin(1,2,'Enter the amount of the loan you');
          Printwin(2,2,'wish to calulate.  The format is');
          Printwin(3,2,'######.##.  do not enter a');
          Printwin(4,2,'negative number.');
        END;
    2 : BEGIN
          Titlewin(2,Attr(15,2),'[ Interest Rate ]');
          Printwin(1,2,'Enter the interest rate for the');
          Printwin(2,2,'the loan you wish to calculate.');
          Printwin(3,2,'The format is ##.##.  Where 11%');
          Printwin(4,2,'would be entered as 11.00.  do');
          Printwin(5,2,'not enter a negative number.');
        END;
    3 : BEGIN
          Titlewin(2,Attr(15,2),'[ No. of Payments ]');
          Printwin(1,2,'Enter the number of payments for');
          Printwin(2,2,'the loan you wish to calulate.');
          Printwin(3,2,'The format is ####.  Enter the');
          Printwin(4,2,'actual number of payments not the');
          Printwin(5,2,'number of years.  do not enter a');
          Printwin(6,2,'negative number.');
        END;
  END;
  Titlewin(5,Attr(15,2),' Press any key to continue ');
  Getkey(ch1,ch2);
  Closewin;
END;

PROCEDURE Errmsg(what:INTEGER);
VAR
  ch1,ch2 : CHAR;
BEGIN
  Openwin(13,44,5,32,Attr(15,4),Attr(15,4),1,8,1,0);
  CASE what OF
    3 : BEGIN
          Printcwin(1,'YOU MUST PROVIDE INPUT');
          Printcwin(2,'FOR ALL THREE FIELDS');
          Printcwin(3,'Press any key to continue ');
        END;
  END;
  Getkey(ch1,ch2);
  Closewin;
END;

PROCEDURE Computepayment(amt,rt:REAL;mo:INTEGER);
 VAR
   hold : REAL;
BEGIN
 IF (amt > 0.0) AND (mo > 0) AND (rt > 0.0) THEN
 BEGIN
   hold := Powerof(1.0 + rt / 1200.0, mo);
   payment := ((rt / 1200.0) * hold * amt) / (hold - 1.0);
   payment := payment + 0.005;
   hold := FRAC(payment * 100.0);
   payment := ((payment * 100.0)-hold)/100.0;
   GOTOXY(21,5);
   WRITE(payment:9:2);
 END
 ELSE Errmsg(3);
END;

BEGIN
  FILLCHAR(loandata,SIZEOF(loandata),#0);
  month  := 0;
  rate   := 0;
  amount := 0;
  Openwin(5,7,14,32,Attr(0,3),Attr(0,3),2,8,1,0);
  Titlewin(2,Attr(15,3),'[ Payment Calculator ]');
  Titlewin(5,Attr(15,3),'[ Esc - Exit ]');
  Printwin(2,2,'Principal Amount:');
  Printwin(3,2,'   Interest Rate:');
  Printwin(4,2,' No. of Payments:');
  Printwin(5,2,'         Payment:');
  Printcwin(7, 'F1 - Help             ');
  Printcwin(8, 'F2 - Calculate Payment');
  Printcwin(9, 'F5 - Pop-up Calculator');
  done := FALSE;
  wfield := 1;
  WHILE NOT done DO
  BEGIN
    IF amount = 0 THEN loandata[1] := '' ELSE STR(amount:9:2,loandata[1]);
    IF rate   = 0 THEN loandata[2] := '' ELSE STR(rate:9:2,loandata[2]);
    IF month  = 0 THEN loandata[3] := '' ELSE STR(month:4,loandata[3]);
    Cursoron;
    REPEAT
      Getrec(info,loandata,3,returncode,wfield,TRUE,Attr(3,0),Attr(0,3))
    UNTIL returncode IN [0,59,60,63];
    Cursoroff;
   VAL(loandata[1],amount,errcode);
   VAL(loandata[2],rate,errcode);
   VAL(loandata[3],month,errcode);
   CASE returncode OF
     0   :  done := TRUE;
     59  :  Helpmessage(wfield);
     60  :  Computepayment(amount,rate,month);
     63  :  Calculator(5,49,Attr(15,5),1);
   END;
 END;
 Closewin;
END;

PROCEDURE Edemo;
BEGIN
  Openwin(2,46,7,22,Attr(0,7),Attr(0,7),1,8,1,0);
  done := FALSE;
  WITH emenu DO
  BEGIN
    WHILE NOT done DO
    BEGIN
      Makevmenu(emenu);
      CASE curntpos OF
        1 : BEGIN
              Openwin(8,8,10,65,Attr(15,5),Attr(15,5),2,0,1,0);
              Printcwin(3,'Windows can be popped');
              Printcwin(4,'onto the screen.');
              DELAY(2000);
              Openwin(5,5,10,50,Attr(0,2),Attr(14,2),2,7,1,0);
              DELAY(2000);
              Openwin(13,15,10,60,Attr(1,3),Attr(15,3),3,7,1,0);
              DELAY(2000);
              Openwin(7,33,10,45,Attr(14,5),Attr(14,5),1,7,1,0);
              Continue;
              FOR x := 1 TO 4 DO
              BEGIN
                Closewin;
              END;
            END;
        2 : BEGIN
              Openwin(8,8,10,65,Attr(15,5),Attr(15,5),2,0,1,0);
              Printcwin(3,'Windows can be zoomed');
              Printcwin(4,'onto the screen.');
              DELAY(2000);
              Openwin(5,5,10,50,Attr(0,2),Attr(14,2),2,7,1,1);
              DELAY(2000);
              Openwin(13,15,10,60,Attr(1,3),Attr(15,3),3,7,1,1);
              DELAY(2000);
              Openwin(7,33,10,45,Attr(14,5),Attr(14,5),1,7,1,1);
              DELAY(2000);
              Openwin(7,20,12,40,Attr(15,4),Attr(14,4),2,7,1,1);
              Printcwin(5,'HOW ABOUT THAT !!!');
              Continue;
              FOR x := 1 TO 5 DO
              BEGIN
                Closewin;
              END;
            END;
         3: Showfile;
         4: Ddemo;
         5: Idemo;
      ELSE
        Closewin;
        done := TRUE;
      END;
    END;
    done := FALSE;
  END;
END;

BEGIN
  curattr := Textattr;
  Cursoroff;
  Initmenus;
  Openwin(1,1,25,80,Attr(0,7),Attr(0,7),0,0,0,0);
  Fakewin(2,1,23,80,Attr(7,1),Attr(7,1),1,0,0,0);
  Openwin(5,20,11,40,Attr(0,7),Attr(1,7),2,8,1,0);
  Printcwin(2,'TW200');
  CASE Curdisplay OF
    0 : msg := 'MONO';
    1 : msg := 'CGA';
    2 : msg := 'EGA';
    3 : msg := 'MCGA';
    4 : msg := 'VGA';
  END;
  STR(lastmode:3,msg1);
  msg := msg + ' monitor in video mode'+msg1;
  Printcwin(3,msg);
  IF Mousehere THEN msg := 'Mouse present and active.' ELSE msg := 'No mouse present';
  Printcwin(4,msg);
  Printcwin(5,'Copyright (C) 1990');
  Printcwin(6,'by Richard D. Fothergill');
  Printcwin(7,'All Rights Reserved');
  x := 0;
  WHILE NOT KEYPRESSED AND (x < 25000) DO Inc(x);
  Closewin;
  IF KEYPRESSED THEN ch := Readkey;
  Sprint(25,1,'             Use arrow keys to change selection - Return to select              ',Attr(0,3));
  done := FALSE;
  WITH mmenu DO
  BEGIN
    WHILE NOT done DO
    BEGIN
      Makehmenu(mmenu);
      CASE curntpos OF
        1 : Fdemo;
        2 : Tdemo;
        3 : Sdemo;
        4 : Edemo;
      ELSE
        Closewin;
        Openwin(9,16,8,52,Attr(0,7),Attr(1,7),2,8,1,0);
        Printcwin(3,' T W ');
        Printcwin(4,'2 0 0');
        DELAY(3000);
        Closewin;
        done := TRUE;
      END;
    END;
  END;
  Cursoron;
END.