{ SCREEN.INC: Scherm Routines }

{==========================================================================}
{ (c) Copyright Waterline Software Developent V.O.F. 1990-1994             }
{                                                                          }
{    Waterline Software Development V.O.F.                                 }
{    Wouter Sluislaan 12                                                   }
{    1461 AC  Zuidoostbeemster                                             }
{    The Netherlands                                                       }
{                                                                          }
{ It not allowed to use this user interface in any program not owned by    }
{ the Waterline Software Development V.O.F.                                }
{ Special conditions apply to programs distributed by the Waterline        }
{ Software Development V.O.F. If the source code of any of these programs  }
{ is distributed as well, it is NOT allowed to use the user interface in   }
{ your own programs. Violators may be prosecuted!                          }
{                                                                          }
{ Please contact the Waterline Software Development V.O.F. at the above    }
{ address for your licence to use the "Ramon" user interface. You will get }
{ the most recent copy of the "Ramon" user interface and the "Ramon" user  }
{ interface expert for free. This program helps you design your user       }
{ interfaces at an instance.                                               }
{                                                                          }
{ This copyright notice should remain in this file and all files that are  }
{ part of the user interface "Ramon".                                      }
{==========================================================================}

{ History:

13-04-93 CursorOn en CursorOff aangepast zodat ze niet meer de huidige cursor
         scan lines veranderen. Ze vragen ze nu eerst op en veranderen
         daarna pas de cursor in zichtbaar of niet.
16-05-93 CursorOff werkt niet op een bepaalde (hercules) videokaart. Nu zet
         ik de cursor in de rechter onderhoek zodat ie in ieder geval niet
         meer in het werkdeel van het scherm blijft staan.
08-06-94 Er heeft de hele tijd een bugje in CursorOff gezeten waardoor de
         scanlijn veranderde. Twee haakjes om de 255-$60 waren de oplossing.
}

CONST ColorAttrs : ARRAY[cDeskTop..cNewHelpTitle,FALSE..TRUE] OF BYTE =
                     (                   { mono, color }
{ cDesktop }          (mBlack*16+mWhite        , cBlue*16+cGreen),
{ cHeaders }          (mWhite*16+mBlack        , cCyan*16+cBlue),
{ cBoxLinesActive }   (mBlack*16+mWhite+mBright, cBlue*16+cYellow),
{ cBoxLinesInactive } (mBlack*16+mWhite        , cBlue*16+cWhite),
{ cBoxBack }          (mBlack*16+mWhite        , cBlue*16+cYellow),
{ cBoxShadow }        (mBlack                  , cBlack*16+cDGray),
{ cBoxData }          (mBlack*16+mWhite        , cBlue*16+cWhite),
{ cBoxDataTagged }    (mBlack*16+mWhite+mBright, cBlue*16+cLGreen),
{ cMenuSelectBar }    (mWhite*16+mBlack        , cLGray*16+cBlack),
{ cMenuSelected }     (mBlack*16+mWhite+mBright, cBlue*16+cYellow),
{ cKeyName }          (mBlack*16+mWhite+mBright, cLGray*16+cRed),
{ cKeyDescr }         (mBlack*16+mWhite        , cLGray*16+cBlack),
{ cKeyBlink }         (mBlack*16+mWhite+mBlink , cLGray*16+cRed+cBlink),
{ cError }            (mWhite*16+mBlack        , cRed*16+cYellow),
{ cMessage }          (mWhite*16+mBlack        , cGreen*16+cWhite),
{ cFieldData }        (mBlack*16+mWhite        , cBlue*16+cWhite),
{ cFieldDisabled }    (mBlack*16+mWhite        , cBlue*16+cLGray),
{ cFieldCursor }      (mWhite*16+mBlack        , cLGray*16+cBlack),
{ cFieldCursorTagged }(mWhite*16+mBlack+mBlink , cLGray*16+cBlack+cBlink),
{ cNotTagable }       (mWhite*16+mBlack        , cRed*16+cWhite),
{ cCustom1 }          (mWhite*16+mBlack        , cBlue*16+cBlack),
{ cCustom2 }          (mWhite*16+mBlack        , cBlue*16+cBlack),
{ cCustom3 }          (mWhite*16+mBlack        , cBlue*16+cBlack),
{ cHelp }             (mWhite*16+mBlack        , cCyan*16+cWhite),
{ cHelpBright }       (mWhite*16+mBlack+mBright, cCyan*16+cYellow),
{ cHelpLink }         (mBlack*16+mWhite        , cCyan*16+cBlue),
{ cScrSaver }         (mBlack*16+mWhite        , cBlack*16+cLGray),
{ cExitPrg }          (mBlack*16+mWhite        , cBlack*16+cLGray),
{ cNewHelpNormal }    (mWhite*16+mBlack        , cCyan*16+cBlack),
{ cNewHelpHighlight } (mWhite*16+mBlack        , cCyan*16+cWhite),
{ cNewHelpLink }      (mBlack*16+mWhite        , cCyan*16+cYellow),
{ cNewHelpLinkCursor }(mBlack*16+mWhite        , cBlue*16+cYellow),
{ cNewHelpTitle }     (mBlack*16+mWhite        , cBlue*16+cWhite)
                     );

