{

Sterretjes...........


.... Made by.... . Frank Disseldorp (email:disseldorp@multiweb.net)


....Greetings Earthlings!.....



...Je videokaart moet wel Vesa1.2 ondersteunen, en het liefst geen S3 heten!
Probeer anders Univbe te installeren...
}

Program Vesa_Sterren;
uses crt;
const
 sterren=200;          { Het aantal Sterren }
 videomode=$101;
var
 ster:array[1..sterren] of record
                            xpos,ypos,col:word;
                            snel:byte;
                           end;
 a,b,c:word;
Type PVesaMode = ^TVesaMode;
     TVesaMode = Array[0..255] Of Word;


     ModeAttr  = (ModeAvail,               { De gehele es:di 256 byte  }
                  ModeExtendInfo,          { buffer... wat een rotzooi }
                  ModeBiosSupport,         { k`moet het nog ff }
                  ModeColor,               { weg zien te halen }
                  ModeGraphics,
                  ModeBit5,
                  ModeBit6,
                  ModeBit7,
                  ModeBit8);

     WinAttr   = (WinSupported,
                  WinReadable,
                  WinWriteable);

     TMemModel = (ModeText,
                  ModeCGA,
                  ModeHerc,
                  Mode4Plane,
                  ModePacked,
                  ModeModeX,
                  ModeRGB);

Var  VesaInfo  : Record
                   Vesa            : Array[1..4] Of Char;
                   Version         : Word;
                   POEM            : PChar;
                   Cap             : LongInt;
                   Modes           : PVesaMode;
                   PMList          : Array[18..255] Of Byte;
                 End;

     ModeInfo  : Record
                   Attr            : Set Of ModeAttr;
                   WinAttrA        : Set Of WinAttr;
                   WinAttrB        : Set Of WinAttr;
                   WinGranularity  : Word;
                   WinSize         : Word;
                   WinSegA         : Word;
                   WinSegB         : Word;
                   WinFunct        : Procedure;
                   ScanBytes       : Word;
                   ExtendInfo      : Record
                                       XRes         : Word;
                                       YRes         : Word;
                                       XCharSize    : Byte;
                                       YCharSize    : Byte;
                                       Planes       : Byte;
                                       BitsPerPixel : Byte;
                                       Banks        : Byte;
                                       MemModel     : TMemModel;
                                       BankSize     : Byte;
                                     End;

                   Pad             : Array[29..255] Of Byte;
                 End;

cx,cy:word;
bank,oudbank:word;
adres:longint;
granularity:byte;      { De beruchte granularity }
Procedure Vraagvesainfo;
 begin;
  asm
   mov ax,4f01h;
   mov cx,videomode;
   mov di,offset modeinfo;
   int 10h;
 end;
end;
Procedure switchbank(bank:byte);  { en houd rekening met granularity }
 begin;
  asm
   mov ax,64;
   mov bl,granularity;
   div bl;
   mov bl,bank;  { van 0 tot (in dit geval) 4}
   mul bl;
   mov dx,ax;
   mov ax,4f05h;
   mov bx,0;
   int 10h;
 end;
end;
Procedure GaSvga;
 begin;
  asm
   mov ax,4f02h;
   mov bx,videomode;
   int 10h;
  end;
 end;
Function BankNo(X,Y : LongInt) : Word;
Var Dummy   : LongInt;
Begin
     Dummy:=(X+(Y*640)) Div 65535;
     BankNo:=Dummy;
End;
Procedure ZetPunt(x,y,c:word);
 begin;
  if (x<640) and (y<480) then
   begin;
    bank:=bankno(x,y);
    if bank<>oudbank then switchbank(bank);
    oudbank:=bank;
    mem[$a000:x+(Y*640)]:=c;   { ja, sorry dit moet dus nog even }
                               { geoptimaliseerd worden....      }	
   end;
 end;
Procedure Vierkantje(x1,y1,x2,y2,cc:word);  { maakt een leeg vierkantje }
var
 v1,v2:word;
 begin;
  for v1:=x1 to x2 do
   begin;
    zetpunt(v1,y1,cc);
    zetpunt(v1,y2,cc);
   end;
  for v2:=y1 to y2 do
   begin;
    zetpunt(x1,v2,cc);
    zetpunt(x2,v2,cc);
   end;
 end;

begin;
 bank:=0;oudbank:=0;
 vraagvesainfo;
 granularity:=modeinfo.wingranularity;
 randomize;
 for a:=1 to sterren do
  begin;
   ster[a].xpos:=random(639);
   ster[a].ypos:=random(479);
   ster[a].col:=15+random(17);
   ster[a].snel:=1+random(4);
  end;
 gasvga;
 repeat;
 for a:=1 to sterren do
  with ster[a] do
   begin;
    zetpunt(xpos,ypos,0);
    dec(xpos,snel);
    if xpos<snel then
     begin;
      ypos:=random(480);
      snel:=1+random(4);
      xpos:=639;
     end;
    zetpunt(xpos,ypos,col);
   end;
 until keypressed;
 textmode(lastmode);
 Writeln(' ... tiny demo by Frank Disseldorp... Email=disseldorp@multiweb.net ..');
 Writeln('ÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍÄÍ');
 Writeln(' ... visit the Frinkel Site!   http://www.multiweb.net/~disseldorp/          ');
 writeln;
end.