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

{ FD>  Hey Greg, do you think you could tell me how to access
 FD> Mode-X, preferably the source, if it's no trouble.... :)

not a problem....  Mostly I do Graphics and stuff With C, but when it all comes
down to it, whether you use Pascal or C For the outer shell the main Graphics
routines are in Assembler (For speed) or use direct hardware port access
(again, For speed).
The following is a demo of using palette scrolling techniques in Mode 13h (X)
to produce a flashy "bouncing bars" effect often seen in demos:
}

Program PaletteTricks;
{ Speccy demo in mode 13h (320x200x256) }

Uses Crt;

Const CGA_CharSet_Seg = $0F000;     { Location of BIOS CGA Character set }
      CGA_CharSet_ofs = $0FA6E;
      CharLength      = 8;          { Each Char is 8x8 bits,  }
      NumChars        = 256;        { and there are 256 Chars }
      VGA_Segment     = $0A000;     { Start of VGA memory     }
      NumCycles       = 200;        { Cycles/lines per screen }
      Radius          = 80;

      DispStr         : String =    ' ...THIS IS A LITTLE '+
      'SCROLLY, DESIGNED to TEST SOME GROOVY PASCAL ROUTinES...'+
      '                                                        ';

      { Colours For moving bars... Each bar is 15 pixels thick }
      { Three colours are palette entries For RGB values...    }
      Colours : Array [1..15*3] of Byte =
                 (  7,  7, 63,
                   15, 15, 63,
                   23, 23, 63,
                   31, 31, 63,
                   39, 39, 63,
                   47, 47, 63,
                   55, 55, 63,
                   63, 63, 63,
                   55, 55, 63,
                   47, 47, 63,
                   39, 39, 63,
                   31, 31, 63,
                   23, 23, 63,
                   15, 15, 63,
                    7,  7, 63  );


Type  OneChar = Array [1..CharLength] of Byte;

Var   CharSet:  Array [1..NumChars] of OneChar;
      Locs:     Array [1..NumCycles] of Integer;
      BarLocs:  Array [1..4] of Integer;         { Location of each bar }
      CurrVert,
      Count:    Integer;
      Key:      Char;
      MemPos:   Word;

Procedure GetChars;
{ Read/copy BIOS Character set into Array }
  Var NumCounter,
      ByteCounter,
      MemCounter:       Integer;
  begin
      MemCounter:=0;
      For NumCounter:=1 to NumChars do
        For ByteCounter:=1 to CharLength do
          begin

CharSet[NumCounter][ByteCounter]:=Mem[CGA_CharSet_Seg:CGA_CharSet_ofs+MemCounter];
            inC(MemCounter);
          end;
  end;


Procedure VideoMode ( Mode : Byte );
{ Set the video display mode }
  begin
      Asm
        MOV  AH,00
        MOV  AL,Mode
        inT  10h
      end;
  end;


Procedure SetColor ( Color, Red, Green, Blue : Byte );
{ Update the colour palette, to define a new colour }
  begin
      Port[$3C8] := Color;      { Colour number to redefine }
      Port[$3C9] := Red;        { Red value of new colour   }
      Port[$3C9] := Green;      { Green "   "   "    "      }
      Port[$3C9] := Blue;       { Blue  "   "   "    "      }
  end;


Procedure DispVert ( Var CurrLine : Integer );
  { Display next vertical 'chunk' of the Character onscreen }
  Var Letter:    OneChar;
      VertLine,
      Count:     Integer;
  begin
      { Calculate pixel position of start of letter: }
      Letter := CharSet[ord(DispStr[(CurrLine div 8)+1])+1];
      VertLine := (CurrLine-1) Mod 8;

      { Push the Character, pixel-by-pixel, to the screen: }
      For Count := 1 to 8 do
        if Letter[Count] and ($80 Shr VertLine) = 0
          then Mem[VGA_Segment:185*320+(Count-1)*320+319] := 0
          else Mem[VGa_Segment:185*320+(Count-1)*320+319] := 181;
  end;

Procedure CalcLocs;
{ Calculate the location of the top of bars, based on sine curve }
  Var Count:    Integer;
  begin
      For Count := 1 to NumCycles do
        Locs[Count] := Round(Radius*Sin((2*Pi/NumCycles)*Count))+Radius+1;
  end;


Procedure DoCycle;
{  Display the bars on screen, by updating the palette entries to
   reflect the values from the COLOUR Array, or black For blank lines }

  Label Wait,Retr,BarLoop,PrevIsLast,Continue1,Continue2,Rep1,Rep2;

  begin
       Asm
          { First, wait For start of vertical retrace: }
          MOV   DX,3DAh
Wait:     in    AL,DX
          TEST  AL,08h
          JZ    Wait
Retr:     in    AL,DX
          TEST  AL,08h
          JNZ   Retr

          { then do bars: }
           MOV   BX,0
BarLoop:
           PUSH  BX
           MOV   AX,Word PTR BarLocs[BX]
           MOV   BX,AX
           DEC   BX
           SHL   BX,1
           MOV   AX,Word PTR Locs[BX]
           PUSH  AX
           CMP   BX,0
           JE    PrevIsLast
           DEC   BX
           DEC   BX
           MOV   AX,Word PTR Locs[BX]
           JMP   Continue1

PrevIsLast:
           MOV   AX,Word PTR Locs[(NumCycles-1)*2]

Continue1:
           MOV   DX,03C8h
           OUT   DX,AL
           inC   DX
           MOV   CX,15*3
           MOV   AL,0
Rep1:
           OUT   DX,AL
           LOOP  Rep1

           DEC   DX
           POP   AX
           OUT   DX,AL
           inC   DX
           MOV   CX,15*3
           xor   BX,BX
Rep2:
           MOV   AL,Byte Ptr Colours[BX]
           OUT   DX,AL
           inC   BX
           LOOP  Rep2

           POP   BX
           inC   Word PTR BarLocs[BX]
           CMP   Word PTR BarLocs[BX],NumCycles
           JNG   Continue2

           MOV   Word PTR BarLocs[BX],1
Continue2:
           inC   BX
           inC   BX
           CMP   BX,8
           JNE   BarLoop

        end;
      end;


begin

    VideoMode($13);             { Set video mode 320x200x256 }
    Port[$3C8] := 1;            { Write palette table entry }
    For Count := 1 to 180 do    { Black out the first 180 colours, }
      SetColor(Count,0,0,0);    { one colour will be used per line }

    { Now colour each scan line using the given palette colour: }
    MemPos := 0;
    For Count := 1 to 180 do
      begin
        FillChar(Mem[VGA_Segment:MemPos],320,Chr(Count));
        MemPos := MemPos + 320;
      end;

    SetColor(181,63,63,0);
    CalcLocs;
    For Count := 1 to 4 do
      BarLocs[Count] := Count*10;

    GetChars;
    CurrVert := 1;
    Repeat
      DoCycle;
      For Count := 1 to 8 do
        Move(Mem[VGA_Segment:185*320+(Count-1)*320+1],
             Mem[VGA_Segment:185*320+(Count-1)*320],319);
      DispVert(CurrVert);
      inC(CurrVert);
      if CurrVert > Length(DispStr) * 8
        then CurrVert := 1;

    Until KeyPressed;   { Repeat Until a key is pressed... }

    Key := ReadKey;     { Absorb the key pressed }
    VideoMode(3);       { Reset video mode back to Textmode } end.
end.

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