{ =========================================================================== }
{ WndwDemo.pas - Multi-level window demo for WNDW5Xb.TPU   ver 5.Xb, 03-04-89 }
{                                                                             }
{ This demo shows just a few features multi-level windows, including high     }
{ speed screen design.                                                        }
{   Copyright (C) 1987-1989 by James H. LeMay,  All rights reserved.          }
{ =========================================================================== }

program WindowDemo;

{$M 16384, 10000, 10000 }
{ R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }       { TP4 directives }
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}  { TP5 directives }

uses Crt,Qwik,Wndw,Goof,Strs;

type
  Str40 = string[40];
  Steps = (Step0,Step1,Step2,Step3,Step4,Step5);

var
  Step:              Steps;
  i,j:               word;
  Key:               char;

const
  FuncKey = #00;
  RetKey = #13;
  EscKey = #27;
  StrA : array [1..16] of Str40 = (
    'WNDW5XB.TPU works these ...',
    '',
    'COMPUTERS:           ADAPTERS:',
    'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ   ÄÄÄÄÄÄÄÄÄ',
    'IBM PC               MDA',
    'IBM XT               CGA',
    'IBM AT               EGA',
    'IBM PCjr             MCGA',
    'IBM PC Convertible   VGA',
    'IBM PS/2 Model 25    8514/A',
    'IBM PS/2 Model 30    Hercules:',
    'IBM PS/2 Model 50     HGC',
    'IBM PS/2 Model 60     HGC Plus',
    'IBM PS/2 Model 70     InColor',
    'IBM PS/2 Model 80 ',
    'IBM 3270 PC');

  StrB : array [1..10] of Str40 = (
    'If you have any questions or comments,',
    'please write to or call:',
    '',
    '     Eagle Performance Software',
    '     TP/TC Products',
    '     Attn: Jordan Gallagher',
    '           (CIS 73557,2342)',
    '     P.O. Box 292786',
    '     Ft. Worth, TX  76029-2786',
    '     1-(214)-539-7855');

procedure DisplayBaseScreen;
begin
  { -- Create initial screen -- }
  WWriteC ( 2,'Multi-Level Virtual Windows');
  WWriteC ( 3,'Version 5.XB for');
  WWriteC ( 4,'Turbo Pascal 5.0');
  TWS.WndwAttr := LightGrayBG;
  WWriteC ( 6,'For each of the following displays:');
  WWriteC ( 8,'1. Press RETURN to continue.');
  WWriteC ( 9,'2. Press ESC to back up.    ');
  TWS.WSline := SingleBrdr;
  WLineH  (12, 1,CRTcols);
  WWriteC (16,'This is the base screen without windows.  Let''s just see ');
  WWriteC (17,'how fast WNDW can create complex screen designs.  As soon');
  WWriteC (18,'as you press return, WNDW will start creating a screen   ');
  WWriteC (19,'from scratch.  Nothing has been done yet.  Then WNDW will');
  WWRiteC (20,'display the resulting window on the screen.  Try to time ');
  WWRiteC (21,'it, but don''t blink!                                     ');
  Step:=Step0;
end;

