#TJHSST ~ Text-Based Landscapes and "Snafux" (Turbo Pascal 5.5)

SNAFUX.PAS

program The_Revenge_of_the_Snafux_for_IBMs;
uses crt,graph;
type
  what = (play,enem,bloc,empt);
  loc = record bx,by : integer end;
var
  gr,gd,x,y,px,py,opy,opx,ex,ey,oex,oey,lvl,dif : integer;
  killed,win,quit : boolean;
  grid : array[0..29,0..15] of what;
  blok : array[1..100] of loc;
  stop : char;

procedure up_move;
  var temp,ty,blocs : integer;
      done : boolean;
  begin
    ty := py - 1;
    blocs := 0;
    done := false;
    repeat
      if grid[px,ty] = bloc then blocs := blocs + 1;
      if grid[px,ty] = enem then done := true;
      ty := ty - 1;
      if ty = 0 then done := true;
    until (grid[px,ty] = empt) or done;
    if not done then begin
      for temp := 1 to blocs do begin
        grid[px,ty] := grid[px,ty+1];
        setcolor(12);
        rectangle((px-1)*20+42,(ty-1)*20+42,(px-1)*20+58,(ty-1)*20+58);
        setcolor(0);
        rectangle((px-1)*20+42,(ty)*20+42,(px-1)*20+58,(ty)*20+58);
        ty := ty + 1;
      end;
    end;
    if not done then py := py - 1;
  end;

procedure down_move;
  var temp,ty,blocs : integer;
      done : boolean;
  begin
    ty := py + 1;
    blocs := 0;
    done := false;
    repeat
      if grid[px,ty] = bloc then blocs := blocs + 1;
      if grid[px,ty] = enem then done := true;
      ty := ty + 1;
      if ty = 15 then done := true;
    until (grid[px,ty] = empt) or done;
    if not done then begin
      for temp := 1 to blocs do begin
        grid[px,ty] := grid[px,ty-1];
        setcolor(12);
        rectangle((px-1)*20+42,(ty-1)*20+42,(px-1)*20+58,(ty-1)*20+58);
        setcolor(0);
        rectangle((px-1)*20+42,(ty-2)*20+42,(px-1)*20+58,(ty-2)*20+58);
        ty := ty - 1;
      end;
    end;
    if not done then py := py + 1;
  end;

procedure left_move;
  var temp,tx,blocs : integer;
      done : boolean;
  begin
    tx := px - 1;
    blocs := 0;
    done := false;
    repeat
      if grid[tx,py] = bloc then blocs := blocs + 1;
      if grid[tx,py] = enem then done := true;
      tx := tx - 1;
      if tx = 0 then done := true;
    until (grid[tx,py] = empt) or done;
    if not done then begin
      for temp := 1 to blocs do begin
        grid[tx,py] := grid[tx+1,py];
        setcolor(12);
        rectangle((tx-1)*20+42,(py-1)*20+42,(tx-1)*20+58,(py-1)*20+58);
        setcolor(0);
        rectangle((tx)*20+42,(py-1)*20+42,(tx)*20+58,(py-1)*20+58);
        tx := tx + 1;
      end;
    end;
    if not done then px := px - 1;
  end;

procedure right_move;
  var temp,tx,blocs : integer;
      done : boolean;
  begin
    tx := px + 1;
    blocs := 0;
    done := false;
    repeat
      if grid[tx,py] = bloc then blocs := blocs + 1;
      if grid[tx,py] = enem then done := true;
      tx := tx + 1;
      if tx = 29 then done := true;
    until (grid[tx,py] = empt) or done;
    if not done then begin
      for temp := 1 to blocs do begin
        grid[tx,py] := grid[tx-1,py];
        setcolor(12);
        rectangle((tx-1)*20+42,(py-1)*20+42,(tx-1)*20+58,(py-1)*20+58);
        setcolor(0);
        rectangle((tx-2)*20+42,(py-1)*20+42,(tx-2)*20+58,(py-1)*20+58);
        tx := tx - 1;
      end;
    end;
    if not done then px := px + 1;
  end;


