|
|
1.1 ! root 1: field = cluster is create, clear, size, dimensions, ! 2: all_changes, display_changes, ! 3: display_cell, ! 4: random_changes, is_alive, set_alive, ! 5: get_setpix, get_clearpix ! 6: ! 7: acell = array[cell] ! 8: cells = sequence[cell] ! 9: seq_cells = sequence[cells] ! 10: seq_acell = sequence[acell] ! 11: ! 12: rep = record[ Cell_Size: int, %% Size of a cell in pixels ! 13: Generation: int, %% Generation count ! 14: Matrix: seq_cells, %% The actual cells ! 15: Testers: seq_acell, %% Cells that may have changed ! 16: % %% between generations. ! 17: SetPix: int, ! 18: ClearPix: int ! 19: ] ! 20: ! 21: ints = sequence[int] ! 22: ! 23: Create = proc (Height: int, Width: int, Cell_Size: int, Gap_Size: int, ! 24: HNs: ints, WNs: ints, SetPix, ClearPix: int) returns (cvt) ! 25: CellA: array[cell] := array[cell]$Predict(1, Width) ! 26: ACells: array[cells] := array[cells]$Predict(1, Height) ! 27: AACell: array[acell] := array[acell]$Predict(1, Height) ! 28: XPos: int := Gap_Size ! 29: for I: int in int$From_To(1, Height) do ! 30: YPos: int := Gap_Size ! 31: TL: acell := acell$Predict(1, Width) ! 32: array[acell]$AddH(AACell, TL) ! 33: array[cell]$Trim(CellA, 1, 0) ! 34: for J: int in int$From_To(1, Width) do ! 35: C: cell := cell$New(XPos, YPos) ! 36: array[cell]$AddH(CellA, C) ! 37: C.Test_List := TL ! 38: YPos := YPos + Cell_Size ! 39: end ! 40: array[cells]$AddH(ACells, cells$A2S(CellA)) ! 41: XPos := XPos + Cell_Size ! 42: end ! 43: Fld: seq_cells := seq_cells$A2S(ACells) ! 44: array[cells]$Trim(ACells, 1, 0) ! 45: for I: int in int$From_To(1, Height) do ! 46: for J: int in int$From_To(1, Width) do ! 47: array[cell]$Trim(CellA, 1, 0) ! 48: for N: int in ints$Indexes(HNs) do ! 49: H: int := I + HNs[N] ! 50: if (H <= 0) ! 51: then H := H + Height ! 52: elseif (H > Height) ! 53: then H := H - Height ! 54: end ! 55: W: int := J + WNs[N] ! 56: if (W <= 0) ! 57: then W := W + Width ! 58: elseif (W > Width) ! 59: then W := W - Width ! 60: end ! 61: array[cell]$AddH(CellA, Fld[H][W]) ! 62: end ! 63: Fld[I][J].Neighbors := cells$A2S(CellA) ! 64: end ! 65: end ! 66: return (rep${ Cell_Size: Cell_Size, ! 67: Generation: 0, ! 68: Matrix: Fld, ! 69: Testers: seq_acell$A2S(AACell), ! 70: SetPix: SetPix, ! 71: ClearPix: ClearPix}) ! 72: end Create ! 73: ! 74: ! 75: Size = proc (F: cvt) returns (int); ! 76: return (seq_cells$Size(F.Matrix) * cells$Size(F.Matrix[1])) ! 77: except when Bounds: ! 78: return (0) ! 79: end ! 80: end Size; ! 81: ! 82: Dimensions = proc (F: cvt) returns (int, int); ! 83: return (seq_cells$Size(F.Matrix), cells$Size(F.Matrix[1])) ! 84: except when Bounds: ! 85: return (0, 0) ! 86: end ! 87: end Dimensions; ! 88: ! 89: Clear = proc (F: cvt); ! 90: F.Generation := 0 ! 91: for Row: cells in seq_cells$Elements(F.Matrix) do ! 92: for C: cell in cells$Elements(Row) do ! 93: cell$Clear(C, -1) ! 94: end; ! 95: end; ! 96: for Row: acell in seq_acell$Elements(F.Testers) do ! 97: acell$Trim(Row, 1, 0) ! 98: end; ! 99: end Clear; ! 100: ! 101: All_Changes = iter (F: cvt) yields (int, int, bool); ! 102: own Changes: array[cell] := array[cell]$New() ! 103: Generation: int := F.Generation + 1 ! 104: except when Overflow: ! 105: Generation := 1 ! 106: end ! 107: F.Generation := Generation ! 108: XPos: int := 1 ! 109: Cell_Size: int := F.Cell_Size ! 110: for Row: acell in seq_acell$Elements(F.Testers) do ! 111: YPos: int := 1 ! 112: for C: cell in acell$Elements(Row) do ! 113: Changed: bool := cell$Generate(C) ! 114: if (Changed) ! 115: then array[cell]$AddH(Changes, C) ! 116: yield (XPos, YPos, C.Born) ! 117: end ! 118: YPos := YPos + Cell_Size ! 119: end; ! 120: XPos := XPos + Cell_Size ! 121: acell$Trim(Row, 1, 0) ! 122: end; ! 123: while (true) do ! 124: cell$Affect_Neighbors(array[cell]$RemH(Changes), Generation) ! 125: end ! 126: except when Bounds: ! 127: end ! 128: end All_Changes; ! 129: ! 130: Display_Changes = proc (F: cvt, w: x_window, dwidth: int) ! 131: returns (bool) ! 132: own Changes: array[cell] := array[cell]$New() ! 133: Generation: int := F.Generation + 1 ! 134: except when Overflow: ! 135: Generation := 1 ! 136: end ! 137: F.Generation := Generation ! 138: Something_Changed: bool := false ! 139: for Row: acell in seq_acell$Elements(F.Testers) do ! 140: for C: cell in acell$Elements(Row) do ! 141: if (cell$Generate(C)) ! 142: then Something_Changed := true ! 143: array[cell]$AddH(Changes, C) ! 144: if (C.Born) ! 145: then x_window$pix_set(w, F.SetPix, C.Y, C.X, ! 146: dwidth, dwidth) ! 147: else x_window$pix_set(w, F.ClearPix, C.Y, C.X, ! 148: dwidth, dwidth) ! 149: end ! 150: end ! 151: end; ! 152: acell$Trim(Row, 1, 0) ! 153: end; ! 154: while (true) do ! 155: cell$Affect_Neighbors(array[cell]$RemH(Changes), Generation) ! 156: end ! 157: except when Bounds: ! 158: end ! 159: return (Something_Changed) ! 160: end Display_Changes ! 161: ! 162: Random_Changes = iter (F: cvt) yields (int, int, bool); ! 163: Generation: int := F.Generation ! 164: Prob: int := 8 %% 1/8 chance of life ! 165: for I: int in seq_cells$Indexes(F.Matrix) do ! 166: Row: cells := F.Matrix[I] ! 167: for J: int in cells$Indexes(Row) do ! 168: C: cell := Row[J] ! 169: %% Only randomly make cells alive. Do not kill them. ! 170: if (random$Next(Prob) = 0) ! 171: then Changed: bool := cell$Set_Alive(C, true, Generation) ! 172: if (Changed) ! 173: then cell$Affect_Neighbors(C, Generation) ! 174: yield (I, J, true) ! 175: end ! 176: end ! 177: end; ! 178: end; ! 179: end Random_Changes; ! 180: ! 181: Is_Alive = proc (F: cvt, I: int, J: int) returns (bool) signals (bounds); ! 182: return (F.Matrix[I][J].Alive) ! 183: resignal Bounds ! 184: end Is_Alive; ! 185: ! 186: Set_Alive = proc (F: cvt, I: int, J: int, Alive: bool) signals (bounds); ! 187: C: cell := F.Matrix[I][J] ! 188: resignal Bounds ! 189: cell$Set_Alive(C, Alive, F.Generation) ! 190: cell$Affect_Neighbors(C, F.Generation) ! 191: end Set_Alive; ! 192: ! 193: Display_Cell = proc (F: cvt, I, J: int, w: x_window, ! 194: dwidth: int) signals (bounds) ! 195: C: cell := F.Matrix[I][J] ! 196: resignal Bounds ! 197: if (C.Alive) ! 198: then x_window$pix_set(w, F.SetPix, C.Y, C.X, dwidth, dwidth) ! 199: else x_window$pix_set(w, F.ClearPix, C.Y, C.X, dwidth, dwidth) ! 200: end ! 201: end Display_Cell ! 202: ! 203: Get_SetPix = proc (F: cvt) returns (int) ! 204: return (F.SetPix) ! 205: end Get_SetPix ! 206: ! 207: Get_ClearPix = proc (F: cvt) returns (int) ! 208: return (F.ClearPix) ! 209: end Get_ClearPix ! 210: ! 211: end field
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.