home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D12 / CHESSOWL.ZIP / MOVELIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  2.6 KB  |  129 lines
  1. unit MoveList;
  2.  
  3. interface
  4.  
  5. uses Objects, ChessDLL;
  6.  
  7. type
  8.   PMoveList = ^TMoveList;
  9.   TMoveList = object(TCollection)
  10.     UndoPos: Integer;
  11.     constructor Init(ALimit, ADelta: Integer);
  12.     constructor Load(var S: TStream);
  13.     procedure Store(var S: TStream); virtual;
  14.     procedure AddMove(Move: TMove);
  15.     function GetItem(var S: TStream): Pointer; virtual;
  16.     procedure FreeItem(Item: Pointer); virtual;
  17.     procedure Redo(var Move: TMove);
  18.     procedure Undo(var Move: TMove);
  19.     procedure PutItem(var S: TStream; Item: Pointer); virtual;
  20.     function RedoAvail: Boolean;
  21.     function UndoAvail: Boolean;
  22.   end;
  23.  
  24. const
  25.   RMoveList: TStreamRec = (
  26.     ObjType: 5000;
  27.     VmtLink: Ofs(TypeOf(TMoveList)^);
  28.     Load:    @TMoveList.Load;
  29.     Store:   @TMoveList.Store);
  30.  
  31. function NewMove(Move: TMove): PMove;
  32. procedure DisposeMove(Move: PMove);
  33.  
  34. implementation
  35.  
  36.  
  37. constructor TMoveList.Init(ALimit, ADelta: Integer);
  38. begin
  39.   inherited Init(ALimit, ADelta);
  40.   UndoPos := 0;
  41. end;
  42.  
  43. constructor TMoveList.Load(var S: TStream);
  44. begin
  45.   inherited Load(S);
  46.   S.Read(UndoPos, SizeOf(UndoPos));
  47. end;
  48.  
  49. procedure TMoveList.Store(var S: TStream);
  50. begin
  51.   inherited Store(S);
  52.   S.Write(UndoPos, SizeOf(UndoPos));
  53. end;
  54.  
  55. procedure TMoveList.AddMove(Move: TMove);
  56. var
  57.   I: Integer;
  58. begin
  59.   if UndoPos < Count - 1 then
  60.     while UndoPos < Count - 1 do 
  61.       AtFree(UndoPos + 1);
  62.   AtInsert(Count, NewMove(Move));
  63.   UndoPos := Count - 1;
  64. end;
  65.  
  66. function TMoveList.GetItem(var S: TStream): Pointer;
  67. var
  68.   Move: TMove;
  69. begin
  70.   S.Read(Move, SizeOf(Move));
  71.   GetItem := NewMove(Move);
  72. end;
  73.  
  74. procedure TMoveList.FreeItem(Item: Pointer);
  75. begin
  76.   DisposeMove(PMove(Item));
  77. end;
  78.  
  79. procedure TMoveList.Redo(var Move: TMove);
  80. begin
  81.   if RedoAvail then
  82.   begin
  83.     Inc(UndoPos);
  84.     Move := PMove(At(UndoPos))^;
  85.   end
  86.   else FillChar(Move, SizeOf(Move), 0);
  87. end;
  88.  
  89. procedure TMoveList.Undo(var Move: TMove);
  90. begin
  91.   if UndoAvail then
  92.   begin
  93.     Move := PMove(At(UndoPos))^;
  94.     Dec(UndoPos);
  95.   end
  96.   else FillChar(Move, SizeOf(Move), 0);
  97. end;
  98.  
  99. procedure TMoveList.PutItem(var S: TStream; Item: Pointer);
  100. begin
  101.   S.Write(PMove(Item)^, SizeOf(TMove));
  102. end;
  103.  
  104. function TMoveList.RedoAvail: Boolean;
  105. begin
  106.   RedoAvail := (Count > 0) and (UndoPos < Count - 1);
  107. end;
  108.  
  109. function TMoveList.UndoAvail: Boolean;
  110. begin
  111.   UndoAvail := (Count > 0) and (UndoPos >= 0);
  112. end;
  113.  
  114. function NewMove(Move: TMove): PMove;
  115. var
  116.   AMove: PMove;
  117. begin
  118.   GetMem(AMove, SizeOf(TMove));
  119.   AMove^ := Move;
  120.   NewMove := AMove;
  121. end;
  122.  
  123. procedure DisposeMove(Move: PMove);
  124. begin
  125.   FreeMem(Move, SizeOf(TMove));
  126. end;
  127.  
  128. end.
  129.