VAR Attr : BYTE;
    XYAd : WORD;


{--------------------------------------------------------------------------}
{ IdentifyVideo                                                            }
{                                                                          }
{ Bepaal de instellingen van de huidige VideoMode en sla ze op in de Video }
{ structuur.                                                               }
{                                                                          }
PROCEDURE IdentifyVideo;

{$IFDEF PLATFORM_OS2}
{$IFNDEF FPC}
VAR Colours : LONGINT;
    Cols    : LONGINT;
    Rows    : LONGINT;
{$ELSE}
(*
VAR VI      : TVIOMODEINFO;
*)
{$ENDIF}
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR  CSBI      : CONSOLE_SCREEN_BUFFER_INFO;
     HOutput   : HANDLE;
{$ENDIF}

BEGIN
{$IFDEF PLATFORM_OS2}
{$IFNDEF FPC}
     GetVideoModeInfo (Cols,Rows,Colours);
     Video.Cols:=Cols;
     Video.Rows:=Rows;

     Video.Color:=TRUE;
{$ELSE}
(*   ## following line generates error??!  Mabe VI.cb doens't exist, have
to investigate
     VI.cb = SizeOf (TVIOMODEINFO);
     VioGetMode (VI, 0);

     Video.Cols := VI.Col;
     Video.Rows := VI.Row;
*)

     Video.Cols := 80;
     Video.Rows := 25;

     Video.Color := TRUE;
{$ENDIF}
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
     HOutput := GetStdHandle (STD_OUTPUT_HANDLE);
     GetConsoleScreenBufferInfo (HOutput, CSBI);
     Video.Cols := CSBI.dwSize.X;
     Video.Rows := CSBI.dwSize.Y;

     Video.Color := TRUE;
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
     Regs.AH:=$F;                                { subfunc F: GetVideoMode }
     Intr ($10,Regs);
     Video.Mode:=Regs.AL;

     Video.Cols:=Mem[Seg0040:$4A];

     Regs.AX:=$1A00;                            { subfunc 1A: Identify VGA }
     Intr ($10,Regs);
     IF (Regs.AL <> $1A) THEN                        { function supported? }
     BEGIN                                          { no -> Not a VGA card }
          Video.Rows:=MemW[Seg0040:$4C] DIV MemW[Seg0040:$4A] DIV 2;
          IF (MemW[Seg0040:$4C] = $4000) THEN
             Video.Rows:=25;      { CGA van school in hercules emulatie... }
          Video.VGA:=FALSE;
          Video.Color:=NOT (Video.Mode IN [0,2,5,7]);
     END ELSE
     BEGIN                                                      { VGA card }
          Video.Rows:=Mem[Seg0040:$84]+1;
          Video.VGA:=TRUE;
          Video.Color:=(Video.Mode <> 7);
     END;

     IF (Video.Mode = 7) THEN Video.Base:=SegB000
                         ELSE Video.Base:=SegB800;

     {$IFDEF DesqView}
     Video.Base:=DV_Get_Video_Buffer (Video.Base);
     {$ENDIF}
{$ENDIF}
END;


{$IFNDEF PLATFORM_OS2_OR_WIN32}
{--------------------------------------------------------------------------}
{ SetVideo                                                                 }
{                                                                          }
{ Schakel over op de nieuwe video mode.                                    }
{                                                                          }
PROCEDURE SetVideo (Mode : BYTE);
BEGIN
     ChangedVideoMode:=TRUE;

     Regs.AX:=Mode; { subfnc 0 (AH=0): SetVideoMode }
     Intr ($10,Regs);

     Regs.AH:=5; { Set video page }
     Regs.AL:=0; { to page 0 }
     Intr ($10,Regs);

     IdentifyVideo;
END;
{$ENDIF}


