{
I have added the words ANASTHASIA just by doing this.  I would create the
letters like this:

111111
11  11
111111
11  11
11  11

and then fill the blanks with zero's (0's), and stick that into BSCR^, which
was previously filled with 0's using fillchar.  And instead of zeroing SCR^
each time, you simply copy the contents of BSCR to SCR which is a bit faster I
think.  Here's the modified code which is a bit larger due to the dots required
to make ANASTHASIA appear :)...

I have also made it move by itself and allow the user to move it, too.  Hope
this helps someone :)... You can modify whatever the letters say at the top
simply by chaning the LETTERS_A variable.... Have fun...This can be put into
SWAG freely..

{
I have a fairly good voxel-source.
This one is not mine. And I forgot who made it.
}

{$R-S-}
program voxel;
uses crt;
type lrgarr=array[0..65534] of byte;
const
  done : boolean = false;
 Letters_A : Array[0..2239] of Byte =(

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
1,1,1,1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,
0,0,0,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,0,
0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,1,1,1,1,
1,1,1,1,1,1,1,0,1,1,1,1,1,0,0,0,0,1,1,1,
1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,1,
1,1,1,1,1,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,
1,0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
0,0,0,0,0,0,1,1,1,0,0,1,1,1,0,1,1,1,0,0,
0,0,0,1,1,1,0,0,1,1,1,0,0,0,0,0,0,1,1,1,
0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,
1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,
1,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,1,1,
1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,
0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
0,0,0,0,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,
0,0,0,1,1,1,0,0,1,1,1,0,0,0,0,0,0,1,1,1,
0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,
1,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,1,1,
1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,
0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
1,1,1,1,1,1,1,1,0,0,1,1,1,0,0,0,1,1,1,0,
0,1,0,1,1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,
0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,1,
1,1,0,0,0,0,0,0,1,1,0,1,1,1,1,1,1,1,1,1,
1,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,1,
1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,1,1,1,0,0,
0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
0,0,0,0,0,0,1,1,1,0,0,1,1,1,0,0,0,0,1,1,
1,0,0,1,1,1,0,0,1,1,1,0,0,0,0,0,0,1,1,1,
0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,1,
1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,1,1,
1,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,
0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,
0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,
0,0,0,0,0,1,1,1,0,0,1,1,1,1,0,0,0,0,0,1,
1,1,0,1,1,1,0,0,1,1,1,0,0,0,0,0,0,1,1,1,
0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,
1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,
1,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,1,1,
1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,1,0,0,
0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,
1,0,0,0,0,1,1,1,1,1,0,1,1,1,0,0,0,0,0,0,
1,1,1,1,1,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,
1,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,1,
1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,
1,1,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,1,
1,1,1,1,1,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,
0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,1,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);


 pal:array[1..384] of byte=(
  0,0,0,48,48,48,1,0,43,1,3,43,2,5,44,2,7,44,3,9,45,4,11,46,5,13,47,6,15,48,
  7,17,49,8,19,50,9,21,51,10,22,52,11,24,52,12,26,54,13,28,54,14,30,56,15,32,
  56,16,34,58,17,34,58,17,36,58,18,38,60,19,40,60,20,42,62,21,44,62,10,31,0,
  11,31,0,11,31,1,11,32,1,12,32,1,12,32,2,12,33,2,13,33,2,14,33,3,15,33,3,15,
  34,3,15,34,4,15,35,4,16,35,4,16,35,5,16,36,5,17,36,5,17,36,6,18,37,6,18,38,
  7,19,38,8,20,39,8,20,40,9,21,40,10,22,41,10,22,42,11,23,42,12,24,43,12,24,
  44,13,25,44,14,25,45,14,26,46,15,27,46,16,27,47,17,28,47,18,28,48,19,29,49,
  19,30,49,20,30,50,21,31,51,21,32,51,22,32,52,23,33,53,23,34,53,24,34,54,25,
  35,55,25,36,55,26,36,56,27,37,57,27,38,57,27,39,57,27,41,57,27,42,57,27,43,
  57,27,44,57,27,45,57,27,46,57,27,47,57,27,49,57,27,50,57,27,51,57,27,52,57,
  27,53,57,27,55,57,27,56,57,27,57,57,27,58,57,27,58,57,26,58,57,25,58,57,24,
  58,56,23,58,55,22,58,54,20,58,53,19,58,51,18,58,50,17,58,50,16,58,49,15,58,
  48,14,58,47,13,58,46,12,58,45,11,58,44,11,58,44,10,58,43,10,58,42,9,57,41,
  8,57,40,8,56,39,7,56,38,6,55,37,5,55,35,4,54,33,4,54,31,2,32,32,32,63,63,63,
  63,63,63,63,63,63,63,63,63,48,48,48,63,63,63,63,63,63);

