Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TURBOWHL.ZIP/POPSCREN.PAS

Pascal/Delphi Source File | 1985-06-28 | 6.0 KB | 169 lines

{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.

    A variable type is declared in SCREENS.TYP that is the same "shape"
    as the (text) screen memory.  Using the "absolute" clause we
    can define variables "MONO" and "COLO" that exist "on top of" the
    Monochrome and Color screen memories.  If we then switch in some
    other SCREEN variable (e.g., "Mono := new_screen"), the whole
    video display changes instantly.

    The procedure MAKESCREEN takes a line of text and converts it into
    one line of a screen variable.  You can get a screen into memory by
    reading it from a file (see GetScreensFromFile below), by using
    MAKESCREEN on text constants (see CreateAScreen below), or by
    "grabbing" it from the screen memory itself (see GrabScreen below).

    One possible application for this sort of screen manipulation is
    a POP-out menu.  Your program can "grab" the current screen, write
    the menu onto the display, and then restore the screen.
}

{$I screens.typ}
{$I popscren.lib}
{$I monitor.lib}
{$I getkeys.lib}
{$I grfxtabl.lib}
{$I titles.lib}

var
  Pops    : array[1..5] of screen;
  N, M    : byte;
  PopFile : text;
  OneLine : lineType;
  C, D    : char;
  Your_title : title_type;

{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure GetScreensFromFile;
{This is one way to put screens into memory}

begin
  Assign(PopFile,'POPSCREN.DAT');
  reset(PopFile);
  N := 0;
  while (not EOF(PopFile)) and (N < 25) do
    begin
      N := N + 1;
      readLn(PopFile,OneLine);
      MakeScreen(Pops[1][N],15,OneLine);
      MakeScreen(Pops[2][N],112,OneLine);
      MakeScreen(Pops[3][N],1,OneLine);
    end;
  close(PopFile);
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure CreateAScreen;
   {This is another way to create a screen}

begin
MakeScreen(Pops[4][1],15,'');
MakeScreen(Pops[4][2],15,'');
MakeScreen(Pops[4][3],15,'');
MakeScreen(Pops[4][4],15,'');
MakeScreen(Pops[4][5],15,
'THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][6],15,
'  THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][7],15,
'     THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][8],15,
'        THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][9],15,
'           THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][10],15,
'              THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][11],15,
'                 THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][12],15,
'                    THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][13],15,
'                       THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][14],15,
'                          THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][15],15,
'                             THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][16],15,
'                                THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][17],15,
'                                   THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][18],15,
'                                      THIS SCREEN WAS NOT READ FROM THAT FILE.');
for N := 19 to 25 do
MakeScreen(Pops[4][N],15,'');
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure GrabScreen;    {Here we "grab" a screen from the actual display}
begin
  WRite('Enter a word of 10 letters or less: ');
  ReadLn(your_title);
  ClrScr;
  MakeTitle(your_title,1);
  MakeTitle(your_title,9);
  MakeTitle(your_title,17);
  if color then Pops[5] := Colo
    else Pops[5] := Mono;
  ClrScr;
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure MenuDemo;
begin
  for N := 1 to 5 do
    begin
      WriteLn('Now to fill the screen with text, in preparation for a');
      WriteLn('demonstration of a pop-out menu.  Pressing a key saves');
      WriteLn('the current screen & shows the menu.');
      WriteLn;
    end;

  repeat
    GetKeys(C,D);
    if ((C = #27) and (D = ';')) then
      begin
        Mono := Pops[5];
        Colo := Pops[5];
      end
    else
      begin
        if color then Pops[5] := Colo
          else Pops[5] := Mono;
        TextColor(black);TextBackground(white);
        GotoXY(20,5);Write ('╔══════════════════════════════╗');
        GotoXY(20,6);Write ('║                              ║');
        GotoXY(20,7);Write ('║  This might well be a menu.  ║');
        GotoXY(20,8);Write ('║  Press F1 to restore the     ║');
        GotoXY(20,9);Write ('║  screen, F2 to end           ║');
        GotoXY(20,10);Write('║                              ║');
        GotoXY(20,11);Write('╚══════════════════════════════╝');
        TextColor(white);TextBackground(black);
     end;
   until (C = #27) and (D = '<');
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
begin
  WriteLn('This is a demonstration of directly writing WHOLE SCREENS to the');
  WriteLn('display.  First, a "picture" screen is read from disk in three');
  WriteLn('different colors.  Next a screen is created directly within this');
  WriteLn('program.  Finally, a screen is created on the display and "grabbed"');
  WriteLn('by the program.');
  WriteLn('After all that, you get a demo of a SCREEN menu.');
  WriteLn('Press a key to start it all');
  repeat until keypressed;
  CheckColor;
  GetScreensFromFile;
  CreateAScreen;
  GrabScreen;
  GotoXY(2,2); write('Keep pressing a key for a quick change of screen.');
  Write('<Esc> to go on.');
  N := 0;
  repeat
    GetKeys(C,D);
    N := N + 1;
    Mono := Pops[(N mod 5) + 1];
    Colo := Pops[(N mod 5) + 1];
  until (C = #27) and (D = #0);
  ClrScr;
  MenuDemo;
  ClrScr;
end.