[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

{ NEEDS A MOUSE !!!
And here as promised to several fellows, the moving landscape!
It needs a mouse, as you can see...
Again nothing realy nifty (imho), no bankswitching, no mode-x, no virtual
screens, no palette tricks, just some hard math! ;-) Have fun with it...

--- cut here ---}

program landscape_2d;
{ 2D landscape (without rotating). Made by Bas van Gaalen, Holland, PD }
const
  vseg = $a000;
  a_density = 4;
  roughness = 20;
  maxx_scape = 320; maxy_scape = 200;
  maxh = 128;
  maxx = 250 div a_density; maxy = 110 div a_density;
var landscape : array[0..maxx_scape*maxy_scape] of byte;

{ mouse routines ------------------------------------------------------------}

function mouseinstalled : boolean; assembler; asm
  xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;

function getmousex : word; assembler; asm
  mov ax,3; int 33h; mov ax,cx end;

function getmousey : word; assembler; asm
  mov ax,3; int 33h; mov ax,dx end;

function leftpressed : boolean; assembler; asm
  mov ax,3; int 33h; and bx,1; mov ax,bx end;

procedure mousesensetivity(x,y : word); assembler; asm
  mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;

procedure mousewindow(l,t,r,b : word); assembler; asm
  mov ax,7; mov cx,l; mov dx,r; int 33h; mov ax,8
  mov cx,t; mov dx,b; int 33h end;

{ lowlevel video routines ---------------------------------------------------}

procedure setvideo(m : word); assembler; asm
  mov ax,m; int 10h end;

procedure putpixel(x,y : word; c : byte); assembler; asm
  mov ax,vseg; mov es,ax; mov ax,y; mov dx,320; mul dx
  mov di,ax; add di,x; mov al,c; mov [es:di],al end;

function getpixel(x,y : word) : byte; assembler; asm
  mov ax,vseg; mov es,ax; mov ax,y; mov dx,320; mul dx
  mov di,ax; add di,x; mov al,[es:di] end;

procedure setpal(c,r,g,b : byte); assembler; asm
  mov dx,03c8h; mov al,c; out dx,al; inc dx; mov al,r
  out dx,al; mov al,g; out dx,al; mov al,b; out dx,al end;

procedure retrace; assembler; asm
  mov dx,03dah; @l1: in al,dx; test al,8; jnz @l1
  @l2: in al,dx; test al,8; jz @l2 end;

{ initialize palette colors -------------------------------------------------}

procedure initcolors;
var i : byte;
begin
  for i := 0 to 63 do begin
    setpal(i+1,21+i div 3,21+i div 3,63-i);
    setpal(i+65,42-i div 3,42+i div 3,i div 3);
  end;
end;

{ landscape generating routines ---------------------------------------------}

procedure adjust(xa,ya,x,y,xb,yb : integer);
var d,c : integer;
begin
  if getpixel(x,y) <> 0 then exit;
  d := abs(xa-xb)+abs(ya-yb);
  c := (50*(getpixel(xa,ya)+getpixel(xb,yb))+trunc((10*random-5)*d*roughness))
div 100;
  if c < 1 then c := 1;
  if c >= maxh then c := maxh;
  putpixel(x,y,c);
end;

procedure subdivide(l,t,r,b : integer);
var x,y : integer; c : integer;
begin
  if (r-l < 2) and (b-t < 2) then exit;
  x := (l+r) div 2; y := (t+b) div 2;
  adjust(l,t,X,t,r,t);
  adjust(r,t,r,Y,r,b);
  adjust(l,b,X,b,r,b);
  adjust(l,t,l,Y,l,b);
  if getpixel(x,y) = 0 then begin
    c := (getpixel(l,t)+getpixel(r,t)+getpixel(r,b)+getpixel(l,b)) div 4;
    putpixel(x,y,c);
  end;
  subdivide(l,t,x,y);
  subdivide(x,t,r,y);
  subdivide(l,y,x,b);
  subdivide(x,y,r,b);
end;

procedure generatelandscape;
var image : file; vidram : byte absolute vseg:0000; i : word;
begin
  assign(image,'plasma.img');
  {$I-} reset(image,1); {$I+}
  if ioresult <> 0 then begin
    randomize;
    putpixel(0,0,random(maxh));
    putpixel(maxx_scape-1,0,random(maxh));
    putpixel(maxx_scape-1,maxy_scape-1,random(maxh));
    putpixel(0,maxy_scape-1,random(maxh));
    subdivide(0,0,maxx_scape,maxy_scape);
    rewrite(image,1);
    blockwrite(image,mem[vseg:0],maxx_scape*maxy_scape);
  end else blockread(image,mem[vseg:0],maxx_scape*maxy_scape);
  close(image);
  move(vidram,landscape,sizeof(landscape));
  fillchar(vidram,maxx_scape*maxy_scape,0);
  for i := 0 to maxx_scape*maxy_scape-1 do landscape[i] := 110+Landscape[i] div
2;
end;

{ the actual displaying of the whole thing! ---------------------------------}

procedure displayscape;
var i,j,previ,prevj,n : word; x : integer;
begin
  i := 0; j := 0;
  repeat
    {retrace;}
    previ := i; i := getmousex; prevj := j; j := getmousey;
    for n := 0 to maxx*maxy-1 do begin
      x := -(a_density*(integer(n mod maxx)-(maxx shr 1)-1)*45) div (integer(n
div maxx)-45)-90;
      if (x >= -250) and (X <= 60) then begin
        mem[vseg:320*(a_density*integer(n div maxx)-landscape[n mod
maxx+previ+(n div maxx+prevj)*maxx_scape])+x] := 0;
        mem[vseg:320*(a_density*integer(n div maxx)-landscape[n mod maxx+i+(n
div maxx+j)*maxx_scape])+x] :=
          landscape[(integer(n mod maxx)+i)+(integer(n div
maxx)+j)*maxx_scape]-100;
      end;
    end;
  until leftpressed;
end;

{ main routine --------------------------------------------------------------}

begin
  if mouseinstalled then begin
    setvideo($13);
    initcolors;
    generatelandscape;
    mousewindow(0,0,maxx_scape-maxx,maxy_scape-maxy);
    mousesensetivity(25,25);
    displayscape;
    setvideo(3);
  end else writeln('This interactive thing realy needs a mouse...');
end.

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]