old/PAS/Model/Objs.pas

Unit Objs;
                     InterFace
Uses Objects, Graph, TypeLib;
Const

 MAXNAME = 30;
 MAXTYPE = 20;

Type
  vec = record x,y:real; end;
  rect = record A,B,C,D : vec; end;
  Pline = ^TLine;
  Tline = record A,B : vec; end;
  PString = ^String;

  ManMoods = (MOOD_STOP,MOOD_WALK,MOOD_ACCEL,MOOD_BRAKING);

  CObjs = Object
    oType  : string[MAXTYPE];
    Name   : string[MAXNAME];
    Color  : integer;
    Heading: Real;
    POS    : vec;
    Speed  : vec;
    Accel  : vec;
    Bounds : TLine;
    procedure Step;
    procedure Draw;
    procedure Clear;
  End;

  CHouse = Object (COBjs)
    UL, BR : vec;
    Door   : Rect;
    Constructor Init(cx,cy,sTop,sBottom,sLeft,sRight : real;aName : string);
    Procedure SetDoor(dx1,dy1,dx2,dy2 : real);
    Procedure Draw;
  end;


  CMan = Object (COBjs)
    Mood     : MANMOODS;
    MaxAccel : real;
    MaxSpeed : real;
    StepPos  : real;
    Scale    : real;
    NewMove  : byte;
    DefBounds: TLine;
    Model    : array [0..5] of PLine;
    Procedure CreateMan(var Ar:array of PLine;SP:real);
    Constructor Init(cx,cy,ang,aScale:real;aName:string;aCol:integer);
    Procedure Rotate(aAng : real);
    Procedure SetSpeed(aNewSpeed : real);
    Procedure SetAccel(aNewAccel : real);
    Procedure Step;
    Procedure Clear;
    Procedure Draw;
    Destructor Destroy;
  end;

  Procedure DrawRay(aC:vec;Ang,Len:real);
  Procedure SetBounds(Ob : array of Pline;numvert:word;var aB:TLine;DefBounds:TLine);
  Procedure RotateVec(var aV : Vec; Ang:Real);
  Procedure RotateRect(var Ob : rect;Ang:real);
  Procedure RotateLine(var Ob : TLine;Ang:real);
  Procedure RotateArray(var Ob : array of Pline;numvert:word;Ang:real);
  Function  Len(aVec : vec) : real;
  Procedure Neg(var aV : real);

                         IMPLEMENTATION
{-------------------------------}
Procedure Neg(var aV : real);
begin
  aV := -aV;
end;{Neg}
{-------------------}
Procedure SetBounds;
var
 i : word;
begin
  with aB do begin
    Ab := DefBounds;
    for i := 0 to NumVert do
     begin
       if ob[i]^.A.X > A.X then A.X:=ob[i]^.A.X;
       if ob[i]^.B.X > A.X then A.X:=ob[i]^.B.X;
       if ob[i]^.A.Y > A.Y then A.Y:=ob[i]^.A.Y;
       if ob[i]^.B.Y > A.Y then A.Y:=ob[i]^.B.Y;
       if ob[i]^.A.X < B.X then B.X:=ob[i]^.A.X;
       if ob[i]^.B.X < B.X then B.X:=ob[i]^.B.X;
       if ob[i]^.A.Y < B.Y then B.Y:=ob[i]^.A.Y;
       if ob[i]^.B.Y < B.Y then B.Y:=ob[i]^.B.Y;
     end;
  end;
end;{SetBounds}
{--------------------}
Procedure DrawRay;
Begin
  Line(Round(aC.X),Round(aC.Y),
       Round(aC.X+Len*cos(PI*Ang/180)),Round(aC.Y+Len*sin(PI*Ang/180)));
end; {DrawRay}
{--------------------}
Procedure RotateVec;
var ps : vec;
begin
  ps.X := aV.X * cos(PI*Ang/180) - aV.Y * sin(PI*Ang/180);
  ps.Y := aV.X * sin(PI*Ang/180) + aV.Y * cos(PI*Ang/180);
  av := ps;
end;{RotateVec}
{--------------------}
Procedure RotateRect;
begin
  RotateVec(ob.A,Ang);
  RotateVec(ob.B,Ang);
  RotateVec(ob.C,Ang);
  RotateVec(ob.D,Ang);
end;{RotateVec}
{--------------------}
Procedure RotateLine;
begin
  RotateVec(ob.A,Ang);
  RotateVec(ob.B,Ang);
end;{RotateVec}
{--------------------}
Procedure RotateArray;
var u : word;
begin
  for u := 0 to numvert do RotateLine(ob[u]^,Ang);
end;{RotateVec}
{--------------------}
Function Len;
begin
  Len := Sqrt(Sqr(aVec.X)+Sqr(aVec.Y));
end;{Len}
{--------------------}
{COBJ}
  Procedure CObjs.step; begin end;
  Procedure CObjs.Draw; begin end;
  Procedure CObjs.Clear; begin end;
{/COBJ}
{------------}
{CMan}
Procedure CMan.CreateMan;
Begin
with Ar[0]^ do Begin
  A.x:=-3*Scale;A.y:=0;B.x:=-7*Scale;B.y:=0;end;
with Ar[1]^ do Begin
  A.x:=3*Scale;A.y:=0;B.x:=7*Scale;B.y:=0;end;
with Ar[2]^ do Begin
  A.x:=-7*Scale;A.y:=0;B.x:=-7*Scale;B.y:=4*Scale-8*abs(SP)/5;end;
