From 6b1bbe57a8cacd8d9e35f6aed6ceeb0a11fe439a Mon Sep 17 00:00:00 2001 From: unknown Date: Wed, 5 Mar 2014 10:22:53 -0500 Subject: [PATCH 1/7] Personalized classpath. Temp solution? I'd rather we weren't scattered... --- .classpath | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.classpath b/.classpath index 6305714..cd2d9fc 100644 --- a/.classpath +++ b/.classpath @@ -2,8 +2,8 @@ - - - + + + From edd2f03535d3ec33deefd58f494d27d02c3d18bf Mon Sep 17 00:00:00 2001 From: unknown Date: Wed, 5 Mar 2014 18:19:24 -0500 Subject: [PATCH 2/7] Trying, damn it. --- .classpath | 1 + src/com/github/izbay/siegeengine/WeaponListener.java | 6 ++++++ 2 files changed, 7 insertions(+) diff --git a/.classpath b/.classpath index cd2d9fc..bf73405 100644 --- a/.classpath +++ b/.classpath @@ -5,5 +5,6 @@ + diff --git a/src/com/github/izbay/siegeengine/WeaponListener.java b/src/com/github/izbay/siegeengine/WeaponListener.java index 9739990..cbd3656 100644 --- a/src/com/github/izbay/siegeengine/WeaponListener.java +++ b/src/com/github/izbay/siegeengine/WeaponListener.java @@ -56,6 +56,12 @@ private void collideHandler(VehicleBlockCollisionEvent e){ } } } + else if(e.getFrom().add(0,-1,0).getBlock().getType().isSolid() && + !e.getTo().add(0,-1,0).getBlock().getType().isSolid() && + e.getTo().add(0,-2,0).getBlock().getType().isSolid()){ + reg.alter(e.getFrom(), Material.RAILS); + reg.alter(e.getTo().add(0,-1,0), Material.RAILS); + } } } From 813ff1348f6dc3e8fa3b96cf80871da5387e61a3 Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 6 Mar 2014 12:04:13 -0500 Subject: [PATCH 3/7] Moving files to D:/Documents/minecraft --- .classpath | 5 ++--- src/com/github/izbay/siegeengine/WeaponListener.java | 7 +------ 2 files changed, 3 insertions(+), 9 deletions(-) diff --git a/.classpath b/.classpath index bf73405..909dfa1 100644 --- a/.classpath +++ b/.classpath @@ -2,9 +2,8 @@ - - + + - diff --git a/src/com/github/izbay/siegeengine/WeaponListener.java b/src/com/github/izbay/siegeengine/WeaponListener.java index cbd3656..615de2b 100644 --- a/src/com/github/izbay/siegeengine/WeaponListener.java +++ b/src/com/github/izbay/siegeengine/WeaponListener.java @@ -56,12 +56,7 @@ private void collideHandler(VehicleBlockCollisionEvent e){ } } } - else if(e.getFrom().add(0,-1,0).getBlock().getType().isSolid() && - !e.getTo().add(0,-1,0).getBlock().getType().isSolid() && - e.getTo().add(0,-2,0).getBlock().getType().isSolid()){ - reg.alter(e.getFrom(), Material.RAILS); - reg.alter(e.getTo().add(0,-1,0), Material.RAILS); - } + } } From c1df209eedf53361409358f79c5bc3c4d40350dc Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 11 Mar 2014 17:18:39 -0400 Subject: [PATCH 4/7] Added a new Listener subclass, RamMoveListener, with reimplemented rail placement on downhill cart movement; do we see if this behavior is acceptable? --- .classpath | 1 + .settings/org.eclipse.core.resources.prefs | 2 + .../izbay/siegeengine/SiegeEnginePlugin.class | Bin 907 -> 1291 bytes .../izbay/siegeengine/RamMoveListener.java | 42 ++++++++++++++++++ .../izbay/siegeengine/SiegeEnginePlugin.java | 6 +++ 5 files changed, 51 insertions(+) create mode 100644 .settings/org.eclipse.core.resources.prefs create mode 100644 src/com/github/izbay/siegeengine/RamMoveListener.java diff --git a/.classpath b/.classpath index 909dfa1..0e6e4e9 100644 --- a/.classpath +++ b/.classpath @@ -5,5 +5,6 @@ + diff --git a/.settings/org.eclipse.core.resources.prefs b/.settings/org.eclipse.core.resources.prefs new file mode 100644 index 0000000..405184d --- /dev/null +++ b/.settings/org.eclipse.core.resources.prefs @@ -0,0 +1,2 @@ +eclipse.preferences.version=1 +encoding//src/com/github/izbay/siegeengine/RamMoveListener.java=UTF-8 diff --git a/bin/com/github/izbay/siegeengine/SiegeEnginePlugin.class b/bin/com/github/izbay/siegeengine/SiegeEnginePlugin.class index e3e1fa153d9ecf62299336e4f35e2c597d57f924..fedc5f37b28ba668bc90df60fa3f326ab36005f9 100644 GIT binary patch literal 1291 zcmb7DYflqF6g@+s+sE=25TzjEqb0QEen`;|#ulxJ;MvEW?y$rLCYiYIC?ym5(eIM4om~B)0NWZ|0VWgZdZ5y99_40Np zU(w6OyumPLgqS7M#h>S1`sf72;j; zD+OYbbyJ0c7{j1J54G0Xt8uqt)*77j45w~3swO2z=Pnps^+Qb{f|QEeNKm-mj%YG0 z8UI%T$~^Aa??f~37ISRfmfHjcHK*bp?vsJVy$$ZRxl50p&V*kwfOAPaL`FfHVK|g- zaH%4Td4?ep3CdYAZPSukbLX|X#Xo11Q}Bpk{@R?@8)k>QhG=@+=57KDNF}j^Ckh@j z%!J~(%7IF~`;1}0<(3q1^)?lW-f<-zPLoSiJ8_WFcUzX6e`1G^F$tx}{fdxWVo zYSae7S!UhYl^y(96$O7lTowt1vC`Ps)0mi87#l5UBqsJWR#K690H47| zf+m(0zJ~8%ybEUC*qk%>%su(;P!C=G`ThD1-~jPRUsly|@3wb;LXdIuoZy`HuWvLY zyZ{9#+oh&`q%&0tuz*GTMGdu#6&H~WMI=|TW@B;WtP@%zQ?U=i_+@xLs@QU|X`e)0 zZez!Oh^|xr-8qy-*5KKJ> Date: Wed, 12 Mar 2014 15:10:58 -0400 Subject: [PATCH 5/7] Remove classpath and project For cross system compatability From 019019479222dc4f010fd5c6c81c8d86c6ebc502 Mon Sep 17 00:00:00 2001 From: izbay Date: Wed, 12 Mar 2014 17:18:29 -0400 Subject: [PATCH 6/7] Added util package Was not able to reference regengine/util (though that would be preferable in the future). Added util to allow error-free compilation. --- .classpath | 7 +- .../izbay/siegeengine/SiegeEnginePlugin.class | Bin 1291 -> 1287 bytes .../izbay/siegeengine/RamMoveListener.java | 7 +- src/com/github/izbay/util/Util.java | 99 ++++++++++++++++++ 4 files changed, 107 insertions(+), 6 deletions(-) create mode 100644 src/com/github/izbay/util/Util.java diff --git a/.classpath b/.classpath index 0e6e4e9..6305714 100644 --- a/.classpath +++ b/.classpath @@ -2,9 +2,8 @@ - - - - + + + diff --git a/bin/com/github/izbay/siegeengine/SiegeEnginePlugin.class b/bin/com/github/izbay/siegeengine/SiegeEnginePlugin.class index fedc5f37b28ba668bc90df60fa3f326ab36005f9..095825e4091494e74830a102d9550e54486ef691 100644 GIT binary patch delta 30 lcmeC?YUkQ;j+xPL@_A-CZY~BU1_lOB1~vxn&3~Br83A-z22cP1 delta 34 pcmZqY>gL*Tj+xPP@_A-Cem(|f1_lOB1~vw61|9~E%|Dp=83BkV25kTU diff --git a/src/com/github/izbay/siegeengine/RamMoveListener.java b/src/com/github/izbay/siegeengine/RamMoveListener.java index 89e9238..dcd254b 100644 --- a/src/com/github/izbay/siegeengine/RamMoveListener.java +++ b/src/com/github/izbay/siegeengine/RamMoveListener.java @@ -5,6 +5,7 @@ import org.bukkit.event.vehicle.*; import org.bukkit.util.*; import org.bukkit.*; + import com.github.izbay.regengine.*; import com.github.izbay.util.Util; @@ -18,6 +19,8 @@ public RamMoveListener(final SiegeEnginePlugin plugin) { plugin.getServer().getPluginManager().registerEvents(this, plugin); }*/ + RegEnginePlugin reg = (RegEnginePlugin)Bukkit.getServer().getPluginManager().getPlugin("RegEngine"); + @EventHandler public void ramMoveHandler(final VehicleMoveEvent ev) { @@ -34,8 +37,8 @@ public void ramMoveHandler(final VehicleMoveEvent ev) { && !Util.isSolid(Util.getBlockBelow(vTo)) && Util.isSolid(Util.getBlockBelow(Util.getBlockBelow(vTo))) ) { - RegEnginePlugin.getInstance().alter(vFrom, Material.RAILS); - RegEnginePlugin.getInstance().alter(Util.getBlockBelow(vTo), Material.RAILS); + reg.alter(vFrom, Material.RAILS); + reg.alter(Util.getBlockBelow(vTo), Material.RAILS); }// if }// if }// ramMoveHandler() diff --git a/src/com/github/izbay/util/Util.java b/src/com/github/izbay/util/Util.java new file mode 100644 index 0000000..47a096f --- /dev/null +++ b/src/com/github/izbay/util/Util.java @@ -0,0 +1,99 @@ +/** + * + */ +package com.github.izbay.util; + +import org.bukkit.Bukkit; +import org.bukkit.Location; +import org.bukkit.World; +import org.bukkit.block.Block; +import org.bukkit.util.BlockVector; +import org.bukkit.util.Vector; + +/** + * @author jdjs + * + */ +/** + * @author J. Jakes-Schauer + * + */ +public class Util +{ + public static BlockVector getBlockVector(final Location l) { + return new BlockVector((int) l.getX(), (int) l.getY(), + (int) l.getZ()); + }// getBlockVector() + + /** + * @param n1 + * @param n2 + * @return ∈ {-1,0,1} + */ + public static int compare(final double n1, final double n2) { + if (n1 == n2) + return 0; + else if (n1 < n2) + return -1; + else + return 1; + }// compare() + + /** + * Imposes a monotonic order on Vectors, with the Y-axis taking highest priority, then the Z- (row-major). + * @param n1 + * @param n2 + * @return ∈ {-1,0,1} + */ + public static int compare(final Vector v1, final Vector v2) { + final int y = compare(v1.getY(), v2.getY()); + if (y == 0) { + final int z = compare(v1.getZ(), v2.getZ()); + if (z == 0) + return compare(v1.getX(), v2.getX()); + else + return z; + }// if + else + return y; + }// compare() + + public static boolean equal(final Vector v1, final Vector v2) + { return compare(v1,v2) == 0; }// equal() + + public static boolean isSolid(final Block b) + { return b.getType().isSolid(); }// isSolid() + + public static World getCurrentWorld() + { return Bukkit.getServer().getWorlds().get(0); } + + public static Block getBlockAt(final Location l) + { return getCurrentWorld().getBlockAt(l); } + + public static Block getBlockAt(final Vector v) + { return getCurrentWorld().getBlockAt( v.getBlockX(), v.getBlockY(), v.getBlockZ()); } + + public static Location getLocation(final Vector v) + { return v.toLocation(getCurrentWorld()); } + + public static Location getLocation(final Block b) + { return b.getLocation(); } + + /** + * Non-mutating Vector addition. + * @return + */ + public static Vector add(final Vector v, final double x, final double y, final double z) + { return new Vector(v.getX()+x, v.getY()+y, v.getZ()+z); } + + public static BlockVector add(final BlockVector v, final int x, final int y, final int z) + { return new BlockVector(v.getX()+x, v.getY()+y, v.getZ()+z); } + + public static Block getBlockBelow(final Vector v) + { return getBlockAt(Util.add(v, 0, -1, 0)); } + + public static Block getBlockBelow(final Block b) + { return getBlockAt(new Vector(b.getX(), b.getY()-1, b.getZ())); } + + private Util() {} +}// Util From b59bc85bb26a8d74d1f9fb2380b34b1480586cce Mon Sep 17 00:00:00 2001 From: unknown Date: Thu, 13 Mar 2014 11:05:54 -0400 Subject: [PATCH 7/7] Uploading Clojure prototyping & testing code, by "popular" demand. re.clj and backup-restore.clj are obsolescent and at the moment unused. mc.clj was the first I wrote and and is still the starting point. dependencies.clj is my in-progress codification of Block dependencies. regen.clj has my current REGENgine prototype, with an alternate version of e.g. RegEngine.alter(). test.clj has utilities I'm working on for R.E. testing. siege.clj contains the prototype for the downward-pointing rails that I added to S.E. --- .gitignore | 5 +- src/cljengine/backup-restore.clj | 203 +++++++++ src/cljengine/dependencies.clj | 428 +++++++++++++++++++ src/cljengine/events.clj | 368 ++++++++++++++++ src/cljengine/mc.clj | 657 +++++++++++++++++++++++++++++ src/cljengine/re.clj | 52 +++ src/cljengine/regen.clj | 700 +++++++++++++++++++++++++++++++ src/cljengine/siege.clj | 116 +++++ src/cljengine/tasks.clj | 233 ++++++++++ src/cljengine/test.clj | 150 +++++++ src/cljengine/util.clj | 103 +++++ 11 files changed, 3014 insertions(+), 1 deletion(-) create mode 100644 src/cljengine/backup-restore.clj create mode 100644 src/cljengine/dependencies.clj create mode 100644 src/cljengine/events.clj create mode 100644 src/cljengine/mc.clj create mode 100644 src/cljengine/re.clj create mode 100644 src/cljengine/regen.clj create mode 100644 src/cljengine/siege.clj create mode 100644 src/cljengine/tasks.clj create mode 100644 src/cljengine/test.clj create mode 100644 src/cljengine/util.clj diff --git a/.gitignore b/.gitignore index b791ff0..f3ac649 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,8 @@ /bin .project .classpath -.gitignore~ /src/com/github/izbay/regengine/bk +/src/cljengine/*.bk* +*~ +*.swp +.gitignore diff --git a/src/cljengine/backup-restore.clj b/src/cljengine/backup-restore.clj new file mode 100644 index 0000000..fffdb80 --- /dev/null +++ b/src/cljengine/backup-restore.clj @@ -0,0 +1,203 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); eval: (viper-mode) -*- +;(ns mc) +(ns cljengine.backup-restore + (:use (clojure core repl pprint reflect) + cljengine.mc) + (:import (org.reflections Reflections) + (org.bukkit Bukkit + Material + Location + World + Effect) + (org.bukkit.block Block + BlockFace ; Enum + BlockState) + (org.bukkit.entity Entity + EntityType + Player) + (org.bukkit.metadata Metadatable) + (org.bukkit.event Event + Cancellable + EventPriority; Enums + HandlerList) + (org.bukkit.event.entity PlayerDeathEvent) + (org.bukkit.event.player PlayerMoveEvent) + (org.bukkit.event.block BlockEvent + BlockPhysicsEvent + BlockBreakEvent) + (org.bukkit.event.vehicle VehicleBlockCollisionEvent + VehicleMoveEvent) + (org.bukkit.util Vector + BlockVector) + (org.bukkit.plugin Plugin) + (org.bukkit.plugin.java JavaPlugin); subtype of Plugin + (org.bukkit.scheduler BukkitScheduler + BukkitTask) + (cljminecraft BasePlugin + ClojurePlugin) + (org.bukkit.util BlockIterator))) + +(defonce *backed-up-region* ()) +(defonce *backed-up-block* nil) +;; TODO: This should cause AIR not to have its state saved. Unless the air blocks are going to have metadata, I don't see how this could be a problem. +(defonce ^:dynamic *ignore-air-blocks* true) + +;; Old version, using Material i/s/o a BlockState: +#_(defn store-block [^Block block] + "Makes a map object storing position & material of block." + {:material (.getType block) + :position (.. block getLocation toVector)}) + +#_(defn ^BlockState backup-block [^Block block] + "Currently stores block in global var *backed-up-block*. Then returns a block image, which currently is a BlockState. +Checks the global *ignore-air-blocks*; unless that is set, AIR isn't backed up. +Note: Currently *not* used by (backup-region)." + (let [material (.getType block)] + (when (or (not (= material Material/AIR)) + *ignore-air-blocks*) + (let [block-state (.getState block)] + (debug-println "Backing up" material "block at" (format-position (.getLocation block))) + (def *backed-up-block* block-state) + (assert (= *backed-up-block* block-state)) + (assert (= *backed-up-block* (.getState block))) + block-state)))) + +(defn restore-block* [^BlockState old-state] + "Impl. for (restore-block), though it can be used on its own." + (let [old-mat-type (.getType old-state) + target-block (get-block-at (.getLocation old-state)) + vec (get-vector target-block)] + (assert (instance? Block target-block)) + (if (= old-state (.getState target-block)) + (do (debug-println "Block at" (format-vector vec) "already exactly matches stored state!")) + (do + (debug-println "Restoring block at" (format-vector vec) + "from material" (.getType target-block) + "to material" old-mat-type) + (.update old-state true))) + (assert (cond + (= old-state (.getState target-block)) true + (= (.getType target-block) (.getType old-state)) + (do (debug-println "States don't match, though materials do.") + true) + :else (do (debug-println "Failing assert; type of block is still " (.getType target-block)) + false))) + ;(assert (= (.getType target-block) old-mat-type)) + ) + true) + +(defn restore-block + ([block] (restore-block* block)) + ([] + "The block stored in *backed-up-block* is regenerated." + (if (nil? *backed-up-block*) + (do + (when *debug-print* (println "No block backed up.")) + false) + (restore-block* *backed-up-block*)))) + + +(defn backup-target-block [^Player entity]; TODO ^Entity + "Calls (backup-block) on (get-target-block)." + (backup-block (get-target-block entity))) + + + + +;; Temporarily substituting the v. in regen.clj: +#_(defn backup-region [^Vector start-corner + ^Vector end-corner] + "Now traverses (gen-region-vectors); less efficient than before but easier to read." + (let [vectors (gen-region-vectors start-corner end-corner)] + (def *backed-up-region* ()) + (doseq [v vectors] + (let [target-block (get-block-at v)] + (assert (instance? Block target-block)) + (debug-println "Backing up block at" (format-vector v)) + (let [block-state (.getState target-block)] + (def *backed-up-region* + (cons block-state *backed-up-region*)))))) + ;; nreverse: + (def *backed-up-region* (reverse *backed-up-region*)) + true) + + +(defn restore-region [& [force]] ; + "Uses BlockStates. Experimental, using (restore-block*). +Unless 'force' is set, a block which already matches won't be regen'd." + (if (and (empty? *backed-up-region*) + (not force)) + (do + (debug-println "No block region backed up.") + false) + (do + (doseq [block-state *backed-up-region*] + (assert (instance? BlockState block-state)) + (restore-block* block-state)) + true))) + +;; May or may not be needed, I don't know. +#_(defn same-block? [b1 b2] + ) + + + +;; Old version, using Material i/s/o a BlockState: +#_(defn backup-block [^Block block] + "The 'block' is stored, by position and material, in the global *backed-up-block*." + (def *backed-up-block* (store-block block)) + (assert (= (:material *backed-up-block*) (.getType block))) + (when *print-debug* + (println "Backed up block of type" (:material *backed-up-block*) + "at position" (format-vector (:position *backed-up-block*)) ".")) + *backed-up-block*) + +;; Old version, using Material i/s/o a BlockState: +#_(defn restore-block [] + "The block stored in *backed-up-block* is regenerated." + (if (nil? *backed-up-block*) + (do + (when *print-debug* (println "No block backed up.")) + false) + (do + (let [{:keys [position material]} *backed-up-block* + loc (.toLocation position (get-current-world)) + block (get-block-at loc)] + (.setType block material) + (assert (= (.getType block) material)) + (debug-println "Restoring block of type" material + "at location" (format-vector position))) + true))) + + +(defn check-backed-up-region [] + "Prints about how the states stored in *backed-up-region* compare to +the blocks they reference. +Returns a duple: number of those that matched and those that didn't." + (if (empty? *backed-up-region*) (println "No region in backup.") + (with-local-vars [matching 0 + non-matching 0] + (doseq [state *backed-up-region*] + (let [pos (get-vector state) + block (get-block-at pos)] + (when (or (not *ignore-air-blocks*) + (not= (.getType state) Material/AIR)) + (cond + (= state (.getState block)) + (do + (println "Block at" pos "still matches:" (.getType state)) + (var-set matching (inc (var-get matching)))), + (= (.getType state) (.getType block)) + (do + (println "Block at" (format-vector pos) "is the right mat," (.getType block)) + (var-set matching (inc (var-get matching)))), + ;(println (format "Block at %s is the right material (%s), but not an exact match." (format-vector vec) (.getType state))) + :else (do + (println "No match at" (format-vector pos) + (format "; %s != %s." (.getType block) + (.getType state))) + (var-set non-matching (inc (var-get non-matching))))) + #_(println (format "No match at %s: state has %s, block has %s." + (.getType state) + (.getType block)))))) + [@matching @non-matching]))) diff --git a/src/cljengine/dependencies.clj b/src/cljengine/dependencies.clj new file mode 100644 index 0000000..46eb0ad --- /dev/null +++ b/src/cljengine/dependencies.clj @@ -0,0 +1,428 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); eval: (viper-mode) -*- +;;;; See http://minecraft-ids.grahamedgecombe.com/ for all the blocks' ID numbers & pictures! + +;; TODO: Continue with changing '*...*' to '+...+' notation. + +(ns mc.block + (:use (clojure core set)) + (:use mc)) + +;; TODO: Should the metatag be ':set' i/s/o 'clojure.core/set'? +(defmacro def-blocktype-set [name & body] + "Wrapper for 'def' that adds some metadata. Metadata within the main declaration will override the addition, so it should be as safe as 'def'." + `(do + (def ~name ~@body) + (alter-meta! #'~name (fn [current-meta# & rest#] (apply merge current-meta# rest#)) '{:semantic-type set}) + ~name)) + +(comment + Block_list ::= [Block_entry*]; + Block_entry ::= Symbol | [Symbol Depends Attribute*]; + Depends ::= Nil_dep | Symbol | [Symbol+]; + Nil_dep ::= nil | []; + Attribute ::= Keyword Value; + + "In this case paired parens can be used interchangeably with paired brackets.") +;; Rule: Sets are flattened. If a set is specified as a member of another set, the union is taken. +;; There are 173 Blocks. + +#_(defn keys* [seq] + "Overloaded so that a list can be passed..." + (econd* + [(map? seq) + (map #(if (seq? %) (first %) %) + seq)] + ;; Else coerce seq to map. + )) + +;; http://minecraft.gamepedia.com/Sign +(def *sign* '[sign-post wall-sign]) +(def *door* '[wooden-door iron-door]) +#_(*redstone-torch* #{diode-block-on diode-block-off}) +(def *fence* '#{fence iron-fence glass-pane nether-fence cobblestone-wall}) + + +;; Based on http://jd.bukkit.org/rb/apidocs/org/bukkit/material/Attachable.html : +; This does not, however, address repeaters or comparators. +#_(def +attachable+ '(button cocoa ladder lever (comment "This is a tech block:" piston-extension-material) sign +torches+ trap-door)) + + + +(def ^{:doc "http://minecraft.gamepedia.com/Opacity#Types_of_transparent_blocks"} + *opaque* + '#{dirt + grass-block + double-slab + double-wood-slab}) + +;; TODO: Perhaps I should use 'nil' for the nonexistent-dependency object. Or have a reduction which maps []->nil. + + +;; TODO: +'(*pressure-plate-supporting* *solid*) + +'(*pressure-plates* #{stone-plate wood-plate + ;; TODO: heavy, light + }) + +;;; Tech blocks: http://minecraft.gamepedia.com/Technical_blocks +;; Technical blocks that are not up for regeneration. +'(*non-regen-technical* #{piston-extension + piston-moving-piece + [glowing-redstone-ore [] :common-name "lit redstone ore"] + ; TODO: lit redstone lamp? + [water stationary-water :common-name "flowing water"] + (lava stationary-lava :common-name "flowing lava") + [burning-furnace [] :common-name "lit furnace"] + monster-eggs}) + + + +;; TODO: We should partition all blocks into disjoint sets '*solid*' and '*nonsolid*'. +;; http://minecraft.gamepedia.com/Opacity#Types_of_transparent_blocks +;; TODO: (*nonsolid* #{air snow +torches+ sign fire nether-portal end-portal}) +;;TODO: +#_(*transparent* ...) + +;; TODO: Is it anything except 'air'? +;(def *carpet-supporting* ) + +;; There sure are a lot of these: +(def ^{:semantic-type 'set} + *stairs* '#{wood-stairs + cobblestone-stairs + brick-stairs + smooth-stairs + nether-brick-stairs + sandstone-stairs + spruce-wood-stairs + birch-wood-stairs + jungle-wood-stairs + quartz-stairs}) + +;; TODO: See the list at http://minecraft.gamepedia.com/Fire +#_(*burnable #{netherrack}) + +;; TODO: Anvils? What else? +#_(def ^{:semantic-type 'set} + +sand-supporting+ (conj (union *opaque* +torches+) 'snow)) ; Anything that can hold up sand +#_nondecaying-leaves ; Can we identify which leaves were player-placed? +;; TODO: Some overlap with *opaque*. +#_*solid* + + +(def-blocktype-set *chests* '#{chest trapped-chest ender-chest}) + +(def ^{:doc "At the block-level-dependency stage of regeneration: if the block underneath is AIR, consider changing it temporarily."} + *melons* '#{pumpkin melon jack-o-lantern}) + +;; TODO: Rails are a hard item; +;; TODO: Leaves? +#_(def *rail-supporting* (union *solid* *melons* '#{redstone-block hopper}) ) ; Blocks that a rail or torch can be placed on + +(def-blocktype-set +crops+ (union *melons* '#{carrot potato wheat})) + +;; TODO: +(def-blocktype-set *torch-supporting* + '#{*opaque* + ;*chests* + glass; partial + ; Not ice. + ; Not leaves. + packed-ice + hopper ; partial + end-portal; surprising. + ;; TODO: slab? + }) + +;; TODO: Cf. what supports redstone dust? Should glowstone be on this list? Stairs?. +#_(*redstone-supporting* #{*opaque* slab *stairs*}) + +#_(*piston-component* #{piston-sticky-base piston-base piston-extension piston-moving-piece}); Tech blocks serving as piston components. These are _unstable_ and should not be regen'd. +(def-blocktype-set *mushroom* '#{brown-mushroom red-mushroom}) + +#_(def ^{:doc "TODO: "} + *bed-supporting* *solid*) + +;; TODO: Stairs? +#_(*partial-block* #{slab}) + +(def-blocktype-set + +torches+ '#{(torch *torch-supporting*) + (redstone-torch-on *torch-supporting*) + (redstone-torch-off *torch-supporting* :common-name "unlit redstone torch" :alias unlit-redstone-torch)}) + +(def-blocktype-set *rail* '#{rail powered-rail detector-rail activator-rail}) + +(def-blocktype-set +block-types+ + "Primary set." + (union '#{air + stone + (grass [] :common-name "Grass Block" :alias grass-block) ; http://minecraft.gamepedia.com/Grass_Block ; Without light, grass will turn to dirt in time. + dirt + cobblestone + (wood nil :common-name "Wood planks") + ;; Finally! Our first dependency! + (sapling [dirt podzol grass-block] :url "http://minecraft.gamepedia.com/Sapling") + bedrock ; There'd better not be dependencies here. + ;(water stationary-water) + (stationary-water [] :alias water-source) + ;(lava stationary-lava) + (stationary-lava [] :alias lava-source) + (sand +sand-supporting+) ; Red Sand is not a separate block. + (gravel +sand-supporting+) + gold-ore + iron-ore + coal-ore + (log nil :common-name "tree" :doc "Material #17.") + (leaves log) + ;*nondecaying-leaves* ;; TODO: Special + sponge ;; We might as well back this up, even though it's not a regularly obtainable item. + glass ; http://minecraft.gamepedia.com/Glass + lapis-ore + lapis-block ; http://minecraft.gamepedia.com/Lapis_Lazuli_Block + dispenser + sandstone + note-block ; http://minecraft.gamepedia.com/Note_block + (bed-block *bed-supporting* :common-name "Bed" :alias bed) ; http://minecraft.gamepedia.com/Bed + (powered-rail *rail-supporting*) ; http://minecraft.gamepedia.com/Powered_rail + (detector-rail *rail-supporting*) + (piston-sticky-base [] :common-name "Sticky Piston" :alias sticky-piston ) + cobweb + (long-grass grass-block :common-name "Grass" :url "http://minecraft.gamepedia.com/Grass") + (dead-bush [sand red-sand podzol hardened-clay flower-pot]) + (piston-base [] :common-name "Piston" :alias piston) + (piston-extension [piston sticky-piston] :common-name "Piston head" :doc "Tech block. TODO: Is it the same extended piece for the sticky p. as the regular?") + wool + ;piston-moving-piece ; #36. TODO: This one is still a mystery. + (yellow-flower [grass farmland podzol dirt flower-pot] :common-name "Dandelion" :url "http://minecraft.gamepedia.com/Flowers#Dandelion") + (red-rose [grass farmland podzol dirt flower-pot] :common-name "Poppy") ; http://minecraft.gamepedia.com/Flowers#Poppy + (brown-mushroom [dirt grass mycelium podzol flower-pot]) ; TODO: farmland? + (red-mushroom [dirt grass mycelium podzol flower-pot]) ; TODO: farmland? + gold-block ; http://minecraft.gamepedia.com/Block_of_Gold + iron-block + (double-step [] :common-name "double slab" :doc "Presumably the result of combining upper and lower slabs in one location.") + ;; 'Slab': + (steps [] :common-name "slab" :alias slab :url "http://minecraft.gamepedia.com/Slabs") + (brick [] :common-name "Bricks" :url "http://minecraft.gamepedia.com/Bricks") + tnt + bookshelf + mossy-cobblestone ; http://minecraft.gamepedia.com/Moss_Stone + obsidian + ; (torch *torch-supporting*) ; TODO: http://minecraft.gamepedia.com/Torch + + ;; Arguably we should only include Netherrack, since the others are unstable. + (fire *burnable*) ; http://minecraft.gamepedia.com/Fire + (mob-spawner [] :doc "Tech block.") + ;wood-stairs ; Handled via (union *stairs*) + ;chest ; Handled via (union *chests*) + (redstone-wire ; See 'Redstone related' at http://minecraft.gamepedia.com/Technical_blocks + [*opaque* glowstone *stairs* hopper]); TODO: Slab? + diamond-ore + diamond-block + (workbench [] :common-name "crafting table" :alias crafting-table) + (crops [farmland] :common-name "wheat" :alias wheat) ; http://minecraft.gamepedia.com/Wheat + (soil [water water-source] :common-name "farmland" :alias farmland :url "http://minecraft.gamepedia.com/Farmland" + :doc "To exist stably, farmland needs to be planted or water within X blocks. Since water can't depend on farmland, it makes sense to put farmland after, though the dependency is not a very strict one.") + furnace + ; burning-furnace ? + ;; TODO: *solid* type for sign anchoring? + (sign-post *solid*) + (wall-sign *solid*) + + ;; TODO: Is this right? + (wooden-door [*opaque* hopper]) + + ;; Ladders are tough. They can be placed on Jack o'Lanterns, which are transparent, but not on Hoppers, Redstone Blocks, or other transparent stuff. + (ladder [*opaque* jack-o-lantern]) ; http://minecraft.gamepedia.com/Ladders + + (rails *rail-supporting* :alias [rail, track]) + + (lever *opaque*) + (stone-plate *pressure-plate-supporting* :common-name "stone pressure plate") + (iron-door-block [*opaque* hopper] :common-name "Iron door" :alias iron-door) + (wood-plate *pressure-plate-supporting* :common-name "wood pressure plate") + redstone-ore + (stone-button *torch-supporting*) + (snow *opaque* :common-name "Snow (cover)" :url "http://minecraft.gamepedia.com/Snow_(cover)") + ice + (snow-block [] :common-name "Snow" :doc "TODO: There may be a difference between a fully-stacked snow block and a partial in some cases.") + (cactus [sand flower-pot] :doc "TODO: A cactus can go in a flowerpot, right?") + (clay [] :common-name "Clay (block)" :alias clay-block) + (sugar-cane-block [] :common-name "Sugar Cane" :alias sugar-cane) + jukebox ; http://minecraft.gamepedia.com/Jukebox + fence + pumpkin ; The melon family cannot be placed on non-solid blocks, but the solid block may be afterward removed. + netherrack + soul-sand + glowstone + (portal obsidian :common-name "Nether portal" :alias nether-portal) + jack-o-lantern + + (cake-block :url "http://minecraft.gamepedia.com/Cake_Block") + ;; TODO: I would like to consider the 'off' state the stable one, hence my giving it the primary name. + (diode-block-off *redstone-supporting* :alias regenable-redstone-repeater :url "http://minecraft.gamepedia.com/Redstone_Repeater") + (diode-block-on *redstone-supporting*) + + (trap-door *solid* :common-name "trapdoor" :alias trapdoor :url "http://minecraft.gamepedia.com/Trapdoor") + ;monster-eggs; Non-regenable tech block. + + (huge-mushroom-1 [] :common-name "Huge Brown Mushroom") + (huge-mushroom-2 [] :common-name "Huge Red Mushroom") + (smooth-brick [] :common-name "Stone bricks") + (iron-fence nil :common-name "Iron bars" :alias iron-bars) + (thin-glass *solid* :common-name "glass pane") + (melon-block [] :common-name "Melon" :alias melon) + (pumpkin-stem farmland) + (melon-stem farmland) + (vine [*solid* *chests* crafting-table] :common-name "Vines" :alias vines + :doc "TODO: An individual vine block depends either on a solid block *or* a vine block above. So the dependency is interesting: the Vine type has one dependency, while individual vine blocks may have another. The progression is also from high to low, the opposite of what is usual.") + (fence-gate nil :url "http://minecraft.gamepedia.com/Fence_gate") + (mycel [] :common-name "Mycelium" :alias mycelium) + (water-lily water-source :common-name "Lily pad" :alias lily-pad) + nether-brick + (nether-fence nil :common-name "Nether brick fence") + ; nether-brick-stairs ; in *stairs* + (nether-warts soul-sand :common-name "Nether Wart") + enchantment-table + (brewing-stand [] :url "http://minecraft.gamepedia.com/Brewing_stand") + cauldron + + (ender-portal ender-portal-frame :common-name "End portal" :alias end-portal) + ender-portal-frame + (ender-stone nil :common-name "End Stone") + dragon-egg + + (redstone-lamp-on nil :common-name "Lit redstone lamp") ; TODO: Regenable? + (redstone-lamp-off nil :common-name "Unlit redstone lamp" :alias regenable-redstone-lamp) + (wood-double-step [] :common-name "double wood slab" :doc "Like the stone 'double slab'.") + ; wood-step: in *stairs* + (cocoa log :doc "Needs to be attached to a Jungle Wood tree.") + emerald-ore + (ender-chest nil :url "http://minecraft.gamepedia.com/Ender_Chest") + (tripwire-hook *solid* :doc "It doesn't sound likely that non-solid blocks could anchor a wire." :url "http://minecraft.gamepedia.com/Tripwire_Hook") + tripwire + emerald-block + (command-block nil :url "http://minecraft.gamepedia.com/Command_Block") + beacon + (cobble-wall nil :common-name "Cobblestone wall" :alias cobblestone-wall :url "http://minecraft.gamepedia.com/Cobblestone_wall") + (flower-pot *solid*) + (carrot farmland) + (potato farmland) + (wood-button *torch-supporting*) + ;; TODO: + (skull [] :common-name "mob head" :url "http://minecraft.gamepedia.com/Skull") + (anvil +sand-supporting+ :url "http://minecraft.gamepedia.com/Anvil") + (gold-plate *pressure-plate-supporting* :common-name "Weighted pressure plate (light)" :url "http://minecraft.gamepedia.com/Weighted_Pressure_Plate") + (iron-plate *pressure-plate-supporting* :common-name "Weighted pressure plate (heavy)" :url "http://minecraft.gamepedia.com/Weighted_Pressure_Plate") + ;; TODO: mask out the 'on' version? + (redstone-comparator-off *redstone-supporting* :alias regenable-redstone-comparator) + (redstone-comparator-on *redstone-supporting*) + (daylight-detector *redstone-supporting* :doc "TODO:") + redstone-block + quartz-ore + hopper + quartz-block + (activator-rail *rail-supporting*) + dropper + (stained-clay nil :url "http://minecraft.gamepedia.com/Stained_clay") + hay-block + stained-glass; #160 + (dark-leaves [dark-wood] :doc "Acacia & dark oak.") + (dark-wood [] :doc "Acacia & dark oak.") + ;; TODO: Forthcoming: + ; (slime-block []) + ; barrier + ; iron trapdoor + (carpet *carpet-supporting*) + (hard-clay nil :common-name "Hardened clay" :url "http://minecraft.gamepedia.com/Stained_clay") + coal-block + packed-ice + (sunflower [grass farmland podzol dirt] :doc "TODO:") + (lilac [grass farmland podzol dirt] :doc "TODO:") + (double-tallgrass [grass farmland podzol dirt] :doc "TODO:") + (large-fern [grass farmland podzol dirt] :doc "TODO:") + (rose-bush [grass farmland podzol dirt] :doc "TODO:") + (peony [grass farmland podzol dirt] :doc "TODO:") + } + ;; Unioned sets: + *chests* + *stairs* + +torches+)) + +(defn get-entry-by-primary-name [name] + "TODO: Name of +block-types+ set. Or whatever. +TODO: Check aliases." + (first (filter (fn [entry] + (econd* + [(coll? entry) (= name (first entry))] + [(symbol? entry) (= entry name)])) + +block-types+))) + + +(defn list-to-map [list] + "Combines duplicate keys. TODO: Might be more elegantly done with (reduce), if I can't find some natural function combination." + (let [multimap; Not actually a multimap; a map of lists. + ;; Convert nil to the empty set: + (or (apply (partial merge-with #(concat (if (coll? %1) %1 [%1]) (if (coll? %2) %2 [%2]))) + (map (partial apply hash-map) (partition 2 list))) + {}) +; keys (keys multimap) +; vals (vals multimap) +; map (zipmap keys (map second vals)) + ] +; (println multimap) + (assert* (map? multimap)) + (zipmap (keys multimap) + ;; Convert singleton lists to singleton sets; wrap eigenvalues as sets. + (map #(if (coll? %1) (set %1) (hash-set %1)) (vals multimap))))) + +(defn all-aliases-of [name & {:keys [main?] + :or {main? true}}] + "Passed the main symbol, returns a collection of any :alias entries. Unless :main? is set false, the primary designator 'name' will appear first on the list. Returns nil if nothing is found." + (let [entry (get-entry-by-primary-name name)] + (econd* + [(nil? entry) nil] + [(list? entry) + (union (if main? #{name} #{}) (:alias (list-to-map (drop 2 entry))))] + [(symbol? entry) (if main? #{name} #{})]))) + +(defn find-block-type + "This is intended to be the main query function, examining both primary names and :alias fields. +If the :error keyword arg is set, an exception will be raised if no matching type is found." + {:test #(do + (assert* (= (find-block-type 'rail) (find-block-type 'rails))) + (assert* (= (find-block-type 'pumpkin) 'pumpkin)))} + ([name-or-alias & {:keys [error?]}] + (if-let [match (first (filter (fn [entry] + (econd* + [(coll? entry) + (let [[name & [dependencies & rest]] entry + all-names (all-aliases-of name) ;(set (conj (:alias (list-to-map rest)) name)) + ] + ;(debug-println all-names) + (contains? all-names name-or-alias))] + [(symbol? entry) (= entry name-or-alias)])) + +block-types+))] + match + (when error? (throw (Exception. (format "No matching Block type found for '%s'." name-or-alias))))))) + +(test #'find-block-type) + + +(defn dependencies [arg & {:keys [error?]}] + "Argument 'arg' should either be a Block name or a collection of Block names, in which case their dependencies are union'd. No other data. +NB: Returns 'nil' if no dependencies found unless the :error keyword arg is set, in which case an exception will be raised." + (when-let [res (econd* + [(symbol? arg) (second (listify (find-block-type arg :error? error?)))] + [(or (list? arg) + (set? arg)) + (mapcat (fn [name] + (assert* (symbol? name)) + (dependencies name)) arg)])] + (if (coll? res) res #{res}))) + + +;;;; ToDo: +; Anvils with ladders,signs,rails +; Slabs with ladders,signs, rails diff --git a/src/cljengine/events.clj b/src/cljengine/events.clj new file mode 100644 index 0000000..0a8b259 --- /dev/null +++ b/src/cljengine/events.clj @@ -0,0 +1,368 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); eval: (viper-mode) -*- +;;;; Utilities for running experiments on the Minecraft event listeners. Requires mc.clj and, of course, clj-minecraft. + +(ns cljengine.events + (:use (clojure core repl pprint reflect) + (cljengine mc tasks ) + (cljminecraft core + entity + [bukkit :exclude [repeated-task + cancel-task]] + events + commands + logging + util + [world :exclude [effect]]; (effect) has a simple bug. + ;; can't pull in all of cljminecraft.player without conflict: + [player :only [send-msg]])) + (:import (org.reflections Reflections) + (org.bukkit Bukkit + Material + Location + World + Effect) + (org.bukkit.block Block + BlockFace ; Enum + BlockState) + (org.bukkit.entity Entity + EntityType + Player) + (org.bukkit.metadata Metadatable) + (org.bukkit.event Event + Cancellable + EventPriority; Enums + HandlerList) + (org.bukkit.event.entity PlayerDeathEvent) + (org.bukkit.event.player PlayerMoveEvent) + (org.bukkit.event.block BlockEvent + BlockPhysicsEvent + BlockBreakEvent) + (org.bukkit.event.vehicle VehicleBlockCollisionEvent + VehicleMoveEvent) + (org.bukkit.util Vector + BlockVector) + (org.bukkit.plugin Plugin) + (org.bukkit.plugin.java JavaPlugin); subtype of Plugin + (org.bukkit.scheduler BukkitScheduler + BukkitTask) + (cljminecraft BasePlugin + ClojurePlugin) + (org.bukkit.util BlockIterator))) + +;(load-file "mc.clj"); Still doesn't work + +(defonce event-log ()) +(defonce last-event nil) +(defonce ^:dynamic *physics-event-log* ()) +(defonce ^:dynamic *log-physics-events* false) + +(defonce ^:dynamic *cancel-event* false) + +;;; As a batch: +(def block-events (disj (apply sorted-set (find-event "block.")) + "block.block" + "block.block-piston")) +(def event-list + "List of all event classes minus the abstract base ones." + (disj (set (find-subclasses "org.bukkit" org.bukkit.event.Event)) + org.bukkit.event.block.BlockEvent + org.bukkit.event.block.BlockPistonEvent + org.bukkit.event.entity.EntityEvent + org.bukkit.event.hanging.HangingEvent + org.bukkit.event.painting.PaintingEvent + org.bukkit.event.player.PlayerEvent + org.bukkit.event.player.PlayerBucketEvent + org.bukkit.event.server.PluginEvent + org.bukkit.event.server.ServerEvent + org.bukkit.event.server.ServiceEvent + org.bukkit.event.vehicle.VehicleEvent + org.bukkit.event.vehicle.VehicleCollisionEvent + org.bukkit.event.weather.WeatherEvent + org.bukkit.event.world.ChunkEvent + org.bukkit.event.world.WorldEvent)) + +(def cljminecraft-event-list + "String form acceptable by (register-event) &c." + [;"block.block" + "block.block-break" + "block.block-burn" + "block.block-can-build" + "block.block-damage" + "block.block-dispense" + "block.block-exp" + "block.block-fade" + "block.block-form" + "block.block-from-to" + "block.block-grow" + "block.block-ignite" + "block.block-physics" + ;"block.block-piston" + "block.block-piston-extend" + "block.block-piston-retract" + "block.block-place" + "block.block-redstone" + "block.block-spread" + "block.entity-block-form" + "block.leaves-decay" + "block.note-play" + "block.sign-change" + "enchantment.enchant-item" + "enchantment.prepare-item-enchant" + "entity.creature-spawn" + "entity.creeper-power" + ;"entity.entity" + "entity.entity-break-door" + "entity.entity-change-block" + "entity.entity-combust" + "entity.entity-combust-by-block" + "entity.entity-combust-by-entity" + "entity.entity-create-portal" + "entity.entity-damage" + "entity.entity-damage-by-block" + "entity.entity-damage-by-entity" + "entity.entity-death" + "entity.entity-explode" + "entity.entity-interact" + "entity.entity-portal" + "entity.entity-portal-enter" + "entity.entity-portal-exit" + "entity.entity-regain-health" + "entity.entity-shoot-bow" + "entity.entity-tame" + "entity.entity-target" + "entity.entity-target-living-entity" + "entity.entity-teleport" + "entity.entity-unleash" + "entity.exp-bottle" + "entity.explosion-prime" + "entity.food-level-change" + "entity.horse-jump" + "entity.item-despawn" + "entity.item-spawn" + "entity.pig-zap" + "entity.player-death" + "entity.player-leash-entity" + "entity.potion-splash" + "entity.projectile-hit" + "entity.projectile-launch" + "entity.sheep-dye-wool" + "entity.sheep-regrow-wool" + "entity.slime-split" + ; "hanging.hanging" + "hanging.hanging-break" + "hanging.hanging-break-by-entity" + "hanging.hanging-place" + "inventory.brew" + "inventory.craft-item" + "inventory.furnace-burn" + "inventory.furnace-extract" + "inventory.furnace-smelt" + "inventory.inventory" + "inventory.inventory-click" + "inventory.inventory-close" + "inventory.inventory-creative" + "inventory.inventory-drag" + "inventory.inventory-interact" + "inventory.inventory-move-item" + "inventory.inventory-open" + "inventory.inventory-pickup-item" + "inventory.prepare-item-craft" + ;"painting.painting" + "painting.painting-break" + "painting.painting-break-by-entity" + "painting.painting-place" + "player.async-player-chat" + "player.async-player-pre-login" + ;"player.player" + "player.player-achievement-awarded" + "player.player-animation" + "player.player-bed-enter" + "player.player-bed-leave" + ; "player.player-bucket" + "player.player-bucket-empty" + "player.player-bucket-fill" + "player.player-changed-world" + "player.player-channel" + "player.player-chat" + "player.player-chat-tab-complete" + "player.player-command-preprocess" + "player.player-drop-item" + "player.player-edit-book" + "player.player-egg-throw" + "player.player-exp-change" + "player.player-fish" + "player.player-game-mode-change" + "player.player-interact" + "player.player-interact-entity" + "player.player-inventory" + "player.player-item-break" + "player.player-item-consume" + "player.player-item-held" + "player.player-join" + "player.player-kick" + "player.player-level-change" + "player.player-login" + "player.player-move" + "player.player-pickup-item" + "player.player-portal" + "player.player-pre-login" + "player.player-quit" + "player.player-register-channel" + "player.player-respawn" + "player.player-shear-entity" + "player.player-statistic-increment" + "player.player-teleport" + "player.player-toggle-flight" + "player.player-toggle-sneak" + "player.player-toggle-sprint" + "player.player-unleash-entity" + "player.player-unregister-channel" + "player.player-velocity" + "server.map-initialize" + ;"server.plugin" + "server.plugin-disable" + "server.plugin-enable" + "server.remote-server-command" + ; "server.server" + "server.server-command" + "server.server-list-ping" + ; "server.service" + "server.service-register" + "server.service-unregister" + ; "vehicle.vehicle" + "vehicle.vehicle-block-collision" +; "vehicle.vehicle-collision" + "vehicle.vehicle-create" + "vehicle.vehicle-damage" + "vehicle.vehicle-destroy" + "vehicle.vehicle-enter" + "vehicle.vehicle-entity-collision" + "vehicle.vehicle-exit" + "vehicle.vehicle-move" + "vehicle.vehicle-update" + "weather.lightning-strike" + "weather.thunder-change" +; "weather.weather" + "weather.weather-change" +; "world.chunk" + "world.chunk-load" + "world.chunk-populate" + "world.chunk-unload" + "world.portal-create" + "world.spawn-change" + "world.structure-grow" +; "world.world" + "world.world-init" + "world.world-load" + "world.world-save" + "world.world-unload"]) + +;; Quick test to make sure we got 'em right: +(assert (== (count event-list) (count cljminecraft-event-list) 158)) + +(defn- clear-event-log [] + (def event-log ()) + (def last-event nil) + (def physics-events-log ()) + (assert (= event-log ())) + event-log) + +(defn- noisy-event-handler [ev] + "Prints info about the occurring event, which can be of any type. Also stores this last event in the 'last-event' global var AND prepends it to the 'event-log' . +The (register-all-events-feedback) func loads this into the listener for *every* event in the game. +TODO: Perhaps send a msg to the first player? We can't use the clj-minecraft {:msg} automessaging; not all events have an associated player." + (def last-event ev) + (let [i (count event-log)] + (def event-log (cons ev event-log)) + (assert (= (count event-log) (inc i)))) + ;; NB: This prints on the server: + (println (format "Event '%s' occured." (.getEventName ev)))) + + +(defn- block-physics-handler [^BlockEvent ev] + "Feedback handler. +Now also cancels events if *cancel-event* is true." + (assert (instance? BlockPhysicsEvent ev)) + (let [block (.getBlock ev) + name (.getEventName ev) + type (.getChangedType ev)] + (debug-println name "; material" type "on block" block) + (when *log-physics-events* + (def *physics-event-log* (cons ev *physics-event-log*)))) + (when *cancel-event* + (if (.isCancelled ev) (debug-println "Already cancelled.") + (do (.setCancelled ev true) + (debug-println "Cancelled.")))) + true) + +(defn event-cancelling-handler [^Event ev] + (when *cancel-event* + (if (instance? Cancellable ev) + (if (.isCancelled ev) (debug-println ev "already cancelled.") + (do (.setCancelled ev true) + (debug-println "Cancelling " (.getEventName ev)) + true)) + (do + (debug-println ev "not cancellable.") + false)))) + +(defn register-handler [^String event-name + callback] + "Wrapper currying the plugin iname." + (cljminecraft.events/register-event *plugin* event-name callback) + true) + +(defn get-registered-handlers [] + "Returns list of all handlers declared by *plugin*." + (HandlerList/getRegisteredListeners *plugin*)) + +(defn ^{:doc "Unregisters events associated with *plugin*. Given no args, it unregisters all; given one, it should be a cljminecraft string as returned by (find-event)."} + unregister-our-events + ([^String eventname] + (assert* *plugin*) + (let [class (resolve (symbol (package-classname "org.bukkit.event" (str eventname "-event"))))] + (eval `(.unregister (. ~class (getHandlerList)) *plugin*)); workaround for not being able to use a dynamically-resolved Class name to invoke a static method. + (debug-println (format "Unregistered %s for our plugin." eventname)) + true)) + ([] + (assert* *plugin*) + (org.bukkit.event.HandlerList/unregisterAll *plugin*) + (debug-println "Removing all event handlers for our plugin.") + (assert* (empty? (HandlerList/getRegisteredListeners *plugin*))) + true)) + + +(defn- register-physics-handler [] + "Currently unregisters all. TODO: Finer control." + (unregister-our-events) + (def *physics-event-log* ()) + (register-event @clj-plugin "block.block-physics" #'block-physics-handler) + (println "Registered BlockPhysicsEvent callback.") + true) + + +(defn- register-all-events-feedback [] + "Relies on global var." + (unregister-our-events) + (doseq [evname cljminecraft-event-list] + (println "Registering handler for" evname) + (register-event @clj-plugin evname #'noisy-event-handler)) + true) + +;(map #(register-event @clj-plugin % #'test-handler) block-events) +(defn- register-all-block-events [] + "Clears all plugin events & reloads those for block events; messy util func." + (unregister-our-events) + (doseq [evname block-events] + (println "Registering handler for" evname) + (register-event @clj-plugin evname #'noisy-event-handler)) + true) + +;(org.bukkit.event.HandlerList/unregisterAll @clj-plugin) + +(defn sort-events-by-pos [ev-coll] + "Returns a collection sorted using (compare-vectors)." + (sort (fn [s1 s2] + (apply compare-vectors + (map (comp get-vector (memfn getBlock)) [s1 s2]))) + ev-coll)) diff --git a/src/cljengine/mc.clj b/src/cljengine/mc.clj new file mode 100644 index 0000000..dfc91fb --- /dev/null +++ b/src/cljengine/mc.clj @@ -0,0 +1,657 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); eval: (viper-mode) -*- +;;;; Load this first of the Minecraft Clojure files. + +(ns cljengine.mc + "Testing Clojure in Minecraft." +; (:require clojure.core) + (:use (clojure core repl pprint reflect set) + (cljminecraft core + entity + [bukkit :exclude [repeated-task + cancel-task]] + events + commands + logging + util + [world :exclude [effect]]; (effect) has a simple bug. + ;; can't pull in all of cljminecraft.player without conflict: + [player :only [send-msg]])) + ;; Add some Enums... + (:import (org.reflections Reflections) + (org.bukkit Bukkit + Material + Location + World + Effect) + (org.bukkit.block Block + BlockFace ; Enum + BlockState) + (org.bukkit.entity Entity + EntityType + Player) + (org.bukkit.metadata Metadatable) + (org.bukkit.event Event + Cancellable + EventPriority; Enums + HandlerList) + (org.bukkit.event.entity PlayerDeathEvent) + (org.bukkit.event.player PlayerMoveEvent) + (org.bukkit.event.block BlockEvent + BlockPhysicsEvent + BlockBreakEvent) + (org.bukkit.event.vehicle VehicleBlockCollisionEvent + VehicleMoveEvent) + (org.bukkit.util Vector + BlockVector) + (org.bukkit.plugin Plugin) + (org.bukkit.plugin.java JavaPlugin); subtype of Plugin + (org.bukkit.scheduler BukkitScheduler + BukkitTask) + (cljminecraft BasePlugin + ClojurePlugin) + (org.bukkit.util BlockIterator))) + +(create-ns 'mc.block); Fwd dec +(alias 'bl 'mc.block) + +(defonce player nil) + +(defonce ^{:dynamic true + :doc "To use in preference to clj-plugin."} + *plugin* + @clj-plugin) + +;;;; **** +;;; TODO: Move utils to util.clj. + +;;;; TODO: Turn debug-* funcs into macros for compile-time removability. +(defonce ^:dynamic *debug-print* true); TODO: Is dynamic the right sort? +(defn debug-println [& forms] + "If *debug-print* is set, passes 'forms' to (println)." + (when *debug-print* (apply #'println forms))) + +(defn debug-msg [& forms] + "If *debug-print* is set, passes 'forms' through (format) to (send-msg) to all players. +TODO: Specify which player." + (when *debug-print* (doseq [pc (online-players)] + (send-msg pc (apply format forms))))) + +(defn debug-announce [& forms] + "Invokes both (debug-println) and (debug-msg) on 'forms', which are run through (format). In turn, they output iff *debug-print* is true." + (let [fmt-string (apply format forms)] + (debug-println fmt-string) + (debug-msg fmt-string))) + +;;; id=math + +(defn mean [coll] + "Statistical average." + (/ (apply + coll) + (count coll))) + +(defn mode [coll] + "Statistical mode." + (key (first (sort #(compare (val %1) (val %2)) (frequencies coll))))) + +;; Absolute value wrapper: +;(def abs (memfn Math/abs)); TODO: This wasn't working. +(definline abs [num] + `(Math/abs ~num)) + +(defn ns-syms [ns] + "Wrapper. Returns & prints (unqualified) names of symbols in namespace 'ns'. Good for poking around--you can use Emacs's Cider smart completion to fill out a valid ns name." + (let [keys (sort (keys (ns-interns ns)))] + (pprint keys) + keys)) + +;;;; **** + +(defonce ^:dynamic *do-not-compile-assertions* false) +(defmacro assert* [expr & forms] + "Modification to (assert) allowing static and dynamic control. Setting *do-not-compile-assertions* at compile-time will have the same effect as compiling a regular (assert)ion with *assert* unset: removal. However, if *do-not-compile-assertions* is false, then *assert* can be used dynamically to enable/disable assertion evaluation, at the slight cost of a boolean test. +Note that (assert*) uses an implicit (format). +3/3/14 update: Now sends a message to players if they're online!" + (assert (var? #'*do-not-compile-assertions*)) + (if *do-not-compile-assertions* + '(do) + (let [rest-forms forms + fmt-form (when rest-forms `(format ~@rest-forms))] +; (debug-println rest-forms) +; (debug-println fmt-form) + `(if *assert* + (try + (assert ~expr ~@(if fmt-form [fmt-form] [])) + (catch AssertionError ass#; TODO: Assertion Exception type? +; (debug-println "Caught exception!") + (when-let [players# (online-players)] + (doseq [player# players#] + (send-msg player# ~(if fmt-form `(format "Assert failed: %s" ~fmt-form) "Assertion failed!")))) +; (debug-println "Re-throwing exception!") + (throw ass#))) + ;; If assertions are run-time disabled, do nada. + (do))))) + +(defmacro assert-seq [varname binding-form & assert-forms] + "Passes 'assert-forms' to (assert*) with 'binding' in place via (doseq). The advantage of doing a raw iteration over assertions is that this form will be compiled out if *do-not-compile-assertions* is set." + (if *do-not-compile-assertions* + '(do) + `(doseq [~varname ~binding-form] + (assert* ~@assert-forms)))) + +(defmacro assert-every? [func-form seq & assert-forms] + "Returns nil on success." + (if *do-not-compile-assertions* + '(do) + `(let [func# ~func-form + seq# ~seq] + (doseq [var# seq#] + (assert* (func# var#) ~@(or assert-forms + `[(format "(%s %s)." '~func-form 'var#)])))))) + +(defmacro cond* [fst-clause & rest-of-clauses] + "I have *had* it with Clojure's (cond). The Scheme style seems utterly pointless; you could simply do with a variadic (if), like Shen. +This version accordingly requires that separate test clauses be enclosed as sequences. Vectors, specifically, with '[]'; when in Clojure, do as Clojurians do." + (let [[fst-test & fst-body] fst-clause] + (letfn [(cond-recur + ([] []) + ([clause & clauses] + (let [[test & body] clause] +; (println "Got this far.") + `(~test (do ~@(or body [])) + ~@(apply cond-recur clauses)))))] + ; (println rest-of-clauses) + `(cond + ~fst-test (do ~@(or fst-body [])) + ~@(if (nil? rest-of-clauses) [] + (apply cond-recur rest-of-clauses)))))) + +(def ^:dynamic *econd-error* nil) + +(defmacro econd* [& all] + "TODO: Need a better way to throw." + `(cond* ~@all + [:else + ;(def *econd-error* '~(first all)) +;\n impertinent form has been stored in '*econd-error*'. + ;; TODO: RuntimeException? + (assert* false (format "(econd*) fall-through: %s" + (str '(econd* ~@all))))])) + +(defn pluralizes? [n] + "For use in format strings: my fixation on proper pluralization." + (if (== n 1) "" "s")) + +(defn listify [arg] + "Utility; converts eigenvalues to lists." + (if (list? arg) arg (list arg))) +(defn print-classpath [] + "Learned from http://pupeno.com/2008/11/26/printing-the-class-path-in-clojure/." + (println (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader))))) + +#_(defmacro typecase* [test-form & clauses] + "Like CL's TYPECASE macro. It has the '*' after the name to indicate that, like (econd*), it expects its clauses to be conses." + `(let [test-form# ~test-form] + (cond* + ~@(let [xformed-clauses (map (fn [clause] + (let [[type & body] clause] + `[(instance? ~type ~test-form#) ~@body])) + clauses)] + xformed-clauses)))) + +#_(defmacro etypecase* [test-form & clauses] + "Hopefully works like ETYPECASE." + (let [typecase-form + (macroexpand-1 `(typecase* ~test-form ~@clauses)) + cond*-form (concat typecase-form + `([:else (assert* false (format "(etypecase*) fall-through: %s failed to match any of %s." + ~test-form (map first '~clauses)))]))] + cond*-form)) + + + + +(defn ticks-to-seconds [t] + (float (/ t 20))) + +#_(defn seconds-to-ticks [s;;;;;;;; & {:keys [coerce] :or {coerce :truncate}} + ] + (long (* s 20))) + +;;;; id=world +(defn get-current-world [] + "Hopefully. Returns a World instance." + (first (worlds))) + +(defn get-seed [] + "World seed." + (.getSeed (get-current-world))) + +(defn get-block-at + ([^Number x ^Number y ^Number z] + "Gets blocks at vector coords." + (get-block-at (new Vector x y z))) + ([pos] + "Wrapper that calls (.getBlockAt) in the first world found. The 'pos' arg may be a Vector or a Location." + (cond* + ((instance? Location pos) (.getBlockAt (get-current-world) pos)) + ((instance? Vector pos) + (get-block-at (.toLocation pos (get-current-world)))) + ((instance? Block pos) pos) + (:else (assert false (format "%s is not a valid type for (get-block-at)." (type pos))))))) + + +(defn get-first-player [] + "nil if no one is online." + (first (online-players))) + +(defn get-player [] + "Like (get-first-player), but stores the value in the 'player' globvar as well." + (def player (get-first-player)) + player) + +(definline get-first-player* [] + `(get-player)) + +;;;; id=pluginmanager +(defn get-plugin [^String name] + "Wrapper." + (.getPlugin (plugin-manager) name)) + +#_(defn get-plugins [] + "Not terribly useful unless you can print out a plugin list." + (.getPlugins (plugin-manager))) + + + +;;;; id=vector +(defn ^Vector get-vector [obj] + "Wrapper. Overloaded for type; returns a fresh vector. +TODO: A more specific exception type." + ;; TODO: I would prefer a CL (cond). + (cond* + [(instance? Vector obj) (.clone obj)] + [(instance? Location obj) (.toVector obj)] + ;; Sadly, trying to get too clever only hurts clarity: + ;((some-fn (partial instance? Block) (partial instance? Entity)) obj) + [(or (instance? Block obj) + (instance? BlockState obj) + (instance? Entity obj)) + (get-vector (.getLocation obj))] + [:else (throw + (new RuntimeException (format "(get-vector) failed on unsupported type %s." (type obj))))])) + + + +(defn ^BlockVector get-block-vector [obj] + "Like (get-vector), but it returns a BlockVector with the coordinates *explicitly* truncated to integers. +Always returns a fresh vector." + (let [vec (get-vector obj)] + (BlockVector. (long (.getX vec)) + (long (.getY vec)) + (long (.getZ vec)) ))) + +(defn compare-vectors [^Vector v1 ^Vector v2] + "(compare) for org.bukkit.util/Vector; may be useful for sorting. Axial precedence in ordering is y>z>x." + (let [y (compare (.getY v1) (.getY v2))] + (if-not (zero? y) y + (let [z (compare (.getZ v1) (.getZ v2))] + (if-not (zero? z) z + (compare (.getX v1) (.getX v2))))))) + +;;;; (compare-vector) tests: +(when-not *do-not-compile-assertions* + (assert (== 0 (compare-vectors (new Vector 2 4 6) (new Vector 2 4 6)))) + (assert (== 1 (compare-vectors (new Vector 2 4 6) (new Vector 2 3 6)))) + (assert (== -1 (compare-vectors (new Vector 2 3 6) (new Vector 2 4 6)))) + (assert (== 1 (compare-vectors (new Vector 2 4 7) (new Vector 2 4 6)))) + (assert (== -1 (compare-vectors (new Vector 2 4 6) (new Vector 2 4 7)))) + (assert (== 1 (compare-vectors (new Vector 3 4 7) (new Vector 2 4 7)))) + (assert (== -1 (compare-vectors (new Vector 1 4 7) (new Vector 2 4 7))))) + + +(defn format-vector [^Vector vec] + (format "(%s,%s,%s)" + (.getX vec) (.getY vec) (.getZ vec))) + +(defn format-position [pos] + "'pos' should be a Vector or Location." + (format-vector (if (instance? Vector pos) pos + (.toVector pos)))) + +;;; id=wrappers +(defn get-location [obj] + "Wrapper." + (cond* + ((instance? Vector obj) (.toLocation obj (get-current-world))) + (:else (.getLocation obj)))) + +#_(defn get-location [obj] + "Wrapper." + (.getLocation obj)) + +(defn add [pos x y z] + "Wrapper for Location.add() that uses a fresh Location. +TODO: Overload for type." + (cond* + [(instance? Location pos) (.add (.clone pos) x y z)] + [:else (add (get-location pos) x y z)])) + +;;;; id=yaw +(defn get-yaw [obj] + (cond* + [(instance? Location obj) + (.getYaw obj)] + [:else (get-yaw (get-location obj))])) + +(defn set-yaw [obj yaw] + "TODO: This seems to have no effect." + (cond* + [(instance? Location obj) + (.setYaw obj yaw)] + [:else (set-yaw (get-location obj) yaw)])) + +(defn get-state [block] + "Wrapper. 'block' may be a Block, a BlockVector, or whatever, as long it can be associated with a BlockState. +NB: If passed a BlockState object, the result, the same object, may be out-of-touch with the world, as BlockStates can be." + (cond* + [(instance? BlockState block) (.clone block)] + [(instance? Block block) (.getState block)] + [:else (get-state (get-block-at (get-vector block)))])) + +(defn get-type [obj] + "Wrapper for Block.getType() that returns a Material/* enum. Not to be confused with Clojure's own (type)." + (cond* + [(or (instance? Block obj) + (instance? BlockState obj)) + (.getType obj)] + [:else (get-type (get-block-at (get-block-vector obj)))])) + +(defn set-type [block mat] + "Wrapper for Block.setType()." + (.setType block mat)) + +(defn force-update [^BlockState state] + "Wrapper for (.update state true)." + (. state BlockState/update true)) + +(defn get-players-block [player] + "Returns the block that 'player' is standing on. TODO: Should do an Entity.isOnGround() check?" + (get-block-at (.add (.getLocation player) + 0 -1 0))) + +(defn destroy-players-block [^Player player] + "Knocks the block out from under player's feet." + (if-let [block (get-players-block player)] + (do + (.setType block Material/AIR) + true))) + +; (defn destroy-region [pos|block-1 pos|block-2] ) + +;(clojure.core/refer 'cljminecraft.core) +(defn spawn-creeper [loc] + (let [player (get-first-player) + world (.getWorld player) + loc (.getLocation player)] + (cljminecraft.player/send-msg player "Trying to spawn a creeper.") + (.spawnEntity world loc EntityType/CREEPER))) + +(defn get-target-block [entity] + "Returns the block a player is \"looking at.\" Attempting to write a replacement for the deprecated Entity.getTargetBlock()." + (let [bit (new BlockIterator entity 20)] + (loop [] + (if (.hasNext bit) + (let [block (.next bit)] + (if (= (.getType block) Material/AIR) + (recur) + block)) + nil)))) + + +#_ (defn light-TNT [] + ;; TODO: Make sure the command-user is a player! + (if (instance? sender Player) + (do) + (warn "That has to be called by a player!"))) + + +#_(defn foo-handler [_] + (cljminecraft.player/send-msg (get-first-player) "Trying to spawn a creeper.") + {:msg "Handling!"}) + + +;; Called on a player, it sets the 'flying' flag. +(defn fly + ([] (fly (get-first-player) true)) + ([player] (fly player true)) + ([player bool] (.setFlying player bool))) + +(defn make-platform + ([player] (make-platform player 20)) + ([player size] + "Makes a square stone platform under the player." + (assert (instance? Player player)) + (let [center (.getLocation (get-players-block player)) + -half (- (int (/ size 2))) + starting-point (.add (.clone center) -half 0 -half)] + (dotimes [x size] + (dotimes [z size] + (let [block-pos (.add (.clone starting-point) x 0 z) + block (get-block-at block-pos)] + ;; Debug messages: + (comment (send-msg player "Making block at (%s,%s,%s)." + (.getX block-pos) (.getY block-pos) (.getZ block-pos))) + (comment (println (format "Making block at (%s,%s,%s)." + (.getX block-pos) (.getY block-pos) (.getZ block-pos)))) + (.setType block Material/STONE) + (assert (= (.getType block) + Material/STONE)))))) + true)) + +(defn make-wall [^Location starting-loc length height & {:keys [inc mat] + :or [^Vector inc (new BlockVector 0 0 1) + mat Material/OBSIDIAN]}] + "Still needs kinks worked out, but the idea is to generate a wall 'length' by 'height'." + ;(assert (instance? Location starting-loc)) + ;(assert (instance? Vector inc)) + {:pre [(pos? length) + (pos? height) + (instance? org.bukkit.Material mat)]} + ;(assert (pos? length)) + ;(assert (pos? height)) + ;(assert (instance? org.bukkit.Material mat)) + (let [start-vec (.clone (.toVector starting-loc))] + (dotimes [i length] + (dotimes [j height] + (let [vec (.add + (.add (.multiply (.clone inc) i) + start-vec) + (new Vector 0 j 0)) + world (get-current-world) + loc (.toLocation vec world) + block (get-block-at loc)] + (assert (instance? Block block)) + (comment (println (format "Making block at (%s,%s,%s)." + (.getX vec) (.getY vec) (.getZ vec)))) + (.setType block mat) + (assert (= (.getType block) mat)))))) + true) + +(defn level-area + ([^Player player] (level-area player 30)) + ([^Player player ^long sz] + "Eliminates blocks in a cube above and around the player's location. 'sz' is a side of the cube. +TODO: Add a way to filter types of blocks." + (let [world (get-current-world) + half (/ sz 2) + center-vec (.. player getLocation toVector) + corner-vec (.subtract (.clone center-vec) + (new BlockVector half 0 half))] + (dotimes [x sz] + (dotimes [z sz] + (dotimes [y sz] + (let [target-vec (.add (.clone corner-vec) + (new BlockVector x y z)) + target-loc (.toLocation target-vec world) + target-block (get-block-at target-loc)] + (.setType target-block Material/AIR) + (assert (= (.getType target-block) Material/AIR))))))) + true)) + + +(defn unregister-all + ([] (unregister-all *plugin*)) + ([plugin] + "Removes all event listeners declared by 'plugin', which defaults to value stored in global *plugin*. +TODO: reset registered-events." + (assert (instance? Plugin plugin)) + (org.bukkit.event.HandlerList/unregisterAll plugin))) + +(defn copy-block [block times direction] + "Makes copies of 'block'; 'direction' should be :x, :y, or :z. Whether the negative or positive direction is used is determined by the sign of " + (assert (instance? Block block)) + (let [mat (.getType block) + world (get-current-world) + unit (if (neg? times) -1 1) + unit-vec (cond (= direction :x) (new BlockVector unit 0 0) + (= direction :y) (new BlockVector 0 unit 0) + (= direction :z) (new BlockVector 0 0 unit))] +; (println "Vector to add: " (format-vector unit-vec)) + (dotimes [i (dec (Math/abs times))] + (let [new-vec (.add (.. block getLocation toVector) + (.multiply (.clone unit-vec) (inc i))) + new-block (get-block-at (.toLocation new-vec world))] + (.setType new-block mat) + ;(println "Making a block at " (format-vector new-vec)) + (assert (= (.getType new-block) mat)))) + true)) + +(defn copy-targeted-block [^Player player ^long times direction] + ;(assert (instance? Player player)) + (copy-block (get-target-block player) times direction)) + +(defn glow [pos] + (.setType (get-block-at pos) Material/GLOWSTONE) + (assert (= (.getType (get-block-at pos)) + Material/GLOWSTONE)) + pos) + +(defn get-vectors-bounding-region [coll] + "TODO: This could be done in one pass." + (let [max-x (apply max (map (comp (memfn getX) get-vector) coll)) + max-y (apply max (map (comp (memfn getY) get-vector) coll)) + max-z (apply max (map (comp (memfn getZ) get-vector) coll)) + min-x (apply min (map (comp (memfn getX) get-vector) coll)) + min-y (apply min (map (comp (memfn getY) get-vector) coll)) + min-z (apply min (map (comp (memfn getZ) get-vector) coll))] + [(new Vector min-x min-y min-z) (new Vector max-x max-y max-z)])) + +;;;; Wrapper: +(defmacro store-state-of-first-players-targeted-block [varname] + `(let [state# (get-state (get-target-block (get-first-player)))] + (def ~varname state#) + (get-type state#))) + +;; TODO: Clojure lazy sequence? +(defn gen-region-vectors [start-corner end-corner] + "Returns a linked list of all Vectors in the enclosed area, from bottom to top." + (let [start-corner (get-block-vector start-corner); shadowing + end-corner (get-block-vector end-corner) + [x-min x-max] ((juxt min max) + (.getX start-corner) (.getX end-corner)) + [y-min y-max] (apply (juxt min max) + (map (memfn getY) [start-corner end-corner])) + [z-min z-max] ((juxt min max) + (.getZ start-corner) (.getZ end-corner))] + ;; Pretty ugly, but reasonable for Java translation: + (with-local-vars [vector-list ()] + ;; The loop goes from bottom to top, stepping through x-values before z-values. + ;; I will opine that the LOOP facility does this more elegantly. + (doseq [y (range y-min (inc y-max))]; for(int i=y-min; i<=y-max; ++i)... + (doseq [z (range z-min (inc z-max))] + (doseq [x (range x-min (inc x-max))] + (var-set vector-list (cons (new BlockVector x y z) + @vector-list))))) + (reverse @vector-list)))) + + +;;;; id=block +(defn gen-block-region [^Vector start-corner + ^Vector end-corner] + "Returns a list of blocks." + (map get-block-at (gen-region-vectors start-corner end-corner))) + + +(defn effect [location effect-id data & [radius]] + "Edited from cljminecraft's world.clj. The 'effect-id' should be either a Java Enum or a keyword as in 'effects'." + (let [effect (if (instance? Effect effect-id) effect-id + (get effects effect-id))] + (if radius + (.playEffect (.getWorld location) location effect data radius) + (.playEffect (.getWorld location) location effect data)))) + +(defn air? [block] + "Returns true if 'block' is made of air or represents a block made of air. If called with an arg that does not represent a block, returns nil." + (if (or (instance? Block block) + (instance? BlockState block)) + (= (.getType block) Material/AIR) + nil)) + +(defn solid? [block] + "True if the block specified, or its material, is classified as 'solid'. The game knows." + (econd* + [(instance? Material block) (.isSolid block)] + [(or (instance? Block block) + (instance? BlockState block)) (.isSolid (.getType block))])) + +(defn block-pos-eq? [obj1 obj2] + "True if the positions of the given game objects are equal up to the nearest block. +TODO: Is this the best way to do this?" +; (apply == (map (comp (memfn hashCode) (memfn toBlockVector) get-vector) [obj1 obj2])) + (let [v1 (get-block-vector obj1) + v2 (get-block-vector obj2)] + (every? #(apply == (map (comp long %) [v1 v2])) + [(memfn getX) + (memfn getY) + (memfn getZ)]))) + +(defn get-block-below [pos] + (get-block-at (add (get-block-vector pos) 0 -1 0))) + +(defn get-block-above [pos] + (get-block-at (add (get-block-vector pos) 0 1 0))) + +(defn block-state-verisimilitude? [^BlockState state] + "Returns true iff 'state' is the same type as the block at its coordinates, i.e., if it's a quasi-accurate reflection of current state." + (= (get-type state) + (get-type (get-block-at (get-vector state))))) + +(defn get-player-space [^Player pc] + "Returns a Vector duple giving the positions of a player's upper and lower coords. TODO: BlockVectors." + (let [pc-pos (get-block-vector pc)] + [pc-pos (add pc-pos 0 1 0)])) + + +(defn player-block-collision? [^Player pc block & {:keys [solid]}] + "Log. true if 'pc' is standing or has his head in a block, else nil. +'block' should be a Block or BlockState. +When 'solid' is log. true, the block must also pass a (solid?) test." + (assert* (instance? Player pc)) + (assert* (or (instance? Block block) + (instance? BlockState block))) +; (debug-println solid) + (when (or (not solid) (solid? block)) + (some #(block-pos-eq? block %) (get-player-space pc)))) + + +#_(defn test-some-shit [] +; (compile 'cljengine.re) + (new cljengine.re.ClojureRegen) +) + +;;;; id=time +(defn get-full-time [] + "Wrapper." + (. (get-current-world) getFullTime))(print-classpath) + +(println "Loaded mc.clj successfully.") diff --git a/src/cljengine/re.clj b/src/cljengine/re.clj new file mode 100644 index 0000000..989af5c --- /dev/null +++ b/src/cljengine/re.clj @@ -0,0 +1,52 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); eval: (viper-mode) -*- + +(ns cljengine.re + (:use (clojure core repl reflect pprint) + ; cljengine.mc + ) + ;; TODO: These aren't transferring to the gen-class calls. + #_(:import (org.bukkit Location + Material) + (org.bukkit.plugin Plugin) + (com.github.izbay.regengine RegEnginePlugin + RegEngine)) + #_(:gen-class + :main false + :prefix "regen-" + :methods [[testMethod [] String]]) + #_(:gen-class + :constructors {[org.bukkit.plugin.Plugin] []} + :init init + :main false + :state state + :prefix "regen-" + :methods [[alter [org.bukkit.Location] String] + [alter [org.bukkit.Location org.bukkit.Material] String] + [testMethod [] String]])) + + +(gen-class :name cljengine.re.ClojureRegen + ;:implements [com.github.izbay.regengine.RegEngine] + :constructors {[org.bukkit.plugin.Plugin] []} + :init init + :main false + :state state + :prefix "regen-" + :methods [;[alter [org.bukkit.Location] String] +; [alter [org.bukkit.Location org.bukkit.Material] String] + [testMethod [] String]]) + +(defn regen-init [parent] + [[] (ref {:parent parent})]) + +#_(defn regen-alter [this ^Location l & [^Material m]] + ;; FIXME + "alter stub.") + +(defn regen-testMethod [this] + "This is a test.") + +(defn self-compile [] + ; (var-set *compile-path* "D:/Documents/minecraft/craftbukkit.jar") + (binding [*compile-path* "D:/Documents/minecraft/classes" ] + (compile 'cljengine.re)) ) diff --git a/src/cljengine/regen.clj b/src/cljengine/regen.clj new file mode 100644 index 0000000..36795f7 --- /dev/null +++ b/src/cljengine/regen.clj @@ -0,0 +1,700 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); eval: (viper-mode) -*- + +(ns cljengine.regen + (:require [cljengine.mc :as mc]) + (:use (clojure [core :exclude [alter]] + repl pprint reflect) + (cljengine mc tasks + events +; [backup-restore :exclude [*backed-up-region*]] + ) + (cljminecraft core + entity + [bukkit :exclude [repeated-task + cancel-task]] + events + commands + logging + util + [world :exclude [effect]]; (effect) has a simple bug. + ;; can't pull in all of cljminecraft.player without conflict: + [player :only [send-msg]]) + ) + (:import (org.reflections Reflections) + (org.bukkit Bukkit + Material + Location + World + Effect) + (org.bukkit.block Block + BlockFace ; Enum + BlockState) + (org.bukkit.entity Entity + EntityType + Player) + (org.bukkit.metadata Metadatable) + (org.bukkit.event Event + Cancellable + EventPriority; Enums + HandlerList) + (org.bukkit.event.entity PlayerDeathEvent) + (org.bukkit.event.player PlayerMoveEvent) + (org.bukkit.event.block BlockEvent + BlockPhysicsEvent + BlockBreakEvent) + (org.bukkit.event.vehicle VehicleBlockCollisionEvent + VehicleMoveEvent) + (org.bukkit.util Vector + BlockVector) + (org.bukkit.plugin Plugin) + (org.bukkit.plugin.java JavaPlugin); subtype of Plugin + (org.bukkit.scheduler BukkitScheduler + BukkitTask) + (cljminecraft BasePlugin + ClojurePlugin) + (org.bukkit.util BlockIterator))) + + +;(load-file "clojure/backup-restore.clj") +;(load-file "clojure/events.clj") +;(load-file "clojure/tasks.clj") + + +#_(gen-interface :name com.github.izbay.regengine.RegenSectionIface + ;:methods [[regen [Block] void]] + ) + +#_(gen-interface :name com.github.izbay.regengine.RegeneratorIface + :methods [ [^{:static true} regen [Block] com.github.izbay.regengine.RegenSectionIface] + [^{:static true} regen [Vector] com.github.izbay.regengine.RegenSectionIface] + [^{:static true} regen [long long long] com.github.izbay.regengine.RegenSectionIface] + ;; getIsFlagged() overloaded: + [^{:static true} getIsFlagged [Vector] boolean] + [^{:static true} getIsFlagged [long long long] boolean]]) + +;;; Was this fucking thing actually working??: +#_(gen-class :name com.github.izbay.regengine.Regenerator + :implements [com.github.izbay.regengine.RegeneratorIface] + ) + +;; TODO: This should cause AIR not to have its state saved. Unless the air blocks are going to have metadata, I don't see how this could be a problem. +(defonce ^:dynamic *ignore-air-blocks* true) + +;; TODO: We'll try to keep blocks from dropping their item equivalents. +; TODO: Further customization? +(defonce ^:dynamic *cancel-block-drops* true) + +;; Determines whether MONITOR-level events should be loaded: +(defonce ^:dynamic *enable-warning-monitor-events* true) + +#_(defonce backed-up-blocks (atom {:blocks () + :block-data {}})); Vectors as keys + ;(defonce global-regen-list (atom ())) + +(defonce ^{:doc "Used by (queue-for-regen)." + :dynamic true} + *blocks-queued-for-regen* (atom #{})) + +;; FIXME: Pick a good default time. +;; TODO: Eventually these should be declared with (defonce). +(def ^{:doc "Default number of ticks between backup & restoration." :dynamic true} + *regen-total-delay* (seconds-to-ticks 20)) + +(def ^{:doc "Number of ticks remaining before regeneration when players first get warned." + :dynamic true} + *regen-warning-delay* (seconds-to-ticks 15)) + +(def ^{:doc "Number of ticks that elapse between warning attempts" + :dynamic true} + *regen-warning-period* (seconds-to-ticks 5)) + +(def ^{:doc "TODO: Pick a distance; explain." + :dynamic true} + *regen-vfx-distance* 20) + +(defonce ^{:doc "Used by (verify-region) and comp."} + latest-regen-region + (atom {})) + +(defonce ^{:doc "Used by (alter-region), (test-alter-region)..."} + block-regen-order-reversed + (atom ())) + +(defonce ^{:doc "Like block-regen-order-reversed, but set only at the end of the (test-alter-region) operation."} + block-regen-order + (atom [])) + +(def regen-warning-effect + "We'll try displaying this as a warning that a block is about to reappear:" + org.bukkit.Effect/MOBSPAWNER_FLAMES) + +(defn visual-warning-at [pos] + "A warning to players that the block is about to be overwritten. The 'nil' arg depends on the effect type." + (effect (.toLocation (get-vector pos) (get-current-world)) regen-warning-effect nil) + #_(.playEffect (get-current-world) (if (instance? Location pos) pos + (.toLocation (get-vector pos) (get-current-world))) + regen-warning-effect nil)) + +(defn- play-effect-at [pos] + (effect (.toLocation (get-vector pos)) regen-warning-effect nil)) + + ;(defonce global-regen-list ()) ) +;; A set. +;(defonce backed-up-blocks (atom #{})) +;(defonce backed-up-blocks #{}) + +#_(defn tagged-for-regen? [^Vector v] + "True if the block at vector v is already enrolled." + (let [{:keys [block-data]} @backed-up-blocks] + (contains? block-data v))) + +#_(defn- tag-for-regen [set & [^Block block]] + "Returns new mapping; intended to be a callback to (swap! backed-up-blocks ...)." + (let [current-time (get-game-time-in-ticks) + time-to-regen (+ current-time *regen-total-delay*) + {:keys [blocks block-data]} set] + {:block-data (assoc block-data (get-vector block) + {:time-to-regen time-to-regen}) + :blocks (cons (.getState block) block-data)})) + +#_(defn tag-for-regen! [^Block block] + "Delegates to side-effect-free (tag-for-regen)." + (swap! backed-up-blocks tag-for-regen block)) + +#_(defn backup-block [^Block block] + (let [v (get-vector block)] + (when-not (tagged-for-regen? v)) + (tag-for-regen! block))) + +#_(defn block-break-handler [^BlockBreakEvent ev] + "Suppresses block drop if *pcancel-block-drops* is set. This requires cancelment of the event, which may or may not make other plugins unhappy. +TODO: Custom event covariant with BlockBreakEvent." + (let [block (.getBlock ev)] + (when (eligible-for-regen? block) + (backup-block block) + (when *cancel-block-drops* + (.setCancelled ev true) + *cancel-block-drops*)))) + + +(defn block-break-monitor [^BlockBreakEvent ev] + "If *enable-warning-monitor-events* is set, this will be added as a MONITOR-priority event listener to check whether the break-event remained cancelled, like doing an (assert)." + (let [block (.getBlock ev)] + (when (and *cancel-block-drops* + (not (.isCancelled ev)) + *enable-warning-monitor-events*) + (cljminecraft.logging/warn "** Block drop has been forcibly reenabled by a rogue plugin.")))) + +#_(defn do-commence-warning [pos] + ;; Load an intervalic handler to make block blink + ;; Check whether a player's already in danger; warn if so + ;; Load a PlayerMoveEvent listener to warn if a player wanders into danger + ) + +;; FIXME: Terrible name, for one thing: +#_(defn do-time-to-regen [] + (let [{:keys [blocks block-data]} @backed-up-blocks + [block & rest] blocks + block-vec (get-vector block) + {:keys [time-to-regen]} (get block-data block-vec)] + (assert* (contains? block-data block-vec)) + (assert* time-to-regen) + (when + + time-before 0)) + (assert* (> time-after 0)) + (recursive-warning-regen (get-location block) + *regen-warning-period* + time-before + time-after + #(send-msg (get-first-player) "Regeneration."))) + #_(schedule-regeneration block #(send-msg (get-first-player) "Regeneration."))) + + + +#_(defn schedule-regeneration [block callback] + "Test func." + (assert* (> *regen-total-delay* *regen-warning-delay*)) + (let [^Location loc (get-location block) + ^BukkitTask warning-task + (repeated-task @clj-plugin + (fn [] + (debug-println "Warning VFX playing.") + (send-msg (get-first-player) "Warning.") + (effect loc regen-warning-effect nil)) + (- *regen-total-delay* *regen-warning-delay*) + *regen-warning-period*) + warning-task-id (.getTaskId warning-task) + ^BukkitTask regen-task (delayed-task @clj-plugin + (fn [] + (debug-println "Regen task firing.") + (assert* (or (running-task? warning-task-id) + (queued-task? warning-task-id))) + (cancel-task warning-task-id) + (assert* (not (queued-task? warning-task-id))) + (callback)) + *regen-warning-delay*) + regen-task-id (.getTaskId regen-task)] + (assert* (or (running-task? warning-task-id) + (queued-task? warning-task-id))) + (assert* (or (running-task? regen-task-id) + (queued-task? regen-task-id))) + [warning-task, regen-task])) + + + + + + +#_(defn backup-region [start-corner end-corner] + "Moving onward from the earlier version in backup-restore.clj." + (let [vs (gen-region-vectors start-corner end-corner) + vectors (if *ignore-air-blocks* + (remove #(air? (get-block-at %)) vs) + vs)] + (def *backed-up-region* ()) + (doseq [v vectors] + (let [target-block (get-block-at v)] + (assert* (instance? Block target-block)) + (debug-println "Backing up block at" (format-vector v)) + (let [block-state (.getState target-block)] + (def *backed-up-region* + (cons block-state *backed-up-region*))))))) + + +(defn taxicab-distance [ob1 ob2] +"FIXME: This is a stub!" + 5) + +(defonce player-move-event-declared (atom false)) +(defonce player-hash-set (atom #{})) +(defonce blocks-to-regen (atom {})) + +(defn player-move-event-declared? [] + "Currently unused." + @player-move-event-declared) + +(defn player-flagged-in-regen-area? [^Player pc] + (contains? @player-hash-set pc)) + +(defn player-in-regen-area? [^Player pc] + "True if either of pc's bounding blocks is within the blocks-to-regen set." + (some #(contains? @blocks-to-regen (get-block-vector %)) + (get-player-space pc)) + #_(some (fn [^BlockVector pos] + (let [block (get @blocks-to-regen pos)] + (player-block-collision? pc block :solid false))) + (keys @blocks-to-regen))) + + + +(defn player-move-event-handler [^PlayerMoveEvent ev] + "Block-regen PlayerMoveEvent handler: when a block is in queue, checks whether a player is moving in or out of the affected area... blah, blah. +TODO: Instead of looping through blocks, check just the player's space." + (try + ;(debug-println "Move event noted.") + (let [pc (.getPlayer ev)] + (cond* + ;; Coming in: + [(and (not (player-flagged-in-regen-area? pc)) + (player-in-regen-area? pc)) + (swap! player-hash-set #(conj % pc)) + (assert (contains? @player-hash-set pc)) + (send-msg pc "You are now in a REG EN zone.")] + ;; Going out: + [(and (player-flagged-in-regen-area? pc) + (not (player-in-regen-area? pc))) + (swap! player-hash-set #(disj % pc)) + (assert* (not (contains? @player-hash-set pc))) + ;; TODO: Fix case where player gets trapped inside... but is told he is 'safely outside'. Happens when the player is considered to have "left" the REG EN zone because the zone disappears. + (send-msg pc "Safely outside the REG EN zone.")])) + (catch Error e + (send-msg (get-first-player) "Exception thrown within player-move warner.") + ; (cleanup-fn) + (throw e)))) + +(defn instate-player-move-event-handler [] + "Used by (regen)." + ;; TODO: Don't just re-initialize every time: + (binding [*debug-print* false] + (unregister-our-events "player.player-move")) + (let [cnt (count (HandlerList/getRegisteredListeners *plugin*))] + (register-event *plugin* "player.player-move" + player-move-event-handler) + (let [count' (count (HandlerList/getRegisteredListeners *plugin*))] + (assert* (= count' (inc cnt)) + "Error with loading the R.E. player-move handler; should have %s registered instead of %s." (inc cnt) count'))) + (debug-println "REG EN's player-move-event-handler loaded.") + true) + +(defn block-queued-for-regen? [obj] + "Predicate; returns true iff obj (or its location Vector) is in blocks-to-regen." + (cond* + [(instance? BlockVector obj) (contains? @blocks-to-regen obj)] + [:else (block-queued-for-regen? (get-block-vector obj))])) + + + +(defn block-queue-regen [block & {:keys [start-time target-time]}] + "Adds a block to the storage pile. Doesn't invoke the machinery around it--use (regen) for that, and let it call this. Has no effect if the block is already there. +If the block is queued, returns ." + (assert* start-time) + (assert* target-time) + (econd* + [(instance? BlockState block) + (let [vec (get-block-vector block) + new-entry {:state block + :starting-ordinal (count @latest-regen-region) + :regen-start-time start-time + :regen-target-time target-time + :actual-regen-time (promise) + :finishing-ordinal (promise)}] + (swap! latest-regen-region #(assoc % vec new-entry)) + (swap! blocks-to-regen #(assoc % vec block)) + (assert* (block-queued-for-regen? block)) + new-entry)] + [(instance? Block block) (block-queue-regen (get-state block) :start-time start-time :target-time target-time)])) + +(defn block-dequeue [obj] + "Removes a block from the queue; do not call directly." + (assert* (block-queued-for-regen? obj)) + (cond* + [(instance? BlockVector obj) (swap! blocks-to-regen #(dissoc % obj))] + [:else (block-dequeue (get-block-vector obj))]) + (assert* (not (block-queued-for-regen? obj)))) + +(defn block-restore* [^BlockState old-state] + "Impl. for (block-restore). Should remove the block from the regen queue. Do not call directly." + (let [^Material old-mat-type (get-type old-state) + ^Block target-block (get-block-at (get-location old-state)) + ^BlockVector vec (get-block-vector target-block) + starting-ordinal (get-in @latest-regen-region [vec :starting-ordinal])] + (assert* (instance? Block target-block)) + (if (= old-state (get-state target-block)) + (do + (debug-println "Block at" (format-vector vec) "already exactly matches stored state!") + ;; Remove from storage: + (block-dequeue vec)) + (do + (debug-println "Restoring block number" starting-ordinal "at" (format-vector vec) + "from material" (.getType target-block) + "to material" old-mat-type) + ;; Force state change: + (.update old-state true) + ;(debug-println "Here") + (deliver (get-in @latest-regen-region [vec :actual-regen-time]) + (get-full-time)) + (assert* (realized? (get-in @latest-regen-region [vec :actual-regen-time]))) + (deliver (get-in @latest-regen-region [vec :finishing-ordinal]) (count @block-regen-order-reversed)) + (swap! block-regen-order-reversed #(cons starting-ordinal %)))) + ;; Remove from storage: + (block-dequeue vec) + (assert* (cond* + [(= old-state (get-state target-block)) true] + [(= (get-type target-block) (get-type old-state)) + (debug-println "States don't match, though materials do.") + true]) + "Failing assert; type of block is still " (get-type target-block))) + (assert* (not (block-queued-for-regen? old-state))) + true) + + +(defn block-restore [obj] + "Moves a block out of the queue and back into the world. Error if the block isn't in queue." + (cond* + [(instance? BlockVector obj) + (assert* (contains? @blocks-to-regen obj)); TODO: Better error type + (let [block-state (get @blocks-to-regen obj)] + (assert* (instance? BlockState block-state)) + ;; Delegate: + (block-restore* block-state))] + [:else +#_(or (instance? Block obj) + (instance? BlockState)) + ;; Recurse: + (block-restore (get-block-vector obj))])) + + +;;;; Very weird. +(defn purge-regen-blocks [] + "Empties the regen queue. Strange, but using the #() lambda-func syntax was causing a compiler failure here." + (swap! blocks-to-regen (constantly {}))) + +(defonce ^{:doc "Map added to by (regen); keys are BlockStates, vals are absolute time coordinates, in ticks, of when (regen) determined the blocks should be restored. I.e., these are the times targeted by the tasks created. Note that (alter-region) resets this var while (regen) doesn't."} + regen-ending-times + (atom {})) + +(defn regen [block & {:keys [delay load-move-handler] + :or {load-move-handler true}}] + "Entry point for regenerating a single block. If :load-move-handler is true (default), then (instate-player-move-event-handler) is called. +Ideally we shall only have to do this if it was deactivated, which we shall learn to detect." + #_(when-not (player-move-event-declared?) + (register-event *plugin* "player.player-move" + player-move-event-handler + ;; TODO: EventPriority/MONITOR. Would that be breaking the rules, because it has side effects if an error is caught? + ;:monitor + ); FIXME: set flag + ) + (if (block-queued-for-regen? block) + (debug-println "Tried to queue a block that's already scheduled!") + (let [total-wait (or delay *regen-total-delay*); default + cur-time (get-full-time) + ;; NB: Decrement! + end-time (+ cur-time total-wait) ; Absolute num of ticks + ] + ;; Make time note: + (swap! regen-ending-times #(assoc % (get-block-vector block) end-time)) + (assert* total-wait) + (when load-move-handler (instate-player-move-event-handler)) + (block-queue-regen block :start-time cur-time :target-time end-time) + ;(block-queue-regen block) + + ;; TODO: Reinstate partial warnings: + (comment [cur-time (get-full-time) + end-time (+ cur-time *regen-warning-delay*) ; Absolute num of ticks + wait (- *regen-total-delay* *regen-warning-delay*) + total-wait (- end-time cur-time)]) + + ;;(debug-println (format "Will begin warning after %ss; will regen block after %ss." (ticks-to-seconds wait) (ticks-to-seconds total-wait))) +; (debug-println (format "Will regenerate block %s after %ss." block (ticks-to-seconds total-wait))) + (let [t1 (promise) + t2 (promise) + ;; This is more concise than using a separate (letfn): + abort-func (fn [] + ; (send-msg (get-first-player) "Exception thrown within (queue-for-regen).") + ;; Empty ENTIRE regen queue: + (purge-regen-blocks) + (debug-println "*** block-queue-regen's abort routine invoked.") + ;; TODO: debug-msg + (send-msg (get-player) "*** Error: block-queue-regen's abort routine invoked.") + (binding [*debug-print* false]; Printing here can lag the game too much. + (unregister-our-events "player.player-move")) + ;(send-msg (get-first-player) "Cleanup func run.") + (doseq [t [t1 t2]] + (when (realized? t) + (let [t' (deref t)] + (assert* (instance? BukkitTask t')) + (when (task-active? t') + (cancel-task t') + (assert* (not (task-active? t'))))))) + ;(swap! *blocks-queued-for-regen* #(disj % block)) + @blocks-to-regen)] + (try + (let ;; Schedules the regeneration action itself. + [t1' (delayed-task *plugin* + (fn [] + (try + ;(debug-println "Stopping regen task; OK.") + ;(debug-println (type t2')) + (assert* (realized? t2)) + (let [t2' (deref t2)] + (assert* (instance? BukkitTask t2')) + (assert* (task-active? t2')) + (let [t2-id (.getTaskId t2')] + ;; Shut down warner: + (cancel-task t2-id) + (assert* (not (task-active? t2-id))) + ;; TODO: Need to not remove ALL the plugin's listeners for the event. + ;(unregister-our-events "player.player-move") + ;(.unregister (PlayerMoveEvent/getHandlerList) *plugin*) + (block-restore block) )) + (catch Error e + (send-msg (get-first-player) "Exception thrown within the regeneration invoker!") + (abort-func) + (throw e)))) + ;; t3's delay: + total-wait) + ;; Warning loop. + t2' (repeated-task + (fn [] + (try + ;(debug-println "Checking for needed warnings.") + ;; Warn every player in zone: + (doseq [pc (online-players)] + ;; TODO: Solid? + (when (player-block-collision? pc block ;:solid true + ) + ;(debug-println "Warning" pc) + (send-msg pc (let [sec (ticks-to-seconds (- end-time (get-full-time)))] + (format "A block at your position is going to reappear in %s second%s." sec (pluralizes? sec)))))) + ;; Show VFX to players "near enough": + (when (some #(< (taxicab-distance % block) + *regen-vfx-distance*) + (online-players)) + (visual-warning-at block)) + (catch Error e + (send-msg (get-first-player) "Exception thrown within the on-tick warner.") + (abort-func) + (throw e)))) + ;; Task t2's timing params: + 0 ;; TODO: Reinstate two-phase warning; for now we use no wait. ; wait + *regen-warning-period* + :exception-cancel false)] + ;; All-important delivery: now that the tasks are created, we can make them available to (cleanup-fn) and the (catch) block: + (deliver t1 t1') + (deliver t2 t2') + ;; Retval + true) + (catch Error e + (send-msg (get-first-player) "Error within (queue-for-regen).") + (abort-func) + (throw e))))))) + + + + +(defonce ^{:doc "Set of BlocksStates used by (verify-altered-region); use for debugging. BlockStates are added hereto when (alter-region), by calling (alter), has tried to erase the block--most likely by changing it to AIR--and it hasn't changed properly. This test is done *after* all blocks have changed; if physics isn't cancelled, the lag time in between may allow other blocks to move. Water can flow, for example. Comparing the these results with those of a test performed immediately after the switch, within (alter), would likely be worth thought. +By default this accumulates between (alter-region) calls, but that can be changed with a keyword arg. +If 'nil', it means (alter-region) has run without (verify-altered-region). If an empty set, there were no failures! Congrats!"} + failures-of-alter-region + (atom nil)) + + +(defonce ^{:doc "Helper memo used by (alter-region), reset on every use."} + latest-alter-region (atom nil)) + +(defn + alter + [block & {:keys [new-mat load-move-handler log-failure delay] + :or {new-mat Material/AIR + load-move-handler true + log-failure true}}] + "REG EN gateway. \"Destroy\" a block and add it to the REG EN body. +If already of type 'new-mat', NOTHING IS DONE, and nil is returned; else returns true. +See (regen) for meaning of :load-move-handler. +If :log-failure is log. true, modifies (failures-of-alter-region)." + (let [^Block block (cond* + [(instance? Block block) block] + [:else (get-block-at (get-vector block))])] + (when (not (= new-mat (get-type block))) + (let [retval (regen block :load-move-handler load-move-handler :delay delay)] + (assert* (block-queued-for-regen? block)) + (set-type block new-mat) + #_(when (and log-errors (not (= (get-type block) new-mat))) (swap! failures-of-alter-region #(conj % (get-state block)))) + (assert* (= (get-type block) new-mat) "(alter) could not change %s from %s to %s." block (get-type block) new-mat) + retval)))) + +(defn verify-altered-region [& {:keys [new-mat] + :or {new-mat Material/AIR}}] + "A map containing three entries is returned: the number of hits, the number of misses, and a vector of misses. Only makes sense if (alter-region) has been called, setting latest-alter-region, and regeneration has not transpired. If it has regenerated, the number of misses will be inflated. +" +; (debug-println "(verify-altered-region).") + (if-not @latest-alter-region + (debug-println "Called (verify-altered-region), but no region stored!") + (do + (swap! failures-of-alter-region (constantly #{})) + (let [fcount (count @failures-of-alter-region)] + (when-not (zero? fcount) + (debug-announce "Warning: (verify-altered-region) found %s failure%s-to-destroy." + (if (== 1 fcount) "a" fcount) (pluralizes? fcount)))) +; (println @failures-of-alter-region) + + #_(doseq [x @latest-region] + (let [v (get-block-vector x) + cur-block (get-block-at v) + cur-type (get-type cur-block)] + (when-not (= cur-type new-mat) + (swap! failures-of-alter-region #(conj % x)) + (assert* (= cur-type new-mat) "(alter-region) postcondition: Block at %s of type %s is not destroyed (%s)." v cur-type new-mat)))) + (let [partitions (group-by #(= (get-type (get-block-at (get-vector %))) new-mat) @latest-alter-region) + failures (get partitions false)] + (swap! failures-of-alter-region (constantly failures)) + {:blocks-hit (count (get partitions true)) + :blocks-missed (count (get partitions false)) + :missed-blocks (get partitions false)})))) + + +(defn alter-region [start-pos end-pos & {:keys [new-mat reset-failures delay] + :or {new-mat Material/AIR + reset-failures true}}] + "Entry point for REG EN'ing (and destroying) a block section. For efficiency, only calls (instate-player-move-event-handler) once, not once per (alter). +If :reset-failures is logical true, the failures-of-alter-region set is purged first." + (assert* (instance? Material new-mat)) + (assert* (empty? @blocks-to-regen) "Called (alter-region) while blocks-to-regen isn't empty.") + (try + (swap! latest-regen-region (constantly {})) + (swap! block-regen-order-reversed (constantly ())) + (swap! block-regen-order (constantly [])) + (debug-println "Cleared 'latest-regen-region' and 'block-regen-order-reversed' in (alter-region).") + (with-local-vars [latest-region []] + (let [vectors (gen-region-vectors start-pos end-pos)] + ;; By default we let failures accrue, but we can reset them: + (when reset-failures (swap! failures-of-alter-region (constantly nil))) + ;; Reset times map, to be set again within (regen): + (def regen-ending-times (atom {})) + (doseq [v vectors] + (let [^BlockState cur-state (get-state (get-block-at v)) + ^Material cur-type (get-type cur-state)] + (assert* (instance? Material cur-type)) + ;; Skip this block if the material already matches. + (when-not (= cur-type new-mat) + (alter v :new-mat new-mat :load-move-handler false :delay delay) + (var-set latest-region (cons cur-state @latest-region))) + ;; Note: this duplicates a check within (alter): + (assert* (= new-mat (get-type (get-block-at (get-vector cur-state))))))) + + (swap! latest-alter-region (constantly @latest-region)) + ;; Test that last assignment: + (assert* (= @latest-region @latest-alter-region)) + ;(assert-seq x @latest-region (= (get-type x) new-mat)) + ;; Check that no blocks of 'new-mat' accidentally were added: + (assert* (not-any? #(= (get-type %) new-mat) (vals @blocks-to-regen))) + ; (debug-println "Here.") + ;; Check whether the blocks all got changed properly! This is most likely to fail. + (verify-altered-region :new-mat new-mat) + ;(assert* (zero? (:blocks-missed (verify-altered-region :new-mat new-mat)))) + + ;; Move handler. TODO: We should put this at the end and have some kind of check. + (instate-player-move-event-handler) + ;; Normal retval: + true)) + ;; If all that happened is an assertion failed, we still want this to run. For any other Error we cancel: + (catch AssertionError a + (debug-println "Caught assertion failure in (alter-region).") + (instate-player-move-event-handler) + (throw a)))) + + +(defn verify-region [] + "Returns a triple-e map, in the fashion of (verify-altered-region)." + (if (empty? @latest-regen-region) + (debug-println "Called (verify-region), but no region stored!") + (do + ;(when reset-failures (swap! failures-of-alter-region )) + (comment (doseq [x @latest-region] + (let [v (get-block-vector x) + cur-block (get-block-at v) + cur-type (get-type cur-block)] + (when-not (= cur-type new-mat) + (swap! failures-of-alter-region #(conj % x)) + (assert* (= cur-type new-mat) "(alter-region) postcondition: Block at %s of type %s is not destroyed (%s)." v cur-type new-mat))))) + (let [partitions (group-by block-state-verisimilitude? @latest-alter-region) + failures (get partitions false)] + {:blocks-regenerated (count (get partitions true)) + :blocks-failed (count (get partitions false)) + :failure-blocks failures})))) diff --git a/src/cljengine/siege.clj b/src/cljengine/siege.clj new file mode 100644 index 0000000..63fb53b --- /dev/null +++ b/src/cljengine/siege.clj @@ -0,0 +1,116 @@ +(ns cljengine.siege + (:use (clojure [core :exclude alter] + repl pprint reflect) + (cljengine mc tasks events regen) + (cljminecraft core + entity + [bukkit :exclude [repeated-task + cancel-task]] + events + commands + logging + util + [world :exclude [effect]]; (effect) has a simple bug. + ;; can't pull in all of cljminecraft.player without conflict: + [player :only [send-msg]])) + (:import (org.reflections Reflections) + (org.bukkit Bukkit + Material + Location + World + Effect) + (org.bukkit.block Block + BlockFace ; Enum + BlockState) + (org.bukkit.entity Entity + EntityType + Player) + (org.bukkit.metadata Metadatable) + (org.bukkit.event Event + Cancellable + EventPriority; Enums + HandlerList) + (org.bukkit.event.entity PlayerDeathEvent) + (org.bukkit.event.player PlayerMoveEvent) + (org.bukkit.event.block BlockEvent + BlockPhysicsEvent + BlockBreakEvent) + (org.bukkit.event.vehicle VehicleBlockCollisionEvent + VehicleMoveEvent) + (org.bukkit.util Vector + BlockVector) + (org.bukkit.plugin Plugin) + (org.bukkit.plugin.java JavaPlugin); subtype of Plugin + (org.bukkit.scheduler BukkitScheduler + BukkitTask) + (cljminecraft BasePlugin + ClojurePlugin) + (org.bukkit.util BlockIterator))) + + + +;;;; id=SIEGEN +(defn- minecart-collision-handler [^VehicleBlockCollisionEvent ev] + "For SIEGEN testing." + (when (= (.getType (.getVehicle ev)) + EntityType/MINECART) + (send-msg (get-player) "Vehicle block collision.") + (def *block-rammed* (.getBlock ev)) + (def *ram* (.getVehicle ev)))) + +(defonce ^:dynamic *minecart-handler-signal-only-transitions* true) + + +(defn- minecart-move-handler [^VehicleMoveEvent ev] + "For SIEGEN testing." + (when (= (.getType (.getVehicle ev)) + EntityType/MINECART) + (let [v1 (get-block-vector (.getFrom ev)) + v2 (get-block-vector (.getTo ev))] + + ;; I need to know if either of these can ever hold: +; (assert* (not (block-pos-eq? v1 v2))) + (assert* (or (== (.getX v1) (.getX v2)) + (== (.getZ v1) (.getZ v2)))) + ;(not *minecart-handler-signal-only-transitions*) + + (if (block-pos-eq? v1 v2) + (debug-println (format "Movement between equal vectors %s and %s." (format-vector v1) (format-vector v2))) + (do + (send-msg (get-player) (format "Minecart moved from %s to %s." (format-vector v1) (format-vector v2))) + (cond* + [(and (== (.getY v1) (.getY v2)) + (-> v1 get-block-below solid?) + (not (-> v2 get-block-below solid?)) + (-> v2 get-block-below get-block-below solid?)) + (send-msg (get-player) "Laying downhill tracks from %s to %s." (format-vector v1) + (format-vector (get-vector (get-block-below v2)))) + (alter (get-block-at v1) :new-mat Material/RAILS :delay 200) + (alter (get-block-below v2) :new-mat Material/RAILS :delay 200) + ;(.setType (get-block-at v1) Material/RAILS) + ;(.setType (get-block-below v2) Material/RAILS) + ] + ))) + #_(when (== (.getY v2) (dec (.getY v1))) + (.setType (get-block-at v1) Material/RAILS) + (.setType (get-block-at v2) Material/RAILS)) + #_(cond* + [(and (-> v1 get-block-below solid?) + (not (-> v2 get-block-below solid?)) + (-> v2 get-block-below get-block-below solid?)) + (send-msg (get-player) "Laying downhill top track at %s." (format-vector v1)) + (.setType (get-block-at v1) Material/RAILS)] + [(and (== (.getY v2) (dec (.getY v1))) + (-> v2 get-block-below solid?)) + (send-msg (get-player) "Laying downhill bottom track at %." (format-vector v2)) + (.setType (get-block-at v2) Material/RAILS)]) + #_(when ;(solid? (get-block-at (add v2 0 -1 0))) + (send-msg (get-player) "Laying downhill tracks.") + (doseq [% [;v1 + v2]] + (.setType (get-block-at %) Material/RAILS) + (assert (= (get-type (get-block-at %)) Material/RAILS))))))) + +(defn- load-minecart-move-handler [] + (unregister-our-events "vehicle.vehicle-move") + (register-event *plugin* "vehicle.vehicle-move" minecart-move-handler)) diff --git a/src/cljengine/tasks.clj b/src/cljengine/tasks.clj new file mode 100644 index 0000000..46eb4d8 --- /dev/null +++ b/src/cljengine/tasks.clj @@ -0,0 +1,233 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); eval: (viper-mode) -*- + +(ns cljengine.tasks + (:use (clojure core repl pprint reflect) + (cljengine mc ) + (cljminecraft core + entity + [bukkit :exclude [repeated-task + cancel-task]] + events + commands + logging + util + [world :exclude [effect]]; (effect) has a simple bug. + ;; can't pull in all of cljminecraft.player without conflict: + [player :only [send-msg]])) + (:import (org.reflections Reflections) + (org.bukkit Bukkit + Material + Location + World + Effect) + (org.bukkit.block Block + BlockFace ; Enum + BlockState) + (org.bukkit.entity Entity + EntityType + Player) + (org.bukkit.metadata Metadatable) + (org.bukkit.event Event + Cancellable + EventPriority; Enums + HandlerList) + (org.bukkit.event.entity PlayerDeathEvent) + (org.bukkit.event.player PlayerMoveEvent) + (org.bukkit.event.block BlockEvent + BlockPhysicsEvent + BlockBreakEvent) + (org.bukkit.event.vehicle VehicleBlockCollisionEvent + VehicleMoveEvent) + (org.bukkit.util Vector + BlockVector) + (org.bukkit.plugin Plugin) + (org.bukkit.plugin.java JavaPlugin); subtype of Plugin + (org.bukkit.scheduler BukkitScheduler + BukkitTask) + (cljminecraft BasePlugin + ClojurePlugin) + (org.bukkit.util BlockIterator))) +(defn get-pending-tasks [] + "Wrapper; checks (scheduler)." + (.getPendingTasks (scheduler))) + + + + + +#_(defn repeated-task* + "Modified version. +Execute a given function repeatedly on the UI thread, delay and period in server ticks. If you specify async?, take care not to directly call any Bukkit API and, by extension, and clj-minecraft functions that use the Bukkit API within this function" + [plugin callback delay period & {:keys [times async]}] + (let [schedule-fn (if async (memfn runTaskTimerAsynchronously) + (memfn runTaskTimer))] + (cond* + [(nil? times) +; (schedule-fn (scheduler) plugin fn (long delay) (long period)) + ] + [(zero? times) (callback)] + [:else + (delayed-task plugin + (fn [] + (callback) + (repeated-task plugin callback )) + period)] + ))) + + +#_(defn schedule-task [callback & {:keys [plugin delay period times async scheduler] + :or [plugin @clj-plugin + delay 0 + async false + scheduler (scheduler)]}] +"If 'delay' is logical false, the callback is run immediately (no scheduling). If 'delay' is 0, it is run on the next tick." + (cond* + [(not period) + (cond* + [(not delay) (callback)] + [(zero? delay) (.runTask scheduler plugin callback)] + [(> delay 0) (.runTaskLater scheduler plugin callback delay)] + [:else false])] + [(not times) + (assert (> period 0)) + (repeated-task plugin callback delay period)] + [(> times 0) + (assert (> period 0)) + (if delay (schedule-task plugin scheduler + callback + :delay nil) + )] + [:else nil])) + + +;; TODO: The functional style I used here works well in Clojure, but is less than long-term practical. +#_(defn ^{:doc "Pretty nice little entry point for the scheduler system. If you use :delay only, you get something like (delayed-task); +you can try :period and :delay to get (repeated-task); but if you use :times, you get something else entirely: a fixed number of repetitions using BukkitScheduler.runTask()."} + schedule-repeated-task [callback & {:keys [delay period times plugin + ; scheduler + ] + :or [delay nil + ; plugin (deref clj-plugin) + period nil + times nil + ; scheduler (scheduler) + ]}] + (let [plugin @clj-plugin] + (assert* (instance? Plugin plugin)) + (if-not delay + (econd* + [(not times) (repeated-task plugin callback delay period)] + [(zero? times) nil] + [(== 1 times) + (callback) +; (debug-println "Done.") + ] + [(> times 1) +; (debug-println times "remaining.") + (assert* (integer? period) "You must specify a nonnegative number of ticks for repetition.") + (assert* (>= period 0)) + (callback) +; (debug-println (dec times) "remaining.") + (schedule-repeated-task callback + :plugin plugin + :delay period ; *** Here's the important change + :period period + ; :scheduler scheduler + :times (dec times))]) + (do + (assert* (integer? delay)) + ;(debug-println delay) + (econd* + [(zero? delay) + (.runTask (scheduler) plugin callback)] + [(> delay 0) +; (debug-println "Rescheduling." delay period times) + (.runTaskLater (scheduler) plugin + #(schedule-repeated-task callback +; :plugin plugin + :delay nil + :period period + :times times) + delay)]))))) + + +(def get-task-id "Wrapper for getTaskId()." + (memfn getTaskId)) + + + + +;; TODO: Rewrite with (etypecase*). +(defn task-active? [task] + "Wrapper; true if 'task' (which may be a BukkitTask or its ID number, either one) is running or waiting to run." + (econd* + [(instance? Long task) (or (.isCurrentlyRunning (scheduler) task) + (.isQueued (scheduler) task))] + [(number? task) (task-active? (long task))] + [(instance? BukkitTask task) (task-active? (.getTaskId task))])) + +(defn cancel-task [task] + "Wrapper; like the cljminecraft func of the same name, but overloaded on param type." + (cond* + [(instance? Long task) + (debug-println "Cancelling task" task) + (.cancelTask (scheduler) task)] + ;; The Long requirement was a nasty bug source. + [(number? task) (cancel-task (long task))] + ;; The absence of the 'long' cast was a nasty bug: + [(instance? BukkitTask task) (cancel-task (long (.getTaskId task)))] + [:else (assert* false (format "Failure in (cancel-task); value %s is of type neither Long nor BukkitTask." task))])) + +(defn cancel-all-tasks [] + (doseq [task (get-pending-tasks)] + (cancel-task task)) + (assert* (zero? (count (get-pending-tasks)))) + (debug-println "** All tasks cancelled.") + nil) + +;;; Borrowed from clj-minecraft with a correction--the original (repeated-task) forgets to include a plugin arg. +#_(defn repeated-task + "Execute a given function repeatedly on the UI thread, delay and period in server ticks. If you specify async?, take care not to directly call any Bukkit API and, by extension, and clj-minecraft functions that use the Bukkit API within this function" + [plugin fn delay period & [async?]] + (if async? + (.runTaskTimerAsynchronously (scheduler) plugin fn (long delay) (long period)) + (.runTaskTimer (scheduler) plugin fn (long delay) (long period)))) + +(defn ^BukkitTask repeated-task [func delay period & {:keys [exception-cancel + units] + :or {exception-cancel true + units :ticks}}] + "A wrapper like clj-minecraft's. However, I've left out the 'async' and 'plugin' options and added 'exception-cancel', which by default is true: unless you disable it, an uncaught exception within the 'func' callback will result in the task's early removal from the scheduler. +The 'units' defaults to :ticks. You can also use :seconds." + (assert* *plugin*) + (let [[delay period] (econd* + [(= units :ticks) [delay period]] + [(= units :seconds) (map seconds-to-ticks [delay period])]) + ;; in case I change this later. Definition borrowed from cljminecraft.bukkit/repeated-task: + impl-func (fn [^Plugin plugin fn delay period] + (.runTaskTimer (scheduler) plugin fn (long delay) (long period)))] + (assert* (number? delay)) + (assert* (number? period)) + (if-not exception-cancel + ;; If we don't need a (try) block, just invoke the callback: + (impl-func *plugin* func delay period) + ;; Otherwise, make a slot to reference the task, once it's created: + (let [task-promised (promise) + ;; ... and wrap the callback in a try-block thunk: + func' (fn [] + (assert* (realized? task-promised)) + (try + ;; Orig. callback + (func) + (catch Error e + (when (task-active? task-promised) + (debug-println "Error observed in periodic task; auto-cancelling.") + (cancel-task task-promised) + (assert* (not (task-active? task-promised))) + (throw e))))) + ;; Finally, schedule task: + task (impl-func *plugin* func' delay period)] + ;; ... and give it a ref to itself: + (deliver task-promised task) + ;; retval: + task)))) diff --git a/src/cljengine/test.clj b/src/cljengine/test.clj new file mode 100644 index 0000000..f4ee4ed --- /dev/null +++ b/src/cljengine/test.clj @@ -0,0 +1,150 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); eval: (viper-mode) -*- + +(ns cljengine.test + (:require [cljengine.mc :as mc] + [cljengine.regen :as regen] + [cljengine.tasks :as tasks]) + (:use (clojure [core :exclude [alter]] + repl pprint reflect) + (cljengine mc + tasks + events + regen) + (cljminecraft core + entity + [bukkit :exclude [repeated-task + cancel-task]] + events + commands + logging + util + [world :exclude [effect]]; (effect) has a simple bug. + ;; can't pull in all of cljminecraft.player without conflict: + [player :only [send-msg]])) + (:import (org.reflections Reflections) + (org.bukkit Bukkit + Material + Location + World + Effect) + (org.bukkit.block Block + BlockFace ; Enum + BlockState) + (org.bukkit.entity Entity + EntityType + Player) + (org.bukkit.metadata Metadatable) + (org.bukkit.event Event + Cancellable + EventPriority; Enums + HandlerList) + (org.bukkit.event.entity PlayerDeathEvent) + (org.bukkit.event.player PlayerMoveEvent) + (org.bukkit.event.block BlockEvent + BlockPhysicsEvent + BlockBreakEvent) + (org.bukkit.event.vehicle VehicleBlockCollisionEvent + VehicleMoveEvent) + (org.bukkit.util Vector + BlockVector) + (org.bukkit.plugin Plugin) + (org.bukkit.plugin.java JavaPlugin); subtype of Plugin + (org.bukkit.scheduler BukkitScheduler + BukkitTask) + (cljminecraft BasePlugin + ClojurePlugin) + (org.bukkit.util BlockIterator))) + +(def +test-vectors+ "Try these with (apply alter-region test-vectors). There's one block which gets added to failures-of-alter-region because it starts as water and water flows into it with the first physics check after it's removed." + [(BlockVector. 4978.0,63.0,5028.0) + (BlockVector. 4875.0,98.0,4997.0)]) + +(def +test-vector-ending-times+ + "The +test-vectors+ produced the following values for their regeneration times, which I acquired using '(sort (keys (group-by val @regen-ending-times)))'. This is giving each block in its own task. Note that there are 155 values for 119808 blocks. The most assigned to a single tick was 1259, and the fewest was zero--the range is 165, so ten ticks were left out." + '(1673498 1673499 1673500 1673501 1673502 1673503 1673504 1673505 1673506 1673507 1673508 1673509 1673510 1673511 1673512 1673513 1673514 1673515 1673516 1673517 1673518 1673519 1673520 1673521 1673522 1673523 1673524 1673525 1673526 1673527 1673528 1673529 1673530 1673531 1673532 1673533 1673534 1673535 1673536 1673537 1673538 1673539 1673540 1673541 1673542 1673543 1673544 1673545 1673546 1673547 1673548 1673549 1673550 1673551 1673552 1673553 1673554 1673555 1673556 1673557 1673558 1673559 1673560 1673561 1673562 1673563 1673564 1673565 1673566 1673567 1673568 1673569 1673570 1673571 1673572 1673573 1673574 1673575 1673576 1673577 1673578 1673579 1673580 1673581 1673582 1673583 1673584 1673585 1673586 1673587 1673588 1673589 1673590 1673591 1673592 1673593 1673594 1673595 1673596 1673597 1673598 1673599 1673600 1673601 1673602 1673603 1673604 1673605 1673606 1673607 1673608 1673609 1673610 1673611 1673612 1673613 1673614 1673615 1673616 1673617 1673618 1673619 1673620 1673621 1673622 1673623 1673624 1673625 1673626 1673627 1673628 1673629 1673630 1673631 1673632 1673633 1673634 1673635 1673636 1673637 1673638 1673639 1673640 1673641 1673642 1673644 1673645 1673646 1673647 1673650 1673651 1673654 1673655 1673659 1673663)) + +(defn test-alter-region [v1 v2 & {:keys [reset-failures new-mat suppress-physics delay coll-max] + :or {reset-failures true + new-mat Material/AIR + suppress-physics false + coll-max 20}}] + "Uses *regen-total-delay* for the time. +'reset-failures' defaults to TRUE. The 'max-output' keyword imposes a limit on the length of a collection that is returned or printed. (These can be long.)" + (assert* (empty? @blocks-to-regen) "(test-alter-region) attempted while blocks are still queued. +Either wait until a regen op finishes, or clear blocks-to-regen.") + (let [delay (or delay *regen-total-delay*)] + (try + (let [region (gen-region-vectors v1 v2) + num-blocks-in-region (count region) ; Total number; some of them may not need to be altered. + attempted (count (remove #(= new-mat (get-type (get-block-at %))) + region))] + (def results! {:seed (get-seed) + :corners [v1 v2] + :delay delay + :new-material new-mat + :physics-suppressed? suppress-physics + :num-blocks-selected num-blocks-in-region + :destruction (promise) + :regeneration (promise)}) + + ; (try + (alter-region v1 v2 :new-mat new-mat :reset-failures reset-failures + :delay delay) ; No longer fails assertion b/c/o (verify-altered-region). + ; (catch AssertionError _) ) + + (assert* (not (empty? @latest-regen-region))) + ;; This should work, I hope: + (let [failures @failures-of-alter-region + ending-times-map (zipmap (keys @latest-regen-region) (map :regen-target-time (vals @latest-regen-region))) ;@regen-ending-times + ending-times (keys (group-by val ending-times-map)) ] + ;(debug-println "Here.") + (let [prelim-results {:num-blocks-tried attempted + :num-blocks-failed (count failures) + :failing-types (distinct (map get-type failures)) + ;; As per the global tick counter: + :num-distinct-ending-times (count ending-times) + ;; This should be zero, in theory: + :ending-time-range (- (apply max (vals ending-times-map)) (apply min (vals ending-times-map))) + ;; Frequency of mode of ending times: + :ending-time-highest-frequency (apply max (map (comp count val) (group-by val ending-times-map)))}] + (assert* (integer? attempted)) + (assert* (integer? (count failures))) + (assert* (<= attempted num-blocks-in-region)) + ;(assert* (>= attempted num-blocks-in-region) "How can you try %s block(s) and get %s?!" attempted num-blocks-in-region) + (assert* (<= (count failures) attempted)) + ;(debug-println "Here too.") + (deliver (:destruction results!) prelim-results) + (when-not (== attempted (count ending-times-map)) + (debug-announce "Number of blocks tried, %s, should equal the number of ending times recorded, %s." attempted (count ending-times-map))) +; (assert* (== attempted (count ending-times-map)) "Number of blocks tried, %s, should equal the number of ending times recorded, %s." attempted (count ending-times-map)) + ))) + (finally + ;; Follow-up: + (delayed-task *plugin* (fn [] + (swap! regen/block-regen-order (constantly (reverse @regen/block-regen-order-reversed))) + (let [ending-time-discrepancies (map #(- (:regen-target-time %) (deref (:actual-regen-time %))) (vals @latest-regen-region)) + {:keys [blocks-regenerated blocks-failed failure-blocks]} (verify-region) + final-results {:num-blocks-regenerated blocks-regenerated + :num-blocks-failed blocks-failed + :failing-types (distinct (map get-type failure-blocks)) + :max-target-time-error (apply max (map abs ending-time-discrepancies)) + :mean-target-time-error (float (mc/mean ending-time-discrepancies)) + :mode-target-time-error (mc/mode ending-time-discrepancies) + :block-permutation (if (< (count @regen/block-regen-order) coll-max) @regen/block-regen-order + (take coll-max @regen/block-regen-order))}] + (deliver (:regeneration results!) final-results)) + (debug-println "Finalising promises.") + (assert* (empty? @blocks-to-regen) "End of (alter-region) regen routine was reached with %s block%s leftover." + (count @blocks-to-regen) (pluralizes? (count @blocks-to-regen)))) + (+ delay (seconds-to-ticks 2))) + results!))) + results!) + +(defn write-test-to-file [filename & [^String comment]] + (when comment (spit filename (println-str comment))) + (spit filename (with-out-str (pprint results!)) :append true) + (spit (str "order_" filename) @regen/block-regen-order)) + + +#_(defn make-test-form [seed + ]) diff --git a/src/cljengine/util.clj b/src/cljengine/util.clj new file mode 100644 index 0000000..62357f4 --- /dev/null +++ b/src/cljengine/util.clj @@ -0,0 +1,103 @@ +; -*- eval: (clojure-mode); eval: (paredit-mode); (viper-mode) -*- + +(defonce ^:dynamic *debug-print* true); TODO: Is dynamic the right sort? +(defn debug-println [& forms] + "If *debug-print* is set, passes 'forms' to (println)." + (when *debug-print* (apply #'println forms))) + +;; Absolute value wrapper: +(definline abs [num] + `(Math/abs ~num)) + +(defn ns-syms [ns] + "Wrapper. Returns & prints (unqualified) names of symbols in namespace 'ns'. Good for poking around." + (let [keys (sort (keys (ns-interns ns)))] + (pprint keys) + keys)) + +(defonce ^:dynamic *do-not-compile-assertions* false) +(defmacro assert* [& forms] + "Modification to (assert) allowing static and dynamic control. Setting *do-not-compile-assertions* at compile-time will have the same effect as compiling a regular (assert)ion with *assert* unset: removal. However, if *do-not-compile-assertions* is false, then *assert* can be used dynamically to enable/disable assertion evaluation, at the slight cost of a boolean test." + (assert (var? #'*do-not-compile-assertions*)) + (if *do-not-compile-assertions* + '(do) + `(if *assert* (assert ~@forms) + (do)))) + + +#_(defmacro cond* + ([[test & body]] + `(cond ~@test (do ~@body))) + ([[fst-test & fst-clause] & rest] + (letfn [(cond-recur + ([[test* & body*]] + `(~test* (do ~@body*))) + ([[test* & body*] & rest*] + `(~test* (do ~@body*) + ~@(apply cond-recur rest*))))] + `(cond + ~fst-clause (do ~@fst-test) + ~@(apply cond-recur rest))))) +#_(defmacro cond* + ([clause] + (let [[test & body] clause] + `(cond ~@test (do ~@body)))) + ([[fst-test & fst-clause] & rest] + (letfn [(cond-recur + ([[test* & body*]] + `(~test* (do ~@body*))) + ([[test* & body*] & rest*] + `(~test* (do ~@body*) + ~@(apply cond-recur rest*))))] + `(cond + ~fst-clause (do ~@fst-test) + ~@(apply cond-recur rest))))) +#_(defmacro cond* + ([[test & body]] + `(cond ~@test (do ~@body))) + ([[fst-test & fst-clause] & rest] + (letfn [(cond-recur + ([[test* & body*]] + `(~test* (do ~@body*))) + ([[test* & body*] & rest*] + `(~test* (do ~@body*) + ~@(apply cond-recur rest*))))] + `(cond + ~fst-clause (do ~@fst-test) + ~@(apply cond-recur rest))))) + +(defmacro cond* [fst-clause & rest-of-clauses] + "I have *had* it with Clojure's (cond). The Scheme style seems utterly pointless; you could simply do with a variadic (if), like Shen. +This version accordingly requires that separate test clauses be enclosed as sequences. Vectors, specifically, with '[]'; when in Clojure, do as Clojurians do." + (let [[fst-test & fst-body] fst-clause] + (letfn [(cond-recur + ([] []) + ([clause & clauses] + (let [[test & body] clause] +; (println "Got this far.") + `(~test (do ~@(or body [])) + ~@(apply cond-recur clauses)))))] + ; (println rest-of-clauses) + `(cond + ~fst-test (do ~@(or fst-body [])) + ~@(if (nil? rest-of-clauses) [] + (apply cond-recur rest-of-clauses)))))) + +(assert + (= (cond* + [false 99] + [false 200] + [true 300] + [true 20]) + 300)) +(assert + (= (cond* + [false 1] + [false 2]) + nil)) +(assert + (= (cond* + [false 1] + [false 2] + [:else 99]) + 99))