-- MakeMaze.mesa 
--   Edited by Sweet, February 4, 1981  11:43 PM

DIRECTORY
  Ascii,
  Inline,
  IODefs,
  PressDefs,
  PressUtilities,
  Random,
  Storage,
  StreamDefs,
  String;

MakeMaze: PROGRAM
  IMPORTS Inline, IODefs, PressDefs, PressUtilities, Random, Storage, StreamDefs, String =
  BEGIN OPEN PressDefs;

  pfdBody: PressFileDescriptor;
  pfd: POINTER TO PressFileDescriptor = @pfdBody;
  Mica: TYPE = CARDINAL;
  MBox: TYPE = RECORD [x,y,w,h: Mica];
  LineWidth: Mica _ 50;
  AnswerWidth: Mica _ 100;
  fudge: Mica;

  serial: CARDINAL;
  serialNumber: STRING = [10];

  PointsToMicas: PROC [points: CARDINAL] RETURNS [Mica] =
    {RETURN [Inline.LongDiv[Inline.LongMult[points, MicasPerInch],72]]};

  DrawLine: PROC [x, y, w, h: Mica] =
    BEGIN
    IF w > h THEN w _ w + h;
    PutRectangle[p: pfd, xstart: x, ystart: y, xlen: w, ylen: h];
    END;

  P2: Mica = PointsToMicas[2];
  M1: Mica = MicasPerInch;
  M12: Mica = MicasPerInch/2;
  M14: Mica = MicasPerInch/4;
  M34: Mica = (3*MicasPerInch)/4;
  M38: Mica = (3*MicasPerInch)/8;

  answers: BOOLEAN;

  Sort: PUBLIC PROCEDURE [
      a: DESCRIPTOR FOR ARRAY OF UNSPECIFIED, 
      Greater: PROC[UNSPECIFIED, UNSPECIFIED] RETURNS [BOOLEAN]] =
    BEGIN
    n: CARDINAL = LENGTH[a];
    i: CARDINAL;
    temp: CARDINAL;
    SiftUp: PROC [l, u: CARDINAL] =
      BEGIN
      s: CARDINAL;
      key: CARDINAL _ a[l-1];
      DO
        s _ l*2;
        IF s > u THEN EXIT;
        IF s < u AND Greater[a[s+1-1], a[s-1]] THEN s _ s+1;
        IF Greater[key, a[s-1]] THEN EXIT;
        a[l-1] _ a[s-1];
        l _ s;
        ENDLOOP;
      a[l-1] _ key;
      END;
    FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP;
    FOR i DECREASING IN [2..n] DO
      SiftUp[1, i];
      temp _ a[1-1];
      a[1-1] _ a[i-1];
      a[i-1] _ temp;
      ENDLOOP;
    END;

  iRandom: ARRAY [0..128) OF CARDINAL;
  jRandom: ARRAY [0..64) OF CARDINAL;

  RandomizeRows: PROC =
    BEGIN
    r:  ARRAY [0..128) OF CARDINAL;
    rGreater: PROC [x, y: CARDINAL] RETURNS [BOOLEAN] =
      {RETURN [r[x] > r[y]]};
    i: CARDINAL;
    FOR i IN [0..nRows) DO
      r[i] _ Random.InRange[0, 1000];
      iRandom[i] _ i;
      ENDLOOP;
    Sort[DESCRIPTOR[@iRandom, nRows], rGreater ];
    END;
      
  RandomizeColumns: PROC =
    BEGIN
    r:  ARRAY [0..64) OF CARDINAL;
    rGreater: PROC [x, y: CARDINAL] RETURNS [BOOLEAN] =
      {RETURN [r[x] > r[y]]};
    i: CARDINAL;
    FOR i IN [0..nCols) DO
      r[i] _ Random.InRange[0, 1000];
      jRandom[i] _ nCols-1-i;
      ENDLOOP;