{--------------------------------------------------------------------------}
{ ModifyColor                                                              }
{                                                                          }
{ Met deze routine kan een kleur veranderd worden. Eigenlijk wordt hier    }
{ direct een CONSTante veranderd, maar het werkt...                        }
{                                                                          }
PROCEDURE ModifyColor (Color : ColorSet; Value : BYTE);
BEGIN
     ColorAttrs[Color,Video.Color]:=Value;
END;


{--------------------------------------------------------------------------}
{ GetColorValue                                                            }
{                                                                          }
{ Deze routine retourneerd the kleur code voor de gevraagde kleur.         }
{                                                                          }
FUNCTION GetColorValue (Color : ColorSet) : BYTE;
BEGIN
     GetColorValue:=ColorAttrs[Color,TRUE];
END;


{--------------------------------------------------------------------------}
{ SetColor                                                                 }
{                                                                          }
{ Stel de kleuren voor de volgende rwrite actie in op de nieuwe opgegeven  }
{ waarden. Voor monochroom en kleur worden andere sets gebruikt.           }
{                                                                          }
PROCEDURE SetColor (Color : ColorSet);
BEGIN
     GetColor:=Color;
     Attr:=ColorAttrs[Color,Video.Color];
END;


{--------------------------------------------------------------------------}
{ FillVideo                                                                }
{                                                                          }
{ Vul een stuk van het video ram met het huidige attribuut.                }
{                                                                          }
PROCEDURE FillVideo (X,Y,LX,LY : XYType; Teken : CHAR);

VAR Lp    : XYType;

{$IFDEF PLATFORM_OS2}
    Cell  : SmallWord;
{$ENDIF}

{$IFDEF PLATFORM_WIN32}
     SX, SY    : XYType;
     I         : XYType;
{$ENDIF}

{$IFDEF PLATFORM_DOS_ALL}
    Start : WORD;
{$ENDIF}

BEGIN

     {$IFDEF PLATFORM_OS2}
     Cell:=Attr*256+Byte (Teken);
     {$ENDIF}
     {$IFDEF PLATFORM_WIN32}
     SX := CRT.WhereX;
     SY := CRT.WhereY;
     CRT.TextAttr := Attr;
     {$ENDIF}
     {$IFDEF PLATFORM_DOS_ALL}
     Start:=(Y*Video.Cols+X)*2;
     {$ENDIF}
     FOR Lp:=1 TO LY DO
     BEGIN
          {$IFDEF PLATFORM_OS2}
          VioWrtNCell (Cell,LX,Y+Lp-1,X,0);
          {$ENDIF}
          {$IFDEF PLATFORM_WIN32}

          CRT.GotoXY (X, Y+Lp-1);
          FOR I := 1 TO LX DO
               Write (Teken);
          {$ENDIF}

          {$IFDEF PLATFORM_DOS_ALL}
          ASM
             MOV AX,Video.Base
             MOV ES,AX
             MOV DI,Start
             MOV AH,Attr
             MOV AL,Teken
             XOR CH,CH
             MOV CL,LX
             CLD
             REP STOSW
          END;

          Start:=Start+Video.Cols*2;
          {$ENDIF}
     END;
     {$IFDEF PLATFORM_WIN32}
     CRT.GotoXY (SX, SY);
     {$ENDIF}
END;


PROCEDURE InitDesktop;
BEGIN
(* init code verplaatst van de implementation RAMON.PAS. Deze code is alleen
   nodig als OpenDesktop gebruikt wordt en daarom hier geplaatst *)

   { probleem niet denken slim op te kunnen lossen door geinitialiseerde }
   { variabelen, want bij een dubbele OpenDesktop, CloseDesktop gaat het }
   { dan mis.                                                            }

{ Windows Init }
     CurrWindowRecordPtr:=NIL;

{ Screen Init }
     IdentifyVideo;

{ Menu Init }
     CurrMenuRecordPtr:=NIL;

{ Fields Init }
     FieldStkPtr:=NIL;

{ List Init }
     CurrListPtr:=NIL;
END;


{--------------------------------------------------------------------------}
{ PaintDesktop                                                             }
{                                                                          }
{ This routine paints the given area in the desktop colours.               }
{                                                                          }
PROCEDURE PaintDesktop (X,Y,LX,LY : XYType);
BEGIN
     SetColor (cDeskTop);
     FillVideo (X-1,Y-1,LX,LY,'°');
END;


{--------------------------------------------------------------------------}
{ OpenDesktop                                                              }
{                                                                          }
{ Stel de juiste scherm mode en achtergrond in en zet de header en footer  }
{ op het scherm. Voor de nieuwe scherm mode wordt mode 3 gebruikt (80x25   }
{ color), maar met de VIDEO environment variabele kan een andere mode      }
{ ingesteld worden zoals bijvoorbeeld 86, dit is 132x60 Color Text op een  }
{ Trident 8900. Verder wordt hier de muis geinitialiseerd.                 }
{                                                                          }
PROCEDURE OpenDesktop (Titel,Version : STRING);

