{*******************************************************} { } { WHY not a compiler? by Y [05-04-00] } { String/integer/float lists } { } { Copyright (c) 1999-2000 CROWELL, Inc. } { All Rights Reserved. } { } {*******************************************************} unit CLists; {$I CDEFINES.PAS} {$IFDEF TPC} {$N+} {$ENDIF} interface uses Objects, CConstants; type PUnsortedCollection = ^TUnsortedCollection; TUnsortedCollection = object(TCollection) Duplicates: Boolean; constructor Init(ALimit, ADelta: Integer); function Compare(Key1, Key2: Pointer): Integer; virtual; function KeyOf(Item: Pointer): Pointer; virtual; function Search(Key: Pointer; var Index: Integer): Boolean; virtual; procedure Insert(Item: Pointer); virtual; end; PUnsortedStringList = ^TUnsortedStringList; TUnsortedStringList = object(TUnsortedCollection) CaseSensitive: Boolean; constructor Init(ALimit, ADelta: Integer); function Add(S: String): Integer; function Compare(Key1, Key2: Pointer): Integer; virtual; procedure FreeItem(Item: Pointer); virtual; procedure Clear; end; PUnsortedIntegerList = ^TUnsortedIntegerList; TUnsortedIntegerList = object(TUnsortedCollection) end; PUnsortedFloatList = ^TUnsortedFloatList; TUnsortedFloatList = object(TUnsortedCollection) function Add(F: Float): Integer; function Compare(Key1, Key2: Pointer): Integer; virtual; procedure FreeItem(Item: Pointer); virtual; end; implementation {TUnsortedCollection} constructor TUnsortedCollection.Init(ALimit, ADelta: Integer); begin inherited Init(ALimit, ADelta); Duplicates := False; end; {TUnsortedCollection.Init} function TUnsortedCollection.Compare(Key1, Key2: Pointer): Integer; begin Abstract; {disable FPC warnings} Compare := Integer(Key1 = Key2); end; {TUnsortedCollection.Compare} procedure TUnsortedCollection.Insert(Item: Pointer); var I: Integer; begin if not Search(KeyOf(Item), I) then AtInsert(I, Item) else if Duplicates then AtInsert(Count, Item); end; {TUnsortedCollection.Insert} function TUnsortedCollection.KeyOf(Item: Pointer): Pointer; begin KeyOf := Item; end; {TUnsortedCollection.KeyOf} function TUnsortedCollection.Search(Key: Pointer; var Index: Integer): Boolean; var i: Integer; Temp: Boolean; begin Temp := False; i := 0; while (not Temp) and (i < Count) do begin if (Compare(KeyOf(Items^[i]), Key) = 0) then begin Temp := True; Index := i; end; Inc(i); end; if not Temp then Index := i; Search := Temp; end; {TUnsortedCollection.Search} {TUnsortedStringList} constructor TUnsortedStringList.Init(ALimit, ADelta: Integer); begin inherited Init(ALimit, ADelta); CaseSensitive := False; end; function TUnsortedStringList.Add(S: String): Integer; var i: Integer; Item: Pointer; begin Item := NewStr(S); if Duplicates then begin i := Count; AtInsert(Count, Item); end else if not Search(KeyOf(Item), i) then AtInsert(i, Item) else DisposeStr(Item); Add := i; end; {TUnsortedStringList.Add} function CompareStringPointers(Key1, Key2: Pointer; CaseSensitive: Boolean): Integer; {Don't try to compare Nil pointers} var i, j: Integer; P1, P2: PString; C1, C2: Char; L1, L2: Integer; begin P1 := PString(Key1); P2 := PString(Key2); if (Length(P1^) < Length(P2^)) then J := Length(P1^) else J := Length(P2^); I := 1; if CaseSensitive then begin while (I < J) and (P1^[I] = P2^[I]) do Inc(I); C1 := P1^[I]; C2 := P2^[I]; end else begin while (I < J) and (LoCase(P1^[I]) = LoCase(P2^[I])) do Inc(I); C1 := LoCase(P1^[I]); C2 := LoCase(P2^[I]); end; if (I = J) then begin L1 := Length(P1^); L2 := Length(P2^); if (C1 < C2) then CompareStringPointers := -1 else if (C1 > C2) then CompareStringPointers := 1 else if (L1 > L2) then CompareStringPointers := 1 else If (L1 < L2) then CompareStringPointers := -1 else CompareStringPointers := 0; end else if (C1 < C2) then CompareStringPointers := -1 else CompareStringPointers := 1; end; (*function CompareStringPointers(Key1, Key2: Pointer; CaseSensitive: Boolean): Integer; assembler; {Don't try to compare Nil pointers} asm PUSH DS CLD LDS SI,Key1 LES DI,Key2 LODSB MOV AH,ES:[DI] INC DI MOV CL,AL CMP CL,AH JBE @@1 MOV CL,AH @@1: XOR CH,CH CALL @CompareStrings SUB AL,AH SBB AH,AH POP DS JMP @Finish {-----------------------------------} @CompareStrings: CMP CaseSensitive, TRUE JE @CompareCaseSens PUSH AX PUSH CX @CompareLoop: MOV AL, ES:[DI] INC DI CALL @LoCase MOV AH, AL LODSB CALL @LoCase CMP AL, AH JNE @CompareStop DEC CX JNZ @CompareLoop @CompareStop: POP CX POP AX JE @CompareFinish MOV AL,ES:[DI-1] CALL @LoCase MOV AH, AL MOV AL,DS:[SI-1] CALL @LoCase JMP @CompareFinish @CompareCaseSens: REP CMPSB JE @CompareFinish MOV AL,DS:[SI-1] MOV AH,ES:[DI-1] @CompareFinish: RETN {-----------------------------------} @LoCase: CMP AL, 'A' JB @LoCaseFin CMP AL, 'Z' JA @LoCaseFin OR AL, 20h @LoCaseFin: RETN {-----------------------------------} @Finish: end; {CompareStringPointers}*) function TUnsortedStringList.Compare(Key1, Key2: Pointer): Integer; var Temp: Integer; begin if Key1 = nil then if Key2 = nil then Temp := 0 else Temp := -1 else if Key2 = nil then Temp := 1 else Temp := CompareStringPointers(Key1, Key2, CaseSensitive); Compare := Temp; end; {TUnsortedStringList.Compare} procedure TUnsortedStringList.FreeItem(Item: Pointer); begin DisposeStr(Item); end; {TUnsortedStringList.FreeItem} procedure TUnsortedStringList.Clear; var i: Integer; begin for i := Count - 1 downto 0 do FreeItem(At(i)); Count := 0; end; {TUnsortedStringList.Clear} {TUnsortedFloatList} function NewFloat(Value: Float): Pointer; var Temp: PFloat; begin New(Temp); Float(Temp^) := Value; NewFloat := Temp; end; {NewFloat} procedure DisposeFloat(Item: Pointer); begin New(PFloat(Item)); end; {DisposeFloat} function TUnsortedFloatList.Add(F: Float): Integer; var i: Integer; Item: Pointer; begin Item := NewFloat(F); if not Search(KeyOf(Item), i) then AtInsert(i, Item) else if Duplicates then begin AtInsert(Count, Item); i := Count; end else DisposeFloat(Item); Add := i; end; {TUnsortedFloatList.Add} function TUnsortedFloatList.Compare(Key1, Key2: Pointer): Integer; var Temp: Integer; begin if (Float(Key1^) = Float(Key2^)) then Temp := 0 else if (Float(Key1^) > Float(Key2^)) then Temp := 1 else Temp := -1; Compare := Temp; end; {TUnsortedFloatList.Compare} procedure TUnsortedFloatList.FreeItem(Item: Pointer); begin DisposeFloat(Item); end; {TUnsortedFloatList.FreeItem} end.