view src/sim.tp @ 45:9f1ca5ba2684

Discard entries for which we can easily tell that it will be impossible for them to be better than the current best. This allows us to terminate when we cannot solve the map
author Mike Pavone <pavone@retrodev.com>
date Sun, 15 Jul 2012 17:26:25 -0700
parents 0c09730c173e
children 5d2e59cbbc7c
line wrap: on
line source

{
	null <- #{}

	eachbyte <- :string action {
		strLen <- string byte_length:
		index <- 0
		while: {index < strLen} do: {
			element <- (string byte: index)
			action: index element
			index <- index + 1
		}
	}

	debugLog <- :str {
		os write: 2 str
	}
	
	abs <- :val {
		if: val < 0 { 0 - val } else: { val }
	}

	makeCellTypes <- {
		typedict <- dict linear
		new <- :idStr {
			cannav <- if: idStr = " "  {true} else: {
			          if: idStr = "."  {true} else: {
			          if: idStr = "\\" {true} else: {
			          if: idStr = "O"  {true} else: {
			                            false         }}}}
			ret <- #{
				id <- (idStr byte: 0)
				string <- idStr
				isrobot <- { false }
				eq <- :other { id = (other id) }
				navigable <- { cannav }				
			}
			typedict set: (ret id) ret
			ret
		}
		#{
			find <- :id {
				if: id = ("R" byte: 0) { robot: } else: {
					typedict get: id withDefault: empty
				}
			}
			wall        <- new: "#"
			empty       <- new: " "
			earth       <- new: "."
			rock        <- new: "*"
			lambda      <- new: "\\"
			closedLift  <- new: "L"
			openLift    <- new: "O"
			newline     <- new: "\n"
			robot       <- {
				commands <- dict linear
				ret <- #{
					id <- ("R"  byte: 0)
					string <- "R"
					x <- 0
					y <- 0
					isrobot <- { true }
					eq <- :other { id = (other id) }
					collected <- 0
					heldBreath <- 0
					razors <- 0
					busted <- false
					mine <- null
					doCmd <- :cmd {
						action <- commands get: cmd withDefault: { null }
						action:
					}
					move <- :xDelta yDelta {
						xPrime <- x + xDelta
						yPrime <- y + yDelta

						writeMove <- {
							mine setCell: xPrime yPrime self
							mine setCell: x y empty
							x <- xPrime
							y <- yPrime
						}
						
						consequenceOf <- :cur {
							if: (cur eq: lambda)   {
								collected <- collected + 1
								mine addPoints: 25
							}
							if: (cur eq: openLift) {mine succeeded!}							
						}

						destination <- mine getCell: xPrime yPrime
						if: (destination navigable: ) {
							consequenceOf: destination
							writeMove:
						} else: {
							if: (destination eq: rock) {
								xPrimePrime <- xDelta * 2 + x
								rockDestination <- mine getCell: xPrimePrime y
								if: (rockDestination eq: empty) {
									mine setCell: xPrimePrime y rock
									writeMove:
								}
							}
						}

					}
					clone <- {
						myclone <- robot
						myclone collected!: collected
						myclone heldBreath!: heldBreath
						myclone razors!: razors
						myclone
					}
				}
				commands set: "L" {ret move: (-1)  0  }
				commands set: "R" {ret move:   1   0  }
				commands set: "U" {ret move:   0   1  }
				commands set: "D" {ret move:   0 (-1) }
				//commands set: "A" {mine ended!: true}
				ret
			}
		}
    }
