-- ROMMakerCommon.mesa
-- cell subroutines to run within Chipmonk

-- last modified by E. McCreight, February 2, 1982  6:46 PM
-- written by E. McCreight, August 7, 1981  3:52 PM

DIRECTORY
  ChipUserInt,
  InlineDefs,
  ppdddefs,
  ppddefs,
  ppdefs,
  RomMakerDefs,
  StringDefs;

RomMakerCommon: PROGRAM
  IMPORTS ChipUserInt, InlineDefs,
  ppdddefs, ppddefs, ppdefs, StringDefs
  EXPORTS RomMakerDefs =
  PUBLIC BEGIN OPEN ChipUserInt, ppdddefs, ppddefs,
    ppdefs, RomMakerDefs;

  lpp: listPtr _ NIL;

  dirFactor:  ARRAY Direction OF Point _
    [ -- vertical -- [x: 0, y: 1],
    -- horizontal -- [x: 1, y: 0],
    -- diagonal -- [x: 1, y: 1],
    -- up -- [x: 0, y: -1],
    -- down -- [x: 0, y: 1],
    -- left -- [x: -1, y: 0],
    -- right -- [x: 1, y: 0],
    -- upAndLeft -- [x: -1, y: -1],
    -- upAndRight -- [x: 1, y: -1],
    -- downAndLeft -- [x: -1, y: 1],
    -- downAndRight -- [x: 1, y: 1]];


  FindCell:  PROCEDURE [
    cellFamily: STRING, member: STRING, required: BOOLEAN _ FALSE,
    vCompat: Cell _ NIL, hCompat: Cell _ NIL] RETURNS [Cell] =
    BEGIN OPEN StringDefs;
    s: STRING _ [100];
    s.length _ 0;
    AppendString[to: s, from: cellFamily];
    AppendString[to: s, from: member];
    FOR cp: LONG POINTER TO cList _ cellList, cp.nxt WHILE cp # NIL DO
      IF StringDefs.EquivalentString[cp.name, s] THEN
        BEGIN
        c: Cell _ cp.ob;
        IF vCompat # NIL THEN CheckPitchCompatability[c, vCompat, vertical];
        IF hCompat # NIL THEN CheckPitchCompatability[c, hCompat, horizontal];
        RETURN[c];
        END;
      ENDLOOP;
    IF required THEN
      {Explain["Missing cell in family [Confirm]"L, s]; SIGNAL Punt};
    RETURN[NIL];
    END;

  FindDCell:  PROCEDURE [
    cellFamily, memberPrefix: STRING, required: BOOLEAN _ FALSE,
    vCompat: Cell _ NIL, hCompat: Cell _ NIL] RETURNS [d: DCell] =
    BEGIN OPEN StringDefs;
    originalLength: INTEGER _ memberPrefix.length;
    member: STRING _ [50];
    member.length _ 0;
    AppendString[to: member, from: memberPrefix];
    AppendString[to: member, from: "0"L];
    d[FALSE] _ FindCell[cellFamily, member, FALSE, vCompat, hCompat];
    member.length _ originalLength;
    AppendString[to: member, from: "1"L];
    d[TRUE] _ FindCell[cellFamily, member, FALSE, vCompat, hCompat];
    IF d[FALSE]=NIL THEN
      d[FALSE] _ FindCell[cellFamily, memberPrefix, required,
        vCompat, hCompat];
    IF d[TRUE]=NIL THEN d[TRUE] _ d[FALSE];
    CheckPitchCompatability[d[FALSE], d[TRUE], diagonal];
    END;  -- of FindDCell

  FindDCellPr:  PROCEDURE [
    cellFamily, memberPrefix: STRING, required: BOOLEAN _ FALSE,
    vCompat: Cell _ NIL, hCompat: Cell _ NIL] RETURNS [p: DCellPr] =
    BEGIN OPEN StringDefs;
    originalLength: INTEGER _ memberPrefix.length;
    member: STRING _ [50];
    member.length _ 0;
    AppendString[to: member, from: memberPrefix];
    AppendString[to: member, from: "0"L];
    p[FALSE] _ FindDCell[cellFamily, member, required, vCompat, hCompat];
    member.length _ originalLength;
    AppendString[to: member, from: "1"L];
    p[TRUE] _ FindDCell[cellFamily, member, required, vCompat, hCompat];
    CheckPitchCompatability[p[FALSE][FALSE], p[TRUE][FALSE], diagonal];
    END;  -- of FindDCell

  CheckPitchCompatability:  PROCEDURE [
    c1, c2: Cell, dir: Direction, rep1: Point _ [1, 1], rep2: Point _ [1, 1]] =
    BEGIN OPEN StringDefs;

    FindCellName: PROCEDURE [c: Cell] RETURNS [STRING] =
      BEGIN
      FOR cp: LONG POINTER TO cList _ cellList, cp.nxt WHILE cp # NIL DO
        IF c = cp.ob THEN RETURN[cp.name] ENDLOOP;
      RETURN[""];
      END;

    IF c1#NIL AND c2#NIL AND Offset[, c1, dir, rep1]#Offset[, c2, dir, rep2] THEN
      BEGIN
      cellNames: STRING _ [50];
      cellNames.length _ 0;
      AppendString[to: cellNames, from: FindCellName[c1]];
      AppendString[to: cellNames, from: " - "L];
      AppendString[to: cellNames, from: FindCellName[c2]];
      SELECT dir FROM
        vertical, up, down =>
          Explain["Incompatible cell vertical pitches [Confirm]"L, cellNames];
        horizontal, left, right =>
          Explain["Incompatible cell horizontal pitches [Confirm]"L, cellNames];
        ENDCASE => Explain["Incompatible cell sizes [Confirm]"L, cellNames];
      SIGNAL Punt;
      END;
    END;  -- of CheckPitchCompatability


  Repeat:  PROCEDURE[p: Point, cell: Cell, corner: Direction _ topLeft,
    dir: Direction _ horizontal, rep: locNum _ 1,
    midCell: Cell _ NIL, midGap: locNum _ 0,
    altCell: Cell _ NIL, altMod: INTEGER _ 0,
    name, midName: NameGroup _ nilNameGroup] =
    BEGIN

    GetCell: PROCEDURE[i: INTEGER] RETURNS[Cell] =
      {RETURN[
        IF i>0 AND altCell#NIL AND altMod>0 AND (i MOD altMod)#0 THEN altCell
        ELSE cell]};

    RepeatArbitrary[p: p, cp: GetCell, corner: corner, dir: dir,
      rep: rep, midCell: midCell, midGap: midGap,
      name: name, midName: midName];
    END;


  RepeatArbitrary:  PROCEDURE[p: Point, cp: PROCEDURE[i: INTEGER] RETURNS[Cell],
    corner: Direction _ topLeft, dir: Direction _ upAndLeft,
    rep: INTEGER _ 1, midCell: Cell _ NIL, midGap: locNum _ 0,
    name, midName: NameGroup _ nilNameGroup] =
    BEGIN
    cellSize: Point _ CellSize[cp[0]];
    midCellSize: Point _ CellSize[midCell];

    SELECT corner FROM
      topRight => p.x _ p.x-cellSize.x;
      bottomLeft => p.y _ p.y-cellSize.y;
      bottomRight => p _ [x: p.x-cellSize.x, y: p.y-cellSize.y];
      ENDCASE => NULL;

    SELECT dir FROM
      vertical, up, down =>
        BEGIN
        FOR iy: INTEGER IN [0..rep) DO
          PlaceCell[p: p, cell: cp[iy],
            rep: [0, iy], midCellSize: midCellSize,
            midGap: [0, midGap], name: name];
          ENDLOOP;
        FOR iy: INTEGER IN [0..MidCellRep[midGap, rep-1, cellSize.y]) DO
          PlaceCell[p: [p.x,
            p.y+(iy+1)*cellSize.y*CellsPerGap[midGap, cellSize.y]+iy*midCellSize.y],
            cell: midCell, name: midName];
          ENDLOOP;
        END;
      horizontal, left, right =>
        BEGIN
        FOR ix: INTEGER IN [0..rep) DO
          PlaceCell[p: p, cell: cp[ix],
            rep: [ix, 0], midCellSize: midCellSize,
            midGap: [midGap, 0], name: name];
          ENDLOOP;
        FOR ix: INTEGER IN [0..MidCellRep[midGap, rep-1, cellSize.x]) DO
          PlaceCell[
            p: [p.x+(ix+1)*cellSize.x*CellsPerGap[midGap, cellSize.x]+ix*midCellSize.x,
              p.y],
            cell: midCell, name: midName];
          ENDLOOP;
        END;
      ENDCASE => NULL;
    END; -- of RepeatArbitrary


  CellsPerGap: PROCEDURE[gap, sizePerCell: locNum] RETURNS[INTEGER] =
    {RETURN[(gap+sizePerCell-1)/sizePerCell] -- ceiling --};


  MidCellRep: PROCEDURE[gap, nCells, sizePerCell: locNum] RETURNS[INTEGER] =
    BEGIN
    cellsPerGap: INTEGER _ CellsPerGap[gap, sizePerCell];
    RETURN[IF cellsPerGap=0 THEN 0 ELSE nCells/cellsPerGap];
    END;


  MakeMidGrid: PROCEDURE[p: Point, cell: Cell, rep: Point,
    midVCell, midHCell, midVHCell: Cell _ NIL, midGap: Point _ [0,0]] =
    BEGIN
    cellSize: Point _ CellSize[cell];
    midCellSize: Point _ [x: CellSize[midVCell].x,
      y: CellSize[midHCell].y];
    sizePerGap: Point _ [x: cellSize.x*CellsPerGap[midGap.x, cellSize.x],
      y: cellSize.y*CellsPerGap[midGap.y, cellSize.y]];
    midCellRep: Point _ [x: MidCellRep[midGap.x, rep.x-1, cellSize.x],
      y: MidCellRep[midGap.y, rep.y-1, cellSize.y]];
    FOR ix: INTEGER IN [0..rep.x) DO
      FOR iy: INTEGER IN [0..midCellRep.y) DO
        PlaceCell[p: [p.x, p.y+sizePerGap.y+iy*(sizePerGap.y+midCellSize.y)], cell: midHCell,
          rep: [ix, 0], midCellSize: CellSize[midVHCell], midGap: midGap];
        ENDLOOP;
      ENDLOOP;
    FOR ix: INTEGER IN [0..midCellRep.x) DO
      Repeat[p: [p.x+sizePerGap.x+ix*(sizePerGap.x+midCellSize.x), p.y], cell: midVCell,
          dir: vertical, rep: rep.y, midCell: midVHCell, midGap: midGap.y];
      ENDLOOP;
    END; -- of MakeMidGrid


  PlaceCell: PROCEDURE[p: Point, cell: Cell, rep: Point _ [0,0], midCellSize: Point _ [0,0],
    midGap: Point _ [0,0], name: NameGroup _ nilNameGroup] =
    BEGIN
    IF cell#NIL THEN
      BEGIN
      cp: Point _ Offset[p: p, cell: cell, dir: diagonal, rep: rep,
        midCellSize: midCellSize, midGap: midGap];
      lp: listPtr _ makeList[cell, cp.x, cp.y, 0, 0];
      AddInstName[lp, name, rep];
      lpp _ insertList[lpp, lp];
      END;
    END;


  AddInstName: PROCEDURE[lp: listPtr, name: NameGroup,
    rep: Point] =
    BEGIN OPEN StringDefs;

    ComputeIndex: PROCEDURE[i: INTEGER, coef: Point]
      RETURNS[indx: INTEGER] =
      BEGIN
      k: INTEGER _ coef.x*i+coef.y;
      RETURN[IF k<0 THEN 0 ELSE k];
      END;

    s: STRING _ [100];
    tp: LONG POINTER TO text prop _ NIL;
    xIndx: INTEGER _ ComputeIndex[rep.x, name.x];
    yIndx: INTEGER _ ComputeIndex[rep.y, name.y];

    IF lp=NIL OR name.basicName=NIL THEN RETURN;
    s.length _ 0;
    AppendString[to: s, from: name.basicName];
    IF xIndx#0 OR yIndx#0 THEN AppendChar[s: s, c: '-];
    IF xIndx#0 THEN AppendDecimal[s: s, n: xIndx];
    IF yIndx#0 THEN
      BEGIN
      AppendChar[s: s, c: '-];
      AppendDecimal[s: s, n: yIndx];
      END;
    tp _ GetSpace[SIZE[text prop]];
    tp^ _ [nxt: lp.props, varpart: text[s: newString[s]]];
    lp.props _ tp;
    END; -- of AddInstName


  DirSize: PROCEDURE[size: Point, dir: Direction _ diagonal] RETURNS[Point] =
    {RETURN[
      [x: dirFactor[dir].x*size.x, y: dirFactor[dir].y*size.y]]};


  CellSize: PROCEDURE[cell: Cell, dir: Direction _ diagonal] RETURNS[Point] =
    {RETURN[IF cell=NIL THEN [0,0] ELSE
      DirSize[size: [x: cell.size[0], y: cell.size[1]], dir: dir]]};


  Offset: PROCEDURE[p: Point _ [0, 0], cell: Cell, dir: Direction, rep: Point _ [0, 0],
    midCell: Cell _ NIL, midCellSize: Point _ [0,0],
    midGap: Point _ [0, 0], includeTerminalMid: BOOLEAN _ TRUE]
    RETURNS [Point] =
    BEGIN
    midRep: Point _ IF includeTerminalMid THEN rep ELSE
      [x: rep.x-1, y: rep.y-1];
    midCellSize _ IF midCell#NIL THEN CellSize[midCell, dir]
      ELSE DirSize[midCellSize, dir];
    RETURN[IF cell=NIL THEN p ELSE 
      [x: p.x+rep.x*CellSize[cell, dir].x+
        MidCellRep[midGap.x, midRep.x, CellSize[cell].x]*
          midCellSize.x,
      y: p.y+rep.y*CellSize[cell, dir].y+
        MidCellRep[midGap.y, midRep.y, CellSize[cell].y]*
          midCellSize.y]];
    END;


  BlockSize: PROCEDURE [cell: Cell, rep: Point _ [1, 1],
    midCell: Cell _ NIL, midGap: Point _ [0, 0]]
    RETURNS [Point] =
    {RETURN[Offset[cell: cell, rep: rep, midCell: midCell, midGap: midGap,
      p: [0,0], dir: diagonal, includeTerminalMid: FALSE]]};


  MakeNewCell: PROCEDURE [name: STRING, lpp: listPtr]
    RETURNS [cp: LONG POINTER TO cList] =
    BEGIN
    min: Point _ [LAST[locNum], LAST[locNum]];
    max: Point _ [FIRST[locNum], FIRST[locNum]];
    lp: listPtr;
    FOR lp _ lpp, lp.nxt WHILE lp # NIL DO
      ii: [0..1] _ IF InlineDefs.BITAND[lp.idx, 4] = 0 THEN 0 ELSE 1;
      min _ [MIN[min.x, lp.lx], MIN[min.y, lp.ly]];
      max _ [
        MAX[max.x, lp.lx + lp.ob.size[ii]], MAX[
        max.y, lp.ly + lp.ob.size[ii + 1]]];
      ENDLOOP;
    FOR lp _ lpp, lp.nxt WHILE lp # NIL DO
      lp.lx _ lp.lx - min.x; lp.ly _ lp.ly - min.y; lp.selected _ FALSE; ENDLOOP;
    cp _ alocCList[];
    cp.nxt _ cellList;
    cellList _ cp;
    cp.ob _ makeCell[max.x - min.x, max.y - min.y, 0, lpp];
    cp.name _ name;
    END;  -- of MakeNewCell

  AddToMasterList: PROCEDURE[lpp: listPtr] =
    BEGIN
    min: Point _ [LAST[locNum], LAST[locNum]];
    max: Point _ [FIRST[locNum], FIRST[locNum]];
    lp: listPtr;
    FOR lp _ lpp, lp.nxt WHILE lp # NIL DO
      ii: [0..1] _ IF InlineDefs.BITAND[lp.idx, 4] = 0 THEN 0 ELSE 1;
      min _ [MIN[min.x, lp.lx], MIN[min.y, lp.ly]];
      max _ [
        MAX[max.x, lp.lx + lp.ob.size[ii]], MAX[
        max.y, lp.ly + lp.ob.size[ii + 1]]];
      ENDLOOP;
    FOR lp _ masterList, lp.nxt WHILE lp # NIL DO
      IF lp.selected THEN
        BEGIN
        lp.selected _ FALSE;
        reDrawRect[getRect[lp], 0, TRUE, TRUE, FALSE];
        END;
      ENDLOOP;
    FOR lp _ lpp, lp WHILE lp # NIL DO
      p: listPtr _ lp; lp _ p.nxt; p.nxt _ NIL;
      p.lx _ p.lx - min.x + xx;
      p.ly _ p.ly - min.y + yy;
      p.selected _ TRUE;
      masterList _ insertList[masterList, p];
      ENDLOOP;
    putMark[xx, yy];
    reDrawRect[
      [x1: xx, x2: xx+max.x-min.x, y1: yy, y2: yy+max.y-min.y],
      0, TRUE, TRUE, FALSE];
    anyChanges _ sinceIOchanges _ TRUE;
    END; -- of AddToMasterList

  DrawCell: PROCEDURE [obp: Cell] =
    BEGIN
    lp: listPtr _ makeList[obp.p.anotherme[obp], xx, yy, 0, 0];
    obp.returnable _ FALSE;
    masterList _ insertList[masterList, lp];
    selNewThing[masterList, lp, TRUE];
    putMark[xx, yy];
    reDrawRect[getRect[lp], 0, TRUE, TRUE, FALSE];
    anyChanges _ sinceIOchanges _ TRUE;
    END;  -- of DrawCell

  END. -- of RomMakerCommon