{$IFDEF PLATFORM_DOS_ALL}
VAR NewMode  : BYTE;
    VideoEnv : STRING;
    VideoVal : BYTE;
    Nop      : INTEGER;
{$ENDIF}

BEGIN
     InitDesktop;

     {$IFNDEF PLATFORM_OS2_OR_WIN32}
     OldVideoMode:=Video.Mode;
     NewMode:=Video.Mode;

     VideoEnv:=GetEnv ('VIDEO');
     IF (VideoEnv <> '') THEN
     BEGIN
          Val (VideoEnv,VideoVal,Nop);
          IF (Nop = 0) THEN NewMode:=VideoVal;
     END;

     IF (NewMode <> Video.Mode) THEN
        SetVideo (NewMode);
     {$ENDIF}

     IF (Video.Cols < 80) THEN
     BEGIN
          {$IFNDEF PLATFORM_OS2_WIN32}
          SetVideo (OldVideoMode);
          {$ENDIF}
          WriteLn ('Minimum of 80 columns required');
          Halt;
     END;

     CursorOff;
     PaintDesktop (1,1,Video.Cols,Video.Rows);

     WriteXYC (1,1,cHeaders,AddUpWithSpaces (Video.Cols,' '+Titel+' v'+Version));
     WriteXY (Video.Cols-Length (DesktopCopyright)-8,1,'(c) '+DesktopCopyright+' '''+DesktopCopyrightYear);

{$IFNDEF NoScrSaver}
     ScreenSaver_SetState (ssOn);
     ScreenSaverMsg:='This is '+Titel+', press any key...';
{$ENDIF}
END;


{--------------------------------------------------------------------------}
{ CloseDesktop                                                             }
{                                                                          }
{ Zet de muis uit, verwijder het achtergrond scherm, keer terug naar de    }
{ standaard mode als ie daar nog niet in staat en wis het scherm.          }
{                                                                          }
PROCEDURE CloseDesktop;
BEGIN
{$IFNDEF NoScrSaver}
     ScreenSaver_SetState (ssOff);
{$ENDIF}

     SetColor (cExitPrg);
     FillVideo (0,0,Video.Cols,Video.Rows,' ');

     {$IFNDEF PLATFORM_OS2_WIN32}
     IF ChangedVideoMode THEN
        SetVideo (OldVideoMode)
     ELSE
     {$ENDIF}
     BEGIN
          CRT.ClrScr;
          CursorOn;
     END;

     {$IFNDEF PLATFORM_OS2_WIN32}
     Video.Base:=0;
     {$ENDIF}

     CRT.LowVideo;
     CRT.TextAttr:=(CRT.TextAttr AND 15); { no blink, black background }
END;


{--------------------------------------------------------------------------}
{ RGotoXY                                                                  }
{                                                                          }
{ Ga naar de opgegeven X en Y positie, relatief aan LinksBoven 1,1.        }
{                                                                          }
PROCEDURE RGotoXY (X,Y : XYType);
BEGIN
     Dec (Y); Dec (X);
     XYAd:=(Y*Video.Cols+X)*2;
     { geen cursor update! (Gebruik CursorUpdatePos of CursorGotoXY) }
END;


{--------------------------------------------------------------------------}
{ RWhereX                                                                  }
{                                                                          }
{ Geef de huidige X positie terug. Deze ligt tussen 1 en Video.Cols.       }
{                                                                          }
FUNCTION RWhereX : XYType;
BEGIN
     RWhereX:=1+((XYAd DIV 2) MOD Video.Cols);
END;


{--------------------------------------------------------------------------}
{ RWhereY                                                                  }
{                                                                          }
{ Geef de huidige Y positie terug.                                         }
{                                                                          }
FUNCTION RWhereY : XYType;
BEGIN
     RWhereY:=1+((XYAd DIV 2) DIV Video.Cols);
END;


{--------------------------------------------------------------------------}
{ RWrite                                                                   }
{                                                                          }
{ Druk tekst af vanaf de huidige positie XYAd in de ingestelde kleur Attr. }
{                                                                          }
PROCEDURE RWrite (Tekst : STRING);
{$IFDEF PLATFORM_OS2}
BEGIN
     VioWrtCharStrAtt (@Tekst[1],Length (Tekst),RWhereY-1,RWhereX-1,Attr,0);
     Inc (XYAd,Length (Tekst)*2);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
