#TJHSST ~ Starflight ~ Terrain Vehicle

terrain.pas

program terrainvehicle;
uses crt,graph;
const
  xsize = 50;
  ysize = 50;
type
  polys = array[1..5,1..3,1..5] of record
                                     x,y : word;
                                   end;
  fillarea = array[1..5,1..3,1..2] of byte;
  scapes = array [1..xsize,1..ysize] of byte;
  dirtype = (updown,leftright);
const
   fillarr : fillarea = (((15,15),(15,35),(15,75)),((75,15),(75,35),
     (75,75)),((100,15),(100,35),(100,75)),((135,15),(135,35),(145,75)),
     ((185,15),(185,35),(205,75)));
   polyfill : polys = ((((x:10;y:10),(x:50;y:10),(x:42;y:30),(x:10;y:30),
     (x:10;y:10)),((x:10;y:30),(x:42;y:30),(x:28;y:65),(x:10;y:65),
     (x:10;y:30)),((x:10;y:65),(x:28;y:65),(x:10;y:110),(x:10;y:65),
     (x:28;y:65))),(((x:50;y:10),(x:93;y:10),(x:88;y:30),(x:42;y:30),
     (x:50;y:10)),((x:42;y:30),(x:88;y:30),(x:80;y:65),(x:28;y:65),
     (x:42;y:30)),((x:28;y:65),(x:80;y:65),(x:70;y:110),(x:10;y:110),
     (x:28;y:65))),(((x:93;y:10),(x:126;y:10),(x:131;y:30),(x:88;y:30),
     (x:93;y:10)),((x:88;y:30),(x:131;y:30),(x:140;y:65),(x:80;y:65),
     (x:88;y:30)),((x:80;y:65),(x:140;y:65),(x:150;y:110),(x:70;y:110),
     (x:80;y:65))),(((x:126;y:10),(x:169;y:10),(x:178;y:30),(x:131;y:30),
     (x:126;y:10)),((x:131;y:30),(x:178;y:30),(x:192;y:65),(x:140;y:65),
     (x:131;y:30)),((x:140;y:65),(x:192;y:65),(x:210;y:110),(x:150;y:110),
     (x:140;y:65))),(((x:169;y:10),(x:210;y:10),(x:210;y:30),(x:178;y:30),
     (x:169;y:10)),((x:178;y:30),(x:210;y:30),(x:210;y:65),(x:192;y:65),
     (x:178;y:30)),((x:192;y:65),(x:210;y:65),(x:210;y:110),(x:192;y:65),
     (x:210;y:65))));
   pix_rex  = 2;
   snakes   = 5;
   timeconst = xsize*ysize*4;
   med : fillpatterntype = (($AA),($55),($AA),($55),($AA),($55),($AA),($55));
   low : fillpatterntype = (($AA),($55),($AA),($55),($AA),($55),($AA),($55));
   high : fillpatterntype = (($AA),($55),($AA),($55),($AA),($55),($AA),($55));
var
  otx,oty,tx,ty,x,y,z : integer;
  ufo : file of scapes;
  terra,specs : scapes;
  dir : 0..5;
  page : boolean;
  quit : boolean;

procedure sp;
  begin
    setactivepage(ord(page));
    setvisualpage(ord(not page));
    page := not page;
  end;

procedure initiate_graphics;
  const
    landscale : palettetype =
                (
                  size : 16;
                  colors : (64,8,1,9,43,40,5,61,47,16,34,50,51,36,37,53)
                );
  var
    gdriver,gmode : integer;
  begin
    page := false;
    randomize;
    gdriver := ega;
    gmode := egahi;
    initgraph(gdriver,gmode,'');
    setallpalette(landscale);
    quit := false;
  end;

