-- 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