home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / vgakit / util / svga.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-10-09  |  18.1 KB  |  740 lines
  1.  
  2. UNIT SVGA;
  3. {$F+}
  4.  
  5. INTERFACE
  6.  
  7.  
  8. USES DOS;
  9.  
  10.  
  11. TYPE  COLORVALUE    = RECORD R,G,B : BYTE END;
  12.       VGAPALETTETYP = ARRAY[0..255] OF COLORVALUE;
  13.  
  14. CONST MINX    : WORD = 0;
  15.       MAXX    : WORD = 319;
  16.       XWID    : WORD = 320;
  17.  
  18.       MINY    : WORD = 0;
  19.       MAXY    : WORD = 199;
  20.       YWID    : WORD = 200;
  21.  
  22.       SEGP    : WORD = $3CD; { PORTADRESSE FÜR VIDEO- RAM- SEGMENT }
  23.  
  24.   CRTC = $3D4;
  25.   SEQ  = $3C4;
  26.   GDC  = $3CE;
  27.   ISTA = $3DA;
  28.   DMC  = $3D8;
  29.  
  30. CONST USEET4000      : BOOLEAN = FALSE;
  31.       FASTSETPALETTE : BOOLEAN = TRUE;
  32.  
  33.  
  34. VAR   VMOD    : BYTE;
  35.       CHRHIG  : BYTE;
  36.  
  37.  
  38. FUNCTION  CHECKVGA(MODE:BYTE):INTEGER;
  39. FUNCTION  GETATC(IDX:BYTE):BYTE;
  40. PROCEDURE SETATC(IDX,DATA:BYTE);
  41. PROCEDURE VGASETPALETTE(VAR P : VGAPALETTETYP; START,STOP : BYTE);
  42. PROCEDURE VGAGETPALETTE(VAR P : VGAPALETTETYP);
  43. PROCEDURE VERLAUF(VAR P:VGAPALETTETYP;F1,R1,G1,B1,F2,R2,G2,B2:BYTE);
  44. PROCEDURE SETSEG(NR:BYTE);
  45. PROCEDURE SETSEGS(RD,WR:BYTE);
  46. PROCEDURE MOVSEG(VON,NACH:BYTE);
  47. PROCEDURE HIFILL(VON:LONGINT;WID:WORD;FILL:CHAR);
  48. PROCEDURE HIMOVE(VON,BIS:LONGINT;WID:WORD);
  49. PROCEDURE RAMTOVGA(VON:POINTER;BIS:LONGINT;WID:WORD);
  50. PROCEDURE VGATORAM(VON:POINTER;BIS:LONGINT;WID:WORD);
  51. FUNCTION  GETPIXEL(X,Y:WORD):BYTE;
  52. PROCEDURE PLOT(X,Y:WORD;FARBE:BYTE);
  53. PROCEDURE XPLOT(X,Y:WORD;FARBE:BYTE);
  54. PROCEDURE OVERSCAN(FARBE:BYTE);
  55. PROCEDURE ROTIERE(VAR PAL:VGAPALETTETYP;VON,BIS:BYTE;RUECKWAERTS:BOOLEAN);
  56. PROCEDURE ABBLENDEN(VAR PAL:VGAPALETTETYP;STUFEN:WORD;AB:BOOLEAN);
  57.  
  58. PROCEDURE SET320X200;
  59. PROCEDURE SET640X350;
  60. PROCEDURE SET640X400;
  61. PROCEDURE SET640X480;
  62. PROCEDURE SET800X600;
  63. PROCEDURE SET1024X768;
  64.  
  65. PROCEDURE SETFONT(HIG:BYTE);
  66. PROCEDURE WRITECHAR(CHR:CHAR;X,Y:WORD;FARBE:BYTE);
  67. PROCEDURE WRITEFGBG(CHR:CHAR;X,Y:WORD;FG,BG:BYTE);
  68. PROCEDURE XORWRITE(CHR:CHAR;X,Y:WORD;FG,BG:BYTE);
  69. PROCEDURE XORTEXT(X,Y:WORD;FG,BG:BYTE;TXT:STRING);
  70. PROCEDURE FGBGTEXT(X,Y:WORD;FG,BG:BYTE;TXT:STRING);
  71. PROCEDURE GRAPHTEXT(X,Y:WORD;FARBE:BYTE;TXT:STRING);
  72. PROCEDURE DOPPTEXT(X,Y:WORD;FARBE:BYTE;TXT:STRING);
  73.  
  74. PROCEDURE STI;   INLINE($FB);
  75. PROCEDURE CLI;   INLINE($FA);
  76.  
  77. {
  78.   VSYNCH UND HSYNCH SIND NICHT FÜR MDA / HERCULES GEEIGNET !
  79.   DAFÜR MUß PORTADRESSE 3BAH VERWANDT WERDEN
  80. }
  81. PROCEDURE HSYNCH;
  82. INLINE($BA/$3DA/  {        MOV  DX,3DAH }
  83.        $EC/       { LOOP1: IN   AL,DX   }
  84.        $A8/1/     {        TEST AL,1    }
  85.        $75/$FB/   {        JNZ  LOOP1   }
  86.        $EC/       { LOOP2: IN   AL,DX   }
  87.        $A8/1/     {        TEST AL,1    }
  88.        $74/$FB    {        JZ   LOOP2   }
  89.       );
  90.  
  91.  
  92. PROCEDURE VSYNCH;
  93. INLINE($BA/$3DA/  {        MOV  DX,3DAH }
  94.        $EC/       { LOOP1: IN   AL,DX   }
  95.        $A8/8/     {        TEST AL,8    }
  96.        $75/$FB/   {        JNZ  LOOP1   }
  97.        $EC/       { LOOP2: IN   AL,DX   }
  98.        $A8/8/     {        TEST AL,8    }
  99.        $74/$FB    {        JZ   LOOP2   }
  100.       );
  101.  
  102.  
  103. IMPLEMENTATION
  104.  
  105.  
  106. TYPE  VADDR = RECORD
  107.         A    : WORD;
  108.         S    : BYTE;
  109.         DUM  : BYTE;
  110.       END;
  111.  
  112.       BYTEARRAY = ARRAY[0..1] OF BYTE;
  113.       BYTEARRP  = ^BYTEARRAY;
  114.  
  115.  
  116. CONST BITMSK  : ARRAY[0..7] OF BYTE = ($80,$40,$20,$10,8,4,2,1);
  117.       BITMSK1 : ARRAY[0..7] OF BYTE = (1,2,4,8,$10,$20,$40,$80);
  118.  
  119.  
  120. VAR   AS    : BYTE;
  121.       VA    : LONGINT;           { VIDEO- ADRESSE }
  122.       V     : VADDR ABSOLUTE VA; { V.S = SEGMENT- ADRESSE }
  123.  
  124.       CHSP  : BYTEARRP;
  125.  
  126.  
  127. { SEGMENT DER VGA- KARTE FÜR LESEN UND SCHREIBEN SETZEN }
  128. PROCEDURE SETSEG(NR:BYTE);
  129. BEGIN
  130.   AS := NR;
  131.   IF USEET4000 THEN BEGIN
  132.     PORT[SEGP] := (NR SHL 4) + NR;
  133.   END ELSE BEGIN
  134.     PORT[SEGP] := (NR * 9) OR $40;
  135.   END;
  136. (*
  137.   IF USEET4000 THEN BEGIN
  138.     PORT[SEGP] := (NR AND $0F) SHL 4 + (NR AND $0F);
  139.   END ELSE BEGIN
  140.     PORT[SEGP] := ((NR AND $07) SHL 3 + (NR AND $07)) OR $40;
  141.   END;
  142. *)
  143. END; { SETSEG }
  144.  
  145.  
  146. { UNTERSCHIEDLICHE SEGMENTE DER VGA- KARTE FÜR LESEN UND SCHREIBEN SETZEN }
  147. PROCEDURE SETSEGS(RD,WR:BYTE);
  148. BEGIN
  149.   IF USEET4000 THEN BEGIN
  150.     PORT[SEGP] := (RD AND $0F) SHL 4 + (WR AND $0F);
  151.   END ELSE BEGIN
  152.     PORT[SEGP] := ((RD AND $07) SHL 3 + (WR AND $07)) OR $40;
  153.   END;
  154. END; { SETSEGS }
  155.  
  156.  
  157. { EINEN BILDSCHIRMINHALT VON VIDEORAM SEGMENT VON
  158.   NACH SEGMENT NACH KOPIEREN - HIGHSPEED }
  159. PROCEDURE MOVSEG(VON,NACH:BYTE);
  160. VAR   I  : WORD;
  161. BEGIN
  162.   IF USEET4000 THEN BEGIN
  163.     PORT[SEGP] := (VON AND $0F) SHL 4 + (NACH AND $0F);
  164.   END ELSE BEGIN
  165.     PORT[SEGP] := ((VON AND $07) SHL 3 + (NACH AND $07)) OR $40;
  166.   END;
  167.   MOVE(MEM[$A000:0],MEM[$A000:0],65535);
  168.   MEM[$A000:$FFFF] := MEM[$A000:$FFFF];
  169.   SETSEG(0);
  170. END; { MOVSEG }
  171.  
  172.  
  173. PROCEDURE HIFILL(VON:LONGINT;WID:WORD;FILL:CHAR);
  174. VAR   BIS  : LONGINT;
  175.       J,K  : WORD;
  176. BEGIN
  177.   SETSEG(VADDR(VON).S);
  178.   BIS := VON + LONGINT(WID);
  179.   IF VADDR(VON).S = VADDR(BIS).S THEN BEGIN
  180.     FILLCHAR(MEM[$A000:VON],WID,FILL);
  181.   END ELSE BEGIN
  182.     J := VADDR(BIS).A;
  183.     K := WID - J;
  184.     FILLCHAR(MEM[$A000:VON],K,FILL);
  185.     SETSEG(VADDR(BIS).S);
  186.     FILLCHAR(MEM[$A000:0],J,FILL);
  187.   END;
  188. END; { HIFILL }
  189.  
  190.  
  191. PROCEDURE HIMOVE(VON,BIS:LONGINT;WID:WORD);
  192. VAR   BUF    : ARRAY[0..1023] OF BYTE;
  193.       J,K    : WORD;
  194.       V2,B2  : LONGINT;
  195. BEGIN
  196.   V2 := VON + LONGINT(WID);
  197.   B2 := BIS + LONGINT(WID);
  198.  
  199.   SETSEG(VADDR(VON).S);
  200.   IF VADDR(VON).S <> VADDR(V2).S THEN BEGIN
  201.     J := VADDR(V2).A;
  202.     K := WID - J;
  203.     MOVE(MEM[$A000:VON],BUF,K);
  204.     SETSEG(VADDR(V2).S);
  205.     MOVE(MEM[$A000:0],BUF[K],J);
  206.   END ELSE BEGIN
  207.     IF (AS = VADDR(BIS).S) AND (AS = VADDR(B2).S) THEN BEGIN
  208.       MOVE(MEM[$A000:VON],MEM[$A000:BIS],WID);
  209.       EXIT;
  210.     END;
  211.     MOVE(MEM[$A000:VON],BUF,WID);
  212.   END;
  213.  
  214.   SETSEG(VADDR(BIS).S);
  215.   IF VADDR(BIS).S = VADDR(B2).S THEN BEGIN
  216.     MOVE(BUF,MEM[$A000:BIS],WID);
  217.   END ELSE BEGIN
  218.     J := VADDR(B2).A;
  219.     K := WID - J;
  220.     MOVE(BUF,MEM[$A000:BIS],K);
  221.     SETSEG(VADDR(B2).S);
  222.     MOVE(BUF[K],MEM[$A000:0],J);
  223.   END;
  224. END; { HIMOVE }
  225.  
  226.  
  227. PROCEDURE RAMTOVGA(VON:POINTER;BIS:LONGINT;WID:WORD);
  228. TYPE  SOF    = RECORD O,S : WORD; END;
  229. VAR   J,K    : WORD;
  230.       B2     : LONGINT;
  231.       V2     : POINTER;
  232. BEGIN
  233.   B2 := BIS + LONGINT(WID);
  234.  
  235.   SETSEG(VADDR(BIS).S);
  236.   IF VADDR(BIS).S = VADDR(B2).S THEN BEGIN
  237.     MOVE(VON^,MEM[$A000:BIS],WID);
  238.   END ELSE BEGIN
  239.     J := VADDR(B2).A;
  240.     K := WID - J;
  241.     MOVE(VON^,MEM[$A000:BIS],K);
  242.     SETSEG(VADDR(B2).S);
  243.     V2 := VON; INC(SOF(V2).O,K);
  244.     MOVE(V2^,MEM[$A000:0],J);
  245.   END;
  246. END; { RAMTOVGA }
  247.  
  248.  
  249. PROCEDURE VGATORAM(VON:POINTER;BIS:LONGINT;WID:WORD);
  250. TYPE  SOF    = RECORD O,S : WORD; END;
  251. VAR   J,K    : WORD;
  252.       B2     : LONGINT;
  253.       V2     : POINTER;
  254. BEGIN
  255.   B2 := BIS + LONGINT(WID);
  256.  
  257.   SETSEG(VADDR(BIS).S);
  258.   IF VADDR(BIS).S = VADDR(B2).S THEN BEGIN
  259.     MOVE(MEM[$A000:BIS],VON^,WID);
  260.   END ELSE BEGIN
  261.     J := VADDR(B2).A;
  262.     K := WID - J;
  263.     MOVE(MEM[$A000:BIS],VON^,K);
  264.     SETSEG(VADDR(B2).S);
  265.     V2 := VON; INC(SOF(V2).O,K);
  266.     MOVE(MEM[$A000:0],V2^,J);
  267.   END;
  268. END; { VGATORAM }
  269.  
  270.  
  271. FUNCTION GETPIXEL(X,Y:WORD):BYTE;
  272. BEGIN
  273.   INLINE($A1/XWID/     {     MOV AX,[XWID] }
  274.          $8B/$9E/Y/    {     MOV BX,[BP+Y] }
  275.          $F7/$E3/      {     MUL BX        }
  276.          $03/$86/X/    {     ADD AX,[BP+X] }
  277.          $73/$01/      {     JNC L1        }
  278.          $42/          { L1: INC DX        }
  279.          $A3/VA/       {     MOV [VA],AX   }
  280.          $89/$16/VA+2  {     MOV [VA+2],DX }
  281.         );
  282.   IF V.S <> AS THEN SETSEG(V.S);
  283.   INLINE($B8/$A000/    { MOV AX,A000       }
  284.          $8E/$C0/      { MOV ES,AX         }
  285.          $8B/$3E/VA/   { MOV DI,[VA]       }
  286.          $26/$8A/$05/  { MOV AL,ES:[DI]    }
  287.          $88/$46/$FF   { MOV [BP-1],AL     }
  288.         );
  289. END; { GETPIXEL }
  290.  
  291.  
  292. PROCEDURE PLOT(X,Y:WORD;FARBE:BYTE);
  293. BEGIN
  294.   INLINE($A1/XWID/     {     MOV AX,[XWID] }
  295.          $8B/$9E/Y/    {     MOV BX,[BP+Y] }
  296.          $F7/$E3/      {     MUL BX        }
  297.          $03/$86/X/    {     ADD AX,[BP+X] }
  298.          $73/$01/      {     JNC L1        }
  299.          $42/          { L1: INC DX        }
  300.          $A3/VA/       {     MOV [VA],AX   }
  301.          $89/$16/VA+2  {     MOV [VA+2],DX }
  302.         );
  303.   IF V.S <> AS THEN SETSEG(V.S);
  304.   INLINE($B8/$A000/    { MOV AX,A000       }
  305.          $8E/$C0/      { MOV ES,AX         }
  306.          $8B/$3E/VA/   { MOV DI,[VA]       }
  307.          $8A/$86/FARBE/{ MOV AL,[BP+FARBE] }
  308.          $26/$88/$05   { MOV ES:[DI],AL    }
  309.         );
  310. END; { PLOT }
  311.  
  312.  
  313. PROCEDURE XPLOT(X,Y:WORD;FARBE:BYTE);
  314. BEGIN
  315.   INLINE($A1/XWID/     {     MOV AX,[XWID] }
  316.          $8B/$9E/Y/    {     MOV BX,[BP+Y] }
  317.          $F7/$E3/      {     MUL BX        }
  318.          $03/$86/X/    {     ADD AX,[BP+X] }
  319.          $73/$01/      {     JNC L1        }
  320.          $42/          { L1: INC DX        }
  321.          $A3/VA/       {     MOV [VA],AX   }
  322.          $89/$16/VA+2  {     MOV [VA+2],DX }
  323.         );
  324.   IF V.S <> AS THEN SETSEG(V.S);
  325.   INLINE($B8/$A000/    { MOV AX,A000       }
  326.          $8E/$C0/      { MOV ES,AX         }
  327.          $8B/$3E/VA/   { MOV DI,[VA]       }
  328.          $8A/$86/FARBE/{ MOV AL,[BP+FARBE] }
  329.          $26/$30/$05   { XOR ES:[DI],AL    }
  330.         );
  331. END; { PLOT }
  332.  
  333.  
  334.  
  335. FUNCTION VIDADAP:WORD; EXTERNAL;
  336. {$L VIDEOID}
  337.  
  338.  
  339. {
  340.   CHECKVGA ERSETZT PROCEDURE MODUS, TESTET ABER AUCH DIE VGA- KARTE
  341.   ERGEBNIS : -1 = KEINE VGA
  342.              -2 = VIDEO- RAM- FEHLER
  343.               0 = KEINE SEGMENT- ZUGRIFFE MÖGLICH
  344.              >0 = ANZAHL VIDEO- SEGMENTE
  345. }
  346. FUNCTION  CHECKVGA(MODE:BYTE):INTEGER;
  347. VAR   V  : BYTE ABSOLUTE $A000:$FFFF;
  348.       I  : BYTE;
  349.       R  : REGISTERS;
  350.  
  351. FUNCTION CHECKSEG(ANZ:BYTE):BOOLEAN;
  352. VAR   B  : BYTE;
  353. BEGIN
  354.   CHECKSEG := FALSE;
  355.   FOR B := 0 TO ANZ DO BEGIN
  356.     SETSEG(B);
  357.     V := B;
  358.   END; { NEXT B }
  359.   FOR B := 0 TO ANZ DO BEGIN
  360.     SETSEG(B);
  361.     IF V <> B THEN EXIT;
  362.   END; { NEXT B }
  363.   CHECKSEG := TRUE;
  364. END; { CHECKSEG }
  365.  
  366. BEGIN { CHECKVGA }
  367.   CHECKVGA := -1;
  368.   IF NOT ( HI(VIDADAP) IN [7,8,11,12] ) THEN EXIT;
  369.  
  370. VSYNCH;
  371.   R.AL := MODE; { VIDEOMODUS }
  372.   R.AH := $00;
  373.   INTR($10,R);  { SETZEN }
  374.  
  375.   CHECKVGA := -2;
  376.   SETSEG(1);
  377.   V := $33;
  378.   IF V <> $33 THEN BEGIN
  379.     V := 0;
  380.     USEET4000 := TRUE;
  381.     SETSEG(1);
  382.     V := $33;
  383.     IF V <> $33 THEN EXIT;
  384.   END;
  385.   V := $AA;
  386.   IF V <> $AA THEN EXIT;
  387.  
  388.   IF NOT CHECKSEG(3) THEN CHECKVGA := 0 ELSE
  389.     IF NOT CHECKSEG(7) THEN CHECKVGA := 4 ELSE
  390.       IF NOT CHECKSEG(15) THEN CHECKVGA := 8 ELSE
  391.         CHECKVGA := 16;
  392.  
  393.   FOR I := 0 TO 15 DO BEGIN
  394.     SETSEG(I);
  395.     V := 0;
  396.   END;
  397.  
  398.   SETSEG(0);
  399.   MINX := 0; MAXX := PRED(XWID);
  400.   MINY := 0; MAXY := PRED(YWID);
  401. END; { CHECKVGA }
  402.  
  403.  
  404. FUNCTION GETATC(IDX:BYTE):BYTE;
  405. VAR   B  : BYTE;
  406. BEGIN
  407.   CLI;
  408.   B := PORT[ISTA];
  409.   PORT[$3C0] := IDX;
  410.   B := PORT[$3C1];
  411.   PORT[$3C0] := B;
  412.   PORT[$3C0] := $20;
  413.   STI;
  414.   GETATC := B;
  415. END; { GETATC }
  416.  
  417.  
  418. PROCEDURE SETATC(IDX,DATA:BYTE);
  419. VAR   B  : BYTE;
  420. BEGIN
  421.   CLI;
  422.   B := PORT[ISTA];
  423.   PORT[$3C0] := IDX;
  424.   PORT[$3C0] := DATA;
  425.   PORT[$3C0] := $20;
  426.   STI;
  427. END; { SETATC }
  428.  
  429.  
  430. PROCEDURE VGASETPALETTE(VAR P : VGAPALETTETYP; START,STOP : BYTE);
  431. BEGIN
  432.   VSYNCH;
  433. {
  434.     FÜR LOKALE VARIABLE UND PROZEDUR- PARAMETER MUß DIE BASEPOINTER- INDIREKTE
  435.   ADRESSIERUNG VERWANDT WERDEN.
  436.     SOLANGE NUR GLOBALE VARIABLE ALS PALETTE ÜBERGEBEN WERDEN, WÜRDE DIE
  437.   ADRESSIERUNG ÜBER DAS DATASEGMENT AUSREICHEN, ABER MIT DEM EXTRASEGMENT
  438.   KÖNNEN AUCH LOKALE VARIABLE ALS PALETTE BENUTZT WERDEN.
  439. }
  440.   INLINE($8E/$86/P+2/    { MOV ES,[BP+P+2]   }
  441.          $8A/$86/START/  { MOV AL,[BP+START] }
  442.          $28/$E4/        { SUB AH,AH         }
  443.          $BA/$3C8/       { MOV DX,3C8H       }
  444.          $EE/            { OUT DX,AL         }
  445.          $89/$C1/        { MOV CX,AX         }
  446.          $01/$C0/        { ADD AX,AX ; START * 2 }
  447.          $01/$C8/        { ADD AX,CX ; START * 3 }
  448.          $03/$86/P/      { ADD AX,[BP+P]     }
  449.          $89/$C6         { MOV SI,AX         }
  450.         );
  451.   INLINE($8A/$86/STOP/   { MOV AL,[BP+STOP]  }
  452.          $28/$E4/        { SUB AH,AH         }
  453.          $40/            { INC AX            }
  454.          $8A/$8E/START/  { MOV CL,[BP+START] }
  455.          $28/$ED/        { SUB CH,CH         }
  456.          $29/$C8/        { SUB AX,CX         }
  457.          $89/$C1/        { MOV CX,AX         }
  458.          $01/$C9/        { ADD CX,CX ; * 2   }
  459.          $01/$C1/        { ADD CX,AX ; * 3   }
  460.          $FC/            { CLD               }
  461.          $BA/$3C9/       { MOV DX,3C9H       }
  462.          $26/$F3/$6E     { REP OUTSB ES:     }
  463.         );
  464. END; { VGASETPALETTE }
  465.  
  466.  
  467. PROCEDURE VGAGETPALETTE(VAR P : VGAPALETTETYP);
  468. VAR   R  : REGISTERS;
  469. BEGIN
  470.   R.AX := $1017;
  471.   R.BX := 0;
  472.   R.CX := 256;
  473.   R.ES := SEG(P);
  474.   R.DX := OFS(P);
  475.   INTR($10,R);
  476. END; { VGAGETPALETTE }
  477.  
  478.  
  479. PROCEDURE VERLAUF(VAR P:VGAPALETTETYP;F1,R1,G1,B1,F2,R2,G2,B2:BYTE);
  480. VAR   I   : BYTE;
  481.       NR  : INTEGER;
  482. BEGIN
  483.   NR := F2 - F1;
  484.   IF NR < 1 THEN EXIT;
  485.   FOR I := 0 TO NR DO BEGIN
  486.     P[F1 + I].R := (R1 * ( NR - I ) + R2 * I) DIV NR;
  487.     P[F1 + I].G := (G1 * ( NR - I ) + G2 * I) DIV NR;
  488.     P[F1 + I].B := (B1 * ( NR - I ) + B2 * I) DIV NR;
  489.   END; { NEXT I }
  490. END; { VERLAUF }
  491.  
  492.  
  493. PROCEDURE SET320X200;
  494. BEGIN
  495.   VMOD := $13;
  496.   XWID := 320;
  497.   YWID := 200;
  498. END; { SET320X200 }
  499.  
  500. PROCEDURE SET640X350;
  501. BEGIN
  502.   VMOD := $2D;
  503.   XWID := 640;
  504.   YWID := 350;
  505. END; { SET640X350 }
  506.  
  507. PROCEDURE SET640X400;
  508. BEGIN
  509.   VMOD := $2F;
  510.   XWID := 640;
  511.   YWID := 400;
  512. END; { SET640X400 }
  513.  
  514. PROCEDURE SET640X480;
  515. BEGIN
  516.   VMOD := $2E;
  517.   XWID := 640;
  518.   YWID := 480;
  519. END; { SET640X480 }
  520.  
  521. PROCEDURE SET800X600;
  522. BEGIN
  523.   VMOD := $30;
  524.   XWID := 800;
  525.   YWID := 600;
  526. END; { SET800X600 }
  527.  
  528. PROCEDURE SET1024X768;
  529. BEGIN
  530.   IF NOT USEET4000 THEN BEGIN
  531.     SET800X600;
  532.   END ELSE BEGIN
  533.     VMOD := $38;
  534.     XWID := 1024;
  535.     YWID := 768;
  536.   END;
  537. END; { SET1024X768 }
  538.  
  539.  
  540. PROCEDURE OVERSCAN(FARBE:BYTE);
  541. VAR   R  : REGISTERS;
  542. BEGIN
  543.   R.AX := $1001;
  544.   R.BH := FARBE;
  545.   INTR($10,R);
  546. END; { OVERSCAN }
  547.  
  548.  
  549. PROCEDURE ROTIERE(VAR PAL:VGAPALETTETYP;VON,BIS:BYTE;RUECKWAERTS:BOOLEAN);
  550. VAR   COL  : COLORVALUE;
  551. BEGIN
  552.   IF RUECKWAERTS THEN BEGIN
  553.     COL := PAL[BIS];
  554.     MOVE(PAL[VON],PAL[SUCC(VON)],SIZEOF(VGAPALETTETYP) - 3 * (256 - BIS + VON));
  555.     PAL[VON] := COL;
  556.   END ELSE BEGIN
  557.     COL := PAL[VON];
  558.     MOVE(PAL[SUCC(VON)],PAL[VON],SIZEOF(VGAPALETTETYP) - 3 * (256 - BIS + VON));
  559.     PAL[BIS] := COL;
  560.   END;
  561.   IF FASTSETPALETTE OR ((BIS - VON) < 128) THEN BEGIN
  562.     VGASETPALETTE(PAL,VON,BIS);
  563.   END ELSE BEGIN
  564.     VGASETPALETTE(PAL,VON,(BIS - VON) SHR 1);
  565.     VGASETPALETTE(PAL,SUCC((BIS - VON) SHR 1),BIS);
  566.   END;
  567. END; { ROTIERE }
  568.  
  569.  
  570. PROCEDURE ABBLENDEN(VAR PAL:VGAPALETTETYP;STUFEN:WORD;AB:BOOLEAN);
  571. VAR   J  : WORD;
  572.  
  573. PROCEDURE BLENDEN;
  574. VAR   I  : BYTE;
  575.       P  : VGAPALETTETYP; { DIE VARIABLE P MUß HIER LOKAL DEFINIERT SEIN }
  576. BEGIN
  577.   P := PAL;
  578.   FOR I := 0 TO 255 DO BEGIN
  579.     WITH P[I] DO BEGIN
  580.       R := (WORD(R) * J) DIV STUFEN;
  581.       G := (WORD(G) * J) DIV STUFEN;
  582.       B := (WORD(B) * J) DIV STUFEN;
  583.     END; { WITH P[I] }
  584.   END; { NEXT I }
  585.   IF FASTSETPALETTE THEN BEGIN
  586.     VGASETPALETTE(P,0,255);
  587.   END ELSE BEGIN
  588.     VGASETPALETTE(P,0,127);
  589.     VGASETPALETTE(P,128,255);
  590.   END;
  591. END; { BLENDEN }
  592.  
  593. BEGIN { BLENDE }
  594.   IF AB THEN FOR J := STUFEN DOWNTO 0 DO BLENDEN
  595.         ELSE FOR J := 0 TO STUFEN DO BLENDEN;
  596. END; { ABBLENDE }
  597.  
  598.  
  599. PROCEDURE SETFONT(HIG:BYTE);
  600. VAR   R  : REGISTERS;
  601. BEGIN
  602.   WITH R DO BEGIN
  603.     CHRHIG := HIG;
  604.     CASE HIG OF
  605.        8 : BX := $300;
  606.       14 : BX := $200;
  607.       16 : BX := $600;
  608.     ELSE
  609.       CHRHIG := 16;
  610.       BX := $600;
  611.     END; { CASE HIG }
  612.     AX := $1130;
  613.     INTR($10,R);
  614.     CHSP := PTR(ES,BP);
  615.   END; { WITH R }
  616. END; { SETFONT }
  617.  
  618.  
  619. PROCEDURE WRITECHAR(CHR:CHAR;X,Y:WORD;FARBE:BYTE);
  620. VAR   I,J,B,BM  : BYTE;
  621.       Z         : WORD;
  622. BEGIN
  623.   Z  := Y;
  624.   FOR I := 0 TO PRED(CHRHIG) DO BEGIN
  625.     BM := $80;
  626.     B  := CHSP^[BYTE(CHR)*CHRHIG + I];
  627.     FOR J := 0 TO 7 DO BEGIN
  628.       IF B AND BM <> 0 THEN PLOT(X+J,Z,FARBE);
  629.       BM := BM SHR 1;
  630.     END; { NEXT J }
  631.     INC(Z);
  632.   END; { NEXT I }
  633. END; { WRITECHAR }
  634.  
  635.  
  636. PROCEDURE WRITEFGBG(CHR:CHAR;X,Y:WORD;FG,BG:BYTE);
  637. VAR   I,J,B,BM  : BYTE;
  638.       Z         : WORD;
  639. BEGIN
  640.   Z  := Y;
  641.   FOR I := 0 TO PRED(CHRHIG) DO BEGIN
  642.     BM := $80;
  643.     B  := CHSP^[BYTE(CHR)*CHRHIG + I];
  644.     FOR J := 0 TO 7 DO BEGIN
  645.       IF B AND BM = 0 THEN PLOT(X+J,Z,BG)
  646.                       ELSE PLOT(X+J,Z,FG);
  647.       BM := BM SHR 1;
  648.     END; { NEXT J }
  649.     INC(Z);
  650.   END; { NEXT I }
  651. END; { WRITEFGBG }
  652.  
  653.  
  654. PROCEDURE XORWRITE(CHR:CHAR;X,Y:WORD;FG,BG:BYTE);
  655. VAR   I,J,B,BM  : BYTE;
  656.       Z         : WORD;
  657. BEGIN
  658.   Z  := Y;
  659.   FOR I := 0 TO PRED(CHRHIG) DO BEGIN
  660.     BM := $80;
  661.     B  := CHSP^[BYTE(CHR)*CHRHIG + I];
  662.     FOR J := 0 TO 7 DO BEGIN
  663.       IF B AND BM = 0 THEN XPLOT(X+J,Z,BG)
  664.                       ELSE XPLOT(X+J,Z,FG);
  665.       BM := BM SHR 1;
  666.     END; { NEXT J }
  667.     INC(Z);
  668.   END; { NEXT I }
  669. END; { XORWRITE }
  670.  
  671.  
  672. PROCEDURE WRITECHAR1(CHR:CHAR;X,Y:WORD;FARBE:BYTE);
  673. VAR   I,J  : BYTE;
  674. BEGIN
  675.   FOR I := 0 TO PRED(CHRHIG) DO BEGIN
  676.     FOR J := 0 TO 7 DO
  677.       IF CHSP^[BYTE(CHR)*CHRHIG+PRED(CHRHIG)-I] AND BITMSK1[J] <> 0
  678.         THEN PLOT(X+J,Y+I,FARBE);
  679.   END; { NEXT I }
  680. END; { WRITECHAR1 }
  681.  
  682.  
  683. PROCEDURE DOPPCHAR(CHR:CHAR;X,Y:WORD;FARBE:BYTE);
  684. VAR   I,J,B,BM  : BYTE;
  685.       Z0,Z      : WORD;
  686. BEGIN
  687.   Z  := Y;
  688.   FOR I := 0 TO PRED(CHRHIG) DO BEGIN
  689.     BM := $80;
  690.     B  := CHSP^[BYTE(CHR)*CHRHIG + I];
  691.     FOR J := 0 TO 7 DO BEGIN
  692.       IF B AND BM <> 0 THEN BEGIN
  693.         Z0 := X + (J SHL 1);
  694.         PLOT(     Z0 ,     Z ,FARBE);
  695.         PLOT(SUCC(Z0),     Z ,FARBE);
  696.         PLOT(     Z0 ,SUCC(Z),FARBE);
  697.         PLOT(SUCC(Z0),SUCC(Z),FARBE);
  698.       END;
  699.       BM := BM SHR 1;
  700.     END; { NEXT J }
  701.     INC(Z,2);
  702.   END; { NEXT I }
  703. END; { DOPPCHAR }
  704.  
  705.  
  706. PROCEDURE GRAPHTEXT(X,Y:WORD;FARBE:BYTE;TXT:STRING);
  707. VAR   I  : BYTE;
  708. BEGIN
  709.   FOR I := 1 TO LENGTH(TXT) DO WRITECHAR(TXT[I],X + 8 * PRED(I),Y,FARBE);
  710. END; { GRAPHTEXT }
  711.  
  712.  
  713. PROCEDURE FGBGTEXT(X,Y:WORD;FG,BG:BYTE;TXT:STRING);
  714. VAR   I  : BYTE;
  715. BEGIN
  716.   FOR I := 1 TO LENGTH(TXT) DO WRITEFGBG(TXT[I],X + 8 * PRED(I),Y,FG,BG);
  717. END; { FGBGTEXT }
  718.  
  719.  
  720. PROCEDURE XORTEXT(X,Y:WORD;FG,BG:BYTE;TXT:STRING);
  721. VAR   I  : BYTE;
  722. BEGIN
  723.   FOR I := 1 TO LENGTH(TXT) DO XORWRITE(TXT[I],X + 8 * PRED(I),Y,FG,BG);
  724. END; { XORTEXT }
  725.  
  726.  
  727. PROCEDURE DOPPTEXT(X,Y:WORD;FARBE:BYTE;TXT:STRING);
  728. VAR   I  : BYTE;
  729. BEGIN
  730.   FOR I := 1 TO LENGTH(TXT) DO DOPPCHAR(TXT[I],X + 16 * PRED(I),Y,FARBE);
  731. END; { DOPPTEXT }
  732.  
  733.  
  734. BEGIN
  735.   AS := PORT[SEGP];
  736.   SET320X200;
  737.   SETFONT(14);
  738. END.
  739.  
  740.