Columbia Kermit/kermit.zip/perqb/pq2iou.pas

Pascal/Delphi Source File | 2020-01-01 | 6KB | 210 lines

MODULE IOUtils;

{=============================================================================}
{
{  Module for various IO operations:
{
{    -- Reading cursorpatterns and fontpatterns
{    -- Clearing/blacking/inverting windows
{
{
{  Author: Petter Hesselberg
{
{=============================================================================}

{=============================================================================}
{
{  Changelog:
{
{  V2.0  19 Jul 83  P Hesselberg    ReadFont, PlaseCursor & Window routines
{                                   work perfectly!
{
{  V1.0  19 Jul 83  P Hesselberg    ReadCursor on the air
{
{  V0.0  19 Jul 83  P Hesselberg    Started (as a cursor test program)
{
{=============================================================================}

{=============================================================================}
                                EXPORTS
{=============================================================================}


IMPORTS IO_Others   FROM IO_Others;
IMPORTS Screen      FROM Screen;
IMPORTS UtilDefs    FROM UtilDefs;


{=============================================================================}


FUNCTION ReadCursor(FileName : String): CurPatPtr;

       { Abstract: Creates a segment in memory and fills it with the cursor
                   definition from <FileName>. Returns a pointer to the
                   segment of type CurPatPtr defined in IO_Others.
                   Returns NIL if file not found.                             }


PROCEDURE PutCursor(Pointer : CurPatPtr;
                          X : XRange;
                          Y : YRange);

        { Abstract: Puts a copy of the cursor referenced by [Pointer]
                    with upper left corner at coordinates (x, y)              }


FUNCTION ReadFont(FileName: String): FontPtr;

       { Abstract: Creates a segment in memory and fills it with the font
                   definition from <FileName>. Returns a pointer to the
                   segment of type FontPtr defined in Screen.                 }


{=============================================================================}


PROCEDURE ClearWindow(WNo: WinRange);

        { Abstract: Sets window [WNo] to white                                }


PROCEDURE InvertWindow(WNo: WinRange);

        { Abstract: Inverts window [WNo]                                      }


PROCEDURE PaintWindow(WNo: WinRange);

        { Abstract: Sets window [WNo] to black                                }



{#P}
{=============================================================================}
                               PRIVATE
{=============================================================================}


IMPORTS Memory      FROM Memory;
IMPORTS FileSystem  FROM FileSystem;
IMPORTS MultiRead   FROM MultiRead;
IMPORTS PERQ_String FROM PERQ_String;

CONST  CursorWidth = 56;
      CursorHeight = 64;
       DfltSizeInc = 1;
        DfltOffset = 0;
        FirstBlock = 0;
            NoFile = 0;
               Org = 0;



{=============================================================================}
{                        Cursor & Font Routines:
{=============================================================================}


FUNCTION ReadCursor(FileName: String): CurPatPtr;

VAR  Blocks, Bits, Seg : INTEGER;
                   FID : FileID;

BEGIN
   FID:= FSLookUp(FileName, Blocks, Bits);
   IF FID = NoFile THEN ReadCursor:= NIL
   ELSE
   BEGIN
      CreateSegment(Seg, Blocks, DfltSizeInc, Blocks);
      MultiRead(FID, MakePtr(Seg, DfltOffset, pDirBlk), FirstBlock,Blocks);
      ReadCursor:= MakePtr(Seg, DfltOffset, CurPatPtr);
   END
END { ReadCursor };


{=============================================================================}


PROCEDURE PutCursor(Pointer: CurPatPtr;
                         X : XRange;
                         Y : YRange);
BEGIN
   RasterOp(ROr, CursorWidth, CursorHeight, X, Y, SScreenW, SScreenP,
                                            Org, Org, 4, Pointer)
END { PutCursor };


{=============================================================================}


FUNCTION ReadFont(FileName: String): FontPtr;

VAR  Blocks, Bits, Seg : INTEGER;
                   FID : FileID;

BEGIN
   FID:= FSLookUp(FileName, Blocks, Bits);
   IF FID = NoFile THEN ReadFont:= NIL
   ELSE
   BEGIN
      CreateSegment(Seg, Blocks, DfltSizeInc, Blocks);
      MultiRead(FID, MakePtr(Seg, DfltOffset, pDirBlk), FirstBlock,Blocks);
      ReadFont:= MakePtr(Seg, DfltOffset, FontPtr);
   END;
END { ReadFont };


{#P}
{=============================================================================}
{                   Window Handling procedures:
{=============================================================================}


PROCEDURE SetWindow(WNo : WinRange; Op : INTEGER);  {******* Local to IOUtils }

VAR Height, Width, OrgX, OrgY : INTEGER;
                     HasTitle : BOOLEAN;
                      Current : WinRange;

BEGIN
   GetWindowParms(Current, OrgX, OrgY, Width, Height, HasTitle);
   ChangeWindow(WNo);
   GetWindowParms(WNo, OrgX, OrgY, Width, Height, HasTitle);
   RasterOp(Op, Width,    Height,
                OrgX,     OrgY,
                SScreenW, SScreenP,
                OrgX,     OrgY,
                SScreenW, SScreenP);
   ChangeWindow(Current);
END { SetWindow };


{=============================================================================}


PROCEDURE ClearWindow(WNo: WinRange);
BEGIN
   SetWindow(WNo, RXor);
END { ClearWindow };


{=============================================================================}


PROCEDURE InvertWindow(WNo: WinRange);
BEGIN
   SetWindow(WNo, RNot);
END { InvertWindow };


{=============================================================================}


PROCEDURE PaintWindow(WNo: WinRange);
BEGIN
   SetWindow(WNo, RXNor);
END { PaintWindow }.