-- ppSortLists.mesa

-- A Chipmonk package that sorts Chipmonk object
-- lists in increasing order by smallest x, and within equal
-- smallest x in increasing order by smallest y.

-- written by E. McCreight, October 13, 1981  3:15 PM

DIRECTORY
  ppdefs,
  SegmentDefs,
  ZoneAllocDefs;

ppSortLists: PROGRAM IMPORTS ppdefs, SegmentDefs, ZoneAllocDefs =
  BEGIN OPEN ppdefs;

  ListPtr: TYPE = LONG POINTER TO list ← NIL;

  SortChipmonkWorld: PUBLIC PROCEDURE[] =
    BEGIN
    FOR cp: LONG POINTER TO cell object ← GetCellSuper[],
      cp.super WHILE cp#NIL DO
      cp.marked ← FALSE;
      ENDLOOP;
    SortObjectListAndItsCells[@masterList];
    END; -- of SortChipmonkWorld

  SortObjectListAndItsCells: PUBLIC PROCEDURE[p: LONG POINTER TO ListPtr] =
    BEGIN
    SortObjectList[p];
    FOR lp: ListPtr ← p↑, lp.nxt WHILE lp#NIL DO
      WITH obj: lp.ob SELECT FROM
        cell =>
          IF NOT obj.marked THEN
            BEGIN
            obj.marked ← TRUE; -- stops infinite regress
            SortObjectListAndItsCells[@obj.ptr];
            END;
        ENDCASE => NULL;
      ENDLOOP;
    END; -- of SortObjectListAndItsCells

  SortObjectList: PUBLIC PROCEDURE[p: LONG POINTER TO ListPtr] =
    BEGIN
    Heap: TYPE = RECORD[
      item: SEQUENCE max: CARDINAL OF ListPtr];
    h: LONG POINTER TO Heap ← NIL;

    l: CARDINAL;
    r: CARDINAL ← 0;
    lp, last: ListPtr;
    stillInOrder: BOOLEAN ← TRUE;

    FOR lp ← p↑, lp.nxt WHILE lp#NIL DO
      r ← r+1;
      IF stillInOrder AND lp.nxt#NIL AND
        (lp.lx>lp.nxt.lx OR
        (lp.lx=lp.nxt.lx AND lp.ly>lp.nxt.ly)) THEN
        stillInOrder ← FALSE;
      ENDLOOP;

    IF stillInOrder THEN RETURN;

    h ← ZoneAllocDefs.uz.NEW[Heap[r+1] !
      SegmentDefs.InsufficientVM => GOTO Cant];
    l ← 1;
    FOR lp ← p↑, lp.nxt WHILE lp#NIL DO
      h.item[l] ← lp;
      l ← l+1;
      ENDLOOP;

    -- Sort by increasing lx, and within equal lx by increasing ly.
    -- At this point, r>=2.
    last ← NIL;
    l ← r/2+1;
    WHILE r>1 DO
      i, j: CARDINAL;
      item: ListPtr;
      kItem: locNum;
      IF l>1 THEN {l ← l-1; item ← h.item[l]}
      ELSE
        BEGIN
        item ← h.item[r];
        h.item[1].nxt ← last;
        last ← h.item[1];
        r ← r-1;
        END;
      kItem ← item.lx;
      FOR i ← l, j DO
        dx: locNum;
        j ← i+i; -- I'd like to say 2*i but I don't trust the optimizer
        IF j>r THEN EXIT;
        IF j<r THEN
          BEGIN
          dx ← h.item[j].lx-h.item[j+1].lx;
          IF dx<0 OR (dx=0 AND h.item[j].ly<h.item[j+1].ly) THEN
            j ← j+1;
          END;
        dx ← kItem-h.item[j].lx;
        IF dx<0 OR (dx=0 AND item.ly<h.item[j].ly)
        THEN h.item[i] ← h.item[j]
        ELSE EXIT;
        ENDLOOP;
      h.item[i] ← item;
      ENDLOOP;

    h.item[1].nxt ← last;
    p↑ ← h.item[1];
    ZoneAllocDefs.uz.FREE[@h];

    EXITS
      Cant => NULL;  -- for now
    END; -- of SortObjectList

  SortChipmonkWorld[]; -- the main program!

  END. -- of ppSortLists