BEGIN
     GotoXY (RWhereX, RWhereY);
     TextAttr := Attr;
     Write (Tekst);
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
VAR Lp : BYTE;

BEGIN
     FOR Lp:=1 TO Length (Tekst) DO
     BEGIN
          MemW[Video.Base:XYAd]:=(Attr SHL 8) OR Ord (Tekst[Lp]);
          Inc (XYAd,2);
     END;
{$ENDIF}
END;


{--------------------------------------------------------------------------}
{ RWritePC                                                                 }
{                                                                          }
{ Druk tekst af vanaf de huidige positie XYAd in de ingestelde kleur Attr. }
{                                                                          }
PROCEDURE RWritePC (Tekst : PChar);

VAR Index : BYTE;

BEGIN
     Index := 0;

     {$IFDEF PLATFORM_OS2}
     WHILE (Tekst[Index] <> #0) DO
           Inc (Index);

     VioWrtCharStrAtt (Tekst,Index,RWhereY-1,RWhereX-1,Attr,0);
     Inc (XYAd,Index*2);
     {$ENDIF}
     {$IFDEF PLATFORM_WIN32}
     TextAttr := Attr;
     GotoXY (RWhereX, RWhereY);
     Write (Tekst);
     {$ENDIF}
     {$IFDEF PLATFORM_DOS_ALL}
     WHILE (Tekst[Index] <> #0) DO
     BEGIN
          MemW[Video.Base:XYAd]:=(Attr SHL 8) OR Byte (Tekst[Index]);
          Inc (XYAd,2);
     END; { while }
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ RWriteC                                                                  }
{                                                                          }
{ Deze routine stelt de huidige kleur in en drukt daarna met RWrite de     }
{ tekst af.                                                                }
{                                                                          }
PROCEDURE RWriteC (Color : ColorSet; Tekst : STRING);
BEGIN
     SetColor (Color);
     RWrite (Tekst);
END;


{--------------------------------------------------------------------------}
{ FWrite                                                                   }
{                                                                          }
{ Druk tekst af vanaf de huidige positie XYAd, maar veranderd de achter-   }
{ grondkleur niet.                                                         }
{                                                                          }
PROCEDURE FWrite (Tekst : STRING);
{$IFDEF PLATFORM_OS2}
BEGIN
     VioWrtCharStr (@Tekst[1],Length (Tekst),RWhereY-1,RWhereX-1,0);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR
     HOutput        : HANDLE;
     Temp           : PChar;
     Len            : LPDWORD;
     Coordinate     : COORD;

BEGIN
     HOutput := GetStdHandle (STD_OUTPUT_HANDLE);

     GetMem (Temp, Length (Tekst)+1);
     StrPCopy (Temp, Tekst);

     Coordinate.X := RWhereX-1;
     Coordinate.Y := RWhereY-1;

     WriteConsoleOutputCharacterA (HOutput, Temp, Length (Tekst), Coordinate, Len);
     FreeMem (Temp, Length (Tekst)+1);
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
VAR Lp : BYTE;

BEGIN
     FOR Lp:=1 TO Length (Tekst) DO
     BEGIN
          Mem[Video.Base:XYAd]:=Ord (Tekst[Lp]);
          Inc (XYAd,2);
     END;
{$ENDIF}
END;


{--------------------------------------------------------------------------}
{ SneakWrite                                                               }
{                                                                          }
{ Schrijf naar een locatie, laat de achtergrond kleur in takt en de cursor }
{ en huidige kleur ook.                                                    }
{                                                                          }
PROCEDURE SneakWrite (X,Y : XYType; Tekst : STRING);
{$IFDEF PLATFORM_OS2}
BEGIN
     VioWrtCharStr (@Tekst[1],Length (Tekst),Y-1,X-1,0);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR
     OldX, OldY: XYType;

BEGIN
     OldX := RWhereX;
     OldY := RWhereY;

     RGotoXY (X, Y);
     RWrite (Tekst);
     RGotoXY (OldX, OldY);
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
VAR Lp   : BYTE;
    XYAd : WORD;

BEGIN
     Dec (Y); Dec (X);
     XYAd:=(Y*Video.Cols+X)*2;

     FOR Lp:=1 TO Length (Tekst) DO
     BEGIN
          Mem[Video.Base:XYAd]:=Ord (Tekst[Lp]);
          Inc (XYAd,2);
     END;
{$ENDIF}
END;


{--------------------------------------------------------------------------}
{ ChangeColor                                                              }
{                                                                          }
{ Met deze routine kan de kleur van een stuk regel op het scherm veranderd }
{ worden. Hierdoor verandert de huidige cursor positie niet.               }
{                                                                          }
PROCEDURE ChangeColor (X,Y,LX : XYType; Color : ColorSet);
{$IFDEF PLATFORM_OS2}
BEGIN
     VioWrtNAttr (ColorAttrs[Color,Video.Color],LX,Y-1,X-1,0);
     Inc (XYAd,LX*2);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR
     HOutput        : HANDLE;
     Temp           : WORD;
     Len            : LPDWORD;
     Coordinate     : COORD;
     TX             : WORD;

BEGIN
     HOutput := GetStdHandle (STD_OUTPUT_HANDLE);

     Coordinate.Y := Y-1;

     Temp := ColorAttrs [Color, Video.Color];

     FOR TX := X TO X+LX-1 DO
     BEGIN
          Coordinate.X := TX-1;
          WriteConsoleOutputAttribute (HOutput, Temp, 1, Coordinate, Len);
     END;
{$ENDIF}

{$IFDEF PLATFORM_DOS_ALL}
VAR XYAd : WORD;

BEGIN
     XYAd:=((Y-1)*Video.Cols+X-1)*2+1;
     WHILE (LX > 0) DO
     BEGIN
          Mem[Video.Base:XYAd]:=ColorAttrs[Color,Video.Color];
          Dec (LX);
          Inc (XYAd,2);
     END;
{$ENDIF}
END;


{--------------------------------------------------------------------------}
{ ReadColor                                                                }
{                                                                          }
{ Met deze routine kan de kleur van een positie op het scherm uitgelezen   }
{ worden. Deze wordt daarna vertaald naar een van ColorSet waarden.        }
{                                                                          }
FUNCTION ReadColor (X,Y : XYType) : ColorSet;

VAR Color  : BYTE;
    Lp     : BYTE;
{$IFDEF PLATFORM_OS2}
    Buf    : SmallWord;
    BufLen : SmallWord;
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR
     HOutput        : HANDLE;
     Temp           : LPWORD;
     Len            : LPDWORD;
     Coordinate     : COORD;
{$ENDIF}

{$IFDEF PLATFORM_DOS_ALL}
    XYAd   : WORD;
{$ENDIF}

BEGIN
     {$IFDEF PLATFORM_OS2}
     BufLen:=2;
     VioReadCellStr (Buf,BufLen,Y-1,X-1,0);
     Color:=(Buf SHL 8);
     {$ENDIF}

     {$IFDEF PLATFORM_WIN32}
     HOutput := GetStdHandle (STD_OUTPUT_HANDLE);
     Coordinate.Y := Y-1;

     Coordinate.X := X-1;
     ReadConsoleOutputAttribute (HOutput, Temp, 1, Coordinate, Len);

     Color := BYTE (Temp^);
     {$ENDIF}

     {$IFDEF PLATFORM_DOS_ALL}
     XYAd:=((Y-1)*Video.Cols+X-1)*2+1;
     Color:=Mem[Video.Base:XYAd];
     {$ENDIF}

     FOR Lp:=Ord (cDesktop) TO Ord (cExitPrg) DO
         IF (ColorAttrs[ColorSet (Lp),Video.Color] = Color) THEN
         BEGIN
              ReadColor:=ColorSet (Lp);
              Exit;
         END;

     ReadColor:=cDesktop; { niet gevonden; neem maar iets willekeurigs }

END;


{--------------------------------------------------------------------------}
{ WriteXY                                                                  }
{                                                                          }
{ Druk de tekst op de opgegeven positie af.                                }
{                                                                          }
PROCEDURE WriteXY (X,Y : XYType; Tekst: STRING);
BEGIN
     RGotoXY (X,Y);
     RWrite (Tekst);
END;


{--------------------------------------------------------------------------}
{ WriteXYC                                                                 }
{                                                                          }
{ Druk de tekst op de opgegeven positie in de opgegeven kleur af.          }
{                                                                          }
PROCEDURE WriteXYC (X,Y : XYType; Color : ColorSet; Tekst: STRING);
BEGIN
     SetColor (Color);
     RGotoXY (X,Y);
     RWrite (Tekst);
END;


{--------------------------------------------------------------------------}
{ CursorUpdatePos                                                          }
{                                                                          }
{ Zet de cursor op de huidige XYAd.                                        }
{                                                                          }
PROCEDURE CursorUpdatePos;
BEGIN
     {$IFDEF PLATFORM_OS2}
     VioSetCurPos (RWhereY-1,RWhereX-1,0);
     {$ENDIF}
     {$IFDEF PLATFORM_WIN32}
     CRT.GotoXY (RWhereX, RWhereY);
     {$ENDIF}
     {$IFDEF PLATFORM_DOS_ALL}
     Regs.AH:=2;
     Regs.BH:=0; { page 0 }
     Regs.DH:=RWhereY-1; { 0-based }
     Regs.DL:=RWhereX-1;
     Intr ($10,Regs);
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ CursorOn                                                                 }
{                                                                          }
{ Laat de cursor zien.                                                     }
{                                                                          }
PROCEDURE CursorOn;
{$IFDEF PLATFORM_OS2}

