Turbo Toolbox/Turbo_Toolbox.iso/1990/09/tricks/space.pas

Pascal/Delphi Source File | 1990-06-15 | 5KB | 169 lines

(* ------------------------------------------------------ *)
(*                       SPACE.PAS                        *)
(*         Unit zum Erzeugen eines Sternenhimmels         *)
(*          (c) 1990 Andreas Heinemann & TOOLBOX          *)
(* ------------------------------------------------------ *)
UNIT SPACE;

INTERFACE

USES Graph;

CONST max_stars                 = 250;
      max_layers                = 4;

TYPE  star                      = RECORD
                                    x, y, pix : WORD;
                                  END;
      space_layer               = ARRAY [1..max_stars] OF
                                     star;
      space_layer_Ptr           = ^space_layer;
      space_typ                 = ARRAY [1..max_layers] OF
                                     space_layer_Ptr;
      space_data                = RECORD
            x1, y1, x2, y2  : WORD;
            layer_stars  : ARRAY[1..max_layers] OF WORD;
            layer_jmp    : ARRAY[1..max_layers] OF INTEGER;
            color        : WORD;
            space_VAR    : space_typ;
                                  END;
      space_data_Ptr            = ^space_data;

CONST starMem                   = SizeOf(star);

PROCEDURE init_space(Ptr : space_data_Ptr);
PROCEDURE Dispose_space(Ptr : space_data_Ptr);
PROCEDURE put_space(Ptr : space_data_Ptr);
PROCEDURE Move_layer(Ptr : space_data_Ptr;nr : INTEGER);
PROCEDURE clear_layer(Ptr : space_data_Ptr;nr : INTEGER);
PROCEDURE Move_layer_ndsp(Ptr : space_data_Ptr;
                          nr : INTEGER);
PROCEDURE put_layer(Ptr : space_data_Ptr;nr : INTEGER);
PROCEDURE Move_space(Ptr : space_data_Ptr);
PROCEDURE Move_space_snow(Ptr : space_data_Ptr);

IMPLEMENTATION

PROCEDURE init_space(Ptr : space_data_Ptr);
VAR i, h : INTEGER;
BEGIN
 WITH Ptr^ DO
      FOR i := 1 TO max_layers DO
          GetMem(space_VAR[i], StarMem * layer_stars[i]);

 WITH Ptr^ DO
      FOR h := 1 TO max_layers DO
          FOR i := 1 TO layer_stars[h] DO
              WITH space_VAR[h]^[i] DO
                   REPEAT
                          x := x1 + Random(x2 - x1);
                          y := y1 + Random(y2 - y1);
                   UNTIL GetPixel(x, y) <> color;
END;

PROCEDURE put_space(Ptr : space_data_Ptr);
VAR i, h : INTEGER;
BEGIN
 WITH Ptr^ DO
      FOR h := 1 TO max_layers DO
          FOR i := 1 TO layer_stars[h] DO
              WITH space_VAR[h]^[i] DO BEGIN
                   pix := GetPixel(x, y);
                   PutPixel(x, y, color);
      END;
END;

PROCEDURE Move_layer(Ptr : space_data_Ptr;nr : INTEGER);
VAR i : INTEGER;
BEGIN
 WITH Ptr^ DO
      FOR i := 1 TO layer_stars[nr] DO
          WITH space_VAR[nr]^[i] DO BEGIN
               PutPixel(x, y, pix);           { Sterne weg }

            REPEAT BEGIN
               IF x + layer_jmp[nr] <= x1 THEN BEGIN
                  x := x2;
                  y := y1 + Random(y2 - y1);
               END;

               x := x + layer_jmp[nr];
               IF x >= x2 THEN BEGIN
                  x := x1;
                  y := y1 + Random(y2 - y1);
               END;

               pix := GetPixel(x, y);

            END UNTIL pix <> color;

            PutPixel(x, y, color);
          END;
END;

PROCEDURE clear_layer(Ptr : space_data_Ptr;nr : INTEGER);
VAR i : INTEGER;
BEGIN
 WITH Ptr^ DO
      FOR i := 1 TO layer_stars[nr] DO
          WITH space_VAR[nr]^[i] DO
               PutPixel(x, y, pix);           { Sterne weg }
END;

PROCEDURE Move_layer_ndsp(Ptr : space_data_Ptr;
                          nr : INTEGER);
VAR i : INTEGER;
BEGIN
 WITH Ptr^ DO
      FOR i := 1 TO layer_stars[nr] DO
          WITH space_VAR[nr]^[i] DO BEGIN
               REPEAT
                      IF x + layer_jmp[nr] <= x1 THEN BEGIN
                         x := x2;
                         y := y1 + Random(y2 - y1);
                      END;

                      x := x + layer_jmp[nr];
                      IF x >= x2 THEN BEGIN
                         x := x1;
                         y := y1 + Random(y2 - y1);
                      END;

                      pix := GetPixel(x, y);
               UNTIL pix <> color;
         END;
END;

PROCEDURE Move_space(Ptr : space_data_Ptr);
VAR i : INTEGER;
BEGIN
 FOR i := 1 TO max_layers DO
     Move_layer(Ptr, i);
END;

PROCEDURE put_layer(Ptr : space_data_Ptr;nr : INTEGER);
VAR i : INTEGER;
BEGIN
 WITH Ptr^ DO
      FOR i := 1 TO layer_stars[nr] DO
          WITH space_VAR[nr]^[i] DO
               PutPixel(x, y, color);
END;

PROCEDURE Move_space_snow(Ptr : space_data_Ptr);
VAR i : INTEGER;
BEGIN
 FOR i := 1 TO max_layers DO clear_layer(Ptr, i);
 FOR i := 1 TO max_layers DO Move_layer(Ptr, i);
 FOR i := 1 TO max_layers DO put_layer(Ptr, i);
END;

PROCEDURE Dispose_space(Ptr : space_data_Ptr);
VAR i : INTEGER;
BEGIN
 WITH Ptr^ DO
      FOR i := 1 TO max_layers DO
          FreeMem(space_VAR[i], StarMem * layer_stars[i]);
END;
END.