procedure bloc_place;
  begin
    for x := 1 to 100 do blok[x].bx := 0;
    x := 1;
    repeat
      repeat
        blok[x].bx := random(28)+1; blok[x].by := random(14)+1;
      until (grid[blok[x].bx,blok[x].by] = empt);
      grid[blok[x].bx,blok[x].by] := bloc;
      x := x + 1;
    until (x = 101);
  end;

procedure enem_move;
  begin
    oex := ex; oey := ey;
    if ((grid[ex+1,ey-1] = bloc) or (ex+1 = 29)) and
       ((grid[ex-1,ey-1] = bloc) or (ex-1 = 0)) and
       ((grid[ex,ey-1] = bloc) or (ey-1 = 0)) and (grid[ex+1,ey] = bloc) and
       ((grid[ex-1,ey] = bloc) or (ex-1 = 0)) and (grid[ex+1,ey+1] = bloc)  and
       (grid[ex-1,ey+1] = bloc) and ((grid[ex,ey+1] = bloc) or (ey+1=15)) then
         win := true;
    if (px>ex) and (grid[ex+1,ey] = empt) then ex := ex+1;
    if (px<ex) and (grid[ex-1,ey] = empt) then ex := ex-1;
    if (py>ey) and (grid[ex,ey+1] = empt) then ey := ey+1;
    if (py<ey) and (grid[ex,ey-1] = empt) then ey := ey-1;
    if ((px>ex) and (py>ey)) and (grid[ex+1,ey+1] = empt) then begin
      ex := ex+1; ey := ey+1; end;
    if ((px>ex) and (py<ey)) and (grid[ex+1,ey-1] = empt) then begin
      ex := ex+1; ey := ey-1; end;
    if ((px<ex) and (py>ey)) and (grid[ex-1,ey+1] = empt) then begin
      ex := ex-1; ey := ey+1; end;
    if ((px<ex) and (py<ey)) and (grid[ex-1,ey-1] = empt) then begin
      ex := ex-1; ey := ey-1; end;
    if ((oex <> ex) or (oey <> ey)) then begin
      setcolor(15);
      rectangle((ex-1)*20+41,(ey-1)*20+41,(ex-1)*20+59,(ey-1)*20+59);
      setcolor(0);
      rectangle((oex-1)*20+41,(oey-1)*20+41,(oex-1)*20+59,(oey-1)*20+59);
      grid[oex,oey] := empt; grid[ex,ey] := enem;
    end;
    if (abs(px-ex)<2) and (abs(py-ey)<2) then begin
      sound(500); delay(100); killed := true; nosound; end;
  end;

procedure play_move;
  var key : char;
  begin
    key := readkey; opy := py; opx := px;
    case key of
      #59 : quit := true;
      #72 : begin if (grid[px,py-1] = empt) then py := py - 1;
                  if (grid[px,py-1] = bloc) then up_move; end;
      #80 : begin if (grid[px,py+1] = empt) then py := py + 1;
                  if (grid[px,py+1] = bloc) then down_move; end;
      #77 : begin if (grid[px+1,py] = empt) then px := px + 1;
                  if (grid[px+1,py] = bloc) then right_move; end;
      #75 : begin if (grid[px-1,py] = empt) then px := px - 1;
                  if (grid[px-1,py] = bloc) then left_move; end;
    end;
    if px>28 then begin sound(400); delay(10); nosound; px:=28; end;
    if px<1 then begin sound(800); delay(10); nosound; px:=1; end;
    if py>14 then begin sound(1000); delay(10); nosound; py:=14; end;
    if py<1 then begin sound(1200); delay(10); nosound; py:=1; end;
    if (abs(px-ex)<2) and (abs(py-ey)<2) then begin
      sound(500); delay(100); nosound; killed := true; end;
    if ((opx <> px) or (opy <> py)) then begin
      setcolor(0);
      rectangle((opx-1)*20+43,(opy-1)*20+43,(opx-1)*20+57,(opy-1)*20+57);
      setcolor(10);
      rectangle((px-1)*20+43,(py-1)*20+43,(px-1)*20+57,(py-1)*20+57);
      grid[opx,opy] := empt; grid[px,py] := play;
    end;
  end;