VAR CurData : VioCursorInfo;

BEGIN
     VioGetCurType (CurData,0);
     CurData.Attr:=0;
     VioSetCurType (CurData,0);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
BEGIN
     CRT.CursorOn;
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
BEGIN
     Regs.AH:=3; { get cursor position and size }
     Regs.BH:=0; { page 0 }
     Intr ($10,Regs);

     Regs.AH:=1; { Set Text-Mode Cursor Shape }
     (* oude code, voordat we gingen opvragen met fnc 3
     Regs.CH:=Mem[$40:$85]; { Normal (b6,5 = 00), Top Scan Line }
     Regs.CL:=Mem[$40:$85]; { Bottom Scan Line }
     *)
     Regs.CH:=(Regs.CH AND (255-$60));
     Intr ($10,Regs);
{$ENDIF}

     CursorIsOn:=TRUE;
END;


{--------------------------------------------------------------------------}
{ CursorOff                                                                }
{                                                                          }
{ Maak de cursor onzichtbaar.                                              }
{                                                                          }
PROCEDURE CursorOff;
{$IFDEF PLATFORM_OS2}
VAR CurData : VioCursorInfo;

BEGIN
     VioGetCurType (CurData,0);
     CurData.Attr:=SmallWord (-1);  { hidden }
     VioSetCurType (CurData,0);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
