home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 06_07 / snap / screenio.inc < prev    next >
Encoding:
Text File  |  1988-03-17  |  7.2 KB  |  285 lines
  1. (* ------------------------------------------------------ *)
  2. (*                  SCREENIO.INC                          *)
  3. (*  Speichern u. Laden des Bildschirm-RAM in allen Text-  *)
  4. (*  und Grafikmodi                                        *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. TYPE   name     = STRING[64];
  8.        feld     = ARRAY[0..11] OF BYTE;
  9.        Hscreen  = ARRAY[0..16383] OF BYTE;
  10.        font8x8  = ARRAY[CHAR, 0..7] OF BYTE;
  11.  
  12. CONST  grafik : BOOLEAN = FALSE;
  13.        Gdata  : feld    = ($35, $2d, $2e, $07, $5b, $02,
  14.                            $57, $57, $02, $03, $00, $00);
  15.        Tdata  : feld    = ($61, $50, $52, $0f, $19, $06,
  16.                            $19, $19, $02, $0d, $0b, $0c);
  17.  
  18. VAR saved, ConOut,
  19.     X_Pos, Y_Pos        : INTEGER;
  20.     Puffer              : ARRAY[0..32767] OF BYTE;
  21.     HercBase            : BYTE ABSOLUTE $B000:0000;
  22.     datei               : FILE;
  23.     font,  font1, font2 : ^font8x8;
  24.     screen              : ^Hscreen;
  25.  
  26. (* ------------------------------------------------------ *)
  27. FUNCTION get_modus (VAR seite : BYTE) : BYTE;
  28.  
  29. VAR regs : regs8088_ ;
  30.  
  31. BEGIN
  32.   regs.AH := $0f;
  33.   INTR($10, regs);
  34.   get_modus := regs.AL;
  35.   seite     := regs.BH;
  36. END;
  37.  
  38. (* ------------------------------------------------------ *)
  39. PROCEDURE set_modus (neu : BYTE);
  40.  
  41. VAR regs : regs8088_ ;
  42.  
  43. BEGIN
  44.   regs.AH := $00;
  45.   regs.AL := neu;
  46.   INTR($10, regs);
  47. END;
  48.  
  49. (* ------------------------------------------------------ *)
  50. PROCEDURE wo_cursor (VAR x, y : INTEGER);
  51.  
  52. VAR  Active_Page  : BYTE ABSOLUTE $0040:$0062;
  53.      Crt_Pages    : ARRAY[0..7]
  54.                     OF INTEGER ABSOLUTE $0040:$0050 ;
  55. BEGIN
  56.    x := Crt_Pages[active_page];
  57.    y := Hi(x) + 1;
  58.    x := Lo(x) + 1;
  59. END;
  60.  
  61. (* ------------------------------------------------------ *)
  62. FUNCTION ByteOffset (x, y : INTEGER) : INTEGER;
  63.  
  64. BEGIN
  65.   ByteOffset := (y AND $0003) SHL 13 + 90 * (y SHR 2)
  66.                 + (x SHR 3)
  67. END;
  68.  
  69. (* ------------------------------------------------------ *)
  70. PROCEDURE texttreiber (ch : CHAR);
  71.  
  72. VAR  I : INTEGER;
  73.   font : ^font8x8;
  74.  
  75. BEGIN
  76.   IF X_Pos=80 THEN BEGIN
  77.     X_Pos := 1;  Y_Pos := Y_Pos + 1;
  78.   END;
  79.   IF ch = #10 THEN BEGIN
  80.     X_Pos := 1;  Exit;
  81.   END;
  82.   IF ch = #13 THEN BEGIN
  83.     Y_Pos := Y_Pos + 1;  Exit;
  84.   END;
  85.   IF ch <= #127 THEN font := font1
  86.   ELSE BEGIN
  87.     font := font2;
  88.     ch := Chr( Ord(ch) - 128);
  89.   END;
  90.   FOR I := 0 TO 7 DO
  91.     screen^[ByteOffset( (X_Pos-1)*8, (Y_Pos-1)*14+I) ]
  92.            := font^[ch, I];
  93.   X_Pos := X_Pos + 1;
  94. END;
  95.  
  96. (* ------------------------------------------------------ *)
  97. PROCEDURE GraphMode;
  98.  
  99. VAR  I : INTEGER;
  100.  
  101. BEGIN
  102.   screen := Ptr($B000, $0000);
  103.   font1  := Ptr($f000, $fa6e);
  104.   font2  := Ptr(memW[0: $007e], memW[0: $007c] );
  105.   X_Pos := 1;   Y_Pos := 1;
  106.   grafik     := TRUE;
  107.   ConOut     := ConOutPtr;
  108.   ConOutPtr  := ofs(texttreiber);
  109.   Port[$3b8] := $02;
  110.   FOR I := 0 TO 11 DO BEGIN
  111.     Port[$3b4] := I;
  112.     Port[$3b5] := Gdata[I];
  113.   END;
  114.   FillChar(screen^, 32767, $0);
  115.   Port[$3bf] := $03;
  116.   Delay(100);
  117.   Port[$3b8]:=$02 OR $08;
  118. END;
  119.  
  120. (* ------------------------------------------------------ *)
  121. PROCEDURE TextMode;
  122.  
  123. VAR I : INTEGER;
  124.  
  125. BEGIN
  126.   screen := Ptr($B000, $0000);
  127.   font1  := Ptr($f000, $fa6e);
  128.   font2  := Ptr(memW[0: $007e], memW[0: $007c] );
  129.   X_Pos := 1;   Y_Pos := 1;
  130.   grafik     := FALSE;
  131.   ConOutPtr  :=ConOut;
  132.   Port[$3b8] := $20;
  133.   FOR I := 0 TO 11 DO BEGIN
  134.     Port[$3b4] := I;
  135.     Port[$3b5] := Tdata[I];
  136.   END;
  137.   FillChar(screen^, 2000, $0);
  138.   Port[$3bf] := $01;
  139.   Delay(100);
  140.   Port[$3b8] := $20 OR $08;
  141. END;
  142.  
  143. (* ------------------------------------------------------ *)
  144. PROCEDURE checkmode;     (* Check auf Grafikmodus der HGC *)
  145.  
  146. VAR sign : CHAR;
  147.  
  148. BEGIN
  149.   Write('okay (j/n) ? ');
  150.   Read(Kbd, sign);
  151.   IF sign = #27 THEN
  152.     IF grafik THEN TextMode ELSE GraphMode;
  153.   Move(Puffer[0], HercBase, 32767);
  154. END;
  155.  
  156. (* ------------------------------------------------------ *)
  157. PROCEDURE HercSave (DateiName : name);
  158.  
  159. CONST okay : BOOLEAN = FALSE;
  160.  
  161. BEGIN
  162.   REPEAT
  163.     Assign(datei, DateiName);
  164.     ReWrite(datei);
  165.     Move(HercBase, Puffer[0], 32767);
  166.     BlockWrite(datei, Puffer[0], 256, saved);
  167.     IF saved < 256 THEN Write(^G) ELSE okay := TRUE;
  168.     Flush(datei);
  169.     Close(datei);
  170.   UNTIL okay;
  171. END;
  172.  
  173. (* ------------------------------------------------------ *)
  174. PROCEDURE HercLoad (DateiName : name);
  175.  
  176. VAR   ch   : CHAR;
  177.  
  178. BEGIN
  179.   Assign(datei, DateiName);  ReSet(datei);
  180.   BlockRead(datei, Puffer[0], 256, saved);
  181.   Move(Puffer[0], HercBase, 32767);
  182.   Close(datei);
  183. END;
  184.  
  185. (* ------------------------------------------------------ *)
  186. (* CGA Routinen                                           *)
  187. (* ------------------------------------------------------ *)
  188.  
  189. VAR CgaBase         : BYTE ABSOLUTE $B800:0000;
  190.     modus, seite    : BYTE;
  191.  
  192. PROCEDURE set_seite (seite : BYTE);
  193. VAR regs : regs8088_ ;
  194. BEGIN
  195.   regs.AH := $05;
  196.   regs.AL := seite;
  197.   INTR($10, regs);
  198. END;
  199.  
  200. PROCEDURE CgaSave (DateiName : name);
  201. CONST okay : BOOLEAN = FALSE;
  202. BEGIN
  203.   modus := get_modus(seite);
  204.   REPEAT
  205.     Assign(datei, DateiName);
  206.     ReWrite(datei);
  207.     Move(CgaBase, Puffer[0], 16383);
  208.     Puffer[16500] := modus;
  209.     Puffer[16501] := seite;
  210.     BlockWrite(datei, Puffer[0], 129, saved);
  211.     IF saved < 129 THEN Write(^G) ELSE okay := TRUE;
  212.     Flush(datei);
  213.     Close(datei);
  214.   UNTIL okay;
  215. END;
  216.  
  217. PROCEDURE CgaLoad (DateiName : name);
  218. VAR regs : regs8088_ ;
  219. BEGIN
  220.   Assign(datei, DateiName);  ReSet(datei);
  221.   BlockRead(datei, Puffer[0], 129, saved);
  222.   modus := Puffer[16500];
  223.   seite := Puffer[16501];
  224.   set_modus(modus);
  225.   set_seite(seite);
  226.   Move(Puffer[0], CgaBase, 16383);
  227.   Close(datei);
  228. END;
  229.  
  230. (* ------------------------------------------------------ *)
  231. (* EGA Routinen                                           *)
  232. (* ------------------------------------------------------ *)
  233.  
  234. VAR  EgaBase      : BYTE ABSOLUTE $A000:0000;
  235.  
  236. PROCEDURE EgaScreen ( nr : INTEGER);
  237. VAR  regs : regs8088_ ;
  238. BEGIN
  239.   nr := nr AND 1;
  240.   regs.AX := $0500 + nr;
  241.   INTR($10, regs);
  242. END;
  243.  
  244. PROCEDURE EgaSave (DateiName : name);
  245. CONST okay : BOOLEAN = FALSE;
  246. VAR      I : INTEGER;
  247. BEGIN
  248.   REPEAT
  249.     modus := get_modus(seite);
  250.     Puffer[0] := modus;
  251.     Assign(datei, DateiName);
  252.     ReWrite(datei);
  253.     BlockWrite(datei, Puffer[0], 1, saved);
  254.     FOR I := 0 TO 3 DO BEGIN
  255.       Port[$03ce] := 4;
  256.       Port[$03cf] := I AND 3;
  257.       Move(EgaBase, Puffer[0], 28000);
  258.       BlockWrite(datei, Puffer[0], 219, saved);
  259.       IF saved < 219 THEN Write(^G) ELSE okay := TRUE;
  260.       Flush(datei);
  261.     END;
  262.     Close(datei);
  263.   UNTIL okay;
  264. END;
  265.  
  266. PROCEDURE EgaLoad (DateiName : name);
  267. VAR regs : regs8088_ ;
  268.     I    : INTEGER;
  269. BEGIN
  270.   EgaScreen(0);
  271.   Assign(datei, DateiName);  ReSet(datei);
  272.   BlockRead(datei, Puffer[0], 1, saved);
  273.   modus := Puffer[0];
  274.   set_modus(modus);
  275.   FOR I := 0 TO 3 DO BEGIN
  276.     Port[$03c4] := $02;
  277.     Port[$03c5] := (1 SHL I);
  278.     BlockRead(datei, Puffer[0], 219, saved);
  279.     Move(Puffer[0], EgaBase, 28000);
  280.   END;
  281.   Close(datei);
  282. END;
  283. (* ------------------------------------------------------ *)
  284. (*                Ende von SCREENIO.INC                   *)
  285.