with Ar[3]^ do Begin
  A.x:=7*Scale;A.y:=0;B.x:=7*Scale;B.y:=-4*Scale+8*abs(SP)/5;end;
with Ar[4]^ do Begin
  A.x:=-4*Scale;A.y:=0;B.x:=-4*Scale;B.y:=-8*Scale+11*abs(SP)/5;end;
with Ar[5]^ do Begin
  A.x:=4*Scale;A.y:=0;B.x:=4*Scale;B.y:=3*Scale-11*abs(SP)/5;end;
End;{CMan.CreateMan}
{--------------------}
  Constructor CMan.Init;
  var i : byte;
  begin
    Heading := Ang;
    oType := 'Man';
    Name  := aName;
    Color := aCol;
    Scale := aScale;
    POS.X := cx;
    POS.Y := cy;
    Mood := MOOD_STOP;
    MaxSpeed := 10;MaxAccel := 5;
    Speed.X:=0;Speed.Y:=0;Accel.X:=0;Accel.Y:=0;
    for i:=0 to 5 do New(Model[i]);
    CreateMan(Model,0);
    RotateArray(Model,5,Heading);
    with DefBounds do begin A.X:=-3*Scale;A.Y:=-3*Scale;B.X:=3*Scale;b.Y:=3*Scale;end;
    SetBounds(Model,5,Bounds,DefBounds);
    NewMove := 0;
  end; {CMan.Init}
  {---------------}
  Procedure CMan.Rotate;
  Begin
    Heading := Heading + aAng;
    If Heading > 360 then Heading := Heading - 360;
    If Heading < 0 then Heading := Heading + 360;
    RotateVec(Speed,aAng);
    RotateVec(Accel,aAng);
    RotateArray(Model,5,aAng);
{    SetBounds(Model,5,Bounds,DefBounds);}
  End;{CMan.Rotate}
  {-------------------}
  Procedure CMan.SetSpeed;
  begin
    if aNewSpeed <> 0 then if Mood = MOOD_STOP then Mood:=MOOD_WALK;
    if aNewSpeed > MaxSpeed then aNewSpeed := MaxSpeed;
    Speed.X := aNewSpeed * cos(PI*Heading/180+PI/2);
    Speed.Y := aNewSpeed * sin(PI*Heading/180+PI/2);
  end;{CMan.SetSpeed}
  {-------------------}
  Procedure CMan.SetAccel;
  begin
    if aNewAccel > 0 then Mood:=MOOD_ACCEL
    else if aNewAccel < 0 then Mood := MOOD_BRAKING;
    if aNewAccel > MaxAccel then aNewAccel := MaxAccel;
    Accel.X := aNewAccel * cos(PI*Heading/180+PI/2);
    Accel.Y := aNewAccel * sin(PI*Heading/180+PI/2);
  end;{CMan.SetSpeed}
  {-------------------}
  Procedure CMan.Step;
  Begin
    POS.X := POS.X + Speed.X;
    POS.Y := POS.Y + Speed.Y;
    StepPos := StepPos + Len(Speed)*0.4;
    while StepPos > 10*Scale do StepPos:=StepPos-10*Scale;
    If StepPos > 5*Scale then StepPos:=StepPos-10*Scale;
    CreateMan(Model,StepPos);
    RotateArray(Model,5,Heading);
    if NewMove <> 0 then Dec(NewMove);
    if NewMove = 1 then
     begin
       NewMove := random(40)+2;
       Rotate(360*random-180);
       SetAccel(MaxAccel*random - MaxAccel/2);
     end;
    Speed.X := Speed.X + Accel.X;
    Speed.Y := Speed.Y + Accel.Y;
    if Len(Speed) > MaxSpeed then SetSpeed(MaxSpeed*random);
    if Len(Speed) < 0.001 then SetAccel(MaxAccel*random - MaxAccel/2);
    if (Pos.X > 630) and (Speed.X > 0) then Pos.X := 10;
    if (Pos.X < 10) and (Speed.X < 0) then Pos.X := 630;
    if (Pos.Y > 470) and (Speed.Y > 0) then Pos.Y:=10;
    if (Pos.Y < 10) and (Speed.Y < 0) then Pos.Y:=470;
  end; {CMan.Step}
  {-------------------}
  Procedure CMan.Draw;
  var i:byte;
  Begin
    SetColor(Color);
    Circle(ROUND(POS.X),Round(480-POS.Y),Round(3*Scale));
    for i := 0 to 5 do
      begin
        Line(ROUND(POS.X+Model[I]^.A.X), ROUND(480-(POS.Y+Model[I]^.A.Y)),
             ROUND(POS.X+Model[I]^.B.X), ROUND(480-(POS.Y+Model[I]^.B.Y)));
      end;
  End; {CMan.Draw}
  {-------------------}
  Procedure CMan.Clear;
  begin
    Bar(ROUND(POS.X+Bounds.A.X)+1, ROUND(480-(POS.Y+Bounds.A.Y))-1,
        ROUND(POS.X+Bounds.B.X)-1, ROUND(480-(POS.Y+Bounds.B.Y))+1);
  end;{CMAn.Clear}
  {-------------------}
  Destructor CMan.Destroy;
  var i:byte;
  begin
    for i := 0 to 5 do Dispose(Model[i]);
  end;{CMan.Destroy}
  {-------------------}
{/CMan}
{CHouse}
  Constructor Chouse.Init; begin end;
  Procedure CHouse.SetDoor; begin end;
  Procedure CHouse.Draw;begin end;
{/CHouse}

END.