BEGIN
     CRT.CursorOff;
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
BEGIN
     Regs.AH:=3; { get cursor position and size }
     Regs.BH:=0; { page 0 }
     Intr ($10,Regs);

     Regs.AH:=1;  { Set Text-Mode Cursor Shape }
     (* oude code, voordat we gingen opvragen met fnc3
     Regs.CH:=$20; { Invisible (b6,5 = 01) }
     *)
     Regs.CH:=(Regs.CH AND (255-$60)) OR $20;
     Intr ($10,Regs);

     { zet de cursor in de linker onderhoek }
     Regs.AH:=2;
     Regs.BH:=0; { page 0 }
     Regs.DH:=Video.Cols-1; { x, 0-based }
     Regs.DL:=Video.Rows-1; { y }
     Intr ($10,Regs);
{$ENDIF}

     CursorIsOn:=FALSE;
END;


{--------------------------------------------------------------------------}
{ CursorGotoXY                                                             }
{                                                                          }
{ Zet de cursor op opgegeven positie.                                      }
{                                                                          }
PROCEDURE CursorGotoXY (X,Y : XYType);
BEGIN
     {$IFDEF PLATFORM_OS2}
     VioSetCurPos (Y-1,X-1,0);
     {$ENDIF}
     {$IFDEF PLATFORM_WIN32}
     CRT.GotoXY (X, Y);
     {$ENDIF}
     {$IFDEF PLATFORM_DOS_ALL}
     Regs.AH:=2;
     Regs.BH:=0; { page 0 }
     Regs.DH:=Y-1; { 0-based }
     Regs.DL:=X-1;
     Intr ($10,Regs);
     {$ENDIF}

     CursorX:=X;
     CursorY:=Y;
END;


{--------------------------------------------------------------------------}
{ ScrollUp                                                                 }
{                                                                          }
{ Deze routine scrollt een stuk van het scherm omhoog. Op het moment is    }
{ deze routine nog heeeel erg traag. Assembly would help!                  }
{                                                                          }
PROCEDURE ScrollUp (X,Y,LX,LY : XYType);
{$IFDEF PLATFORM_OS2}

VAR Cell : SmallWord;

BEGIN
     Cell:=Attr*256+Ord (' ');
     VioScrollUp (Y-1,X-1,Y+LY-2,X+LX-2,1,Cell,0);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
VAR
     SX, SY: XYType;