procedure DisplayScreenDesign;
{}procedure DoAssets;
  begin
  SetWindowModes (SeeThruMode+RelMode);
  MakeWindow ( 3, 1,12,39,GreenBG,SameAttr,NoBrdr,aWindow);
  with TWS do
    begin
      WndwAttr := LightGrayBG;
      WClrLine (1);
      WWriteC ( 1,    'A S S E T S');
      WEosToRC ( 3,33);
      QfillEos (12, 7,LightGrayBG,' ');
      WndwAttr := OrigAttr;
      WWrite  ( 2, 2, 'Current Assets:');
      WWrite  ( 3, 3,  'Cash and Equivalents');
      WWrite  ( 4, 3,  'Accounts Receivable:');
      WClrEos (WndwAttr);
      WWrite  ( 5, 4,   'United States');
      WWrite  ( 6, 4,   'Canada');
      WWrite  ( 7, 4,   'Europe');
      WWrite  ( 8, 3,  'Contracts in process');
      WWrite  ( 9, 3,  'Inventories');
      WWrite  (10, 3,  'Prepaid expenses');
      WWrite  (11, 2, 'Total Current Assets');
      WWrite  (12, 2, 'Property and Equipment');
      WWrite  (14, 2, 'Total Assets:');
    end;
{}end;
{}procedure DoAssetNums;
  const
    Cash:         integer =   128;
    US:           integer =  1757;
    Canada:       integer =  1827;
    Europe:       integer =  1426;
    Contracts:    integer = 10802;
    Inventory:    integer =  4872;
    Prepaid:      integer =   443;
    Property:     integer =  1140;
  var
   TotalCA,TotalAssets: longint;
  begin
  MakeWindow ( 3,33,12, 7,LightGrayBG,SameAttr,NoBrdr,aWindow);
  TotalCA := Cash+US+Canada+Europe+Contracts+Inventory;
  TotalAssets := TotalCA+PrePaid;
  WWriteC ( 3,StrLF(Cash       ,5));
  WWriteC ( 5,StrLF(US         ,5));
  WWriteC ( 6,StrLF(Canada     ,5));
  WWriteC ( 7,StrLF(Europe     ,5));
  WWriteC ( 8,StrLF(Contracts  ,5));
  WWriteC ( 9,StrLF(Inventory  ,5));
  WWriteC (10,StrLF(Prepaid    ,5));
  WWriteC (11,StrLF(TotalCA    ,5));
  WWriteC (12,StrLF(Property   ,5));
  WWriteC (14,StrLF(TotalAssets,5));
{}end;
{}procedure DoLiabilities;
  begin
  MakeWindow ( 3,41,12,38,GreenBG,SameAttr,NoBrdr,aWindow);
  with TWS do
    begin
      WEosToRC ( 3,32);
      QfillEos (12, 7,LightGrayBG,' ');
      WndwAttr := White+RedBG;
      WClrLine (1);
      WWriteC ( 1,    'L I A B I L I T I E S');
      WndwAttr := OrigAttr;
      WWrite  ( 2, 2, 'Current Liabilities:');
      WClrEos (WndwAttr);
      WWrite  ( 3, 3,  'Commercial paper');
      WWrite  ( 4, 3,  'Accounts payable');
      WWrite  ( 5, 3,  'Accrued salariess');
      WWrite  ( 6, 3,  'Deferred taxes');
      WWrite  ( 7, 2, 'Total Current');
      WWrite  ( 8, 2, 'Noncurrent Liabilities:');
      WClrEos (WndwAttr);
      WWrite  ( 9, 3,  'Long-term debt');
      WWrite  (10, 3,  'Product liability');
      WWrite  (11, 3,  'Deferred taxes');
      WWrite  (12, 2, 'Total Noncurrent');
      WWrite  (14, 2, 'Total Liabilities:');
    end;
{}end;
{}procedure DoLiabNums;
  const
    Paper:        integer =  3331;
    Payable:      integer =  5776;
    Salaries:     integer =  6430;
    Taxes1:       integer =  2344;
    LongTerm:     integer =   402;
    Product:      integer =  1876;
    Taxes2:       integer =  1096;
  var
   TotalCL,TotalNL,TotalLiabs: longint;
  begin
  MakeWindow ( 3,72,12, 7,LightGrayBG,SameAttr,NoBrdr,aWindow);
  TotalCL := Paper+Payable+Salaries+Taxes1;
  TotalNL := LongTerm+Product+Taxes2;
  TotalLiabs := TotalCL+TotalNL;
  WWriteC ( 3,StrLF(Paper      ,5));
  WWriteC ( 4,StrLF(Payable    ,5));
  WWriteC ( 5,StrLF(Salaries   ,5));
  WWriteC ( 6,StrLF(Taxes1     ,5));
  WWriteC ( 7,StrLF(TotalCL    ,5));
  WWriteC ( 9,StrLF(LongTerm   ,5));
  WWriteC (10,StrLF(Product    ,5));
  WWriteC (11,StrLF(Taxes2     ,5));
  WWriteC (12,StrLF(TotalNL    ,5));
  WWriteC (14,StrLF(TotalLiabs ,5));
{}end;
{}procedure DoAuditor;
  begin
  MakeWindow (18, 1, 6,78,GreenBG,SameAttr,NoBrdr,aWindow);
  with TWS do
    begin
      WWrite   ( 1, 2,'Auditor:');
      WWrite   ( 2, 2,'Business Address:');
      WWrite   ( 3, 2,'Mailing Address:');
      WWrite   ( 4, 2,'Contact:');
      WWrite   ( 5, 2,'Comments:');
      SetWindowModes (RelMode);
      MakeWindow (18,19, 6,60,White+BrownBG,SameAttr,NoBrdr,aWindow);
      WWrite   ( 1, 1,'Ferret Auditors of Texas, Inc.');
      WWrite   ( 2, 1,'1234 Technical Avenue      ');
      QwriteEos (GreenBG,' State: ');
      QwriteEos (SameAttr,'Texas    ');
      QwriteEos (GreenBG,' Zip: ');
      QwriteEos (SameAttr,'76125-1200');
      WWrite   ( 3, 1,'P.O. Box 122237            ');
      QwriteEos (GreenBG,' State: ');
      QwriteEos (SameAttr,'Texas    ');
      QwriteEos (GreenBG,' Zip: ');
      QwriteEos (SameAttr,'76125-1281');
      WWrite   ( 4, 1,'John Q. Public, CPA        ');
      QwriteEos (GreenBG,' Phone: ');
      QwriteEos (SameAttr,'(817)-555-1212');
      WWrite   ( 5, 1,'Was this screen fast enough for you?');
      WWrite   ( 6, 1,'Press RETURN to continue or ESC to back up.');
    end;
{}end;
{}procedure DoPartitions;
  begin
  RemoveWindow;   { Back to parent window. }
  with TWS do
    begin
      WWriteC ( 1,'1989 CONSOLIDATED BALANCE (Dollars in thousands)');
      WSline := SingleBrdr;
      WLineH    ( 2, 1,Wcols);
      WLineH    (15, 1,Wcols);
      WLineV    ( 3,40,14);
      WLinePart ( 2,40,BrdrTT);
      WLinePart (15,40,BrdrCL);
      WBrdrH (17);
    end;
{}end;
begin
  { -- You can compare how much slower it would be if we didn't use -- }
  { -- HiddenMode.  Try without it and comment out WriteToHidden.   -- }
  SetWindowModes (HiddenMode+CursorOffMode);
  MakeWindow ( 1, 1,25,80,black+GreenBG,White+GreenBG,HdoubleBrdr,Window1);
  WriteToHidden (Window1);
  TitleWindow (Top,Left,Yellow+GreenBG,' High Speed Screen Design ');
  DoAssets;
  DoAssetNums;
  DoLiabilities;
  DoLiabNums;
  DoAuditor;
  DoPartitions;
  ShowWindow (Window1);
end;

procedure DisplayEquipmentList;
begin
  { -- Compatible computers and adapters for WNDW5XB.TPU -- }
  SetWindowModes (ZoomMode);
  MakeWindow ( 4,35,18,34,White+BlueBG,LightCyan+blueBG,HdoubleBrdr,aWindow);
  TitleWindow (Top,Center,SameAttr,' Software Compatibility ');
  for j:=1 to 16 do
    WWrite (j, 2,StrA[j]);
end;

procedure DisplayAuthor;
begin
  { -- Author for WNDW5XB.TPU -- }
  SetWindowModes (ZoomMode);
  if VideoMode<>7 then
      SetWindowModes (WindowModes+ShadowRight);
  Brdr[UserBrdr2].BrdrArray:='ÚÁ¿´ÃÀÂÙÅÄÅųÅÅ';
  MakeWindow ( 6,20,13,42,White+BrownBG,BrownBG,UserBrdr2,aWindow);
  for j:=1 to 10 do
    WWrite (j,2,StrB[j]);
  TitleWindow (Bottom,Center,SameAttr,' Press RETURN to exit ');
end;

procedure GetKey;
var
  ExtKey: boolean;
begin
  repeat
    Key:=ReadKey;                        { Read keyboard input.      }
    if KeyPressed and (Key=FuncKey) then { If first Char was #00 ... }
      begin
        Key:=ReadKey;                    { ... read second char.     }
        ExtKey := true
      end
    else ExtKey:=false;
  until (Key=RetKey) or (Key=EscKey);
end;

procedure FindNextStep;
begin
  case Key of
  EscKey: if Step>Step0 then
           begin
             RemoveWindow;
             dec (Step);
           end;
  RetKey: inc (Step);
  end  { case }
end;

procedure DisplayWindows;
begin
  repeat
    GetKey;
    FindNextStep;
    if Key=RetKey then
      case Step of
        Step1:  DisplayScreenDesign;
        Step2:  DisplayEquipmentList;
        Step3:  DisplayAuthor;
      end;
   until Step=Step4;
end;

begin
{ Qsnow := false; }
  ModCursor (CursorOff);
  PreferMultiTask := true;
  InitWindow (blue+LightGrayBG,true);
  DisplayBaseScreen;
  DisplayWindows;
  { -- Use the following statment to return to the original screen.-- }
  for i:=1 to LI do RemoveWindow;
  WClrScr;
  WWriteC (12,'Copyright (c) 1986-1989  James H. LeMay');
  WWriteC (13,'Eagle Performance Software');
  ModCursor (CursorOn);
  GotoRC (CRTrows,1);
end.