
(* Nice HausBauRoutine by Zulu & Grey of Rebels *)

Program DoItYourSelf_HausBau;

uses     graph,crt;

const    normalh=20;
         normall=30;

var      x,y,zoom,newx,realzoom:integer;
         treib,modus:integer;
         maxx:word;

procedure House(x,y,zoom:integer;var newxpos:integer);

          var newh,newl,x1,x2,y1,y2,door:integer;
begin
         newh:=normalh*zoom;
         newl:=normall*zoom;
         door:=normalh div zoom;

         x1:=x;
         y1:=y-newh;
         x2:=x+newl;
         y2:=y;

         if (x+newl)<maxx then begin

                               setfillstyle(1,15);
                               bar(x1,y1,x2,y2);

                               x1:=x;
                               y1:=y-newh;
                               x2:=x+(newl DIV 2);
                               y2:=y1-(newh div 2);

                               setcolor(4);
                               setfillstyle(1,4);
                               line(x1,y1,x2,y2);
                               x1:=x1+newl;
                               line(x2,y2,x1,y1);
                               line(x,y-newh,x1,y1);
                               floodfill(x1-(newl div 2),y1-(newh div 2)+4,4);

                               x1:=x+door+(newl div 6);
                               y1:=y-(newh div 2);
                               x2:=x1+(newl div 5);
                               y2:=y;
                               bar(x1,y1,x2,y2);

                               x2:=x+newl-door-(newl div 8);
                               x1:=x+newl-door-(newl div 2);
                               y1:=y-newh+(newh div 4);
                               y2:=y1+(newh div 4);
                               bar(x1,y1,x2,y2);

                               setcolor(15);
                               setfillstyle(1,15);

                               circle(x+(newl div 2),y-newh-(newh div 4),zoom*2);
                               floodfill(x+(newl div 2),y-newh-(newh div 4),15);

                               end;

         newxpos:=x+newl;
end;

begin
         clrscr;
         writeln('Demoprogramm fuer einfachen Hausbau relativ zu einer Koordinate');
         writeln;
         write('Bitte geben Sie nun die X-Position des Punktes ein: ');readln(x);
         write('Bitte geben Sie nun die Y-Position des Punktes ein: ');readln(y);
         write('Bitte geben Sie nun den minimalen Zoomfaktor ein:   ');readln(zoom);

         randomize;

         treib:=detect;
         initgraph(treib,modus,'c:\tp\bgi');

         maxx:=getmaxx;

         repeat
               realzoom:=zoom+random(7);

               if realzoom>1 then begin
                                  House(x,y,realzoom,newx);
                                  x:=newx+2;
                                  end;

         until newx>=maxx;

         readln;
         closegraph;
end.

