home *** CD-ROM | disk | FTP | other *** search
/ Multimedia Classic / MultimediaClassic.mdf / utility / vts139b.arj / LIB / VID43.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-06-05  |  7.5 KB  |  354 lines
  1. UNIT Vid43;
  2.  
  3. INTERFACE
  4.  
  5. USES Dos;
  6.  
  7.  
  8.  
  9.  
  10. CONST
  11.   ScreenSizeX  : WORD = 90;
  12.   ScreenBytesX : WORD = 180;
  13.   ScreenSizeY  : WORD = 63;
  14.   ScreenBytes  : WORD = 180 * 63;
  15.   ScreenWords  : WORD = 90 * 63;
  16.   ScrSegment   : WORD = $B800;
  17.   ScrOffset    : WORD = $0000;
  18.  
  19.   ForceEGA     : BOOLEAN = TRUE;
  20.  
  21.   InVideoMode43 : BOOLEAN = FALSE;
  22.  
  23. VAR
  24.   BIOSScrSize   : WORD ABSOLUTE 0:$44C;
  25.   BIOSScrOffset : WORD ABSOLUTE 0:$44E;
  26.  
  27.  
  28.  
  29.  
  30. PROCEDURE InitVid43;
  31. PROCEDURE PoneVideoMode43;
  32. PROCEDURE QuitaVideoMode43;
  33.  
  34.  
  35.  
  36.  
  37. IMPLEMENTATION
  38.  
  39. USES Debugging, FileUtil, BiosVideo, Heaps, SwapManager, HexConversions, Kbd;
  40.  
  41. TYPE
  42.   TChar = ARRAY[0..7] OF BYTE;
  43.  
  44. CONST
  45.   OldMode         : BYTE    = $FF;
  46.   SaveBufferRec   : TVideoStateSaved = (Mode: 3; FontSize: 16; Buffer: NIL);
  47.   SaveBufferSize  : WORD    = 0;
  48.   SaveBufferNotValid : BOOLEAN = TRUE;
  49.  
  50. VAR
  51.   ScrImageHandle  : TSwapHandle;
  52.  
  53.  
  54. CONST
  55.   DefPalette : ARRAY[1..17] OF BYTE = ($00, $01, $02, $03, $04, $05, $14, $07,
  56.                                        $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
  57.                                        $00);
  58.  
  59.   Palette : ARRAY[1..17] OF BYTE = {($00, $01, $3B, $03, $04, $3F, $14, $07,
  60.                                      $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
  61.                                      $00);}
  62.  
  63.                                    ($00, $01, $3A, $07, $24, $38, $3E, $3F,
  64.                                     $00, $14, $3A, $07, $24, $38, $3E, $3F,
  65.                                     $00);
  66.  
  67.   { Negro, Azul, Verde,      , Rojo,       , Amarillo, Blanco }
  68.   {  0       1     2      3     4      5         6       7    }
  69.  
  70.   { 0 -> 0 }
  71.   { 1 -> 3 }
  72.   { 2 -> 7 }
  73.   { 3 -> 4 }
  74.   { 4 -> 2 }
  75.   { 5 -> 1 }
  76.   { 6 -> 5 }
  77.   { 7 -> 6 }
  78.  
  79.  
  80. {$L FONT.OBJ}
  81. PROCEDURE Font8x8; EXTERNAL;
  82.  
  83. TYPE
  84.   TFont = ARRAY[0..256*8-1] OF BYTE;
  85. VAR
  86.   PixFont8x8   : ARRAY[0..255] OF TChar;
  87.   Font8x8Array : ^TFont;
  88.  
  89.  
  90. CONST
  91.   CRTCTable    : ARRAY[0..$18] OF BYTE =
  92.     (
  93. {
  94.       $6A, $4F, $50, $82,
  95.       $55, $81, $BF, $1F,
  96.       $00, $4F, $00, $0F,
  97.       $00, $00, $07, $80,
  98.       $9C, $0E, $8F, $28,
  99.       $1F, $96, $B9, $A3,
  100.       $FF
  101.  
  102.       $5F, $4F, $50, $82,
  103.       $55, $81, $BF, $1F,
  104.       $00, $47, $07, $00,
  105.       $0F, $A0, $0F, $A0,
  106.       $9C, $0E, $8F, $28,
  107.       $1F, $96, $B9, $A3,
  108.       $FF
  109. }
  110.       $6A, $59, $5A, $8D,
  111.       $5F, $89, $2F, $B2,
  112.       $00, $67, $07, $00,
  113.       $16, $26, $0F, $A0,
  114.       $04, $0E, $F7, $2D,
  115.       $1F, $00, $29, $A3,
  116.       $FF
  117.  
  118.  
  119.     );
  120.  
  121.  
  122.  
  123.  
  124. PROCEDURE PoneVideoMode43;
  125.   VAR
  126.     i : WORD;
  127.   BEGIN
  128.  
  129.     IF InVideoMode43 THEN EXIT;
  130.  
  131.     IF NOT SaveBufferNotValid THEN
  132.       SaveVideoState(SaveBufferRec)
  133.     ELSE
  134.       OldMode := GetVideoMode;
  135.  
  136.     ScrImageHandle.Write(Ptr($B800, BIOSScrOffset)^, BIOSScrSize);
  137.  
  138.     SetVideoMode(3);
  139.  
  140.     SelectFont8x8(0);
  141.     FOR i := 1 TO 7 DO
  142.       SelectFontQuiet8x8(i);
  143.  
  144.     IF NOT Debug THEN
  145.       BEGIN
  146.         FillFont(0, #0, 256, 8, @Font8x8);
  147.         FillFont(1, #0, 256, 8, @PixFont8x8);
  148.         SelectFonts(0, 1);
  149.       END;
  150.  
  151.     BlinkOff;
  152.  
  153.     NoCursor;
  154.     FillVideoMemory(' ', $00);
  155.     IF NOT Debug THEN
  156.       SetPalette(@Palette);
  157.  
  158.     ScrOffset := ScreenBytes;
  159.  
  160.     InVideoMode43 := TRUE;
  161.  
  162.     IF NOT Debug THEN
  163.       ASM
  164.                 MOV     DX,$3C4         { 8 dot characters. }
  165.                 MOV     AL,1
  166.                 OUT     DX,AL
  167.                 INC     DX
  168.                 IN      AL,DX
  169.                 OR      AL,1
  170.                 OUT     DX,AL
  171.  
  172.                 MOV     DX,$3D4
  173.                 MOV     AL,$11
  174.                 OUT     DX,AL
  175.                 INC     DX
  176.                 IN      AL,DX
  177.                 AND     AL,$7F
  178.                 OUT     DX,AL
  179.                 DEC     DX
  180.  
  181.                 MOV     SI,OFFSET CRTCTable + $18
  182.                 STD
  183.  
  184.                 MOV     CX,$18
  185. @@lp:           MOV     AL,CL
  186.                 OUT     DX,AL
  187.                 INC     DX
  188.                 LODSB
  189.                 OUT     DX,AL
  190.                 DEC     DX
  191.                 JCXZ    @@1
  192.                 DEC     CX
  193.                 JMP     @@lp
  194. @@1:
  195.                 CLD
  196.  
  197.                 MOV     DX,$3DA
  198. @@l1:           IN      AL,DX
  199.                 AND     AL,8
  200.                 JNZ     @@l1
  201.  
  202.                 MOV     DX,$3C0
  203.                 MOV     AL,$33
  204.                 OUT     DX,AL
  205.                 INC     DX
  206.                 IN      AL,DX
  207.  
  208.                 MOV     AH,AL
  209.  
  210.                 MOV     DX,$3DA         { VSync }
  211. @@l2:           IN      AL,DX
  212.                 AND     AL,8
  213.                 JZ      @@l2
  214.  
  215.  
  216.                 MOV     DX,$3C0         { Pel panning. }
  217.                 MOV     AL,$33
  218.                 OUT     DX,AL
  219.                 MOV     AL,AH
  220.                 AND     AL,$F0
  221.                 OUT     DX,AL
  222.  
  223.  
  224.                 MOV     DX,$3CC         { Set clock and polarity. }
  225.                 IN      AL,DX
  226.                 MOV     DX,$3C2
  227.                 OR      AL,$C4
  228.                 OUT     DX,AL
  229.       END;
  230.  
  231.     FillVideoMemory(' ', $07);
  232.  
  233.   END;
  234.  
  235.  
  236. PROCEDURE QuitaVideoMode43;
  237.   BEGIN
  238.     IF NOT InVideoMode43 THEN EXIT;
  239.  
  240.     IF NOT SaveBufferNotValid THEN
  241.       RestoreVideoState(SaveBufferRec)
  242.     ELSE
  243.       SetVideoMode(OldMode);
  244.  
  245.     ScrImageHandle.Read(Ptr($B800, BIOSScrOffset)^, BIOSScrSize);
  246.     ScrImageHandle.Free;
  247.  
  248.     InVideoMode43 := FALSE;
  249.   END;
  250.  
  251.  
  252.  
  253.  
  254. VAR
  255.   OldExitProc : POINTER;
  256.  
  257.  
  258. PROCEDURE MyExitProc; FAR;
  259.   BEGIN
  260. {
  261.     QuitaVideoMode43;
  262.     ScrImageHandle.Done;
  263. }
  264.     ExitProc := OldExitProc;
  265.   END;
  266.  
  267.  
  268.  
  269.  
  270. PROCEDURE PokePixel(VAR Ch: TChar; w, i: BYTE);
  271.   BEGIN
  272.  
  273.     CASE i OF
  274.       1: BEGIN
  275.            Ch[0] := Ch[0] OR w;
  276.            Ch[1] := Ch[1] OR w;
  277.            IF w <> $C0 THEN
  278.              IF (Ch[3] AND (w SHL 2)) <> 0 THEN
  279.                Ch[2] := Ch[2] OR (w SHL 1);
  280.          END;
  281.       2: BEGIN
  282.            Ch[3] := Ch[3] OR w;
  283.            Ch[4] := Ch[4] OR w;
  284.            IF w <> $C0 THEN
  285.              BEGIN
  286.                IF (Ch[1] AND (w SHL 2)) <> 0 THEN
  287.                  Ch[2] := Ch[2] OR (w SHL 1);
  288.                IF (Ch[6] AND (w SHL 2)) <> 0 THEN
  289.                  Ch[5] := Ch[5] OR (w SHL 1);
  290.              END;
  291.          END;
  292.       3: BEGIN
  293.            Ch[6] := Ch[6] OR w;
  294.            Ch[7] := Ch[7] OR w;
  295.            IF w <> $C0 THEN
  296.              IF (Ch[4] AND (w SHL 2)) <> 0 THEN
  297.                Ch[5] := Ch[5] OR (w SHL 1);
  298.          END;
  299.     END;
  300.  
  301.   END;
  302.  
  303.  
  304.  
  305.  
  306. PROCEDURE InitVid43;
  307.   VAR
  308.     i, j, w: WORD;
  309.   BEGIN
  310.     OldExitProc := ExitProc;
  311.     ExitProc    := @MyExitProc;
  312.  
  313.     FOR i := 0 TO 255 DO BEGIN
  314.       FOR j := 0 TO 7 DO PixFont8x8[i][j] := 0;
  315.  
  316.       w := $C0;
  317.       IF ( i SHR 6       ) > 0 THEN PokePixel(PixFont8x8[i], w,  i SHR 6);
  318.  
  319.       w := $30;
  320.       IF ((i SHR 4) AND 3) > 0 THEN PokePixel(PixFont8x8[i], w, (i SHR 4) AND 3);
  321.  
  322.       w := $0C;
  323.       IF ((i SHR 2) AND 3) > 0 THEN PokePixel(PixFont8x8[i], w, (i SHR 2) AND 3);
  324.  
  325.       w := $03;
  326.       IF ( i        AND 3) > 0 THEN PokePixel(PixFont8x8[i], w,  i        AND 3);
  327.     END;
  328.  
  329.     Font8x8Array := POINTER(@Font8x8);
  330.  
  331.     FOR i := 0 TO 256*8-1 DO
  332.       Font8x8Array^[i] := Font8x8Array^[i] XOR $FF;
  333.  
  334.     ASM
  335.                 MOV     AX,$1C00
  336.                 MOV     CX,$07
  337.                 INT     $10
  338.                 SUB     AL,$1C
  339.                 MOV     [SaveBufferNotValid],AL
  340.  
  341.                 MOV     [SaveBufferSize],BX
  342.     END;
  343.  
  344.     IF NOT SaveBufferNotValid THEN
  345.       FullHeap.HGetMem(SaveBufferRec.Buffer,  SaveBufferSize  * 64);
  346.  
  347.     ScrImageHandle.Init;
  348.   END;
  349.  
  350.  
  351.  
  352.  
  353. END.
  354.