home *** CD-ROM | disk | FTP | other *** search
/ Superpower (Alt) / SUPERPOWER.iso / q / editoren / mbq311 / procs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-07-12  |  7.4 KB  |  284 lines
  1. function i2s(i:longint):string;
  2. var s:string;
  3. begin
  4.     str(i,s);
  5.     i2s:=s;
  6. end;
  7.  
  8. procedure insertnewbrush;
  9. begin
  10.     brush[numbrushes].x:=-50;
  11.     brush[numbrushes].y:=-50;
  12.     brush[numbrushes].z:=-50;
  13.     brush[numbrushes].xl:=50;
  14.     brush[numbrushes].yl:=50;
  15.     brush[numbrushes].zl:=50;
  16.     brush[numbrushes].texture:=defaulttex;
  17.     curbrush:=numbrushes;
  18.     inc(numbrushes);
  19.  
  20. end;
  21.  
  22. procedure drawbrushes;
  23. var b:byte;
  24.     vx,vy,vz,vxl,vyl,vzl:integer;
  25. begin
  26.     cleardevice;
  27.     for b:=0 to numbrushes-1 do begin
  28.         setcolor(7); if b=curbrush then setcolor(12);
  29.         with brush[b] do begin
  30.                if curview=0 then if zoommode=1 then rectangle(x+xdiv,y+ydiv,xl+xdiv,yl+ydiv) else
  31.                 rectangle((x div zoommode)+xdiv,(y div zoommode)+ydiv,(xl div zoommode)+xdiv,(yl div zoommode)+ydiv);
  32.             if curview=1 then if zoommode=1 then rectangle(y+xdiv,(z*-1)+ydiv,yl+xdiv,(zl*-1)+ydiv) else
  33.                 rectangle((y div zoommode)+xdiv,((z div zoommode)*-1)+ydiv,(yl div zoommode)+xdiv,((zl div zoommode)*-1)+ydiv);
  34.             if curview=2 then if zoommode=1 then rectangle(x+xdiv,(z*-1)+ydiv,xl+xdiv,(zl*-1)+ydiv) else
  35.                 rectangle((x div zoommode)+xdiv,((z div zoommode)*-1)+ydiv,(xl div zoommode)+xdiv,((zl div zoommode)*-1)+ydiv);
  36.         end;
  37.         setcolor(12);
  38.         with brush[curbrush] do begin
  39.                if curview=0 then if zoommode=1 then rectangle(x+xdiv,y+ydiv,xl+xdiv,yl+ydiv) else
  40.                 rectangle((x div zoommode)+xdiv,(y div zoommode)+ydiv,(xl div zoommode)+xdiv,(yl div zoommode)+ydiv);
  41.             if curview=1 then if zoommode=1 then rectangle(y+xdiv,(z*-1)+ydiv,yl+xdiv,(zl*-1)+ydiv) else
  42.                 rectangle((y div zoommode)+xdiv,((z div zoommode)*-1)+ydiv,(yl div zoommode)+xdiv,((zl div zoommode)*-1)+ydiv);
  43.             if curview=2 then if zoommode=1 then rectangle(x+xdiv,(z*-1)+ydiv,xl+xdiv,(zl*-1)+ydiv) else
  44.                 rectangle((x div zoommode)+xdiv,((z div zoommode)*-1)+ydiv,(xl div zoommode)+xdiv,((zl div zoommode)*-1)+ydiv);
  45.         end;
  46.  
  47.         setcolor(8);
  48.         line(0,470,0,479); line(0,479,10,479);
  49.         if curview=0 then begin
  50.             outtextxy(0,459,'x');
  51.             outtextxy(10,469,'y');
  52.         end;
  53.         if curview=1 then begin
  54.             outtextxy(0,459,'y');
  55.             outtextxy(10,469,'z');
  56.         end;
  57.         if curview=2 then begin
  58.             outtextxy(0,459,'x');
  59.             outtextxy(10,469,'z');
  60.         end;
  61.     end;
  62.  
  63.  
  64.     outtextxy(30,469,'zm:'+i2s(zoommode));
  65.     outtextxy(80,469,i2s((brush[curbrush].x-brush[curbrush].xl)*-1)+' '+i2s((brush[curbrush].y-brush[curbrush].yl)*-1)+' '+
  66.         i2s((brush[curbrush].z-brush[curbrush].zl)*-1)+' '+brush[curbrush].texture);
  67.     if movemode=true then outtextxy(20,459,'M');
  68.     putpixel(0+xdiv,0+ydiv,15);
  69. end;
  70.  
  71. procedure getnewdefaulttexture;
  72.  
  73. begin
  74.     outtextxy(0,40,'Enter default texture for new inserted brushes:');
  75.     gotoxy(1,1);
  76.     readln(defaulttex);
  77.     if numbrushes>0 then drawbrushes else cleardevice;
  78. end;
  79.  
  80. procedure deletecurbrush;            { this is VERY buggy, i think (not sure) }
  81. var i:byte;
  82. begin
  83.     if numbrushes>1 then begin
  84.     for i:=curbrush to numbrushes-1 do begin
  85.         brush[i]:=brush[i+1]
  86.     end;
  87.     dec(numbrushes);
  88.     if curbrush>=numbrushes then curbrush:=0;
  89.     end else begin
  90.         outtextxy(0,0,'gotta have at least one brush...');
  91.     end;
  92.  
  93. end;
  94.  
  95.  
  96.  
  97.  
  98.  
  99. procedure getnewmoverate;
  100.  
  101. begin
  102.     outtextxy(0,40,'Enter new moverate:');
  103.     gotoxy(1,1);
  104.     readln(moverate);
  105.     if numbrushes>0 then drawbrushes else cleardevice;
  106. end;
  107.  
  108. procedure save;
  109. var
  110.     f:file of cube;
  111.     e:file of ent;
  112.     saveas:string;
  113.     i:byte;
  114. begin
  115.     if numbrushes>0 then begin
  116.         outtextxy(0,40,'Do not give an extension!  save as:');
  117.         gotoxy(0,0);
  118.         readln(saveas);
  119.         assign(f,saveas+'.qck');
  120.         rewrite(f);
  121.         for i:=0 to numbrushes-1 do begin
  122.             write(f,brush[i]);
  123.         end;
  124.         close(f);
  125.         assign(e,saveas+'.ent');
  126.         rewrite(e);
  127.         for i:=0 to numentities-1 do begin
  128.             write(e,entity[i]);
  129.         end;
  130.         close(e);
  131.         drawbrushes; outtextxy(0,0,'Saved...');
  132.     end else begin
  133.         outtextxy(0,0,'nothing to save.');
  134.     end;
  135. end;
  136.  
  137. procedure insertnewentity;
  138. begin
  139.     entity[numentities].class:='"info_player_start"';
  140.     entity[numentities].ox:=0;
  141.     entity[numentities].oy:=0;
  142.     entity[numentities].oz:=0;
  143.     entity[numentities].angle:=0;
  144.     curentity:=numentities;
  145.     inc(numentities);
  146. end;
  147.  
  148. procedure load;
  149. var
  150.     f:file of cube;
  151.     e:file of ent;
  152.     l:string;
  153.     i:byte;
  154.     c:cube;
  155.     en:ent;
  156. label alldone;
  157. begin
  158.     outtextxy(0,40,'load brush and entity data (use shift-l for brushes only):');
  159.     gotoxy(0,0);
  160.     readln(l);
  161.     if l='' then goto alldone;
  162.     assign(f,l+'.qck');
  163.     reset(f);
  164.         numbrushes:=0;
  165.         repeat
  166.             insertnewbrush;
  167.             read(f,c);
  168.             brush[numbrushes-1]:=c;
  169.         until eof(f);
  170.     close(f);
  171.     assign(e,l+'.ent');
  172.     reset(e);
  173.         numentities:=0;
  174.         repeat
  175.             insertnewentity;
  176.             read(e,en);
  177.             entity[numentities-1]:=en;
  178.         until eof(e);
  179.     close(e);
  180. alldone:
  181. end;
  182.  
  183. procedure oldload;
  184. var
  185.     f:file of cube;
  186.     l:string;
  187.     i:byte;
  188.     c:cube;
  189. label alldone;
  190. begin
  191.     outtextxy(0,40,'brushes only load:');
  192.     gotoxy(0,0);
  193.     readln(l);
  194.     if l='' then goto alldone;
  195.     assign(f,l);
  196.     reset(f);
  197.         numbrushes:=0;
  198.         repeat
  199.             insertnewbrush;
  200.             read(f,c);
  201.             brush[numbrushes-1]:=c;
  202.         until eof(f);
  203.     close(f);
  204.     str(numbrushes,l);
  205.     curview:=0; drawbrushes; outtextxy(0,0,'Loaded '+l+' brushes');
  206. alldone:
  207. end;
  208.  
  209.  
  210.  
  211. procedure texture;
  212. var t:string;
  213. begin
  214.     if numbrushes>0 then begin
  215.         outtextxy(0,40,'New texture for this brush:');
  216.         gotoxy(0,0);
  217.         readln(t);
  218.         brush[curbrush].texture:=t;
  219.     end;
  220. end;
  221.  
  222.  
  223.  
  224. procedure drawentities;
  225. var e:byte;
  226.     r:byte;
  227. begin
  228.     r:=2;
  229.     setcolor(7);
  230.     if numentities>0 then begin
  231.       for e:=0 to numentities do begin
  232.         with entity[e] do begin
  233.         if curview=0 then circle((ox div zoommode)+xdiv,(oy div zoommode)+ydiv,r);
  234.         if curview=1 then circle((oy div zoommode)+xdiv,((oz div zoommode)*-1)+ydiv,r);
  235.         if curview=2 then circle((ox div zoommode)+xdiv,((oz div zoommode)*-1)+ydiv,r);
  236.           end;
  237.       end;
  238.       setcolor(12);
  239.       with entity[curentity] do begin
  240.         if curview=0 then circle((ox div zoommode)+xdiv,(oy div zoommode)+ydiv,r);
  241.         if curview=1 then circle((oy div zoommode)+xdiv,((oz div zoommode)*-1)+ydiv,r);
  242.         if curview=2 then circle((ox div zoommode)+xdiv,((oz div zoommode)*-1)+ydiv,r);
  243.            outtextxy(400,459,'angle: '+i2s(angle));
  244.         outtextxy(400,469,'class: '+class);
  245.  
  246.       end;
  247.  
  248.     end;
  249. end;
  250.  
  251. function s2i(s:string):integer;
  252. var c,i:integer;
  253. begin
  254.     val(s,i,c);
  255.     s2i:=i;
  256. end;
  257.  
  258. procedure curentityangle;
  259. var s:string;
  260.     i:integer;
  261. begin
  262.     if numentities>0 then begin
  263.         outtextxy(0,40,'New angle for this entity:');
  264.         gotoxy(0,0);
  265.         readln(s);
  266.         if s='' then i:=0 else i:=s2i(s);
  267.         entity[curentity].angle:=i;
  268.     end;
  269.     drawbrushes;
  270.     drawentities;
  271. end;
  272.  
  273. procedure curentityclass;
  274. var s:string;
  275. begin
  276.     if numentities>0 then begin
  277.         outtextxy(0,40,'New classname for this entity:');
  278.         gotoxy(0,0);
  279.         readln(s);
  280.         if s='' then s:='info_player_start' else entity[curentity].class:=s;
  281.     end;
  282.     drawbrushes;
  283.     drawentities;
  284. end;