PROGRAM NSAMP10;   { Direct memory mapping with snow removal }

USES Crt, TPlus, TPWindow;

{ When accessing display memory, you can experience static, or
  "snow" with some displays.  This  problem is common with the IBM CGA
  color display.  By using the Turbo-Plus procedures "Screenoff" and
  "Screenon" you can eliminate this problem on all displays.  Screenoff
  will actually disable the display  until you have built the screen
  image in the display memory buffer.  Then Screenon will activate the
  display and the image will be displayed.  These routines are very fast
  as you will see in this demonstration program. }

            { Tailorable character FastWrite included here!! }

{ This program contains a character FastWrite procedure written in pascal.
  You may find it useful.  You can use the routine to create your own
  FastDisplay procedures. }


CONST WhiteCyan : BYTE = $3f;     { white on cyan Attribute BYTE }
      CyanRed   : BYTE = $43;     { cyan on red Attribute }


VAR Row, Column, Index : INTEGER;
    Msg : AnyStr;
    SType : CHAR;
    HoldFg, HoldBg : INTEGER;
    Scan : BYTE;
    ASCII : String1;



PROCEDURE cdisplay (Row, Column : INTEGER; Character : CHAR; Attribute : BYTE);

BEGIN
   Display^[Column,Row,2] := Attribute;        { insert character Attribute }
   Display^[Column,Row,1] := ORD (Character);  { insert character }
END;


PROCEDURE Left;

BEGIN
   ChangeAtt (1, HoldFg, HoldBg);             { restore Attributes }
   IF WhereX > 1 THEN
      GOTOXY (WhereX-1, WhereY);              { move cursor }
   GetAtt (HoldFg, HoldBg);                   { save Attributes }
   ChangeAtt (1, black, lightgray);           { non-blinking reverse cursor }
END;                                          { could be any color combo }


PROCEDURE Right;

BEGIN
   ChangeAtt (1, HoldFg, HoldBg);             { restore Attributes }
   IF WhereX < 80 THEN
      GOTOXY (WhereX+1, WhereY);              { move cursor }
   GetAtt (HoldFg, HoldBg);                   { save Attributes }
   ChangeAtt (1, black, lightgray);           { non-blinking reverse cursor }
END;                                          { could be any color combo }


PROCEDURE Down;

BEGIN
   ChangeAtt(1, HoldFg, HoldBg);              { restore Attributes }
   IF WhereY < 25 THEN
      GOTOXY (WhereX, WhereY+1);              { move cursor }
   GetAtt (HoldFg, HoldBg);                   { save Attributes }
   ChangeAtt (1, black, lightgray);           { non-blinking reverse cursor }
END;                                          { could be any color combo }


PROCEDURE Up;

BEGIN
   ChangeAtt (1, HoldFg, HoldBg);             { restore Attributes }
   IF WhereY > 1 THEN
      GOTOXY (WhereX, WhereY-1);              { move cursor }
   GetAtt (HoldFg, HoldBg);                   { save Attributes }
   ChangeAtt (1, black, lightgray);           { non-blinking reverse cursor }
END;                                          { could be any color combo }



{********* BEGIN MAIN LINE OF PROGRAM *********}


BEGIN
   SetColorsN(lightgray,black);
   { Turn off the display while doing memory mapping }
   ScreenOff;

   { Fill the entire display with a "." in white with cyan background }
   FOR Row := 1 TO 80 DO
      FOR Column:= 1 TO 25 DO
          cdisplay (Row, Column, '.', WhiteCyan);

   { Now display a message }
   Msg := 'Press Esc To End........';
   FOR Index := 1 TO LENGTH (Msg) DO
      cdisplay (Index, 1, Msg[Index], CyanRed);

   { Turn the display back on to show the results }
   Screenon;
   GOTOXY (Index+1,15);                     { position cursor after message }

   { Propagate message down screen using MoveScreen }
   FOR Index := 2 TO 24 DO
      FmoveScreen (Display^[1,1,1], Display^[Index,1,1], LENGTH (Msg) * 2);

   HoldFg := yellow;
   HoldBg := brown;
   GOTOXY (1,1);
   WRITE ('Now Use Arrow Keys To Move Customized Cursor Around Screen. Esc To End.');
   GOTOXY (1,1);
   ChangeBAtt (2000,brown);
   Scan := 0;
   CursorOff;                         { Turn Cursor off }
   ChangeAtt (1, black, lightgray);         { Let Cursor Move Around Screen }
   WHILE Scan <> 1 DO
      BEGIN
         ReadKb (Scan, ASCII);
         IF Scan = ArrowLfKey THEN
            Left;
         IF Scan = ArrowRtKey THEN
            Right;
         IF Scan = ArrowUpKey THEN
            Up;
         IF Scan = ArrowDnKey THEN
            Down;
      END;
   CursorOn;                         { Turn Cursor Back On }
   ClearScn;                                { clear the display }
END.

