(*
* Platform: BP7 in dosbox, cycles=fixed 10000
* Controls: <ESC> to exit, anything else to pause/resume
*)
program sky;
uses
    graph, crt;

type
    Point = record
        x, y: word;
        color: byte;
        velocity: byte;
    end;

const
    N = 1000;
    VELOCITY_MAX = 5;

    COLOR_MAX = 7;
    PALETTE: array [1..3*COLOR_MAX] of byte = (
        $92, $B5, $FF,
        $A2, $C0, $FF,
        $D5, $E0, $FF,
        $FF, $FF, $FF,
        $FF, $ED, $E3,
        $FF, $B5, $6C,
        $FF, $DA, $B5
    );

var
    gd, gm: integer;
    page, W, H: word;
    stars: array [1..N] of Point;
    ch: char;

procedure skyPalette;
var
    i, j: word;
begin
    j := 1;
    for i:=1 to COLOR_MAX do begin
        setPalette(i, i);
        setRGBPalette(i,
            PALETTE[j] shr 2,
            PALETTE[j+1] shr 2,
            PALETTE[j+2] shr 2
        );

        inc(j,3);
    end;
end;

function randomColor: byte;
var
    x: word;
    c: byte;
begin
    x := random(10000);

    if x >= 2355 then
        c := 7
    else if x >=1145 then
        c := 6
    else if x >= 385 then
        c := 5
    else if x >= 85 then
        c := 4
    else if x >= 25 then
        c := 3
    else if x >= 12 then
        c := 2
    else
        c := 1;

    randomColor := c;
end;

function randomPwr( limit: word): word;
var
    t, f: real;
begin
    t := 2*random - 1;

    f := exp(1.6*ln(abs(t)));
    if t < 0 then
        f := -f;

    randomPwr := round((f+1)*(limit-1)/2);
end;

procedure randomPoint( var p: Point; m: word);
begin
    if m > 0 then
        p.x := W - m + random(m)
    else
        p.x := random(W);

    p.y := randomPwr(H);
    p.color := randomColor;
    p.velocity := randomPwr(VELOCITY_MAX) + 1;
end;

procedure skyInit;
var
    i: word;
begin
    randomize;
    for i:=1 to N do
        randomPoint(stars[i], 0);
end;

procedure skyShift;
var
    i: word;
begin
    for i:=1 to N do begin
        if stars[i].x < stars[i].velocity then
            randomPoint(stars[i], 1)
        else
            dec(stars[i].x, stars[i].velocity);
    end;
end;

procedure skyPaint;
var
    i: word;

begin
    for i:=1 to N do
        putPixel(stars[i].x, stars[i].y, stars[i].color);
end;


begin
    gd := VGA;
    gm := VGAMed;
    initGraph(gd, gm, 'c:\bp\bgi');

    W := getMaxX + 1;
    H := getMaxY + 1;

    skyPalette;
    skyInit;
    skyPaint;

    repeat
        repeat
            skyShift;
            page := page xor 1;
            setActivePage(page);
            clearDevice;
            skyPaint;
            setVisualPage(page);
            delay(20);
        until keypressed;

        while keypressed do
            ch := readkey;

        if ch <> #27 then
            ch := readkey;
    until ch = #27;

    closeGraph;
end.