procedure do_landscape;
  var
    count,count2 : integer;
    x,y : array[1..snakes] of integer;

  procedure snakemove(snake : integer);
    var
      rand : integer;
    begin
      rand := random(8)+1;
      case rand of
        4,6,1 : x[snake] := x[snake] - 1;
        5,3,8 : x[snake] := x[snake] + 1;
      end;
      case rand of
        1,2,3 : y[snake] := y[snake] + 1;
        6,7,8 : y[snake] := y[snake] - 1;
      end;
      if (x[snake] > xsize) then x[snake] := 1;
      if (y[snake] > ysize) then y[snake] := 1;
      if (x[snake] < 1) then x[snake] := xsize;
      if (y[snake] < 1) then y[snake] := ysize;
      case pix_rex of
        1 : begin
              setcolor((terra[x[snake],y[snake]] mod 16) + 1);
              rectangle((x[snake]*4)-1,(y[snake]*4)-1,
                        (x[snake]*4)+1,(y[snake]*4)+1);
            end;
        2 : putpixel(x[snake]*2,y[snake]*2,(terra[x[snake],y[snake]] mod 16) + 1);
      end;
      terra[x[snake],y[snake]] := terra[x[snake],y[snake]] + 2;
      if (y[snake] > 1) then
        terra[x[snake],y[snake]-1] := terra[x[snake],y[snake]-1] + 1;
      if (y[snake] < ysize) then
        terra[x[snake],y[snake]+1] := terra[x[snake],y[snake]+1] + 1;
      if (x[snake] > 1) and (y[snake] < ysize) then
        terra[x[snake]-1,y[snake]+1] := terra[x[snake]-1,y[snake]+1] + 1;
      if (x[snake] > 1) then
        terra[x[snake]-1,y[snake]] := terra[x[snake]-1,y[snake]] + 1;
      if (x[snake] > 1) and (y[snake] > 1) then
        terra[x[snake]-1,y[snake]-1] := terra[x[snake]-1,y[snake]-1] + 1;
      if (x[snake] < xsize) and (y[snake] < ysize) then
        terra[x[snake]+1,y[snake]+1] := terra[x[snake]+1,y[snake]+1] + 1;
      if (x[snake] < xsize) then
        terra[x[snake]+1,y[snake]] := terra[x[snake]+1,y[snake]] + 1;
      if (x[snake] < xsize) and (y[snake] > 1) then
        terra[x[snake]+1,y[snake]-1] := terra[x[snake]+1,y[snake]-1] + 1;
    end;

  begin
    cleardevice;
    for count := 1 to xsize do begin
      for count2 := 1 to ysize do begin
        terra[count,count2] := 0;
      end;
    end;
    for count := 1 to snakes do begin
      x[count] := random(xsize);
      y[count] := random(ysize);
    end;
    count := 1;
    setcolor(7);
    case pix_rex of
      1 : rectangle(2,2,(xsize * 4),(ysize * 4));
      2 : rectangle(2,2,(xsize * 2)+3,(ysize * 2)+3);
    end;
    repeat
      for count2 := 1 to snakes do begin
        snakemove(count2);
        count := count + 1;
      end;
    until (count >= timeconst) or keypressed;
  end;

procedure divide_landscape;
  var
    x,y,z : byte;
  begin
    for x := 1 to xsize-1 do begin
      for y := 1 to ysize-1 do begin
        if (terra[x,y] <= 8) then
          terra[x,y] := 1
        else
          for z := 2 to 16 do begin
           if (terra[x,y] <= (8 * z)) and
              (terra[x,y] >= (8 * (z - 1))) then
             terra[x,y] := z;
          end;
      end;
    end;
  end;

procedure move_vehicle(way : dirtype) ;
  var
    command : char;
    invert : shortint;
  begin
    command := readkey;
    if (dir=4) or (dir=3)
      then invert := -1
      else invert := 1;
    if (way = leftright) then
      case command of
        #72{8} : tx := tx+1*invert;
        #80{2} : tx := tx-1*invert;
      end;
    if (way = updown) then
      case command of
        #72{8} : ty:=ty-1*invert;
        #80{2} : ty:=ty+1*invert;
      end;
    case command of
      #77{6} : dir := dir+1;
      #75{4} : dir := dir-1;
      'q'    : quit := true;
    end;
    if (dir > 4) then dir := 1;
    if (dir < 1) then dir := 4;
    if (tx > xsize-3) then tx := xsize-3;
    if (tx < 3) then tx := 3;
    if (ty > ysize-3) then ty := ysize-3;
    if (ty < 3) then ty := 3;
  end;

