home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 07 / fastscr.inc next >
Encoding:
Text File  |  1987-06-10  |  4.8 KB  |  203 lines

  1. (*-------------------------------------------------------------------------*)
  2. (*                             FASTSCR.INC                                 *)
  3. (*  beschleunigter Bildschirmaufbau fuer Trubo-Pascal auf IBM-Kompatible   *)
  4. (*-------------------------------------------------------------------------*)
  5.  
  6. CONST
  7.   ScreenBaseAdress = $B800;      (* Segmentadresse des Bildschirmspeichers *)
  8.   ScrSize          = 2048;       (* muss wg. BLOCKWRITE u. -READ ein Viel- *)
  9.                                  (* faches von 128 sein !!!!!!!!!!!!!!!!!! *)
  10.  
  11. TYPE
  12.   strng = STRING [255];
  13.  
  14. VAR
  15.   ScrBuf : ARRAY [1..ScrSize,1..2] OF CHAR;  (* Fuer Bild-Blitzanimationen *)
  16.   Screen : ARRAY [1..ScrSize,1..2] OF CHAR ABSOLUTE ScreenBaseAdress:$0000;
  17.   ScrFil : FILE ;
  18.  
  19. (*-------------------------------------------------------------------------*)
  20.  
  21. PROCEDURE Stop;
  22.  
  23. VAR Break: CHAR;
  24.  
  25. BEGIN
  26.   Read(Kbd, Break);
  27.   IF Break = #19 THEN Read(Kbd, Break);
  28.   IF Break = #03 THEN Halt;
  29. END ;
  30.  
  31. (*-------------------------------------------------------------------------*)
  32.  
  33. PROCEDURE ClearScreen;
  34.  
  35. BEGIN
  36.   ClrScr;  Move(Screen, ScrBuf, 4000);
  37. END;
  38.  
  39. (*-------------------------------------------------------------------------*)
  40.  
  41. FUNCTION ReadScreen (PosX, PosY, Len: INTEGER): strng;
  42.  
  43. VAR count: INTEGER;
  44.     temp : strng;
  45.  
  46. BEGIN
  47.   PosX := PosX + Pred(PosY) * 80 - 1;
  48.   temp := ' ';
  49.   FOR count := 1 TO Len DO
  50.     temp := temp + Screen[PosX+count,1];
  51.   ReadScreen := temp;
  52. END ;
  53.  
  54. (*-------------------------------------------------------------------------*)
  55.  
  56. PROCEDURE WriteScrBuf (PosX, PosY: INTEGER; Puffer: strng);
  57.  
  58. VAR count: INTEGER ;
  59.     Len  : BYTE;
  60.  
  61. BEGIN
  62.   PosX := PosX + Pred(PosY) * 80 - 1;
  63.   Move(Puffer[0], Len, 1);
  64.   FOR count := 1 TO Len DO
  65.     ScrBuf[PosX+count,1] := Puffer[count];
  66.   IF KeyPressed THEN Stop;
  67. END;
  68.  
  69. (*-------------------------------------------------------------------------*)
  70.  
  71. PROCEDURE WriteScr (PosX, PosY: INTEGER; Puffer: strng);
  72.  
  73. VAR count: INTEGER;
  74.     Len  : BYTE;
  75.  
  76. BEGIN
  77.   PosX := PosX + Pred(PosY) * 80 - 1;
  78.   Move(Puffer[0], Len, 1);
  79.   FOR count := 1 TO Len DO
  80.     Screen[PosX+count,1] := Puffer[count];
  81.   IF KeyPressed THEN Stop;
  82. END;
  83.  
  84. (*-------------------------------------------------------------------------*)
  85.  
  86. PROCEDURE WriteScrCol (PosX, PosY, Farbe: INTEGER; Puffer: strng);
  87.  
  88. VAR count: INTEGER;
  89.     Color: CHAR;
  90.     Len  : BYTE;
  91.  
  92. BEGIN
  93.   Color := Chr(Farbe);
  94.   PosX  := PosX + Pred(PosY) * 80 - 1;
  95.   Move(Puffer[0], Len, 1);
  96.   FOR count := 1 TO Len DO
  97.     BEGIN
  98.       Screen[PosX+count,1] := Puffer[count];
  99.       Screen[PosX+count,2] := Color;
  100.     END;
  101.   IF KeyPressed THEN Stop;
  102. END;
  103.  
  104. (*-------------------------------------------------------------------------*)
  105.  
  106. PROCEDURE ColorScreen (PosX, PosY, Farbe, Len: INTEGER);
  107.  
  108. VAR count: INTEGER;
  109.     Color: CHAR;
  110.  
  111. BEGIN
  112.   Color := Chr(Farbe);
  113.   PosX  := PosX + Pred(PosY) * 80 - 1;
  114.   FOR count := 1 TO Len DO
  115.     Screen[PosX+count,2] := Color;
  116.   IF KeyPressed THEN Stop;
  117. END;
  118.  
  119. (*-------------------------------------------------------------------------*)
  120.  
  121. PROCEDURE ShowScreen;
  122.  
  123. BEGIN
  124.   Move(ScrBuf, Screen, 4000);
  125.   IF KeyPressed THEN Stop;
  126. END;
  127.  
  128. (*-------------------------------------------------------------------------*)
  129.  
  130. PROCEDURE BufScreen;
  131.  
  132. BEGIN
  133.   Move(Screen, ScrBuf, 4000);
  134. END;
  135.  
  136. (*-------------------------------------------------------------------------*)
  137.  
  138. FUNCTION SaveScreen (Name: strng): BOOLEAN;
  139.  
  140. VAR Anzahl: INTEGER;
  141.  
  142. BEGIN
  143.   Anzahl := 0;
  144.   Assign(ScrFil, Name);
  145.   ReWrite(ScrFil);
  146.   BlockWrite(ScrFil, Screen, 32, Anzahl);
  147.   Close(ScrFil);
  148.   SaveScreen := (Anzahl = 32);
  149. END;
  150.  
  151. (*-------------------------------------------------------------------------*)
  152.  
  153. FUNCTION LoadScreen (Name: strng): BOOLEAN;
  154.  
  155. VAR Anzahl: INTEGER;
  156.  
  157. BEGIN
  158.   Anzahl := 0;
  159.   Assign(ScrFil, Name);
  160.   (*$I-*)
  161.   ReSet(ScrFil);
  162.   (*$I+*)
  163.   IF IOResult = 0 THEN
  164.     BlockRead(ScrFil, Screen, 32, Anzahl);
  165.   Close(ScrFil);
  166.   LoadScreen := (Anzahl = 32);
  167. END;
  168.  
  169. (*-------------------------------------------------------------------------*)
  170.  
  171. FUNCTION SaveScrBuf (Name: strng): BOOLEAN;
  172.  
  173. VAR Anzahl: INTEGER;
  174.  
  175. BEGIN
  176.   Anzahl := 0;
  177.   Assign(ScrFil, Name);
  178.   ReWrite(ScrFil);
  179.   BlockWrite(ScrFil, ScrBuf, 32, Anzahl);
  180.   SaveScrBuf := (Anzahl = 32);
  181. END;
  182.  
  183. (*-------------------------------------------------------------------------*)
  184.  
  185. FUNCTION LoadScrBuf (Name: strng): BOOLEAN;
  186.  
  187. VAR Anzahl: INTEGER;
  188.  
  189. BEGIN
  190.   Anzahl := 0;
  191.   Assign(ScrFil, Name);
  192.   (*$I-*)
  193.   ReSet(ScrFil);
  194.   (*$I+*)
  195.   IF IOResult = 0 THEN
  196.     BlockRead(ScrFil, ScrBuf, 32, Anzahl);
  197.   Close(ScrFil);
  198.   LoadScrBuf := (Anzahl = 32);
  199. END;
  200.  
  201. (*-------------------------------------------------------------------------*)
  202. (*                      Ende von FASTSCR.INC                               *)
  203.