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