--    Sort[DESCRIPTOR[@jRandom, nCols], rGreater ];
    END;
      

  nRows, nCols: CARDINAL _ 20;
  start, stop: CARDINAL;
  Direction: TYPE = {n, e, s, w};
  PathRec: TYPE = RECORD [i, j: [0..256), link: POINTER TO PathRec];
  thisPath: POINTER TO PathRec _ NIL;

  Step: PROC [dir: Direction] =
    BEGIN
    node[i][j].path _ first;
    IF ~node[i][j].this THEN {
      tn: POINTER TO PathRec _ Storage.Node[SIZE[PathRec]];
      tn^ _ [i: i, j: j, link: thisPath];
      thisPath _ tn;
      node[i][j].this _ TRUE;
      IF i < nRows/2 THEN upperHalf _ upperHalf + 1
      ELSE lowerHalf _ lowerHalf + 1};
    SELECT dir FROM
      n => {
	node[i][j].n _ TRUE;
	node[i-1][j].s _ TRUE;
	i _ i-1};
      e => {
	node[i][j].e _ TRUE;
	IF j # nCols - 1 THEN node[i][j+1].w _ TRUE;
	j _ j+1};
      s => {
	node[i][j].s _ TRUE;
	node[i+1][j].n _ TRUE;
	i _ i+1};
      w => {
	node[i][j].w _ TRUE;
	node[i][j-1].e _ TRUE;
	j _ j-1};
      ENDCASE;
    END;

  SolveStep: PROC =
    BEGIN
    dir: Direction;
    node[i][j].dead _ TRUE;
    SELECT TRUE FROM
      node[i][j].n AND ~node[i-1][j].dead AND node[i-1][j].path => {
	dir _ n; i _ i-1};
      node[i][j].e AND 
          (j = nCols-1 OR (~node[i][j+1].dead AND node[i][j+1].path)) => {
	dir _ e; j _ j+1};
      node[i][j].s AND ~node[i+1][j].dead AND node[i+1][j].path => {
	dir _ s; i _ i+1};
      node[i][j].w AND ~node[i][j-1].dead AND node[i][j-1].path => {
	dir _ w; j _ j-1};
      ENDCASE;
    SolveDraw[dir];
    END;
  

  SolveDraw: PROC [dir: Direction] =
    BEGIN
    x, y: Mica;
    x _ j * boxMicas + leftMargin + fudge;
    y _ (nRows - 1 - i) * boxMicas + bottomMargin + fudge;
    SELECT dir FROM
      n => DrawLine[x: x, y: y- boxMicas, w: AnswerWidth, h: boxMicas];
      s => DrawLine[x: x, y: y, w: AnswerWidth, h: boxMicas];
      e => DrawLine[x: x- boxMicas, y: y, w: boxMicas, h: AnswerWidth];
      w => DrawLine[x: x, y: y, w: boxMicas, h: AnswerWidth];
      ENDCASE;
    END;
    
  Decide: PROC RETURNS [dir: Direction] = 
    BEGIN
    choice: ARRAY [0..12] OF Direction;
    nC: CARDINAL _ 0;
    AddC: PROC [d: Direction] = {choice[nC] _ d; nC _ nC + 1};
    canE, canW, canN, canS, mtE, mtW, mtN, mtS: BOOLEAN _ FALSE;

    IF first AND Right[] THEN AddC[e];

    IF ~Left[] AND
      ~(first AND (Top[] OR Bottom[])) AND
      ~node[i][j-1].this THEN {
	canW _ TRUE;
	IF ~first AND ~node[i][j-1].done THEN mtW _ TRUE};

    IF ~Right[] AND
      ~(~first AND (Top[] OR Bottom[])) AND
      ~node[i][j+1].this THEN {
	canE _ TRUE;
	IF ~first AND ~node[i][j+1].done THEN mtE _ TRUE};

    IF ~Top[] AND
      ~(first AND Left[] AND start < i) AND
      ~(~first AND ((Left[] AND start > i) OR (Right[] AND stop > i))) AND
      ~node[i-1][j].this THEN {
        canN _ TRUE;
	IF ~first AND ~node[i-1][j].done THEN mtN _ TRUE};

    IF ~Bottom[] AND
      ~(first AND Left[] AND start > i) AND
      ~(~first AND ((Left[] AND start < i) OR (Right[] AND stop < i))) AND
      ~node[i+1][j].this THEN {
        canS _ TRUE;
	IF ~first AND ~node[i+1][j].done THEN mtS _ TRUE};

    IF canN THEN AddC[n];
    IF canE THEN AddC[e];
    IF canS THEN AddC[s];
    IF canW THEN AddC[w];
    
    IF first THEN {
      IF canN AND 10*lowerHalf > 12*upperHalf THEN AddC[n];
      IF canS AND 10*upperHalf > 12*lowerHalf THEN AddC[s]}
    ELSE {
      IF mtN THEN AddC[n];
      IF mtS THEN AddC[s];
      IF mtE AND ~mtW THEN AddC[e];
      IF mtW THEN AddC[w]};

    IF nC = 0 THEN {
      node[i][j].dead _ TRUE;
      SELECT TRUE FROM
	node[i][j].w AND ~node[i][j-1].dead => {
	  Step[w]; RETURN [Decide[]]};
	node[i][j].n AND ~node[i-1][j].dead => {
	  Step[n]; RETURN [Decide[]]};
	node[i][j].s AND ~node[i+1][j].dead => {
	  Step[s]; RETURN [Decide[]]};
	node[i][j].e AND ~node[i][j+1].dead => {
	  Step[e]; RETURN [Decide[]]};
        ENDCASE;
      SIGNAL Trapped};

    RETURN [choice[Random.InRange[0,nC-1]]];
    END;
    
  upperHalf, lowerHalf: CARDINAL;

  Walk: PROC =
    BEGIN
    dir: Direction;
    thisPath _ NIL;
    DO
      dir _ Decide[];
      IF first AND dir = e AND Right[] THEN {
	Step[e]; stop _ i; EXIT};
      Step[dir];
      IF node[i][j].done THEN EXIT;
      ENDLOOP;
    WHILE thisPath # NIL DO
      next: POINTER TO PathRec = thisPath.link;
      node[thisPath.i][thisPath.j].done _ TRUE;
      node[thisPath.i][thisPath.j].this _ FALSE;
      Storage.Free[thisPath];
      thisPath _ next;
      ENDLOOP;
    END;

  GenerateMaze: PROC =
    BEGIN
    DO
      GenMaze[ 
        !Trapped => {
	  IODefs.WriteLine[IF first THEN "no path" ELSE "no fill"];
	  LOOP}];
      EXIT;
      ENDLOOP;

    IF answers THEN 
      FOR r: CARDINAL IN [0..nRows) DO
        FOR c: CARDINAL IN [0..nCols) DO
          astream.put[astream, node[r][c]];
          ENDLOOP;
        ENDLOOP;
    END;

  
  ComputeMargins: PROC =
    BEGIN
    rMax, cMax: Mica;

    cMax _ (13*M1)/2*nCols;
    rMax _ regionSize/nRows;
    boxMicas _ MIN [rMax, cMax, M38];
    fudge _ (boxMicas + LineWidth - AnswerWidth)/2;

    bottomMargin _ (regionSize - nRows*boxMicas)/2 + regionStart;
    leftMargin _ ((17*M1)/2 - nCols * boxMicas)/2;
    END;
    
  GenMaze: PROC =
    BEGIN
    ComputeMargins[];

    FOR r: CARDINAL IN [0..nRows) DO
      FOR c: CARDINAL IN [0..nCols) DO
	node[r][c] _ [];
	ENDLOOP;
      ENDLOOP;
    i _ start _ Random.InRange[0,nRows-1];
    j _ 0; upperHalf _ lowerHalf _ 0;
    first _ TRUE;
    node[i][j].w _ TRUE;
    Walk[];
    IODefs.WriteLine["path"];
    RandomizeRows[];
      RandomizeColumns[];
    first _ FALSE;
    FOR r: CARDINAL IN [0..nRows) DO
      FOR c: CARDINAL IN [0..nCols) DO
	i _ iRandom[r]; j _ jRandom[c];
	IF ~node[i][j].done THEN Walk[];
	ENDLOOP;
      ENDLOOP;
    END;

  boxMicas, leftMargin, bottomMargin: Mica;

  WriteMaze: PROC =
    BEGIN
    r, c: CARDINAL;
    runStart, runStop: CARDINAL;
    BoxX: PROC [r, c: CARDINAL] RETURNS [Mica] = INLINE {
      RETURN[c * boxMicas + leftMargin]};
    BoxY: PROC [r, c: CARDINAL] RETURNS [Mica] = INLINE {
      RETURN[(nRows - 1 - r) * boxMicas + bottomMargin]};
        
    IODefs.WriteLine["pressing"];
    serialNumber.length _ 0;
    String.AppendDecimal[serialNumber, serial];
    PutText[pfd, serialNumber, leftMargin, bottomMargin + nRows*boxMicas + P2];
    -- draw outside
    DrawLine[
      x: BoxX[0,0], y: BoxY[0,0] + boxMicas, 
      w: nCols*boxMicas, h: LineWidth];
    DrawLine[
      x: BoxX[nRows-1,0], y: BoxY[nRows-1,0],
      w: nCols*boxMicas, h: LineWidth];
    IF start # 0 THEN DrawLine[
      x: BoxX[start,0], y: BoxY[start,0]+boxMicas,
      w: LineWidth, h:  start*boxMicas];
    IF start # nRows-1 THEN DrawLine[
      x: BoxX[nRows-1,0], y: BoxY[nRows-1,0],
      w: LineWidth, h:  (nRows-1-start)*boxMicas];
    IF stop # 0 THEN DrawLine[
      x: BoxX[stop,nCols-1] + boxMicas, y: BoxY[stop,nCols-1]+boxMicas,
      w: LineWidth, h:  stop*boxMicas];
    IF stop # nRows-1 THEN DrawLine[
      x: BoxX[nRows-1,nCols-1] + boxMicas, y: BoxY[nRows-1,nCols-1],
      w: LineWidth, h:  (nRows-1-stop)*boxMicas];
    -- do horizontals
    FOR r IN [0..nRows-1) DO
      c _ 0;
      WHILE c < nCols DO
	WHILE c < nCols AND node[r][c].s DO c _ c + 1 ENDLOOP;
	runStart _ c;
	WHILE c < nCols AND ~node[r][c].s DO c _ c + 1 ENDLOOP;
	runStop _ c;
	IF runStart = nCols THEN EXIT;
	DrawLine[
	  x: BoxX[r, runStart], y: BoxY[r, runStart],
	  w: (runStop-runStart)*boxMicas, h: LineWidth];
	ENDLOOP;
      ENDLOOP;
    -- do verticals
    FOR c IN (0..nCols) DO
      r _ 0;
      WHILE r < nRows DO
	WHILE r < nRows AND node[r][c].w DO r _ r + 1 ENDLOOP;
	runStart _ r;
	WHILE r < nRows AND ~node[r][c].w DO r _ r + 1 ENDLOOP;
	runStop _ r;
	IF runStart = nRows THEN EXIT;
	DrawLine[
	  x: BoxX[runStop-1, c], y: BoxY[runStop-1, c],
	  w: LineWidth, h: (runStop-runStart)*boxMicas];
	ENDLOOP;
      ENDLOOP;
    serial _ serial + 1;
    END;

  Top: PROC RETURNS [BOOLEAN] = INLINE {RETURN [i = 0]};
  Bottom: PROC RETURNS [BOOLEAN] = INLINE {RETURN [i = nRows-1]};
  Left: PROC RETURNS [BOOLEAN] = INLINE {RETURN [j = 0]};
  Right: PROC RETURNS [BOOLEAN] = INLINE {RETURN [j = nCols - 1]};

  i, j, nPages: CARDINAL;
  first: BOOLEAN;
  Trapped: SIGNAL = CODE;
  
  regionStart, regionSize: Mica;
  twoPer: BOOLEAN;

  Node: TYPE = RECORD [n, e, s, w, this, done, dead, path: BOOLEAN _ FALSE];

  node: POINTER TO ARRAY [0..128) OF PACKED ARRAY [0..64) OF Node;

  Yes: PROC RETURNS [BOOLEAN] =
    BEGIN OPEN IODefs;
    SELECT ReadChar[] FROM
      'y, 'Y, CR => {WriteLine["yes"]; RETURN[TRUE]};
      ENDCASE => {WriteLine["no"]; RETURN[FALSE]};
    END;
    
  Input: TYPE = RECORD [rows, cols, pages: CARDINAL, twoPer: BOOLEAN, link: POINTER TO Input _ NIL];
  
  firstInput, lastInput: POINTER TO Input _ NIL;
  
  Solve: PROC =
    BEGIN
    i _ start; j _ 0;
    SolveDraw[e];
    UNTIL j = nCols DO SolveStep[] ENDLOOP;
    END;

  CharHeight: Mica;
  CharWidth: POINTER TO ARRAY CHARACTER OF Mica;
  HCharWidth: ARRAY CHARACTER OF Mica;
  TRCharWidth: ARRAY CHARACTER OF Mica;

  Helvetica: PROC =
    BEGIN
    SetFont[p: pfd, Name: "Helvetica", PointSize: 18, Face: 2];
    CharWidth _ @HCharWidth;
    END;

  TimesRoman: PROC =
    BEGIN
    SetFont[p: pfd, Name: "TimesRoman", PointSize: 18, Face: 2];
    CharWidth _ @TRCharWidth;
    END;

  DigestFonts: PROC =
    BEGIN
    [] _ PressUtilities.FindFontWidths[
      family: "Helvetica"L,
      points: 18,
      weight: bold,
      slope: regular,
      widths: LOOPHOLE[@HCharWidth]];
    [] _ PressUtilities.FindFontWidths[
      family: "TimesRoman"L,
      points: 18,
      weight: bold,
      slope: regular,
      widths: LOOPHOLE[@TRCharWidth]];
    CharHeight _ PointsToMicas[18];
    END;
    
  astream: StreamDefs.StreamHandle;
  
  Driver: PROC =
    BEGIN OPEN IODefs, StreamDefs;
    firstSerial: CARDINAL;
    state: Random.State;
    newInput: POINTER TO Input;
    sh: StreamHandle;
    node _ Storage.Words[SIZE[Node, 128*64]];
    DigestFonts[];
    InitPressFileDescriptor[pfd, "Maze.press"L];
    Helvetica[];
    WriteString["new randoms? "];
    IF Yes[] THEN {
      Random.ReadState[@state];
      sh _ NewWordStream["Random.state",ReadWriteAppend];
      [] _ WriteBlock[sh, @state, SIZE[Random.State]];
      sh.destroy[sh]};
    sh _ NewWordStream["Random.state", Read];
    [] _ ReadBlock[sh, @state, SIZE[Random.State]];
    sh.destroy[sh];
    Random.WriteState[@state];
    WriteString["answers? "];
    answers _ Yes[];
    IF answers THEN astream _ NewByteStream["Maze.temp$", ReadWriteAppend];
    WriteString["first serial number: "L];
    serial _ 1;
    serial _ ReadNumber[nRows , 10! String.InvalidNumber => CONTINUE];
    firstSerial _ serial;
    WriteChar[CR];

    DO
      DO
        WriteString["rows: "L];
        nRows _ ReadNumber[nRows , 10! String.InvalidNumber => GO TO done];
        IF nRows > 128 THEN {WriteLine[" at most 128"]; LOOP};
        EXIT;
        ENDLOOP;
      WriteChar[CR];
      IF nRows = 0 THEN EXIT;
      DO
        WriteString["cols: "L];
        nCols _ ReadNumber[nCols, 10];
        IF nCols > 64 THEN {WriteLine[" at most 64"]; LOOP};
        EXIT;
        ENDLOOP;
      WriteChar[CR];
      WriteString["pages: "L];
      nPages _ ReadNumber[nPages , 10! String.InvalidNumber =>
        {nPages _ 1; CONTINUE}];
      WriteChar[CR];
      WriteString["two per page? "];
      twoPer _ Yes[];
      IF twoPer THEN regionSize _ 4*M1+M12 ELSE regionSize _ 9*M1;
      newInput _ Storage.Node[SIZE[Input]];
      newInput^ _ 
        [rows: nRows, cols: nCols, pages: nPages, twoPer: twoPer];
      IF lastInput = NIL THEN firstInput _ newInput
      ELSE lastInput.link _ newInput;
      lastInput _ newInput;
        THROUGH [0..nPages) DO
          regionStart _ IF twoPer THEN 5*M1 + M34 ELSE M1;
	  GenerateMaze[];
	  WriteMaze[];
	  IF twoPer THEN {
	    regionStart _ M34;
	    GenerateMaze[];
	    WriteMaze[]};
	  WritePage[pfd];
          ENDLOOP;
      REPEAT
        done => NULL;
      ENDLOOP;
    ClosePressFile[pfd];
    IF answers THEN
      BEGIN
      next: POINTER TO Input;
      serial _ firstSerial;
      astream.reset[astream];
      WriteChar[CR]; WriteLine["Pressing answers"];
      Random.WriteState[@state];
      InitPressFileDescriptor[pfd, "Maze-solutions.press"L];
      Helvetica[];
      FOR in: POINTER TO Input _ firstInput, next UNTIL in = NIL DO
        next _ in.link;
        nRows _ in.rows; nCols _ in.cols; nPages _ in.pages;
        twoPer _ in.twoPer;
        THROUGH [0..nPages) DO
          regionStart _ IF twoPer THEN 5*M1 + M34 ELSE M1;
	  RereadMaze[];
	  Solve[];
	  WriteMaze[];
	  IF twoPer THEN {
	    regionStart _ M34;
	    RereadMaze[];
	    Solve[];
	    WriteMaze[]};
	  WritePage[pfd];
          ENDLOOP;
        Storage.Free[in];
	ENDLOOP;
      ClosePressFile[pfd];
      astream.destroy[astream];
      END;
    Storage.FreeWords[node];
    END;
    
  RereadMaze: PROC =
    BEGIN
    FOR r: CARDINAL IN [0..nRows) DO
      FOR c: CARDINAL IN [0..nCols) DO
        node[r][c] _ astream.get[astream];
        ENDLOOP;
      ENDLOOP;
    start _ 0;
    UNTIL node[start][0].w DO start _ start + 1 ENDLOOP;
    stop _ 0;
    UNTIL node[stop][nCols-1].e DO stop _ stop + 1 ENDLOOP;
    ComputeMargins[];
    END;

  Driver[];
  END.