Skip to content

Instantly share code, notes, and snippets.

@MarkGoldberg
Last active August 29, 2015 14:19
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save MarkGoldberg/ff56e8444aec422bef43 to your computer and use it in GitHub Desktop.
Save MarkGoldberg/ff56e8444aec422bef43 to your computer and use it in GitHub Desktop.
Clarion - SORT Comparer Function example
PROGRAM
MAP
_Comparer(*GROUP a, *GROUP b), SIGNED
_Comparer2(*GROUP a, *GROUP b), SIGNED
_Comparer3(*GR A, *GR B),SIGNED !<-- typed groups
END
ct CLASS, TYPE
field1 STRING(1)
end
gr GROUP, TYPE
c &ct
END
qt QUEUE(gr), TYPE
END
q &qt
CODE
q &= new qt
clear(q); q.c &= new ct; q.c.field1 = 'd'; add(q)
clear(q); q.c &= new ct; q.c.field1 = 'z'; add(q)
clear(q); q.c &= new ct; q.c.field1 = 'q'; add(q)
clear(q); q.c &= new ct; q.c.field1 = 'a'; add(q)
clear(q); q.c &= new ct; q.c.field1 = 'q'; add(q)
DO ShowQ
SORT(q, _Comparer3)
DO ShowQ
ShowQ ROUTINE
DATA
Msg Any
Ptr LONG,AUTO
CODE
LOOP Ptr = 1 TO RECORDS(Q)
GET(Q, Ptr)
Msg = Msg & '['& Ptr &'] Field1['& Q.C.Field1 &']|'
END
Message( Msg )
_Comparer PROCEDURE(*GROUP A, *GROUP B) !<-- generic groups
AQt LIKE(Qt)
BQt LIKE(Qt)
CODE
AQt = A
BQt = B
IF AQt.C.Field1 < BQt.C.Field1 THEN RETURN -1
ELSIF AQt.C.Field1 > BQt.C.Field1 THEN RETURN 1
END
RETURN 0
_Comparer2 PROCEDURE(*GROUP A, *GROUP B) !<-- generic groups
AQt &gr
BQt &gr
CODE
AQt &= ADDRESS(A)
BQt &= ADDRESS(B)
IF AQt.C.Field1 < BQt.C.Field1 THEN RETURN -1
ELSIF AQt.C.Field1 > BQt.C.Field1 THEN RETURN 1
END
RETURN 0
_Comparer3 PROCEDURE(*GR A, *GR B) !<-- typed groups
CODE
IF A.C.Field1 < B.C.Field1 THEN RETURN -1
ELSIF A.C.Field1 > B.C.Field1 THEN RETURN 1
END
RETURN 0
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment