home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / tricks / graphm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-10  |  4.7 KB  |  177 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    GRAPHM.PAS                          *)
  3. (*          Erweiterung der Standardunit Graph            *)
  4. (*           (C) 1989 Markus Meyer & TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. UNIT GraphM;
  7.  
  8. INTERFACE
  9.  
  10. USES Graph, Crt;
  11.  
  12. TYPE
  13.   strng40 = STRING[40];
  14.  
  15. PROCEDURE save_screen  (Name   : strng40; Nummer : INTEGER);
  16. PROCEDURE load_screen  (Name   : strng40; Nummer : INTEGER);
  17. PROCEDURE copy_screen  (Nummer : INTEGER);
  18. PROCEDURE clear_screen (Nummer : INTEGER);
  19. PROCEDURE invert_screen(Nummer : INTEGER);
  20. PROCEDURE swap_screen  (Zeit   : INTEGER);
  21.  
  22. IMPLEMENTATION
  23.  
  24. CONST
  25.   GABase = $B000; { Startadresse (Hercules) }
  26.   Size   = 32765; { Länge des Bildschirms }
  27.   SizeP  = 32768; { Zweiter Bildschirm = Erster Bildschirm }
  28.  
  29. VAR
  30.   PufferA : ARRAY [0..Size] OF BYTE ABSOLUTE GABase : 0000;
  31.   PufferB : ARRAY [0..Size] OF BYTE ABSOLUTE GABase : SizeP;
  32.  
  33.   FUNCTION Exist(DateiN : strng40) : BOOLEAN;
  34.   VAR
  35.     Datei : FILE;
  36.   BEGIN
  37.     Assign(Datei, DateiN);
  38.     {$I-}
  39.     Reset(Datei);
  40.     {$I+}
  41.     Exist := (IOResult = 0);
  42.   END;
  43.  
  44.   PROCEDURE PError(Nummer : BYTE);
  45.   BEGIN
  46.     CloseGraph;
  47.     ClrScr;
  48.     GotoXY(5,5);
  49.     Write ( ' -> Graph-Plus Error ' );
  50.     GotoXY(9,7);
  51.     CASE Nummer OF
  52.       1 : Write ('Disk full');
  53.       2 : Write ('Invlid file name');
  54.       3 : Write ('Wrong file Size');
  55.       4 : Write ('Illegal Page number');
  56.     END; {case}
  57.     Write(' : ERROR');
  58.     WriteLn;
  59.     Halt;
  60.   END;
  61.  
  62.   PROCEDURE Save_Screen(Name : strng40; Nummer : INTEGER);
  63.   VAR
  64.     D_Read  : WORD;
  65.     D_Write : WORD;
  66.     Datei   : FILE;
  67.   BEGIN
  68.     IF (Nummer <> 0) AND (Nummer <> 1) THEN PError(4);
  69.     Assign(Datei, Name);
  70.     Rewrite(Datei, 1);
  71.     D_Read := Size;
  72.     IF Nummer = 1 THEN
  73.       BlockWrite(Datei, PufferB[0], D_Read, D_Write)
  74.     ELSE
  75.       BlockWrite(Datei, PufferA[0], D_Read, D_Write);
  76.     Close(Datei);
  77.     IF D_Read <> D_Write THEN PError(1);
  78.   END;
  79.  
  80.   PROCEDURE Load_Screen(Name : strng40; Nummer : INTEGER);
  81.   VAR
  82.     D_Read  : WORD;
  83.     D_Write : WORD;
  84.     Datei   : FILE;
  85.   BEGIN
  86.     IF (Nummer <> 0) AND (Nummer <> 1) THEN PError(4);
  87.     Assign(Datei, Name);
  88.     IF Exist (Name) THEN BEGIN
  89.       Reset(Datei,1);
  90.       D_Write := Size;
  91.       IF Nummer = 1 THEN
  92.         BlockRead(Datei, PufferB[0], D_Write, D_Read)
  93.       ELSE
  94.         BlockRead(Datei, PufferA[0], D_Write, D_Read);
  95.       Close(Datei);
  96.       IF D_Read <> D_Write THEN PError(3);
  97.     END ELSE PError(2);
  98.   END;
  99.  
  100.   PROCEDURE Copy_Screen(Nummer : INTEGER);
  101.   BEGIN
  102.     IF (Nummer <> 0) AND (Nummer <> 1) THEN PError(4);
  103.     CASE Nummer OF
  104.       0 : Move (PufferA[0], PufferB[0], Size);
  105.       1 : Move (PufferB[0], PufferA[0], Size);
  106.     END;
  107.   END;
  108.  
  109.   PROCEDURE Clear_Screen(Nummer : INTEGER);
  110.   BEGIN
  111.     IF (Nummer <> 0) AND (Nummer <> 1) THEN PError(4);
  112.     CASE Nummer OF
  113.       0 : FillChar(PufferA[0], Size, #0);
  114.       1 : FillChar(PufferB[0], Size, #0);
  115.     END;
  116.   END;
  117.  
  118.   PROCEDURE Invert_Screen(Nummer : INTEGER);
  119.   VAR
  120.     count : WORD;
  121.   BEGIN
  122.     IF (Nummer <> 0) AND (Nummer <> 1) THEN PError(4);
  123.     CASE Nummer OF
  124.       0 : BEGIN
  125.             FOR count := 0 TO Size DO
  126.               PufferA[count] := NOT (PufferA[count]);
  127.           END;
  128.       1 : BEGIN
  129.             FOR count := 0 TO Size DO
  130.               PufferB[count] := NOT (PufferB[count]);
  131.           END;
  132.     END;
  133.   END;
  134.  
  135.   PROCEDURE Swap_Screen(Zeit : INTEGER);
  136.   CONST
  137.     buffer  = 6000;
  138.   VAR
  139.     count   : WORD;
  140.     puffer  : BYTE;
  141.     wait    : BYTE;
  142.     len     : INTEGER;
  143.     ende    : BOOLEAN;
  144.     PufferM : ARRAY[0..buffer] OF BYTE;
  145.   BEGIN
  146.     IF (Zeit > 10) OR (Zeit < 0) THEN Zeit := 10;
  147.     IF Zeit <> 0 THEN BEGIN
  148.       FOR count := 0 TO Size DO BEGIN
  149.         puffer := PufferA[count];
  150.         PufferA[count] := PufferB[count];
  151.         PufferB[count] := puffer;
  152.         FOR wait := 0 TO Zeit DO BEGIN END;
  153.       END;
  154.     END ELSE BEGIN
  155.       count := 0;
  156.       ende := FALSE;
  157.       REPEAT
  158.         IF count < Size-buffer THEN BEGIN
  159.           Move(PufferA[count], PufferM[0], buffer);
  160.           Move(PufferB[count], PufferA[count], buffer);
  161.           Move(PufferM[0], PufferB[count], buffer);
  162.         END ELSE BEGIN
  163.           Move(PufferA[count], PufferM[0], buffer);
  164.           Move(PufferB[count], PufferA[count], buffer);
  165.           Move(PufferM[0], PufferB[count], Size-count);
  166.           ende := TRUE;
  167.         END;
  168.         count := count+buffer
  169.       UNTIL ende;
  170.     END;
  171.   END;
  172.  
  173. BEGIN
  174. END.
  175. (* ------------------------------------------------------ *)
  176. (*                 Ende von GRAPHM.PAS                    *)
  177.