[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]

    Program CopperExampleNo2;
    {$G+} { Enable 286 Instructions }

    {                                }
    {       Copper Example #2        }
    {    Programmed by David Dahl    }
    {                                }
    { THIS EXAMPLE RUNS IN TEXT MODE }
    {                                }
    {     This is PUBLIC DOMAIN      }
    {                                }

    { This Example Works FLAWLESSLY On My ET4000AX Based VGA Card.    }
    { On My Friend's Trident, However, The Three Sinus Bars Have Snow }
    { Covering Their Leftmost Sides For About An Inch.  This Is Due   }
    { To The Double VGA DAC Set Required To Display Both The Sinus    }
    { Bars And The Smooth Color Transitions Of The Large Text.        }

    Uses CRT;

    Const MaxRaster = 399;

          Status1   = $3DA;
          DACWrite  = $3C8;
          DACData   = $3C9;

    Type  CopperRec   = Record
                              Color : Byte;
                              Red   : Byte;
                              Green : Byte;
                              Blue  : Byte;
                        End;

          CopperArray = Array [0..MaxRaster] of CopperRec;

          BarArray    = Array [0..19] of CopperRec;

    Var   CopperList : CopperArray;

          Bar        : Array[0..2] of BarArray;
          BarPos     : Array[0..2] of Integer;

          SinTab     : Array[0..255] of Integer;

    {-[ Build Sine Lookup Table ]----------------------------------------------}
    Procedure MakeSinTab;
    Var Counter : Integer;
    Begin
         For Counter := 0 to 255 do
             SinTab[Counter] := 115 + Round(90 * Sin(Counter * PI / 128));
    End;
    {-[ Build Colors For Sinus Bars ]------------------------------------------}
    Procedure MakeBars;
    Var Counter : Integer;
    Begin
         { Clear Colors }
         FillChar (Bar, SizeOf(Bar), 0);

         For Counter := 0 to 9 do
         Begin
              Bar[0][Counter].Red   := Trunc(Counter * (63 / 9));
              Bar[1][Counter].Green := Trunc(Counter * (63 / 9));
              Bar[2][Counter].Blue  := Trunc(Counter * (63 / 9));
              If Odd(Counter)
              Then
              Begin
                   Bar[0][Counter].Green := Trunc(Counter * (63 / 9));
                   Bar[1][Counter].Red   := Trunc(Counter * (63 / 9));
                   Bar[1][Counter].Blue  := Trunc(Counter * (63 / 9));
                   Bar[2][Counter].Green := Trunc(Counter * (63 / 9));
              End;
         End;
         For Counter := 10 to 19 do
         Begin
              Bar[0][Counter].Red   := Trunc((19-Counter) * (63 / 9));
              Bar[1][Counter].Green := Trunc((19-Counter) * (63 / 9));
              Bar[2][Counter].Blue  := Trunc((19-Counter) * (63 / 9));
              If Odd(Counter)
              Then
              Begin
                   Bar[0][Counter].Green := Trunc((19-Counter) * (63 / 9));
                   Bar[1][Counter].Red   := Trunc((19-Counter) * (63 / 9));
                   Bar[1][Counter].Blue  := Trunc((19-Counter) * (63 / 9));
                   Bar[2][Counter].Green := Trunc((19-Counter) * (63 / 9));
              End;
         End;
    End;
    {-[ Make COPPER List ]-----------------------------------------------------}
    Procedure MakeCopperList;
    Var Counter1 : Integer;
        Counter2 : Integer;
    Begin
         { Clear List }
         FillChar (CopperList, SizeOf(CopperList), 0);

         { Make Transition From White To Yellow For }
         { Color 1 On Scanlines 10 Through 250      }
         For Counter1 := 10 to 250 do
         With CopperList[Counter1] do
         Begin
              Color := 1;
              Red   := 63;
              Green := 63;
              Blue  := Round((250 - Counter1) * (63 / 200));
         End;

         { Make Transition From Black To Dark Blue For }
         { Color 0 On Scanlines 254 Through 274        }
         For Counter1 := 254 to 254 + 20 do
         With CopperList[Counter1] do
         Begin
              Color := 0;
              Red   := 0;
              Green := 0;
              Blue  := Counter1 - 254;
         End;
         { Make Dark Blue Background (Color 0) For   }
         { Scanlines 275 Through 287 Except Scanline }
         { 280 Which Is Yellow                       }
         For Counter1 := 275 to 287 do
         With CopperList[Counter1] do
         Begin
              Color := 0;
              Red   := 0;
              Green := 0;
              If Counter1 = 280
              Then
              Begin
                   Red   := 45;
                   Green := 45;
              End
              Else
                  Blue := 20;
         End;
         { Make Dark Blue Background (Color 0) For   }
         { Scanlines 336 Through 394 Except Scanline }
         { 343 Which Is Yellow                       }
         For Counter1 := 336 to 349 do
         With CopperList[Counter1] do
         Begin
              Color := 0;
              Red   := 0;
              Green := 0;
              If Counter1 = 343
              Then
              Begin
                   Red   := 45;
                   Green := 45;
              End
              Else
                  Blue := 20;
         End;
         { Make Transition From Dark Blue To Black }
         { For Background From Scanline 350 to 370 }
         For Counter1 := 350 to 350 + 20 do
         With CopperList[Counter1] do
         Begin
              Color := 0;
              Red   := 0;
              Green := 0;
              Blue  := (350 + 20 - Counter1);
         End;

         { Color Text Lines 18, 19, and 20 For Text Color 1 }
         { As Red -> Yellow (L18), Purple -> White (L20)    }
         For Counter1  := 18 to 20 do
           For Counter2 := 0 to 15 do
           With CopperList[Counter2 + (Counter1 * 16)] do
           Begin
                Color := 1;
                Red   := 63;
                Green := Trunc(Counter2 * (63 / 15));
                Blue  := ((Counter1 - 18) * 31) AND 63;
           End;
    End;
    {-[ Center And Write A String As Solid Chars And Spaces ]------------------}
    Procedure WSol (StringIn : String);
    Var Counter : Integer;
    Begin
         For Counter := 1 to (40 - (Length(StringIn) DIV 2)) do
             Write(#32);

         For Counter := 1 to Length(StringIn) do
           If StringIn[Counter] <> #32
           Then
               Write (#219)
           Else
               Write (#32);

         Writeln;
    End;
    {-[ Put Text On Screen ]---------------------------------------------------}
    Procedure SetUpScreen;
    Begin
         ClrScr;

         GotoXY (1,5);
         TextColor (1);
         WSol('  ####     ####    ######    ######    ########  ######  ');
         WSol(' ##  ##   ##  ##   ##   ##   ##   ##   ##        ##   ## ');
         WSol('##       ##    ##  ##    ##  ##    ##  ##        ##    ##');
         WSol('##       ##    ##  ##    ##  ##    ##  #####     ##    ##');
         WSol('##       ##    ##  ##   ##   ##   ##   ##        ##   ## ');
         WSol('##       ##    ##  ######    ######    ##        ######  ');
         WSol(' ##  ##   ##  ##   ##        ##        ##        ##   ## ');
         WSol('  ####     ####    ##        ##        ########  ##    ##');
         GotoXY(21, 19);
         Writeln('Textmode COPPER Example #2 by David Dahl');
         GotoXY(27, 21);
         Writeln('This Program is Public Domain');
    End;
    {-[ Update COPPER ]--------------------------------------------------------}
    Procedure UpdateCopper;
    Var Raster     : Word;
        DrawBar    : Integer;
        BarNum     : Integer;
        BarCounter : Integer;
    Begin
         Raster := 1;

         DrawBar := -1;
         BarNum  := 0;

         Inc(BarPos[0],1);
         Inc(BarPos[1],1);
         Inc(BarPos[2],1);

         { Sorry For All The Assembly Here, But Plain Vanilla Pascal  }
         { Just Isn't Fast Enough To Properly Display BOTH Sinus Bars }
         { And The Color Transitions For The Large Text.              }
         ASM
            PUSH DS
            MOV AX, SEG @Data
            MOV DS, AX
            CLI

            { Wait For End Of Vertical Retrace }
            MOV DX, Status1
            @NotVert:
              IN  AL, DX
              AND AL, 8
            JNZ @NotVert
            @IsVert:
              IN  AL, DX
              AND AL, 8
            JZ @IsVert

            @DrawAllBarsLoop:
              {--- Check For Bars ---}
              MOV CX, 3
              @BarRasterCompare:

                { Calculate Location of Bar (Start Line Placed In AX) }
                MOV BX, CX
                DEC BX
                SHL BX, 1
                MOV BX, word(BarPos[BX])
                AND BX, 255
                SHL BX, 1
                MOV AX, word(SinTab[BX])

                { Check If A Bar Is On Current Raster }
                CMP AX, Raster
                JNS @BarNotDisplayed
                MOV BX, AX
                ADD AX, 20
                CMP Raster, AX
                JNS @BarNotDisplayed

                { Bar Is On Raster So Mark It }
                SUB BX, Raster
                XOR AX, AX
                SUB AX, BX

                MOV word(DrawBar), AX
                MOV word(BarNum), CX
                DEC word(BarNum)

                @BarNotDisplayed:
                @DoneChecking:
              LOOP @BarRasterCompare

              {--- Draw Bars ---}
              MOV  BX, DrawBar
              OR   BX, BX
              JL   @NoDrawBar

              { Build Index To Bar Color Table }
              SHL BX, 2

              MOV AX, word(BarNum)
              MOV CX, AX
              SHL AX, 6
              SHL CX, 4
              ADD AX, CX
              ADD BX, AX

              { Set Up Next Scan Line Color }
              MOV DX, DACWRITE
              XOR AX, AX
              OUT DX, AL

              MOV DX, DACDATA
              INC BX
              MOV AL, Byte(Bar[BX])
              OUT DX, AL
              INC BX
              MOV AL, Byte(Bar[BX])
              OUT DX, AL

              { Wait For End of Horiz Retrace }
              MOV DX, Status1
              @NotHoriz1:
                IN  AL, DX
                AND AL, 1
              JNZ @NotHoriz1
              @IsHoriz1:
                IN  AL, DX
                AND AL, 1
              JZ @IsHoriz1

              { Send Last Byte Of DAC Reg So Color Is Updated }
              MOV DX, DACDATA
              INC BX
              MOV AL, byte(Bar[BX])
              OUT DX, AL

              { Update Color From Copper Table }
              MOV DX, DACWRITE
              MOV BX, Raster
              SHL BX, 2
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL

              MOV DX, DACDATA
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL

              JMP @Done

              @NoDrawBar:
              { Update Color }
              MOV DX, DACWRITE
              MOV BX, Raster
              SHL BX, 2
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL

              MOV DX, DACDATA
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL

              { Wait For End of Horiz Retrace }
              MOV DX, Status1
              @NotHoriz2:
                IN  AL, DX
                AND AL, 1
              JNZ @NotHoriz2
              @IsHoriz2:
                IN  AL, DX
                AND AL, 1
              JZ @IsHoriz2

              { Update Last }
              MOV DX, DACDATA
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL

              @Done:

              INC Word(Raster)

           { If Raster <= 250 Then Loop }
           CMP Word(Raster), 250
           JLE @DrawAllBarsLoop

           {--- Color Background And Text At Bottom of Screen ---}
           @TextColorLoop:
              MOV DX, DACWRITE
              MOV BX, Raster
              SHL BX, 2
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL

              MOV DX, DACDATA
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL

              MOV DX, Status1
              @NotHoriz3:
                IN  AL, DX
                AND AL, 1
              JNZ @NotHoriz3
              @IsHoriz3:
                IN  AL, DX
                AND AL, 1
              JZ @IsHoriz3

              MOV DX, DACDATA
              INC BX
              MOV AL, Byte(CopperList[BX])
              OUT DX, AL

              INC Word(Raster)
           CMP Word(Raster), MaxRaster
           JLE @TextColorLoop
           STI
           POP DS
         END;
    End;
    {=[ Main Program ]=========================================================}
    Var Key : Char;
    Begin
         TextMode (C80);
         MakeSinTab;
         MakeCopperList;
         MakeBars;
         SetUpScreen;
         BarPos[0] := 30;
         BarPos[1] := 15;
         BarPos[2] :=  0;
         Repeat
               UpdateCopper;
         Until Keypressed;
         While Keypressed do
               Key := ReadKey;
         TextMode (C80);
    End.

[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]