procedure view;
  var
    l,b : shortint;
  begin
    if (dir = 1) then begin
      for x := 1 to 5 do begin
        for y := 1 to 3 do begin
          if (odd(terra[tx-3+x,ty-3+y]))
            then setfillpattern(med,((terra[tx-3+x,ty-3+y]-1) div 2)+1)
            else setfillstyle(1,((terra[tx-3+x,ty-3+y]-1) div 2)+1);
{          if (terra[tx-3+x,ty-3+y]<>
              getpixel(fillarr[x,y,1],fillarr[x,y,2])) then}
            fillpoly(5,polyfill[x,y]);
        end;
      end;
    end;
    if (dir = 2) then begin
      for y := -2 to 2 do begin
        l := 4;
        for x:=1 to 3 do begin
          dec(l);
          if (odd(terra[tx+l-1,ty+y]))
            then setfillpattern(med,((terra[tx+l-1,ty+y]-1) div 2)+1)
            else setfillstyle(1,((terra[tx+l-1,ty+y]-1) div 2)+1);
{          if (terra[tx+l-1,ty+y]<>
              getpixel(fillarr[y+3,x,1],fillarr[y+3,x,2])) then}
            fillpoly(5,polyfill[y+3,x]);
        end;
      end;
    end;
    if (dir = 3) then begin
      b := 6;
      for x:=1 to 5 do begin
        l := 4;
        dec(b);
        for y := 1 to 3 do begin
          dec(l);
          if (odd(terra[tx-3+b,ty+l-1]))
            then setfillpattern(med,((terra[tx-3+b,ty+l-1]-1) div 2)+1)
            else setfillstyle(1,((terra[tx-3+b,ty+l-1]-1) div 2)+1);
{          if (terra[tx-3+b,ty+l-1]<>
              getpixel(fillarr[x,y,1],fillarr[x,y,2])) then}
            fillpoly(5,polyfill[x,y]);
        end;
      end;
    end;
    if (dir = 4) then begin
      b:=0;
      for y := 2 downto -2 do begin
        inc(b);
        for x:=-2 to 0 do begin
          dec(l);
          if (odd(terra[tx+x,ty+y]))
            then setfillpattern(med,((terra[tx+x,ty+y]-1) div 2)+1)
            else setfillstyle(1,((terra[tx+x,ty+y]-1) div 2)+1);
{          if (terra[tx+x,ty+y]<>
              getpixel(fillarr[b,x+3,1],fillarr[b,x+3,2])) then}
            fillpoly(5,polyfill[b,x+3]);
        end;
      end;
    end;
  end;

begin
  initiate_graphics;
  do_landscape;
  repeat until keypressed;
  divide_landscape;
  tx := xsize div 2;
  ty := ysize div 2;
  dir := 1;
  cleardevice;
  for x:= 1 to xsize-1 do begin
    for y := 1 to ysize-1 do begin
      setcolor(((terra[x,y]-1) div 2)+1);
      if (odd(terra[x,y]))
        then setfillpattern(med,((terra[x,y]-1) div 2)+1)
        else setfillstyle(1,((terra[x,y]-1) div 2)+1);
      bar(x*5+210,y*5,x*5+210+4,y*5+4);
      sp;
      bar(x*5+210,y*5,x*5+210+4,y*5+4);
    end;
  end;
  otx := tx;
  oty := ty;
  repeat
    setcolor(0);
    bar(otx*5+210,oty*5,otx*5+210+4,oty*5+4);
    view;
    setfillstyle(1,13);
    bar(tx*5+210,ty*5,tx*5+210+4,ty*5+4);
    sp;
    if (odd(terra[otx,oty]))
      then setfillpattern(med,((terra[otx,oty]-1) div 2)+1)
      else setfillstyle(1,((terra[otx,oty]-1) div 2)+1);
    bar(otx*5+210,oty*5,otx*5+210+4,oty*5+4);
    setcolor(0);
    otx := tx;
    oty := ty;
    case dir of
      1,3 : move_vehicle(updown);
      2,4 : move_vehicle(leftright);
    end;
  until quit;
end.

Turbo Pascal program attempting to re-create the planet-side terrain vehicle aspect of "Starflight" and "Starflight II" found on an old 5.25 floppy disk from when I was a nerd at Thomas Jefferson High School for Science and Technology between 1988 and 1992.

http://en.wikipedia.org/wiki/Starflight

Anyone can do whatever they'd like to with this program--if anything.

I remain a Black Egg detonating and Crystal Planet exploding nerd.