MODULE World EXPORTS World, Main; IMPORT Word; IMPORT WRandom; IMPORT Altitude; IMPORT P; (* IMPORT MapSc; *) IMPORT GLWorld; TYPE WORD = Word.T; TYPE LONG = INTEGER; CONST brief = FALSE; VAR oldmap := FALSE; VAR numerical := FALSE; VAR opengl := TRUE; VAR deterministic := FALSE; VAR approxmap := FALSE; VAR branching := TRUE; VAR tracestep := FALSE; VAR too_much := FALSE; VAR check_fsm := FALSE; VAR repeat := FALSE; VAR height := 0.0; VAR fade := 0; VAR wobbly := 2; REVEAL Scene = PubScene BRANDED OBJECT OVERRIDES z := SceneZ; END; PROCEDURE SceneZ(self : Scene; x, y : REAL) : REAL = VAR last : CARDINAL; x00, y00, dxdi, dxdj, dydi, dydj, i, j, si, sj : REAL; sq : Square; ir, jr : INTEGER; BEGIN <*ASSERT self # NIL *> <*ASSERT self.s # NIL *> last := LAST(self.s^); x00 := FLOAT(self.s[0,0].x, REAL) - x; y00 := FLOAT(self.s[0,0].y, REAL) - y; dxdi := FLOAT(self.s[last, 0].x - self.s[0, 0].x, REAL) / FLOAT(last, REAL); dxdj := FLOAT(self.s[0, last].x - self.s[0, 0].x, REAL) / FLOAT((last), REAL); dydi := FLOAT(self.s[last, 0].y - self.s[0, 0].y, REAL) / FLOAT((last), REAL); dydj := FLOAT(self.s[0, last].y - self.s[0, 0].y, REAL) / FLOAT((last), REAL); P.p("x " & P.f(x) & "; y " & P.f(y) & "; x00 " & P.f(x00) & "; y00 " & P.f(y00) &"; dxdi " & P.f(dxdi) &"; dxdj " & P.f(dxdj) &"; dydi " & P.f(dydi) &"; dydj " & P.f(dydj) &"; last " & P.d(last)); i := (dydj * x00 - dxdj * y00) / (dxdj * dydi - dxdi * dydj); j := (dxdi * y00 - dydi * x00) / (dxdj * dydi - dxdi * dydj); P.p(" i " & P.f(i) & "; j " & P.f(j) & "\n"); ir := ROUND(i); IF ir < 0 THEN ir := 0; END; IF ir > last THEN ir := last; END; jr := ROUND(j); IF jr < 0 THEN jr := 0; END; IF jr > last THEN jr := last; END; P.p(" ir " & P.d(ir) & "; jr " & P.d(jr) & "\n"); sq := self.s[ir, jr]; si := i - FLOAT(ir, REAL); sj := j - FLOAT(jr, REAL); P.p("si " & P.f(si) & " sj " & P.f(sj) & "; z " & P.f(sq.z[0]) & ", " & P.f(sq.z[2]) & ", " & P.f(sq.z[2]) & ", " & P.f(sq.z[3]) & ", "); RETURN ( FLOAT(sq.z[0], REAL)*(sj + 0.5) + FLOAT(sq.z[2], REAL)*(0.5 - sj) + FLOAT(sq.z[3], REAL)*(si + 0.5) + FLOAT(sq.z[1], REAL)*(0.5 - si) ) / 2.0; END SceneZ; (* Some tiles are square, some are triangular, corresponding to the two-phase algorithm of quartering squares diagonally and then fusing the triangles *) VAR preprogram, preplimit : ARRAY [0..10-1] OF NAT; prepcount : NAT := 0; preplen : NAT := 10; fakerand : BOOLEAN := FALSE; PROCEDURE reset_prep(b : BOOLEAN) = BEGIN FOR i := 0 TO preplen - 1 DO preprogram[i] := 0; preplimit[i] := 0; END; prepcount := 0; fakerand := b; END reset_prep; PROCEDURE choose(n : NAT; VAR seed : WRandom.Seed) : NAT = VAR v : NAT; BEGIN IF deterministic THEN v := n-1; ELSE v := ROUND(WRandom.drandom(seed) * FLOAT(n, LONGREAL)); IF v >= n THEN v := 0 END; END; RETURN v; END choose; VAR scale : Altitude.T := 20.0 (* Altitude.init_scale *); (* We use upside-down mathematician's coordiates, where y is down and where x is right. if accidental reflection occurs in screen display, everything will be mirror image and no one will be the wiser. *) PROCEDURE coorddown(xu, yu : LONG; VAR xd, yd : LONG) = BEGIN xd := xu + yu; yd := yu - xu; RETURN; END coorddown; (* Having no rotational symmetry, right-angled triangles can have an intrinsic internal orientation. The state of a triangle is expressed relative to this internal coordinate grid. We usually speak of the right angle as being on the "top left". *) TYPE Triangle = RECORD present : BOOLEAN; x, y : INTEGER; (* coordinates of right angle in the scale for which this triangle is half a square. Note that each scale down is rotated 45 degrees from the next higher *) kind : INTEGER; seed : WRandom.Seed; z, (*starting at hypotenuse, going clockwise *) table (* same for water table *) : ARRAY [0..3-1] OF Altitude.T; lake : ARRAY[0..3-1] OF BOOLEAN; (* starting after hypotenuse, going clockwise *) END; (* Squares are rotationally symmetric; they can thus have a number of apparently equivalent coordinate systems. The stats of a square is coded according to an arbitrary coordinate system, and the rot field indicates how that should be transformed to the actual one. *) TYPE TT = {blank, in, out, cross}; TYPE square_type = RECORD top, right, bottom, left : TT; (* clockwise *) unusual : BOOLEAN; END; CONST sqty = ARRAY OF square_type { square_type{ TT.blank, TT.blank, TT.blank, TT.blank, FALSE }, square_type{ TT.out, TT.blank, TT.blank, TT.in, FALSE }, square_type{ TT.blank, TT.out, TT.blank, TT.in, FALSE }, square_type{ TT.blank, TT.blank, TT.out, TT.in, FALSE }, square_type{ TT.in, TT.in, TT.blank, TT.out, FALSE }, square_type{ TT.in, TT.blank, TT.in, TT.out, FALSE }, square_type{ TT.blank, TT.in, TT.in, TT.out, FALSE }, square_type{ TT.out, TT.out, TT.in, TT.in, TRUE }, (* incomplete *) square_type{ TT.out, TT.in, TT.out, TT.in, TRUE }, (* incomplete *) square_type{ TT.in, TT.out, TT.in, TT.out, TRUE }, (* incomplete *) square_type{ TT.in, TT.in, TT.in, TT.out, FALSE }, square_type{ TT.blank, TT.blank, TT.blank, TT.out, FALSE } }; (* 0 1 2 3 4 5 6 *-----* *--^--* *-----* *-----* *--V--* *--V--* *-----* | | | / | | | | | | / | | / | | | | | >- | >-----> >- | <-----< <- | <-----< | | | | | | | \ | | | | \ | | \ | *-----* *-----* *-----* *--V--* *-----* *--^--* *--^--* 7 8 9 10 11 *--^--* *--^--* *--V--* *--V--* *-----* | / | | / | | / | | / | | | >- -> >- -< <- -> <-----< <--- | | / | | / | | / | | \ | | | *--^--* *--V--* *--^--* *--^--* *-----* *) PROCEDURE sq_edge_type(VAR s : Square; edge : CARDINAL) : TT = BEGIN INC(edge, 4); DEC(edge, s.rot DIV 2); WHILE edge >= 4 DO DEC(edge, 4); END; CASE edge OF | 0 => RETURN sqty[s.kind].top; | 1 => RETURN sqty[s.kind].right; | 2 => RETURN sqty[s.kind].bottom; | 3 => RETURN sqty[s.kind].left; END; END sq_edge_type; PROCEDURE fmtt(tt : TT) : TEXT = BEGIN CASE tt OF | TT.blank => RETURN "blank"; | TT.in => RETURN "in"; | TT.out => RETURN "out"; | TT.cross => RETURN "cross"; ELSE RETURN "xxx-tt"; END; END fmtt; TYPE Triangle_type = RECORD hyp, right1, right2 : TT; (* clockwise *) END; CONST tt = ARRAY OF Triangle_type { Triangle_type{TT.blank, TT.blank, TT.blank}, Triangle_type{TT.blank, TT.in, TT.out}, Triangle_type{TT.out, TT.in, TT.blank}, Triangle_type{TT.in, TT.blank, TT.out}, Triangle_type{TT.in, TT.out, TT.blank}, Triangle_type{TT.out, TT.blank, TT.in}, Triangle_type{TT.blank, TT.out, TT.in}, Triangle_type{TT.in, TT.out, TT.in}, Triangle_type{TT.out, TT.in, TT.in}, Triangle_type{TT.in, TT.in, TT.out} }; (* 1 2 3 4 5 6 *---^---* *-------* *---^---* *-------* *---V---* *---V---* | / / | / | | / | / | | / | / / >- / *---> | ^ <---< | V <- / | / | / | / | / | / | / * * * * * * 7 8 9 *---V---* *---V---* *---^---* | / / * | / * /| / <---< >---> >- ^ | / | / | / * * * *) PROCEDURE check_tri_height(VAR t : Triangle ) : BOOLEAN = VAR kind : NAT; has_out : BOOLEAN; outz : Altitude.T; BEGIN (* only for REF IF t = NIL THEN RETURN FALSE; END; *) IF NOT t.present THEN RETURN TRUE; END; kind := t.kind; WITH ty = tt[kind] DO has_out := FALSE; IF ty.hyp = TT.out THEN outz := t.z[0]; has_out := TRUE; END; IF ty.right1 = TT.out THEN outz := t.z[1]; has_out := TRUE; END; IF ty.right2 = TT.out THEN outz := t.z[2]; has_out := TRUE; END; IF has_out AND ty.hyp = TT.in AND outz > t.z[0] OR has_out AND ty.right1 # TT.out AND outz > t.z[1] OR has_out AND ty.right2 # TT.out AND outz > t.z[2] THEN RETURN FALSE; END; END; RETURN TRUE; END check_tri_height; PROCEDURE ftri(VAR t : Triangle) : TEXT = BEGIN (* only with REF IF t = NULL THEN RETURN "NULLtriangle"; ELSE *) RETURN "\nt[p" & P.b(t.present) & " k" & P.d(t.kind) & " x" & P.d(t.x) & " y" & P.d(t.y) & " z" & P.Af(t.z[0]) & " z" & P.Af(t.z[1]) & " z" & P.Af(t.z[2]) & "]" ; (* only with REF END; *) END ftri; PROCEDURE ptri(VAR t : Triangle) = BEGIN P.p(ftri(t)); END ptri; PROCEDURE fsq(tag : TEXT; VAR s : Square) : TEXT = BEGIN (* only with REF IF(s = NULL) THEN RETURN "NULLsquare"; ELSE *) RETURN tag & " s[p" & P.b(s.present) & " k" & P.d(s.kind) & " r" & P.d(s.rot) & " x" & P.d(s.x) & " y" & P.d(s.y) & " z" & P.Af(s.z[0]) & " z" & P.Af(s.z[1]) & " z" & P.Af(s.z[2]) & " z" & P.Af(s.z[3]) & " w" & P.Af(s.table[0]) & " w" & P.Af(s.table[1]) & " w" & P.Af(s.table[2]) & " w" & P.Af(s.table[3]) & "]\n"; (* only with REF END; *) END fsq; PROCEDURE psq(tag : TEXT; VAR s : Square) = BEGIN P.p(fsq(tag, s)); END psq; PROCEDURE rot( r : INTEGER; VAR s : Square) = VAR t : Altitude.T; b : BOOLEAN; BEGIN INC(s.rot, r); s.rot := Word.And(s.rot, 7); WHILE r > 0 DO DEC(r, 2); t := s.z[3]; s.z[3] := s.z[2]; s.z[2] := s.z[1]; s.z[1] := s.z[0]; s.z[0] := t; t := s.table[3]; s.table[3] := s.table[2]; s.table[2] := s.table[1]; s.table[1] := s.table[0]; s.table[0] := t; b := s.lake[3]; s.lake[3] := s.lake[2]; s.lake[2] := s.lake[1]; s.lake[1] := s.lake[0]; s.lake[0] := b; END; END rot; (* The following are the basic refinement procedures on tiles. World refinement proceeds by performing tile refinement over and over again. Most of the details of combine and split are mostly up to the world author; I provide coordinate transformation only. *) PROCEDURE fusetable(l, r : INTEGER; VAR vv : INTEGER) : BOOLEAN = VAR v : INTEGER; CONST N = 10; BEGIN (* right 0 1 2 3 4 5 6 7 8 9 left 0 0 14 X X X X 36 X X X 1 1 80 X X X X 70 X X X 2 X X X 3 2 X X 44 X 56 3 X X 34 X X 26 X X 42 X 4 X X 24 X X 16 X X 60 54 5 X X X 22 12 X X 54 X 66 6 32 74 X X X X 90 X X X 7 X X 40 X X 50 X X 100 X 8 X X X 46 64 X X 104 X 106 9 X X 52 X X 62 X X 102 X tile, rot take the tile, and rotate it clockwise as indicated. *) CASE N*l + r OF | 0*N+0=> v:=00; | 0*N+1=> v:=14; | 0*N+3=> v:=116; | 0*N+4=> v:=114; | 0*N+6=> v:=36; | 1*N+0=> v:=10; | 1*N+1=> v:=80; | 1*N+6=> v:=70; | 2*N+3=> v:=30; | 2*N+4=> v:=20; | 2*N+7=> v:=44; | 2*N+9=> v:=56; | 3*N+0=> v:=112; | 3*N+2=> v:=34; | 3*N+5=> v:=26; | 3*N+8=> v:=42; | 4*N+0=> v:=110; | 4*N+2=> v:=24; | 4*N+5=> v:=16; | 4*N+8=> v:=60; | 5*N+3=> v:=22; | 5*N+4=> v:=12; | 5*N+7=> v:=54; | 5*N+9=> v:=66; | 6*N+0=> v:=32; | 6*N+1=> v:=74; | 6*N+6=> v:=90; | 7*N+2=> v:=40; | 7*N+5=> v:=50; | 7*N+8=> v:=100; | 8*N+3=> v:=46; | 8*N+4=> v:=64; | 8*N+7=> v:=104; | 8*N+9=> v:=106; | 9*N+2=> v:=52; | 9*N+5=> v:=62; | 9*N+8=> v:=102; ELSE v:=0; vv := v; RETURN FALSE; END; vv := v; RETURN TRUE; END fusetable; PROCEDURE fuse(l, r : INTEGER; VAR vv : INTEGER) : BOOLEAN = BEGIN IF fusetable(l, r, vv) THEN RETURN TRUE; END; IF l = 3 AND fusetable(0, r, vv) THEN RETURN TRUE; END; IF r = 3 AND fusetable(l, 0, vv) THEN RETURN TRUE; END; IF l = 4 AND fusetable(0, r, vv) THEN RETURN TRUE; END; IF r = 4 AND fusetable(l, 0, vv) THEN RETURN TRUE; END; IF l = 7 AND fusetable(6, r, vv) THEN RETURN TRUE; END; IF r = 7 AND fusetable(l, 6, vv) THEN RETURN TRUE; END; IF l = 9 AND fusetable(1, r, vv) THEN RETURN TRUE; END; IF r = 9 AND fusetable(l, 1, vv) THEN RETURN TRUE; END; P.p("\nNo fuse for " & P.d(l) & " " & P.d(r) & "."); RETURN FALSE; END fuse; PROCEDURE match_in_out(a, b : TT) : BOOLEAN = BEGIN RETURN ( a = TT.blank AND b = TT.blank OR a = TT.in AND b = TT.out OR a = TT.out AND b = TT.in OR a = TT.in AND b = TT.blank OR a = TT.blank AND b = TT.in ); END match_in_out; PROCEDURE check_fusion ( VAR l, r : Triangle; VAR s : Square; tag : TEXT ) : BOOLEAN = VAR error : BOOLEAN; BEGIN error := FALSE; IF (l.present AND r.present) # s.present THEN P.p("presence mismatch in fusion " & tag & ".\n"); error := TRUE; END; IF NOT l.present OR NOT r.present OR NOT s.present THEN RETURN TRUE; END; IF NOT match_in_out(tt[l.kind].hyp, tt[r.kind].hyp) THEN error := TRUE; P.p("hypotenuses in fusion " & tag & " do not match io.\n"); END; IF l.z[0] # r.z[0] THEN error := TRUE; P.p("hypotenuses in fusion " & tag & " have differing heights"); END; IF( l.table[0] # r.table[0] ) THEN error := TRUE; P.p("hypotenuses in fusion " & tag & " have differing tables"); END; RETURN NOT error; END check_fusion; PROCEDURE combine ( VAR left, right : Triangle; VAR s : Square; tag : TEXT ) = (* Fuse the left and right triangles after rotating the right triangle by 180 degrees. This gives a square in the coordinate system used internally by the left triangle. *) VAR seed : WRandom.Seed; BEGIN seed := Word.Or(1, Word.Xor(left.seed, right.seed)); s.present := left.present AND right.present; IF(s.present) THEN VAR v : INTEGER; VAR r : LONGREAL; BEGIN r := WRandom.drandom(seed); s.x := (left.x + right.x) DIV 2; s.y := (left.y + right.y) DIV 2; (* #if 0 s.z := left.z * r + right.z * (1.0 - r); #endif *) s.rot := 0; s.z[0] := left.z[2]; s.z[1] := right.z[1]; s.z[2] := right.z[2]; s.z[3] := left.z[1]; s.table[0] := left.table[2]; s.table[1] := right.table[1]; s.table[2] := right.table[2]; s.table[3] := left.table[1]; s.lake[0] := right.lake[0]; s.lake[1] := right.lake[1]; s.lake[2] := left.lake[0]; s.lake[3] := left.lake[1]; (* #if 0 if(left.kind == 0 AND right.kind # 0) s.z := right.z; else if(right.kind == 0 AND left.kind # 0) s.z := left.z; #endif *) IF NOT fuse(left.kind, right.kind, v) THEN v := 0; END; s.kind := v DIV 10; s.rot := v MOD 10; END; END; IF( too_much) THEN psq("combine made", s); P.p("from"); ptri(left); ptri(right);P.p("."); END; EVAL check_fusion(left, right, s, tag); END combine; CONST count = ARRAY OF NAT{0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4}; CONST pick = ARRAY [0..16-1] OF ARRAY [0..4-1] OF NAT { ARRAY [0..4-1] OF NAT{ 0, 0, 0, 0 }, ARRAY [0..4-1] OF NAT{ 0, 0, 0, 0 }, ARRAY [0..4-1] OF NAT{ 1, 0, 0, 0 }, ARRAY [0..4-1] OF NAT{ 0, 1, 0, 0 }, ARRAY [0..4-1] OF NAT{ 2, 0, 0, 0 }, ARRAY [0..4-1] OF NAT{ 0, 2, 0, 0 }, ARRAY [0..4-1] OF NAT{ 1, 2, 0, 0 }, ARRAY [0..4-1] OF NAT{ 0, 1, 2, 0 }, ARRAY [0..4-1] OF NAT{ 3, 0, 0, 0 }, ARRAY [0..4-1] OF NAT{ 0, 3, 0, 0 }, ARRAY [0..4-1] OF NAT{ 1, 3, 0, 0 }, ARRAY [0..4-1] OF NAT{ 0, 1, 3, 0 }, ARRAY [0..4-1] OF NAT{ 2, 3, 0, 0 }, ARRAY [0..4-1] OF NAT{ 0, 2, 3, 0 }, ARRAY [0..4-1] OF NAT{ 1, 2, 3, 0 }, ARRAY [0..4-1] OF NAT{ 0, 1, 2, 3 } }; PROCEDURE choosealt(alts : NAT; VAR seed : WRandom.Seed) : NAT = VAR c, r : NAT; BEGIN c := count[alts]; r := choose(c, seed); RETURN pick[c][r]; END choosealt; PROCEDURE splitcanontile ( VAR s : Square; VAR top, right, bottom, left : Triangle; VAR edge : ARRAY OF Altitude.T; VAR table : ARRAY[0..4-1] OF Altitude.T; VAR w : ARRAY [0..4-1] OF BOOLEAN; ) = VAR r : NAT; c : ARRAY[0..4-1] OF Altitude.T; (* Altitude.Ts on diagonals; c[0] top right c[1] bottom right c[2] bottom left c[3] top left *) ctable : ARRAY[0..4-1] OF Altitude.T; (* water table on diagonals *) water : BOOLEAN; (* lake at centre *) seed : WRandom.Seed; BEGIN WRandom.brandom(s.seed, seed, 1); IF wobbly > 1 THEN water := choose(5, seed) <= ORD(w[0])+ORD(w[1])+ORD(w[2])+ORD(w[3]); (* unless changed later *) ELSE water := ORD(w[0]) + ORD(w[1]) + ORD(w[2]) + ORD(w[3]) >= 3; (* ??? or >= 2 ?? *) END; IF NOT lakes THEN water := FALSE; END; IF too_much THEN P.p("\nedge[0] " & P.Af(edge[0]) & "; z[0] " & P.Af(s.z[0]) & "."); END; (* #if 1 *) c[0] := Altitude.meld(edge[0], edge[1], scale, seed); (* top right *) c[1] := Altitude.meld(edge[1], edge[2], scale, seed); (* bottom right *) c[2] := Altitude.meld(edge[2], edge[3], scale, seed); (* bottom left *) c[3] := Altitude.meld(edge[3], edge[0], scale, seed); (* top left *) VAR alts : NAT; BEGIN CASE s.kind OF | 1=> alts := 16_f; IF( NOT w[0] AND NOT w[2] AND w[1] ) THEN alts := 16_1; water := FALSE; END; IF( w[0] # w[1] OR w[1] # w[2]) THEN alts := 16_1; END; IF wobbly < 1 AND Word.And(alts, 16_1) # 0 THEN alts := 16_1; END; IF wobbly > 1 AND Word.And(alts, 16_c) # 0 THEN alts := 16_c; END; r := choosealt(alts, seed); CASE(r) OF | 0=> top.kind := 5; left.kind := 4; bottom.kind := 0; right.kind := 0; c[3] := Altitude.between(edge[0], edge[3], seed); c[0] := Altitude.above(edge[0], c[3], scale, seed); c[2] := Altitude.above(edge[2], c[3], scale, seed); c[1] := Altitude.meld(edge[1], edge[2], scale, seed); IF(w[1] AND NOT w[0] AND NOT w[2]) THEN water := FALSE; END; | 1=> top.kind := 8; left.kind := 4; bottom.kind := 0; right.kind := 1; c[0] := Altitude.morethan(edge[0], scale, seed); c[3] := Altitude.between(edge[0], edge[3], seed); c[1] := Altitude.morethan(c[0], scale, seed); c[2] := Altitude.above(edge[3], c[1], scale, seed); IF(lakes AND w[0] AND w[1] AND w[2]) THEN water := TRUE; END; | 2=> top.kind := 2; left.kind := 3; bottom.kind := 1; right.kind := 1; c[1] := Altitude.between(edge[0], edge[3], seed); c[0] := Altitude.between(c[1], edge[0], seed); c[2] := Altitude.between(c[1], edge[3], seed); c[3] := Altitude.above(edge[3], c[0], scale, seed); water := w[3]; (* c3 ??? *) | 3=> top.kind := 8; left.kind := 4; bottom.kind := 1; right.kind := 1; c[3] := Altitude.between(edge[3], edge[0], seed); c[0] := Altitude.morethan(edge[0], scale, seed); c[1] := Altitude.morethan(c[0], scale, seed); c[2] := Altitude.above(c[1], c[3], scale, seed); IF(lakes AND w[0] AND w[1] AND w[2]) THEN water := TRUE; END; END; | 2=> r := 4; IF(wobbly # 1) THEN r := 2; END; IF(NOT branching) THEN r := 2; END; r := choose(r, seed); IF(wobbly > 1 AND branching) THEN INC(r, 2); END; CASE(r) OF | 0=> top.kind := 6; left.kind := 4; bottom.kind := 0; right.kind := 5; c[3] := Altitude.between(edge[3], edge[1], seed); c[0] := Altitude.between(c[3], edge[1], seed); c[2] := Altitude.morethan(edge[3], scale, seed); c[1] := Altitude.morethan(c[0], scale, seed); IF(lakes AND w[1] AND w[2]) THEN water := TRUE; END; | 1=> top.kind := 0; left.kind := 3; bottom.kind := 1; right.kind := 2; c[2] := Altitude.between(edge[3], edge[1], seed); c[1] := Altitude.between(c[2], edge[1], seed); c[0] := Altitude.morethan(c[1], scale, seed); c[3] := Altitude.morethan(edge[3], scale, seed); IF(lakes AND w[0] AND w[3]) THEN water := TRUE; END; | 2=> top.kind := 6; left.kind := 4; bottom.kind := 1; right.kind := 8; c[3] := Altitude.between(edge[3], edge[1], seed); c[0] := Altitude.between(c[3], edge[1], seed); c[1] := Altitude.morethan(edge[1], scale, seed); c[2] := Altitude.above(c[1], c[3], scale, seed); IF(lakes AND w[2] OR w[3]) THEN water := TRUE; END; | 3=> top.kind := 6; left.kind := 3; bottom.kind := 1; right.kind := 8; c[2] := Altitude.between(edge[3], edge[1], seed); c[1] := Altitude.between(c[2], edge[1], seed); c[0] := Altitude.morethan(edge[1], scale, seed); c[3] := Altitude.above(c[0], c[2], scale, seed); IF(lakes AND w[2] OR w[3]) THEN water := TRUE; END; END; | 3=> (* Why isn't this like case 1 ??? *) alts := 16_f; IF( NOT w[0] AND NOT w[2] AND w[1] ) THEN alts := 16_1; water := FALSE; END; IF( w[0] # w[1] OR w[1] # w[2]) THEN alts := 16_1; END; IF wobbly < 1 AND Word.And(alts, 16_1) # 0 THEN alts := 16_1; END; IF wobbly > 1 AND Word.And(alts, 16_c) # 0 THEN alts := 16_c; END; r := choosealt(alts, seed); CASE r OF | 0=> top.kind := 0; right.kind := 0; bottom.kind := 2; left.kind := 3; c[2] := Altitude.between(edge[2], edge[3], seed); c[1] := Altitude.above(edge[2], c[2], scale, seed); c[3] := Altitude.above(edge[0], c[2], scale, seed); c[0] := Altitude.meld(edge[1], edge[0], scale, seed); IF(w[0] AND NOT w[1] AND NOT w[2]) THEN water := FALSE; END; | 1=> top.kind := 0; left.kind := 3; bottom.kind := 8; right.kind := 6; c[1] := Altitude.morethan(edge[2], scale, seed); c[2] := Altitude.between(edge[2], edge[3], seed); c[0] := Altitude.morethan(c[1], scale, seed); c[3] := Altitude.above(edge[3], c[0], scale, seed); IF(lakes AND w[0] AND w[1] AND w[3]) THEN water := TRUE; END; | 2=> top.kind := 6; left.kind := 4; bottom.kind := 5; right.kind := 6; c[0] := Altitude.between(edge[2], edge[3], seed); c[1] := Altitude.between(c[0], edge[2], seed); c[3] := Altitude.between(c[0], edge[3], seed); c[2] := Altitude.above(edge[3], c[1], scale, seed); water := w[2]; | 3=> top.kind := 6; left.kind := 3; bottom.kind := 8; right.kind := 6; c[2] := Altitude.between(edge[3], edge[2], seed); c[1] := Altitude.morethan(edge[2], scale, seed); c[0] := Altitude.morethan(c[1], scale, seed); c[3] := Altitude.above(c[0], c[2], scale, seed); IF(lakes AND w[0] AND w[1] AND w[3]) THEN water := TRUE; END; END; (* #if 0 top.kind := 0; right.kind := 0; bottom.kind := 2; left.kind := 3; c[2] := Altitude.between(edge[3], edge[2], seed); c[3] := Altitude.morethan(edge[3], scale, seed); c[1] := Altitude.morethan(c[2], scale, seed); c[0] := Altitude.meld(edge[0], edge[1], scale, seed); if(w[0] AND NOT w[1] AND NOT w[3]) water := FALSE; #endif *) | 4 => top.kind := 9; left.kind := 2; bottom.kind := 0; right.kind := 3; c[3] := Altitude.between(edge[3], MIN(edge[0], edge[1]), seed); c[0] := Altitude.between(c[3], edge[1], seed); c[1] := Altitude.morethan(edge[1], scale, seed); c[2] := Altitude.morethan(c[3], scale, seed); | 5 => alts := 16_7; IF(wobbly < 1) THEN alts := 16_1; END; IF(wobbly > 1) THEN alts := 16_6; END; r := choosealt(alts, seed); CASE r OF | 0=> top.kind := 3; left.kind := 8; bottom.kind := 4; right.kind := 0; c[3] := Altitude.between(edge[3], edge[0], seed); c[2] := Altitude.between(edge[3], edge[2], seed); c[1] := Altitude.morethan(edge[2], scale, seed); c[0] := Altitude.morethan(edge[0], scale, seed); | 1=> top.kind := 9; right.kind := 1; bottom.kind := 4; left.kind := 8; c[3] := Altitude.between(edge[3], edge[0], seed); c[2] := Altitude.between(edge[3], edge[2], seed); c[0] := Altitude.morethan(c[3], scale, seed); c[1] := Altitude.above(c[2], c[0], scale, seed); | 2=> top.kind := 3; right.kind := 6; bottom.kind := 7; left.kind := 8; c[3] := Altitude.between(edge[3], edge[0], seed); c[2] := Altitude.between(edge[3], edge[2], seed); c[1] := Altitude.morethan(c[2], scale, seed); c[0] := Altitude.above(c[1], c[3], scale, seed); END; | 6=> r := choose(2, seed); IF(wobbly > 1) THEN r := 1; END; IF(wobbly < 1) THEN r := 0; END; CASE r OF | 0 => top.kind := 0; left.kind := 5; bottom.kind := 7; right.kind := 4; c[2] := Altitude.between(edge[3], MIN(edge[1], edge[2]), seed); c[1] := Altitude.between(c[2], edge[1], seed); c[0] := Altitude.morethan(edge[1], scale, seed); c[3] := Altitude.morethan(c[2], scale, seed); | 1 => top.kind := 1; left.kind := 8; bottom.kind := 4; right.kind := 3; c[1] := Altitude.above(edge[1], edge[2], scale, seed); c[2] := Altitude.between(edge[3], edge[2], seed); c[0] := Altitude.between(edge[3], MIN(edge[0], edge[1]), seed); c[3] := Altitude.between(edge[3], c[0], seed); END; | 7=> top.kind := 5; left.kind := 4; bottom.kind := 3; right.kind := 2; c[1] := Altitude.between(edge[1], edge[2], seed); c[3] := Altitude.between(edge[0], edge[3], seed); c[0] := Altitude.above(c[1], c[3], scale, seed); c[2] := Altitude.above(edge[2], edge[3], scale, seed); IF(lakes AND w[0] AND w[2]) THEN water := TRUE; END; IF(NOT w[0] AND NOT w[2]) THEN water := FALSE; END; | 8=> top.kind := 5; left.kind := 4; bottom.kind := 5; right.kind := 4; c[1] := Altitude.between(edge[2], edge[1], seed); c[3] := Altitude.between(edge[0], edge[3], seed); c[0] := Altitude.above(c[3], edge[1], scale, seed); c[2] := Altitude.above(edge[3], c[1], scale, seed); IF(lakes AND w[0] AND w[2]) THEN water := TRUE; END; IF(NOT w[0] AND NOT w[2]) THEN water := FALSE; END; | 9=> top.kind := 3; left.kind := 2; bottom.kind := 3; right.kind := 2; c[1] := Altitude.between(edge[1], edge[2], seed); c[3] := Altitude.between(edge[3], edge[0], seed); c[0] := Altitude.above(edge[0], c[1], scale, seed); c[2] := Altitude.above(edge[2], c[3], scale, seed); IF(lakes AND w[0] AND w[2]) THEN water := TRUE; END; IF(NOT w[0] AND NOT w[2]) THEN water := FALSE; END; | 10=> r := 2; r := choose(r, seed); IF(r # 0) THEN top.kind := 3; left.kind := 8; bottom.kind := 7; right.kind := 4; c[3] := Altitude.between(edge[3], edge[0], seed); c[2] := Altitude.between(edge[3], MIN(edge[2], edge[1]), seed); c[1] := Altitude.between(c[2], edge[1], seed); c[0] := Altitude.above(edge[0], edge[1], scale, seed); ELSE top.kind := 9; left.kind := 8; bottom.kind := 4; right.kind := 3; c[3] := Altitude.between(edge[3], MIN(edge[0], edge[1]), seed); c[2] := Altitude.between(edge[3], edge[2], seed); c[0] := Altitude.between(c[3], edge[1], seed); c[1] := Altitude.above(edge[1], edge[2], scale, seed); END; | 11=> IF(w[0] OR w[1]) THEN water := FALSE; r := 0; top.kind := 0; left.kind := 2; bottom.kind := 0; right.kind := 0; c[3] := Altitude.morethan(edge[3], scale, seed); c[2] := Altitude.morethan(edge[3], scale, seed); ELSE IF wobbly > 1 THEN r := 2 + choose(2, seed); ELSIF wobbly < 1 THEN r := choose(2, seed); ELSE r := choose(4, seed); END; CASE r OF | 0=> top.kind := 1; left.kind := 2; bottom.kind := 0; right.kind := 1; c[3] := Altitude.morethan(edge[3], scale, seed); c[0] := Altitude.morethan(c[3], scale, seed); c[1] := Altitude.morethan(c[0], scale, seed); c[2] := Altitude.above(c[3], c[1], scale, seed); | 1=> top.kind := 0; left.kind := 5; bottom.kind := 6; right.kind := 6; c[2] := Altitude.morethan(edge[3], scale, seed); c[1] := Altitude.morethan(c[2], scale, seed); c[0] := Altitude.morethan(c[1], scale, seed); c[3] := Altitude.above(c[2], c[0], scale, seed); | 2=> top.kind := 1; left.kind := 2; bottom.kind := 1; right.kind := 1; c[3] := Altitude.morethan(edge[3], scale, seed); c[0] := Altitude.morethan(c[3], scale, seed); c[1] := Altitude.morethan(c[0], scale, seed); c[2] := Altitude.morethan(c[1], scale, seed); | 3=> top.kind := 6; left.kind := 5; bottom.kind := 6; right.kind := 6; c[2] := Altitude.morethan(edge[3], scale, seed); c[1] := Altitude.morethan(c[2], scale, seed); c[0] := Altitude.morethan(c[1], scale, seed); c[3] := Altitude.morethan(c[0], scale, seed); END; END; ELSE (* also case 0 *) top.kind := 0; left.kind := 0; bottom.kind := 0; right.kind := 0; c[0] := Altitude.meld(edge[0], edge[1], scale, seed); c[1] := Altitude.meld(edge[1], edge[2], scale, seed); c[2] := Altitude.meld(edge[2], edge[3], scale, seed); c[3] := Altitude.meld(edge[3], edge[0], scale, seed); END; (* end case s.kind *) END; (* First approx too water table *) FOR i := 0 TO 4-1 DO ctable[i] := c[i]; END; top.z[0] := edge[0]; right.z[0] := edge[1]; bottom.z[0] := edge[2]; left.z[0] := edge[3]; top.table[0] := table[0]; right.table[0] := table[1]; bottom.table[0] := table[2]; left.table[0] := table[3]; top.z[1] := c[0]; right.z[2] := c[0]; right.z[1] := c[1]; bottom.z[2] := c[1]; bottom.z[1] := c[2]; left.z[2] := c[2]; left.z[1] := c[3]; top.z[2] := c[3]; top.table[1] := ctable[0]; right.table[2] := ctable[0]; right.table[1] := ctable[1]; bottom.table[2] := ctable[1]; bottom.table[1] := ctable[2]; left.table[2] := ctable[2]; left.table[1] := ctable[3]; top.table[2] := ctable[3]; top.lake[0] := w[0]; top.lake[1] := water; top.lake[2] := w[3]; right.lake[0] := w[1]; right.lake[1] := water; right.lake[2] := w[0]; bottom.lake[0] := w[2]; bottom.lake[1] := water; bottom.lake[2] := w[1]; left.lake[0] := w[3]; left.lake[1] := water; left.lake[2] := w[2]; WRandom.brandom(seed, top.seed, 2); WRandom.brandom(seed, right.seed, 3); WRandom.brandom(seed, bottom.seed, 4); WRandom.brandom(seed, left.seed, 5); END splitcanontile; PROCEDURE splittile ( VAR s : Square; VAR top, right, bottom, left : Triangle ) = VAR edge, table : ARRAY[0..4-1] OF Altitude.T; t : Altitude.T; b : BOOLEAN; lake : ARRAY[0..4-1] OF BOOLEAN; i : NAT; BEGIN IF(too_much)THEN P.p("\nsplittile z is " & P.Af(s.z[0]) & "."); END; FOR i := 0 TO 4-1 DO table[i] := s.table[i]; edge[i] := s.z[i]; lake[i] := s.lake[i]; END; i := 0; WHILE i < s.rot DO t := edge[0]; edge[0] := edge[1]; edge[1] := edge[2]; edge[2] := edge[3]; edge[3] := t; t := table[0]; table[0] := table[1]; table[1] := table[2]; table[2] := table[3]; table[3] := t; b := lake[0]; lake[0] := lake[1]; lake[1] := lake[2]; lake[2] := lake[3]; lake[3] := b; INC(i, 2); END; CASE(s.rot) OF | 6 => splitcanontile(s, left, top, right, bottom, edge, table, lake); | 4 => splitcanontile(s, bottom, left, top, right, edge, table, lake); | 2 => splitcanontile(s, right, bottom, left, top, edge, table, lake); ELSE (* also case 0: *) splitcanontile(s, top, right, bottom, left, edge, table, lake); END; END splittile; PROCEDURE split ( VAR s : Square; VAR top, right, bottom, left : Triangle; ) = (* square in, triangles out *) (* Perhaps we should produce an array of triangles *) BEGIN top.present := s.present; left.present := s.present; bottom.present := s.present; right.present := s.present; IF(s.present) THEN (* coorddown(s.x, s.y, &top.x, &top.y); *) VAR seed : WRandom.Seed; BEGIN WRandom.brandom( s.seed, seed, 6); left.x := s.x; right.x := s.x; bottom.x := s.x; top.x := s.x; left.y := s.y; right.y := s.y; bottom.y := s.y; top.y := s.y; (* #if 0 left.z := s.z; right.z := s.z; bottom.z := s.z; top.z := s.z; #endif *) IF(too_much) THEN P.p("split s.z[0] " & P.Af(s.z[0]) & "."); END; splittile(s, top, right, bottom, left); (* #if 0 IF(NOT left.kind) THEN INC( left.z, drandom(seed)*scale); END; IF(NOT right.kind) THEN INC( right.z, drandom(seed)*scale); END; IF(NOT bottom.kind) THEN INC( bottom.z, drandom(seed)*scale); END; IF(NOT top.kind) THEN INC( top.z, drandom(seed)*scale); END; #endif *) END; END; IF(too_much) THEN P.p("\nsplit made "); ptri(top); ptri(right); ptri(bottom); ptri(left); psq("from", s); P.p("."); END; END split; PROCEDURE check_split ( VAR s : Square; VAR t : ARRAY [0..4-1] OF Triangle; ) : BOOLEAN = VAR error : BOOLEAN; i, next : INTEGER; a, b : TT; x : TT; side : ARRAY [0..4-1] OF TT; BEGIN error := FALSE; (* only for REF IF(NOT s) THEN P.p("No square to check_split"); RETURN FALSE; END; *) (* not with present being Boolean IF(s.present < 0 OR s.present > 1) THEN P.p("\npresence out of bounds in check_split."); psq("\n ", s); RETURN FALSE; END; *) IF(NOT s.present) THEN RETURN TRUE; END; side[0] := sqty[s.kind].top; side[1] := sqty[s.kind].right; side[2] := sqty[s.kind].bottom; side[3] := sqty[s.kind].left; (* #if 0 P.p("kind %d rot %d sides %d %d %d %d.\n", s.kind, s.rot, side[0], side[1], side[2], side[3]); #endif *) i := 0; WHILE i < s.rot DO x := side[3]; side[3] := side[2]; side[2] := side[1]; side[1] := side[0]; side[0] := x; INC(i, 2) END; i := 0; WHILE i < 4 DO IF NOT check_tri_height(t[i]) THEN P.p("triangle " & P.d(i) & " failed height check.\n"); RETURN FALSE; END; INC(i); END; (* #if 0 P.p("s after all 4 check_tri_height in check_split"); psq("\n ", s); #endif *) i := 0; WHILE i < 4 AND NOT error DO next := i + 1; IF(next = 4) THEN next := 0; END; IF(t[i].z[0] # s.z[i]) THEN P.p("hyp height not square height.\n"); error := TRUE; END; IF(t[i].table[0] # s.table[i]) THEN P.p("hyp table not square table.\n"); error := TRUE; END; IF(t[i].z[1] # t[next].z[2]) THEN P.p("triangle side heights different in square.\n"); error := TRUE; END; IF(t[i].table[1] # t[next].table[2]) THEN P.p("triangle side tables different in square.\n"); error := TRUE; END; IF( tt[t[i].kind].hyp # side[i] ) THEN error := TRUE; P.p("hyp type does not match square.\n"); P.p("hyp " & fmtt(tt[t[0].kind].hyp) & " " & fmtt(tt[t[1].kind].hyp) & " " & fmtt(tt[t[2].kind].hyp) & " " & fmtt(tt[t[3].kind].hyp) & " sides " & fmtt(side[0]) & " " & fmtt(side[1]) & " " & fmtt(side[2]) & " " & fmtt(side[3]) & " rot " & P.d(s.rot) & ".\n"); END; a := tt[t[i].kind].right1; b := tt[t[next].kind].right2; IF match_in_out(a, b) THEN (* ok *) ELSE error := TRUE; P.p("in and out do not match\n"); END; IF(t[i].z[1] # t[next].z[2]) THEN error := TRUE; P.p("height jumps\n"); END; IF(t[i].table[1] # t[next].table[2]) THEN error := TRUE; P.p("height jumps\n"); END; IF(error) THEN P.p("tt[t[i].kind].right1 " & fmtt(a) & ";tt[t[next].kind].right2 " & fmtt(b) & ";"); END; INC(i); END; RETURN NOT error; END check_split; PROCEDURE splitt ( VAR s : Square; VAR top, right, bottom, left : Triangle ) = VAR t : ARRAY [0..4-1] OF Triangle; BEGIN (* only for REF IF(NOT s) THEN psq("Null square.", s); RAISE quit; END; *) (* not for BOOLEAN IF s.present < 0 OR s.present > 1 THEN psq("presence out of bounds.\n", s); RAISE quit; END; *) split(s, top, right, bottom, left); t[0] := top; t[1] := right; t[2] := bottom; t[3] := left; (* only for REF IF(NOT s) THEN psq("Null square after.", s); RAISE quit; END; *) (* not for BOOLEAN IF s.present < 0 OR s.present > 1 THEN psq("presence out of bounds after.", s); RAISE quit; END; *) IF NOT check_split(s, t) THEN psq("split failed. Error:", s); FOR i := 0 TO 4-1 DO ptri(t[i]); END; RAISE quit; END; END splitt; PROCEDURE test_split() : BOOLEAN = VAR s : Square; t : ARRAY[0..4-1] OF Triangle; rot : NAT; BEGIN FOR kind := 0 TO 11 DO rot := 0; WHILE rot < 8 DO s.present := TRUE; s.x := 100; s.y := 100; s.rot := rot; s.kind := kind; s.z[0] := Altitude.One; s.z[1] := Altitude.One; s.z[2] := Altitude.One; s.z[3] := Altitude.One; s.table[0] := Altitude.One; s.table[1] := Altitude.One; s.table[2] := Altitude.One; s.table[3] := Altitude.One; split(s, t[0], t[1], t[2], t[3]); IF NOT check_split(s, t) THEN psq("error:", s); FOR i := 0 TO 4-1 DO ptri(t[i]); END; RETURN FALSE; END; INC(rot, 2); END; END; RETURN TRUE; END test_split; PROCEDURE downgrid( VAR old : ARRAY OF ARRAY OF Square; size : NAT; VAR new : ARRAY OF ARRAY OF Square; VAR nsize : NAT ) : BOOLEAN = (* These arrays are two-dimensional, but with varying stride The size of new is size * 2 - 2. *) VAR t, ta3, tb2 : REF ARRAY OF Triangle; (* t[size], ta3[size], tb2[size]; *) sa, sb : REF ARRAY OF Square; (* sa[size], sb[size]; *) VAR t1s, t2e, t3w, t3n, t3s, t3e, sa3, sb2, sc3, sd0, sd1, sd2, sd3, se0, se1, se2, se3 : Triangle; VAR r3, se, sd, s12, s13, s21, s30 : Square; BEGIN t := NEW(REF ARRAY OF Triangle, size); ta3 := NEW(REF ARRAY OF Triangle, size); tb2 := NEW(REF ARRAY OF Triangle, size); sa := NEW(REF ARRAY OF Square, size); sb := NEW(REF ARRAY OF Square, size); FOR i := 0 TO size-1 DO FOR j := 0 TO size-1 DO PROCEDURE pt(VAR h : Triangle; s : TEXT) = BEGIN IF tracestep THEN P.p("t " & s & "[" & P.d(i) & " " & P.d(j) & " ] " & P.d(h.kind) & "; "); END; END pt; PROCEDURE ps(VAR h : Square; s : TEXT) = BEGIN IF tracestep THEN P.p("s " & s & "[" & P.d(i) & " " & P.d(j) & " ] " & P.d(h.kind) & " " & P.d(h.rot) & "; "); END; END ps; BEGIN IF i = 0 THEN sa3.present := FALSE; sb2.present := FALSE; t1s.present := FALSE; ELSE sa3 := ta3[j]; sb2 := tb2[j]; t1s := t[j]; END; IF j = 0 THEN sc3.present := FALSE; t2e.present := FALSE; END; r3 := old[i, j]; IF(tracestep) THEN P.p("<" & P.d(i) & " " & P.d(j) & ">"); psq("", r3); END; ps(r3, "r3"); splitt(r3, t3n, t3e, t3s, t3w); (* ... *) pt(t3n, "t3n"); pt(t3w, "t3w"); pt(t3s, "t3s"); pt(t3e, "t3e"); combine(t2e, t3w, se, "se"); ps(se, "se"); combine(t1s, t3n, sd, "sd"); ps(sd, "sd"); splitt(sd, sd1, sd3, sd2, sd0); (* ??? *) pt(sd1, "sd1"); pt(sd0, "sd0"); pt(sd2, "sd2"); pt(sd3, "sd3"); combine(sa3, sd0, s12, "s12"); ps(s12, "s12"); combine(sb2, sd1, s13, "s13"); rot(2, s13); ps(s13, "s13"); splitt(se, se0, se1, se3, se2); pt(se0, "se0"); pt(se2, "se2"); pt(se3, "se3"); pt(se1, "se1"); combine(sc3, se0, s21, "s21"); ps(s21, "s21"); combine(sd2, se1, s30, "s30"); rot(2, s30); ps(s30, "s30"); IF(i > 0) THEN IF j > 0 THEN new[(2 * i - 1), 2 * j - 1] := s30; new[(2 * i - 2), 2 * j - 1] := s12; new[(2 * i - 1), 2 * j - 2] := s21; END; IF j < size-1 THEN new[(2 * i - 2), 2 * j ] := s13; END; END; sc3 := sd3; t2e := t3e; t[j] := t3s; ta3[j] := se3; IF(j > 0) THEN tb2[j-1] := se2; END; END; END; (* Now relabel for i++ and stash away *) END; (* if(t)free(t); if(ta3)free(ta3); if(tb2)free(tb2); if(sa)free(sa); if(sb)free(sb); *) RETURN TRUE; END downgrid; PROCEDURE check_grid(VAR grid : ARRAY OF ARRAY OF Square; size : NAT) : BOOLEAN = VAR (* i, j : NAT; *) error : BOOLEAN; BEGIN error := FALSE; FOR i := 0 TO size-1 DO FOR j := 0 TO size-1 DO WITH here = grid[i, j] DO IF here.present THEN IF(i > 0) THEN WITH upper = grid[i - 1, j] DO IF( upper.present ) THEN IF( NOT match_in_out( sq_edge_type(here, 0), sq_edge_type(upper, 2) ) ) THEN P.p("square " & P.d(i) & " " & P.d(j) & " has bad upper neighbour.\n"); psq("upper", upper); psq("here", here); error := TRUE; END; IF( here.z[0] # upper.z[2] ) THEN P.p("height above square %d %d does not match.\n"); psq("upper", upper); psq("here", here); error := TRUE; END; END; END (* upper *) END (* i > 0 *); IF(j > 0) THEN WITH left = grid[i, j - 1] DO IF left.present THEN IF( NOT match_in_out ( sq_edge_type(here, 3), sq_edge_type(left, 1) ) ) THEN P.p("square " & P.d(i) & P.d(j) & "%d %d has bad left neighbour.\n"); psq("left: ", left); psq("here: ", here); error := TRUE; END; IF( here.z[3] # left.z[1] ) THEN P.p("height to left of square " & P.d(i) & " " & P.d(j) & " does not match.\n"); psq("left: ", left); psq("here: ", here); error := TRUE; END; IF( here.table[3] # left.table[1] ) THEN P.p("table to left of square " & P.d(i) & " " & P.d(j) & " does not match.\n"); psq("left: ", left); psq("here: ", here); error := TRUE; END; END; END (* WITH left *); END (* j>0 *); END (* here.present *) END (* WITH here *); END (* FOR j *); END (* FOR i*); RETURN NOT error; END check_grid; (* previous row provides sa2, sb3, t1s. previous element this row provides sc3, t2e, t2s * * / | \ / | \ / | \ / | \ / | \ / | \ * sa------r1------sb-------* / \ | sa3 / | \ sb2 | / / \ | s12 t1s s13 | / / \ | / sd0 | sd1 \ | / *------sc-------*======sd=======* \ | sc3 / @ \ sd2 | sd3 / @ \ | s21 @ s30 t3n / @ \ | / se0 @ se1 \ | / @ r2--t2e-se-t3w--r3---t3e-* / | \ se2 @ se3 / | \ @ / t2s \ @ / t3s \ @ / | \ @ / | \ @ *-------*-------*=======*=======* *) (* Downcell2(r3, t1s, t2e, sa3, sb2, sc3, --> s12, s13, s21, s30) *) (* subsquare coordinates *-------*-------* | \ | / | | 0,0 | 0,1 | | \ | / | |-------*-------| | / | \ | | 1,0 | 1,1 | | / | \ | *-------.-------* *) (* tilted subsquare coordinates *----x-y+1,x+y----* | \ | / | | \ | / | | 0,0 | 0,1 | | \ | / | | \ | / | x-y,x+y----x,y--x-y+1,x+y+1 | / | \ | | / | \ | | 1,0 | 1,1 | | / | \ | | / | \ | *----x-y,x+y+1----* *) (* #if 0 -- Proposed code for caching squares and recomputing them when needed. Square *all_squares; init_all_squares(void); { all_squares := stralloc(Square); all_squares->next := all_squares; all_squares->prev := all_squares; } take(Square *s, Square *list) { Square *n, *p; if(s == list) RETURN; p := s->prev; n := s->next; if(s->prev) p->next := n; if(s->next) n->prev := p; } append(Square *s, Square *list) { p := list->prev; n := list; p->next := s; n->prev := s; s->next := n; s->prev := p; } Square bound_squares := NULL, free_squares := NULL; Square *lookup(int scale, int x, int y) { Square *t; static Square *(lists[]) := { &bound_squares, &free_squares }; for(i := 0; i <= 1; i++) { list := lists[i]; for(t := list->next; t # list; t := t->next) { if(t->scale == scale AND t->x == x AND t->y == y) { take(t, list); append(t, &bound_squares); t->ref ++; RETURN t; } } } RETURN NULL; } release(Square **q) { ( *q)->ref --; if(( *q)->ref == 0) { append( *q, &free_squares);} *q := NULL; } split_square(sq, side, &tri) (* orthogonal squares: side 0:top, 2:right, 4:bottom, 6:left. diamond-oriented squares: 1: top right, 3: right bottom, 5: bottom left, 7: left top. *) { struct tri t0, t2, t4, t6; splitt(sq, &t0, &t2, &t4, &t6); switch(side) { 0, 1: *tri := t0; RETURN; 2, 3: *tri := t2; RETURN; 4, 5: *tri := t4; RETURN; 6, 7: *tri := t6; RETURN; default: P.p("No side %d in splitt.", side); quit(4); } } (* 10 21 00 [[0,0]] 11 [[1,0]] 22 01 12 [[0,1]] 02 [[1,1]] 13 03 *) Square * get_square(int scale, int x, int y) (* to be modified *) { Square f, l, u; Triangle ub, lr, fu, fl; Square su, sl; Triangle t1, t2; Square newsq; s := lookup(x, y); if(s) RETURN s; X := (x+y)/2; Y := (y-x)/2; if(even x+y) { left := get_square(scale+1, X-1, Y); right := get_square(scale+1, X, Y); split(left, 2, tl); split(right, 6, tr); fuse(tl, tr, s); stash(scale, x, y, tr); discard(left); discard(right); } else { top := get_square(scale+1, X, Y); bottom := get_square(scale+1, X, Y+1); split(top, 4, tu); split(bottom, 0, td); fuse(tu, td, s); stash(scale, x, y, rot(2, tr)); discard(top); discard(bottom); } RETURN s; } #endif *) PROCEDURE make9( (*--- tease : BrainTease.T; ---*) VAR seed : WRandom.Seed; VAR finalsize : CARDINAL; VAR s : REF ARRAY OF ARRAY OF Square (*--- ; VAR rix : Rix.T ---*) ) = VAR size, nsize : NAT; t : REF ARRAY OF ARRAY OF Square; BEGIN (*--- rix := NEW(Rix.T).init(tease); ---*) size := 3; s := NEW(REF ARRAY OF ARRAY OF Square, size, size); FOR i := 0 TO 3-1 DO FOR j := 0 TO 3-1 DO s[i, j] . x := 256 * j - 128 + 10; (* orig s[i, j] . y := 128 * i - 64 + 10; *) s[i, j] . y := 256 * i - 128 + 10; FOR k := 0 TO 4-1 DO s[i, j].z[k] := 0.0; s[i, j].lake[k] := FALSE; END; s[i, j] . rot := 0; s[i, j] . present := TRUE; s[i, j] . kind := 0; (* orig s[i, j] . seed := WRandom.init_seed; *) WRandom.brandom(seed, s[i, j] . seed, i*3 + j); END; END; IF oldmap THEN FOR k := 0 TO 4-1 DO s[0,1].z[k] := scale; END; FOR k := 0 TO 4-1 DO s[1,0].z[k] := scale; END; FOR k := 0 TO 4-1 DO s[1,1].z[k] := scale / 2.0; END; s[0,1] . kind := 2; s[0,1] . rot := 2; s[1,0] . kind := 2; s[1,1] . kind := 6; s[1,1] . rot := 4; s[1,2] . kind := 2; ELSE FOR k := 0 TO 4-1 DO s[2,2].z[k] := scale * 2.0; END; FOR k := 0 TO 4-1 DO s[2,1].z[k] := scale; END; s[2,1].z[1] := scale * 2.0; FOR k := 0 TO 4-1 DO s[2,0].z[k] := scale * 2.0; END; s[2,0].z[1] := scale; FOR k := 0 TO 4-1 DO s[1,2].z[k] := scale; END; s[1,2].z[2] := scale * 2.0; FOR k := 0 TO 4-1 DO s[1,1].z[k] := scale / 2.0; END; s[1,1].z[1] := scale; s[1,1].z[2] := scale; s[1,0].z[1] := scale / 2.0; s[1,0].z[2] := scale * 2.0; FOR k := 0 TO 4-1 DO s[0,2].z[k] := scale * 1.5; END; s[0,2].z[2] := scale; s[0,1].z[2] := scale * 0.5; s[0,1].z[1] := scale * 1.5; s[2,1] . kind := 2; s[2,1] . rot := 6; s[1,2] . kind := 2; s[1,2] . rot := 4; s[1,1] . kind := 6; s[1,1] . rot := 0; s[1,0] . kind := 2; s[1,0] . rot := 4; END; P.p("hi!"); FOR i := 0 TO 3-1 DO FOR j := 0 TO 3-1 DO FOR k := 0 TO 4-1 DO s[i, j].z[k] := s[i, j].z[k] + height; s[i, j].table[k] := s[i, j].z[k]; END; END; END; (* P.p("Aha!"); *) scale := 20.0; IF(NOT check_grid(s^, size)) THEN P.p("initial grid bad..\n"); RAISE quit; END; LOOP IF brief THEN IF size >= 34 THEN EXIT; END; ELSE IF size >= 130 THEN EXIT; END; (* IF size >= 500 THEN EXIT; END; *) END; wobbly := 2; IF(size >= 8) THEN wobbly := 1; END; IF(size >= 16) THEN wobbly := 0; END; (* P.p("\nsize " & P.d(size) & "."); *) scale := scale / 2.0; nsize := size * 2 - 2; P.p("\nnsize " & P.d(nsize) & "."); t := NEW(REF ARRAY OF ARRAY OF Square, nsize, nsize); P.p("\nwill downgrid."); IF(NOT downgrid(s^, size, t^, nsize)) THEN P.p("\ndowngrid fails."); EXIT; END; P.p("\ndowngrid succeeds."); s := t; size := nsize; (*--- IF(approxmap) THEN TeaseWorld.DrawG(rix, tease, size, s); END; ---*) IF(NOT check_grid(s^, size)) THEN P.p("downgrid gives invalid map.\n"); RAISE quit; END; END; finalsize := nsize; P.p("end size " & P.d(finalsize) & "."); (* IF s THEN free(s); END; IF t THEN free(t); END; *) END make9; PROCEDURE world_init() = BEGIN reset_prep(FALSE); END world_init; PROCEDURE test_tables() = BEGIN FOR i := 0 TO 100-1 DO P.p("\n" & P.d(i) & "."); IF( test_split() ) THEN P.p("OK"); ELSE P.p(">>KO<<"); RETURN; END; END; END test_tables; (* extern int fade; *) PROCEDURE main( ) = VAR seed : WRandom.Seed; BEGIN (* #if NOT RESTRICT *) P.p("test version.\n"); (* do this again sometinme * if(argc > 1) * { * for( a := *++argp; *a; a++) * { switch( *a) * { * case '*': repeat := 1; break; * case '.': a++; colour_map_name := *a; break; * case 's': brief := NOT brief; break; * case 'm': showmap := NOT showmap; break; * case 'l': lakes := NOT lakes; break; * case 'p': showmap := 0; perspective_opt := 1; break; * case 'n': numerical := 1; break; * case 'o': oldmap := 1; break; * case 'd': deterministic := 1; break; * case 'a': approxmap := 1; break; * case 'b': branching ^= 1; break; * case 't': tracestep := 1; break; * case '#': too_much := 1; break; * case 'h': height := 300; break; * case 'c' : check_fsm ^= 1; break; * case '?': * P.p("m map\nn numerical\no oldmap\nd deterministic\n" * "a approxmap\nb branching\nt tracestep\n" * "# too much\nh height300\nc check fsm\n" * ); * exit(1); * default: P.p("?%c?", *a); * } * } * } *) (* CHANGE *) showmap := TRUE; perspective_opt := FALSE; (* #endif *) IF showmap THEN fade := 0; ELSE fade := 1; END; world_init(); seed := WRandom.init_seed; (* TODO: set map colours set_new_map_colours(colour_map_name); *) IF check_fsm THEN test_tables(); ELSE (* P.p("will make 9"); *) VAR finalsize : CARDINAL; s : REF ARRAY OF ARRAY OF Square; (*--- rix : Rix.T; ---*) BEGIN REPEAT make9( seed, finalsize, s ); scene.nsize := finalsize; scene.s := s; UNTIL NOT repeat; (* P.p("done.\n"); *) END END; <*ASSERT scene.s # NIL*> GLWorld.StartOpenGL(); (* TODO: wait *) (* CloseEditWindow(); *) END main; BEGIN scene := NEW(Scene); main(); END World.