BEGIN
     SX := CRT.WhereX;
     SY := CRT.WhereY;

     {## verify behaviour}
     Window (X, Y, X+LX-1, Y+LY-1);
     DelLine;
     Window (1, 1, Video.Cols, Video.Rows);
     FillVideo (X, Y+LY-2, LX, 1, ' ');

     CRT.GotoXY (SX, SY);
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
VAR PutOfs,
    GetOfs,
    AddToNextLine : WORD;

    Lp,Lp2        : XYType;

BEGIN
     PutOfs:=((Y-1)*Video.Cols+X-1)*2;
     GetOfs:=PutOfs+Video.Cols*2;
     AddToNextLine:=(Video.Cols-LX)*2;

     FOR Lp:=1 TO LY-1 DO
     BEGIN
          FOR Lp2:=1 TO LX DO
          BEGIN
               MemW[Video.Base:PutOfs]:=MemW[Video.Base:GetOfs];
               Inc (GetOfs,2);
               Inc (PutOfs,2);
          END;

          GetOfs:=GetOfs+AddToNextLine;
          PutOfs:=PutOfs+AddToNextLine;
     END;
{$ENDIF}
END;


{---------------------------------------------------------------------------}
{ ScreenDumpToFile                                                          }
{                                                                           }
{ Deze routine dumpt het hele scherm naar de opgegeven file. Kan voor alle  }
{ text video modes gebruikt worden.                                         }
{                                                                           }
PROCEDURE ScreenDumpToFile (Filename : STRING);

{$IFNDEF PLATFORM_OS2_WIN32}
VAR DumpFile : FILE;
    IORes    : BYTE;
    BlkSize  : WORD;
    BlkPtr   : POINTER;
{$ENDIF}

BEGIN
{$IFNDEF PLATFORM_OS2_WIN32}
     Assign (DumpFile,Filename);
     {$I-} ReWrite (DumpFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          Error ('Cannot create screen-dump file "'+Filename+'" (error '+Byte2String (IORes)+')');
          Exit;
     END;

     BlkSize:=2*Video.Rows*Video.Cols;
     BlkPtr:=Ptr (Video.Base,0);

     BlockWrite (DumpFile,BlkPtr^,BlkSize);

     Close (DumpFile);
{$ENDIF}
END;


{---------------------------------------------------------------------------}
{ ScreenDumpToTextFile                                                      }
{                                                                           }
{ Deze routine dumpt het hele scherm naar de opgegeven file. Kan voor alle  }
{ text video modes gebruikt worden.                                         }
{                                                                           }
PROCEDURE ScreenDumpToTextFile (Filename : STRING);

{$IFNDEF PLATFORM_OS2_WIN32}
VAR DumpFile : FILE;
    IORes    : BYTE;
    XLp,YLp  : XYType;
    Line     : ARRAY[1..255] OF BYTE;
    Addr     : WORD;
{$ENDIF}

BEGIN
{$IFNDEF PLATFORM_OS2_WIN32}
     Assign (DumpFile,Filename);
     {$I-} ReWrite (DumpFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          Error ('Cannot create screen-dump textfile "'+Filename+'" (error '+Byte2String (IORes)+')');
          Exit;
     END;

     Line[Video.Cols+1]:=13;
     Line[Video.Cols+2]:=10;

     Addr:=0;

     FOR YLp:=1 TO Video.Rows DO
     BEGIN
          FOR XLp:=1 TO Video.Cols DO
          BEGIN
               Line[XLp]:=Mem[Video.Base:Addr];
               Inc (Addr,2);
          END;

          BlockWrite (DumpFile,Line[1],Video.Cols+2);
     END;

     Close (DumpFile);
{$ENDIF}
END;

{---------------------------------------------------------------------------}
{ Win32WriteNewAttribute                                                    }
{                                                                           }
{ Rewrites attributes in a given area, leaving the text as-is.              }
{                                                                           }
{$IFDEF PLATFORM_WIN32}
PROCEDURE Win32WriteNewAttribute (Attr: BYTE; X, Y, LX, LY: XYType);
VAR
     cx, cy : XYType;

     HOutput        : HANDLE;
     Temp           : WORD;
     Len            : LPDWORD;
     Coordinate     : COORD;
     TX, TY         : XYType;

BEGIN
     HOutput := GetStdHandle (STD_OUTPUT_HANDLE);

     Coordinate.Y := Y-1;

     Temp := Attr;

     FOR TX := X TO X+LX-1 DO
          FOR TY := Y TO Y+LY-1 DO
          BEGIN
               Coordinate.X := TX-1;
               Coordinate.Y := TY-1;
               WriteConsoleOutputAttribute (HOutput, Temp, 1, Coordinate, Len);
          END;
END;
{$ENDIF}

{ end of file screen.inc }

