-- I/O module of silicon (pretty picture) program

-- last modified by McCreight, December 3, 1982  8:59 AM
--  to remove repeated objects.
-- modified by Petit, Sept 20, 1981

DIRECTORY
  InlineDefs,
  StreamDefs,
  SystemDefs,
  IODefs,
  AltoDefs,
  DirectoryDefs,
  AltoFileDefs,
  StringDefs,
  ppoutdefs,
  ppdefs;
ppout: PROGRAM
  IMPORTS ppdefs, InlineDefs, StreamDefs, DirectoryDefs EXPORTS ppoutdefs =
  BEGIN OPEN ppdefs, ppoutdefs, InlineDefs, StreamDefs, IODefs, DirectoryDefs;

  ppHandle: PUBLIC DiskHandle;
  fp: AltoFileDefs.FP;

  cellNameA: PUBLIC LONG DESCRIPTOR FOR ARRAY OF LONG POINTER TO cell object;

  oCnt, cCnt: PUBLIC CARDINAL;

  outObject: PROCEDURE [ob: LONG POINTER TO object] =
    BEGIN
    i, j: CARDINAL;
	qq:INTEGER;
    SELECT ob.otyp FROM
      cell =>
        BEGIN
        outWord[1];  -- code for cell
        j _ 0;
        FOR i IN [1..cCnt] DO
          IF ob = cellNameA[i] THEN BEGIN j _ i; EXIT; END; ENDLOOP;
        outWord[j];  -- unique # to identify cell
        END;
      xstr =>
        BEGIN
        d: LONG POINTER TO xstr object;
        d _ LOOPHOLE[ob];
        outWord[2];  -- code for xstr
        outWord[d.width];
        outWord[d.length];
        j _ d.lExt + d.wExt*64;
        IF d.pullup THEN j _ BITOR[j, 40000B];
        IF d.impl THEN j _ BITOR[j, 100000B];
        IF d.angle THEN j _ BITOR[j, 20000B];
        IF d.l=pdif THEN j _ BITOR[j, 10000B];
        outWord[j];  -- packed word
	IF d.l=pdif THEN outWord[d.surround];
        IF d.angle THEN
	    BEGIN
		qq_MAX[0,d.size[1]-d.wExt-d.length-2*d.lExt];
        	outWord[qq];  -- angle extension
	    END;
        END;
      cont =>
        BEGIN
        d: LONG POINTER TO cont object _ LOOPHOLE[ob];
	ss:INTEGER_d.size[1];
        outWord[3];  -- code for contact
        j _ 0;
        FOR i IN [1..contTypALen] DO
          IF d.typ = contTypA[i] THEN BEGIN j _ i; EXIT; END; ENDLOOP;
        j _ BITOR[j, BITSHIFT[ss, 8]];
        outWord[j];  -- contact type code
	outWord[d.surround];-- put out surround
	IF d.typ=burr THEN
	    BEGIN
		outWord[d.size[0]];
		outWord[BITOR[BITSHIFT[d.wExt,8],d.lExt]];
	    END;
        END;
      wire =>
        BEGIN
        d: LONG POINTER TO wire object _ LOOPHOLE[ob];
	s0:INTEGER_d.size[0];
	s1:INTEGER_d.size[1];
        outWord[4];  -- code for wire
        outWord[s0];
        outWord[s1];
        outWord[d.l];
	IF d.l=pdif THEN outWord[d.surround];
        END;
      rect =>
        BEGIN
        outWord[5];  -- code for rect
        outWord[ob.size[0]];
        outWord[ob.size[1]];
        outWord[ob.l];
        END;
      bus =>
        BEGIN
        d: LONG POINTER TO bus object;
        d _ LOOPHOLE[ob];
        outWord[7];  -- code for wire
        outWord[d.wwidth];
        outWord[d.firstLength];
        outWord[d.l];
        outWord[d.wCnt];
        outWord[d.wspace];
        outWord[d.topIncr];
        outWord[d.lenIncr+d.topIncr];
        END;
      ENDCASE =>
        BEGIN
        outWord[0];  -- code for unknown
        outWord[0];  -- unknown procedures code
        END;
    END;

  outList: PROCEDURE [lp: LONG POINTER TO list] =
    BEGIN
    i: CARDINAL;
    tp: LONG POINTER TO list;
    pop: LONG POINTER TO prop;
    tp _ lp;
    i _ 0;
    WHILE tp # NIL DO i _ i + 1; tp _ tp.nxt; ENDLOOP;
    outWord[i];
    WHILE lp # NIL DO
      outWord[lp.lx];
      outWord[lp.ly];
      outWord[lp.idx];
      outObject[lp.ob];
      pop _ lp.props;
      IF pop = NIL THEN outWord[0]
      ELSE
        BEGIN
        i _ 0;
        WHILE pop # NIL DO
          SELECT pop.ptyp FROM text => i _ i + 1; ENDCASE; pop _ pop.nxt; ENDLOOP;
        outWord[i];
        pop _ lp.props;
        WHILE pop # NIL DO
          SELECT pop.ptyp FROM
            text =>
              BEGIN
              outWord[1];  --code for text prop
              outString[LOOPHOLE[pop, LONG POINTER TO text prop].s];
              END;
            ENDCASE;
          pop _ pop.nxt;
          ENDLOOP;
        END;
      lp _ lp.nxt;
      ENDLOOP;
    END;
  outWord: PROCEDURE [ww: UNSPECIFIED] = BEGIN ppHandle.put[ppHandle, ww]; END;

  outCell: PROCEDURE [p: obPtr, cp: LONG POINTER TO cList] =
    BEGIN
    WITH dp: p SELECT FROM
      cell =>
        BEGIN
        IF dp.marked THEN RETURN;
        FOR lp: listPtr _ dp.ptr, lp.nxt WHILE lp # NIL DO
          outCell[lp.ob, cp];
          ENDLOOP;
        oCnt _ oCnt + 1;
        cellNameA[oCnt] _ @dp;
        p.marked _ TRUE;
        outWord[oCnt];
        outCellName[@dp, cp];
        outWord[p.size[0]];
        outWord[p.size[1]];
        outWord[dp.cnt];
        outList[dp.ptr];
        END;
      ENDCASE => NULL;
    END;
  outCellName: PROCEDURE [
    p: LONG POINTER TO cell object, cp: LONG POINTER TO cList] =
    BEGIN
    s: STRING _ "";
    WHILE cp # NIL DO
      IF cp.ob = p THEN BEGIN s _ cp.name; EXIT; END; cp _ cp.nxt; ENDLOOP;
    outString[s];
    END;

  writeAll: PUBLIC PROCEDURE [
    mp: LONG POINTER TO list, cp: LONG POINTER TO cList] =
    BEGIN
    cdp, ctp: LONG POINTER TO cell object;
    oCnt _ cCnt _ 0;
    ctp _ cdp _ GetCellSuper[];
    WHILE ctp # NIL DO
      cCnt _ cCnt + 1; ctp.marked _ FALSE; ctp _ ctp.super; ENDLOOP;
    outWord[codeWordForDataFile];
    outWord[5];  -- version #
    outWord[cCnt];  -- output count of cell objects
    cellNameA _ DESCRIPTOR[
      GetSpace[(cCnt + 1)*SIZE[LONG POINTER TO cell object]], cCnt + 1];
    WHILE cdp # NIL DO outCell[cdp, cp]; cdp _ cdp.super; ENDLOOP;
    IF oCnt # cCnt THEN ERROR;

    outList[mp];  -- output master list

    FreeSpace[BASE[cellNameA]];
    END;
  outString: PROCEDURE [s: STRING] =
    BEGIN
    bflg: BOOLEAN _ FALSE;
    sav: UNSPECIFIED;
    i: CARDINAL;
    obyt: PROCEDURE [u: UNSPECIFIED] =
      BEGIN
      IF bflg THEN outWord[BITOR[u, sav]] ELSE sav _ BITSHIFT[u, 8];
      bflg _ NOT bflg;
      END;
    obyt[s.length];
    FOR i IN [0..s.length) DO obyt[s[i]]; ENDLOOP;
    obyt[0];
    END;
  openOfile: PUBLIC PROCEDURE [fname: STRING, existOK: BOOLEAN]
    RETURNS [BOOLEAN] =
    BEGIN
    IF NOT existOK AND DirectoryLookup[@fp, fname, FALSE] THEN RETURN[FALSE];
    ppHandle _ NewWordStream[fname, Write + Append];
    RETURN[TRUE];
    END;
  closeFile: PUBLIC PROCEDURE = BEGIN ppHandle.destroy[ppHandle]; END;

  END.