var
  mp, bscr, scr     : ^lrgarr;
  rng               : array[0..320] of byte;
  dir,i,x,y         : integer;


FUNCTION ReadCursorX: byte; assembler;  {Get X position of cursor}
asm
  MOV   ah, 03h
  XOR   bx, bx
  INT   10h
  MOV   al, dl
end;

FUNCTION ReadCursorY: byte; assembler;  {Get Y position of cursor}
asm
  MOV   ah, 03h
  XOR   bx, bx
  INT   10h
  MOV   al, dh
end;


PROCEDURE MovCursor (X,Y : byte);  {Moves the cursor to (X,Y)}
begin
  asm
  MOV   ah, 02h
  XOR   bx, bx
  MOV   dh, Y
  MOV   dl, X
  INT   10h
  end;
end;


PROCEDURE PutText (TextData : string; Color : byte);  {Write a string}
var      {It's not the fastest way to do it, but it does the job}
 z, ASCdata, CursorX, CursorY : byte;
begin
 CursorX := ReadCursorX;
 CursorY := ReadCursorY;
 for z := 1 to Length(TextData) do
 begin
  ASCdata := Ord(TextData[z]);
  asm
  MOV   AH, 0Ah
  MOV   AL, ASCdata   {pass the character, as we write it char per char}
  XOR   BX, BX       {set it to zero, a lot faster then MOV BX, 0}
  MOV   BL, Color    {pass the color parameter to BL}
  MOV   CX, 1
  INT   10h         {call interupt 10h for output}
  end;
  inc(CursorX);
  if CursorX=40 then begin CursorX:=0; inc(CursorY); end;
  MovCursor(CursorX,CursorY);
 end;
end;





function ncol(mc,n,dvd:integer):integer;
var loc:integer;
begin
  loc:=(mc+n-random(2*n)) div dvd; ncol:=loc;
  if loc>250 then ncol:=250; if loc<5 then ncol:=5
end;

procedure plasma(x1,y1,x2,y2:word);
var xn,yn,dxy,p1,p2,p3,p4:word;
begin
  if (x2-x1<2) and (y2-y1<2) then exit;
  p1:=mp^[256*y1+x1]; p2:=mp^[256*y2+x1]; p3:=mp^[256*y1+x2];
  p4:=mp^[256*y2+x2]; xn:=(x2+x1) shr 1; yn:=(y2+y1) shr 1;
  dxy:=5*(x2-x1+y2-y1) div 3;
  if mp^[256*y1+xn]=0 then mp^[256*y1+xn]:=ncol(p1+p3,dxy,2);
  if mp^[256*yn+x1]=0 then mp^[256*yn+x1]:=ncol(p1+p2,dxy,2);
  if mp^[256*yn+x2]=0 then mp^[256*yn+x2]:=ncol(p3+p4,dxy,2);
  if mp^[256*y2+xn]=0 then mp^[256*y2+xn]:=ncol(p2+p4,dxy,2);
  mp^[256*yn+xn]:=ncol(p1+p2+p3+p4,dxy,4);
  plasma(x1,y1,xn,yn); plasma(xn,y1,x2,yn);
  plasma(x1,yn,xn,y2); plasma(xn,yn,x2,y2);
end;

procedure draw(xp,yp,dir:integer);
var z,zobs,ix,iy,iy1,iyp,ixp,x,y,s,csf,snf,mpc,i,j:integer;
begin
  fillchar(rng,sizeof(rng),200); zobs:=100+mp^[256*yp+xp];
  csf:=round(256*cos(dir/180*pi)); snf:=round(256*sin(dir/180*pi));
{  if Random(100) > 90 Then
     fillchar(scr^,64000,1)
  Else}
  scr^ := bscr^;
  for iy:=yp to yp+55 do begin
    iy1:=1+2*(iy-yp); s:=4+300 div iy1;
    for ix:=xp+yp-iy to xp-yp+iy do begin
      ixp:=xp+((ix-xp)*csf+(iy-yp)*snf) shr 8;
      iyp:=yp+((iy-yp)*csf-(ix-xp)*snf) shr 8;
      x:=160+360*(ix-xp) div iy1;
      if (x>=0) and (x+s<=318) then begin
        z:=mp^[iyp shl 8+ixp]; mpc:=z shr 1;
        if z<47 then z:=46;  y:=100+(zobs-z)*30 div iy1;
        if (y<=199) and (y>=0) then for j:=x to x+s do begin
          for i:=y to rng[j] do scr^[320*i+j]:=mpc;
          if y<rng[j] then rng[j]:=y
        end;
      end;
    end;
  end;
  move(scr^,mem[$a000:0],64000);
end;

begin
  writeln('þ Creating landscape...');
  randomize; x:=0; y:=0; dir:=0;
  new(mp); fillchar(mp^,65535,0);
  new(scr); fillChar(scr^, 64000, 0);
  new(bscr); fillChar(bscr^, 64000, 0);
  for x:= 0 to 2239 do
      bscr^[x] := Letters_A[x];
  scr^ := bscr^;

  mp^[$0000]:=128; plasma(0,0,256,256);

  asm
     xor ax,ax;
     mov al,$13;
     int $10;
  end;

  port[$3c8]:=0; for i:=1 to 384 do port[$3c9]:=pal[i];
  randomize;
  repeat
    dir:=dir mod 360;
    draw(x,y,dir);
    case random(100) of
                {left}
        96..98: inc(dir, 10);
                {right}
       99..100: dec(dir, 10);
                {forward left}
        66..80: begin
                     y:=y+round(5*cos(dir/180*pi));
                     x:=x+round(5*sin(dir/180*pi));
                     inc(dir, 10);
                end;
                {forward-right}
        81..95: begin
                     y:=y+round(5*cos(dir/180*pi));
                     x:=x+round(5*sin(dir/180*pi));
                     Dec(dir, 10);
                end;
                {forward}
         1..65: begin
                     y:=y+round(5*cos(dir/180*pi));
                     x:=x+round(5*sin(dir/180*pi));
                  end;
                  {back}
{        81..90: begin
                     y:=y-round(5*cos(dir/180*pi));
                     x:=x-round(5*sin(dir/180*pi));
                  end;}
    end;
    if keypressed Then
       Done := Not Done;
{    case readkey of
      #0:case readkey of
        #75:dec(dir,10);
        #77:inc(dir,10);
        #72:begin
          y:=y+round(5*cos(dir/180*pi));
          x:=x+round(5*sin(dir/180*pi));
        end;
        #80:begin
          y:=y-round(5*cos(dir/180*pi));
          x:=x-round(5*sin(dir/180*pi));
        end;
      end;
      #27:begin asm xor ax,ax; mov al,$3; int $10; end; halt end
    end}
  until Done;
  asm
     xor ax,ax;
     mov al,$3;
     int $10;
  end;
end.