begin
  randomize;
  gr := ega;
  gd := egahi;
  initgraph(gr,gd,'');
  quit := false;
  setactivepage(0);
  setcolor(2);
  outtextxy(150,200,'title screen');
  setvisualpage(0);
  setactivepage(1);

  repeat
    cleardevice;
    for x := 0 to 29 do begin
      for y := 0 to 15 do begin
        grid[x,y] := empt;
      end;
    end;
    px := random(8)+20;
    py := random(4)+10;
    ex := random(10)+1;
    ey := random(10)+1;
    grid[px,py] := play;
    grid[ex,ey] := enem;
    bloc_place;
    setcolor(13);
    rectangle(40,40,600,320);
    for x := 0 to 27 do begin
      for y := 0 to 13 do begin
        rectangle(x*20+40,y*20+40,x*20+60,y*20+60);
      end;
    end;
    setcolor(12);
    for x:=1 to 100 do
      rectangle((blok[x].bx-1)*20+42,(blok[x].by-1)*20+42,
                (blok[x].bx-1)*20+58,(blok[x].by-1)*20+58);
    setcolor(10);
    rectangle((px-1)*20+43,(py-1)*20+43,(px-1)*20+57,(py-1)*20+57);
    setcolor(15);
    rectangle((ex-1)*20+41,(ey-1)*20+41,(ex-1)*20+59,(ey-1)*20+59);
    setvisualpage(1);
    killed := false;
    win := false;
    repeat
      if keypressed then begin
        play_move;
      end;
      if ((random(2000)) = 1000) then enem_move;
    until (killed) or (win) or (quit);
    setvisualpage(0);
    stop := readkey;
  until quit;
end.

TXTLND.PAS

program terrainvehicle;
uses crt;
const
  xsize = 80;
  ysize = 24;
  timeconst = xsize * ysize * 4;
  snakes = 5;
  elevation : array [1..15] of byte =
    (1,1,9,11,25,42,34,14,6,110,106,12,68,20,1);
  terrain : array [1..15] of byte =
    (177,176,176,176,177,177,177,177,177,177,177,177,177,177,219);
type
  scapes = array [1..xsize,1..ysize] of byte;
var
  x,y : integer;
  terra : scapes;

procedure beep;
  begin
    sound(1000);
    delay(100);
    nosound;
  end;

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

  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;
      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
    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;
    repeat
      for count2 := 1 to snakes do begin
        snakemove(count2);
        count := count + 1;
      end;
      done := (count >= timeconst) or keypressed;
    until done;
    beep;
  end;

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

begin
  randomize;
  do_landscape;
  divide_landscape;
  clrscr;
  for x := 1 to xsize do begin
    for y := 1 to ysize do begin
      textattr := elevation[terra[x,y]];
      gotoxy(x,y);
      write(chr(terrain[terra[x,y]]));
    end;
  end;
  repeat until keypressed;
end.

These are two Pascal programs found on old 5.25 floppy disks from when I was in high school between 1988 and 1992.

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

Download Free Turbo Pascal, Turbo Pascal 5.5 Download
http://www.brothersoft.com/turbo-pascal-272949.html

Unzip to C:\TP

Or, rather than using the following, you can use DOSBox: http://www.dosbox.com/

Open two "cmd" windows.

In first window:

subst B: C:\TP\Disk1
pause
subst B: /D
subst B: C:\TP\Disk2
pause
subst B: /D

In second window:

C:\
cd\TP
cd Disk1
INSTALL.EXE

Follow command sequence in 1st and 2nd windows:

1 - Set drive substition for "B:" => "C:\TP\Disk1"
2 - Run "INSTALL.EXE"
2 - "Enter the SOURCE drive to use:" => "B"
2 - Continue installation until "Disk2" requested
1 - Delete drive substition for "B:"
1 - Set drive substition for "B:" => "C:\TP\Disk2"
2 - Continue installation
1 - Delete drive substition for "B:"