#{

	cellTypes <- makeCellTypes:

	state <- #{
		new <- :in_grid in_width in_height { 
			nextGrid <- #[]
			_robot <- null
			endreached <- false
			
			_succeeded <- false
			ret <- #{
				grid <- in_grid
				width <- in_width
				height <- in_height
				calcIndex <- :x y { x + y * width }
				calcX <- :index {index % width}
				calcY <- :index {index / width}
				setCell <- :x y val {
					grid set: (calcIndex: x y) val
				}
				getCell <- :x y {
					grid get: (calcIndex: x y)
				}
				validDest?:from <- :index :fromIndex {
					cell <- (grid get: index)
					if: (cell navigable) {true} else: {
						if: (cell eq: (cellTypes rock)) {
							diff <- index - fromIndex
							//make sure movement was horizontal
							if: (abs: diff) = 1 {
								rockdest <- index + diff
								if: ((grid get: rockdest) eq: (cellTypes empty)) {
									//make sure rock destination doesn't wrap
									(calcY: rockdest) = (calcY: index)
								}
							}
						}
					}
				}
				validMoves <- :x y {
					
					amove <- :idx name {#{
						index <- idx
						cmd <- name
						string <- {
							name . "(" . idx . ")"
						} 
					}}
					here <- calcIndex: x y
					//TODO: Add wait move when rocks are in motion
					//(amove: here "W") 
					cur <- #[(amove: here "A")]
					up <- amove: (calcIndex: x y + 1) "U"
					down <- amove: (calcIndex: x y - 1) "D"
					left <- amove: (calcIndex: x - 1 y) "L"
					right <- amove: (calcIndex: x + 1 y) "R"
					foreach: #[up down left right] :idx el {
						if: (validDest?: (el index) from: here) {
							cur append: el
						}
					}
					cur
				}
				getRobot <- { _robot }
				updatePos <- :obj Index {
					obj x!: (calcX: Index)
					obj y!: (calcY: Index)
				}
				lambdaCount <- 0
				water <- 0
				flooding <- 0
				waterproof <- 10
				moves <- #[]
				score <- 0
				maxScore <- { score + (lambdaCount - (_robot collected)) * 25 + lambdaCount * 50 }
				addPoints <- :points { score <- score + points }
				ended <- {endreached}
				succeeded <- {_succeeded}
				succeeded! <- {
					endreached <- true
					_succeeded <- true
					addPoints: lambdaCount * 50
				}
				doUpdate <- {
					foreach: grid :index value {
						if: (value eq: (cellTypes rock)) {
							x <- calcX: index
							y <- calcY: index
							below <- getCell: x (y - 1)
							if: (below eq: (cellTypes empty)) {
								setCell: x y (cellTypes empty)
								setCell: x (y - 1) value
							}
						} else: {
							if: (value eq: (cellTypes closedLift)) {
								if: (_robot collected) = lambdaCount {
									grid set: index (cellTypes openLift)
								}
							}
						}
					}
				}
				advance <- :roboCmd {
					if: roboCmd = "A" {
						endreached <- true
						moves append: roboCmd
						addPoints: (_robot collected) * 25
					}
					
					if: (not: endreached) {
						_robot doCmd: roboCmd
						score <- score - 1
						moves append: roboCmd
						doUpdate:
					}
					self
				}
				printGrid <- {
					cur <- (grid length) - width
					col <- 0
					while: {cur >= 0} do: {
						os write: 2 ((grid get: cur) string)
						cur <- cur + 1
						col <- col + 1
						if: col = width {
							col <- 0
							cur <- cur - (width + width)
							os write: 2 "\n"
						}
					}
					os write: 2 "score: " . score . "\n"
					os write: 2 "collected: " . (_robot collected) . "\n"
					os write: 2 "moves: "
					foreach: moves :idx m {
						os write: 2 m
					}
					os write: 2 "\n"
				}
				clone <- {
					cgrid <- #[]
					foreach: grid :idx el {
						if: (el isrobot) {
							cgrid append: (el clone)
						} else: {
							cgrid append: el
						}
					}
					myclone <- state new: cgrid width height
					myclone water!: water
					myclone flooding!: flooding
					myclone waterproof!: waterproof
					movesclone <- #[]
					foreach: moves :idx el {
						movesclone append: el
					}
					myclone moves!: movesclone
					myclone score!: score
					myclone lambdaCount!: lambdaCount
					myclone
				}
			}
			foreach: in_grid :index el{
				nextGrid append: el
				if: (el isrobot) {
					_robot <- el
					_robot mine!: ret
					ret updatePos: _robot index
				} else: { 
					if: (el eq: (cellTypes lambda)) {
						ret lambdaCount!: (ret lambdaCount) + 1
					}
				}

				  
//				  adding a 'new' method to robot and doing this instead
//				  wolud allow me to treat robots and other cellTypes equaly
//				  particularly for adding methods or state to other cellTypess.
//
//				if: (el = (cellTypes robot)) {
//					robot <- el new:
//					(ret grid) set: index robot
//					robot mine!: ret
//					ret updatePos: robot index
//					nextGrid append: el
//				} else: {
//					nextGrid append: el
//				}

			}
			ret
		}
		
		fromStr <- :str {
			strLen <- str byte_length:
			maxCol <- 0
			nl <- (cellTypes newline) id
			blank <- cellTypes empty
			lines <- #[]
			curline <- #[]
			eachbyte: str :index element {
				if: element = nl {
					col <- curline length
					maxCol <- if: col > maxCol {col} else: {maxCol}
					lines append: curline
					curline <- #[]
				} else: {
					curline append: (cellTypes find: element)
				}
			}
			grid <- #[]
			cur <- (lines length) - 1
			while: { cur >= 0 } do: {
				curline <- (lines get: cur)
				foreach: curline :idx el {
					grid append: el
				}
				extra <- maxCol - (curline length)
				while: { extra > 0 } do: {	
					grid append: blank
					extra <- extra - 1
				}
				cur <- cur - 1
			}
			new: grid maxCol (lines length)
		}
	}

	readFd <- :fd {
		if: fd < 0 { "" } else: {
			cur <- ""
			part <- ""
			while: { 
				part <- os read: fd 128
				part != ""
			} do: {
				cur <- cur . part
			}
			cur
		}
	}
	
	readFile <- :path {
		fd <- os open: path (os O_RDONLY)
		out <- readFd: fd
		os close: fd
		out
	}
	
	getMove <- {
		ret <- os read: 0 1
		while: {ret = "\n"} do: {
			ret <- os read: 0 1
		}
		ret
	}

	main <- :args {
		if: (args length) < 2 {
			print: "usage: sim filename\n"
		} else: {
			verbose <- true
			text <- readFile: (args get: 1)
			print: text
			//os close: 1
			simState <- state fromStr: text
			while: { not: (simState ended: ) } do: {
				simState advance: (getMove: )
				if: verbose {
					simState printGrid
				}
			}
		}
	}

}
}