unit loadasc;
interface

const maxvertices=1024;
      maxfaces=1024;

type vertextype=record
                 x,y,z:integer;
                end;
     lvertextype=record
                  x,y,z:longint;
                 end;
     facetype=record
               a,b,c:word;
              end;
     objtype=record
              vertex:array[0..maxvertices-1] of vertextype;
              face:array[0..maxfaces-1] of facetype;
              vertices,faces:word;
             end;

function lataa_asc(filename:string; var obj:objtype; mul:real):boolean;

implementation
uses sumthing;

function lataa_asc(filename:string; var obj:objtype; mul:real):boolean;
var f:text;

function vall(str:string):real;
var res:real;
    cod:integer;
begin
 val(str,res,cod);
 if cod<>0 then res:=0;
 vall:=res;
end;

procedure error(str:string);
begin
 writeln('error: ',str);
 halt(0);
end;

function getline:string;
var res:string;
begin
 readln(f,res);
 getline:=ucase(res);
end;

procedure getobj; {sarjassamme näin koo-tAAt niin kökköä koodia,}
                  {ettei siitä ota erkkikään selvää.}
var tmp,tmp2:string;
    index:word;
    p1,p2:byte;
    read:word;
begin
 repeat
  tmp:=getline;
 until (pos('VERTICES:',tmp)>0) or (eof(f));

 if eof(f) then error('not a .asc file');
 p1:=pos(':',tmp);
 tmp2:=copy(tmp,p1+2,length(tmp)-p1-2);
 p1:=pos(' ',tmp2);
 tmp2:=copy(tmp2,1,p1-1);
 obj.vertices:=round(vall(tmp2));

 p1:=pos('FACES:',tmp);
 tmp2:=copy(tmp,p1+7,length(tmp)-p1-5);
 obj.faces:=round(vall(tmp2));
 repeat
  tmp:=getline;
 until (pos('VERTEX LIST',tmp)>0) or (eof(f));
 if eof(f) then error('vertex list not found.');
 read:=0;
 repeat
  tmp:=getline;
  if (pos('VERTEX',tmp)>0) and (pos('FACE',tmp)=0) then begin
   inc(read,1);
   p1:=pos(' ',tmp);
   p2:=pos(':',tmp);
   tmp2:=copy(tmp,p1,p2-p1);
   index:=round(vall(tmp2));
   write('reading vertex ',index,#13);
   with obj.vertex[index] do begin
    p1:=pos('X: ',tmp);
    tmp2:=copy(tmp,p1+3,length(tmp)-p1-3);
    p1:=pos(' ',tmp2);
    tmp2:=copy(tmp2,1,p1-1);
    x:=round(vall(tmp2)*mul);

    p1:=pos('Y: ',tmp);
    tmp2:=copy(tmp,p1+3,length(tmp)-p1-3);
    p1:=pos(' ',tmp2);
    tmp2:=copy(tmp2,1,p1-1);
    y:=round(vall(tmp2)*mul);

    p1:=pos('Z: ',tmp);
    tmp2:=copy(tmp,p1+3,length(tmp)-p1-2);
    p1:=length(tmp2);
    tmp2:=copy(tmp2,1,p1);
    z:=round(vall(tmp2)*mul);
   end;
  end;
 until (read=obj.vertices);
 writeln(read,' vertices read.                                               ');
 if eof(f) then error('face list not found.');
 while (pos('FACE LIST',tmp)=0) do tmp:=getline;
 read:=0;
 repeat
  tmp:=getline;
  if (pos('FACE',tmp)>0) and (pos('VERT',tmp)=0) then begin
   inc(read,1);
   p1:=pos(' ',tmp);
   p2:=pos(':',tmp);
   tmp2:=copy(tmp,p1+1,p2-p1-1);
   index:=round(vall(tmp2));
   write('reading face ',index,#13);
   with obj.face[index] do begin
    p1:=pos('A:',tmp);
    tmp2:=copy(tmp,p1+2,length(tmp)-p1-3);
    p1:=pos(' ',tmp2);
    tmp2:=copy(tmp2,1,p1-1);
    a:=round(vall(tmp2));

    p1:=pos('B:',tmp);
    tmp2:=copy(tmp,p1+2,length(tmp)-p1-3);
    p1:=pos(' ',tmp2);
    tmp2:=copy(tmp2,1,p1-1);
    b:=round(vall(tmp2));

    p1:=pos('C:',tmp);
    tmp2:=copy(tmp,p1+2,length(tmp)-p1-3);
    p1:=pos(' ',tmp2);
    tmp2:=copy(tmp2,1,p1-1);
    c:=round(vall(tmp2));
   end;
  end;
 until (read=obj.faces);
 writeln(read,' faces read.                               ');
end;

begin
 lataa_asc:=false;
 fillchar(obj,sizeof(obj),0);
{$i-}
 assign(f,filename);
 reset(f);
 if ioresult<>0 then error('asc file nat found.');
 getobj;
 close(f);
 lataa_asc:=true;
end;

begin
end.