home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / pq2iou.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  6KB  |  210 lines

  1. MODULE IOUtils;
  2.  
  3. {=============================================================================}
  4. {
  5. {  Module for various IO operations:     
  6. {
  7. {    -- Reading cursorpatterns and fontpatterns
  8. {    -- Clearing/blacking/inverting windows
  9. {
  10. {
  11. {  Author: Petter Hesselberg
  12. {
  13. {=============================================================================}
  14.  
  15. {=============================================================================}
  16. {
  17. {  Changelog:
  18. {          
  19. {  V2.0  19 Jul 83  P Hesselberg    ReadFont, PlaseCursor & Window routines
  20. {                                   work perfectly!
  21. {
  22. {  V1.0  19 Jul 83  P Hesselberg    ReadCursor on the air
  23. {
  24. {  V0.0  19 Jul 83  P Hesselberg    Started (as a cursor test program)
  25. {
  26. {=============================================================================}
  27.  
  28. {=============================================================================}
  29.                                 EXPORTS
  30. {=============================================================================}
  31.     
  32.  
  33. IMPORTS IO_Others   FROM IO_Others;
  34. IMPORTS Screen      FROM Screen;
  35. IMPORTS UtilDefs    FROM UtilDefs;
  36.    
  37.        
  38. {=============================================================================}
  39.  
  40.  
  41. FUNCTION ReadCursor(FileName : String): CurPatPtr; 
  42.  
  43.        { Abstract: Creates a segment in memory and fills it with the cursor
  44.                    definition from <FileName>. Returns a pointer to the 
  45.                    segment of type CurPatPtr defined in IO_Others.
  46.                    Returns NIL if file not found.                             }
  47.  
  48.  
  49. PROCEDURE PutCursor(Pointer : CurPatPtr;
  50.                           X : XRange;
  51.                           Y : YRange);
  52.  
  53.         { Abstract: Puts a copy of the cursor referenced by [Pointer]
  54.                     with upper left corner at coordinates (x, y)              }
  55.  
  56.  
  57. FUNCTION ReadFont(FileName: String): FontPtr;
  58.  
  59.        { Abstract: Creates a segment in memory and fills it with the font
  60.                    definition from <FileName>. Returns a pointer to the 
  61.                    segment of type FontPtr defined in Screen.                 }
  62.  
  63.  
  64. {=============================================================================}
  65.  
  66.  
  67. PROCEDURE ClearWindow(WNo: WinRange);
  68.  
  69.         { Abstract: Sets window [WNo] to white                                }
  70.  
  71.  
  72. PROCEDURE InvertWindow(WNo: WinRange);
  73.  
  74.         { Abstract: Inverts window [WNo]                                      }
  75.  
  76.  
  77. PROCEDURE PaintWindow(WNo: WinRange);
  78.  
  79.         { Abstract: Sets window [WNo] to black                                }
  80.  
  81.                                        
  82.  
  83. {#P}
  84. {=============================================================================}
  85.                                PRIVATE
  86. {=============================================================================}
  87.  
  88.     
  89. IMPORTS Memory      FROM Memory; 
  90. IMPORTS FileSystem  FROM FileSystem; 
  91. IMPORTS MultiRead   FROM MultiRead; 
  92. IMPORTS PERQ_String FROM PERQ_String; 
  93.  
  94. CONST  CursorWidth = 56;
  95.       CursorHeight = 64; 
  96.        DfltSizeInc = 1;
  97.         DfltOffset = 0;
  98.         FirstBlock = 0;
  99.             NoFile = 0;
  100.                Org = 0;
  101.       
  102.  
  103.  
  104. {=============================================================================}
  105. {                        Cursor & Font Routines:
  106. {=============================================================================}
  107.     
  108.  
  109. FUNCTION ReadCursor(FileName: String): CurPatPtr; 
  110.  
  111. VAR  Blocks, Bits, Seg : INTEGER;
  112.                    FID : FileID;
  113.                
  114. BEGIN
  115.    FID:= FSLookUp(FileName, Blocks, Bits); 
  116.    IF FID = NoFile THEN ReadCursor:= NIL 
  117.    ELSE
  118.    BEGIN 
  119.       CreateSegment(Seg, Blocks, DfltSizeInc, Blocks);
  120.       MultiRead(FID, MakePtr(Seg, DfltOffset, pDirBlk), FirstBlock,Blocks);
  121.       ReadCursor:= MakePtr(Seg, DfltOffset, CurPatPtr); 
  122.    END
  123. END { ReadCursor };
  124.  
  125.  
  126. {=============================================================================}
  127.               
  128.  
  129. PROCEDURE PutCursor(Pointer: CurPatPtr; 
  130.                          X : XRange;
  131.                          Y : YRange);
  132. BEGIN                                     
  133.    RasterOp(ROr, CursorWidth, CursorHeight, X, Y, SScreenW, SScreenP,
  134.                                             Org, Org, 4, Pointer)
  135. END { PutCursor };
  136.  
  137.  
  138. {=============================================================================}
  139.  
  140.  
  141. FUNCTION ReadFont(FileName: String): FontPtr;
  142.  
  143. VAR  Blocks, Bits, Seg : INTEGER;
  144.                    FID : FileID;
  145.                
  146. BEGIN
  147.    FID:= FSLookUp(FileName, Blocks, Bits); 
  148.    IF FID = NoFile THEN ReadFont:= NIL 
  149.    ELSE
  150.    BEGIN
  151.       CreateSegment(Seg, Blocks, DfltSizeInc, Blocks);
  152.       MultiRead(FID, MakePtr(Seg, DfltOffset, pDirBlk), FirstBlock,Blocks);
  153.       ReadFont:= MakePtr(Seg, DfltOffset, FontPtr); 
  154.    END;
  155. END { ReadFont };
  156.   
  157.  
  158. {#P}
  159. {=============================================================================}
  160. {                   Window Handling procedures:
  161. {=============================================================================}
  162.  
  163.  
  164. PROCEDURE SetWindow(WNo : WinRange; Op : INTEGER);  {******* Local to IOUtils }
  165.  
  166. VAR Height, Width, OrgX, OrgY : INTEGER;
  167.                      HasTitle : BOOLEAN;                     
  168.                       Current : WinRange;
  169.  
  170. BEGIN 
  171.    GetWindowParms(Current, OrgX, OrgY, Width, Height, HasTitle);
  172.    ChangeWindow(WNo);
  173.    GetWindowParms(WNo, OrgX, OrgY, Width, Height, HasTitle);
  174.    RasterOp(Op, Width,    Height,
  175.                 OrgX,     OrgY,
  176.                 SScreenW, SScreenP,
  177.                 OrgX,     OrgY,
  178.                 SScreenW, SScreenP);
  179.    ChangeWindow(Current);
  180. END { SetWindow };
  181.  
  182.  
  183. {=============================================================================}
  184.  
  185.  
  186. PROCEDURE ClearWindow(WNo: WinRange);
  187. BEGIN
  188.    SetWindow(WNo, RXor);
  189. END { ClearWindow };
  190.  
  191.  
  192. {=============================================================================}
  193.  
  194.  
  195. PROCEDURE InvertWindow(WNo: WinRange);
  196. BEGIN
  197.    SetWindow(WNo, RNot);
  198. END { InvertWindow };
  199.  
  200.  
  201. {=============================================================================}
  202.  
  203.  
  204. PROCEDURE PaintWindow(WNo: WinRange);
  205. BEGIN
  206.    SetWindow(WNo, RXNor);
  207. END { PaintWindow }.
  208.  
  209.  
  210.