Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/hxc.clj @ 420:acc3d1ad24e8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Found HP restored by SODA POP, FRESH WATER, LEMONADE; also found number of steps for REPEL, SUPER REPEL, MAX REPEL.
author Dylan Holmes <ocsenave@gmail.com>
date Sat, 14 Apr 2012 09:27:49 -0500
parents 7c89fe478de4
children
comparison
equal deleted inserted replaced
419:4901ba2d3860 420:acc3d1ad24e8
182 182
183 183
184 184
185 185
186 (defn hxc-pokedex-names 186 (defn hxc-pokedex-names
187 "The names of the pokemon in hardcoded pokedex order. List begins at 187 "The names of the pokemon in hardcoded pokedex order. List of the
188 pokedex numbers of each pokemon (in internal order) begins at
188 ROM@410B1. See also, hxc-pokenames." 189 ROM@410B1. See also, hxc-pokenames."
189 ([] (hxc-pokedex-names 190 ([] (hxc-pokedex-names
190 com.aurellem.gb.gb-driver/original-rom)) 191 com.aurellem.gb.gb-driver/original-rom))
191 ([rom] 192 ([rom]
192 (let [names (hxc-pokenames rom)] 193 (let [names (hxc-pokenames rom)]
348 349
349 350
350 351
351 (def hxc-places 352 (def hxc-places
352 "The hardcoded place names in memory. List begins at 353 "The hardcoded place names in memory. List begins at
353 ROM@71500. [Cinnabar] Mansion seems to be dynamically calculated." 354 ROM@71500. [Cinnabar/Celadon] Mansion seems to be dynamically calculated."
354 (hxc-thunk-words 0x71500 560)) 355 (hxc-thunk-words 0x71500 560))
355
356 356
357 (defn hxc-dialog 357 (defn hxc-dialog
358 "The hardcoded dialogue in memory, including in-game alerts. Dialog 358 "The hardcoded dialogue in memory, including in-game alerts. Dialog
359 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000." 359 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."
360 ([rom] 360 ([rom]
921 ;; note: DD4D spells out pokemon vital stat names ("speed", etc.) 921 ;; note: DD4D spells out pokemon vital stat names ("speed", etc.)
922 922
923 ;; note: 1195C-6A says ABLE#NOT ABLE#, but so does 119C0-119CE. 923 ;; note: 1195C-6A says ABLE#NOT ABLE#, but so does 119C0-119CE.
924 ;; The first instance is for Machines; the second, for stones. 924 ;; The first instance is for Machines; the second, for stones.
925 925
926 ;; 0x251A (in indexable mem): image decompression routine seems to begin here. 926 ;; note: according to
927 ;; http://www.upokecenter.com/games/rby/guides/rgbtrainers.php
928 ;; the amount of money given by a trainer is equal to the
929 ;; base money times the level of the last Pokemon on that trainer's
930 ;; list. Other sources say it's the the level of the last pokemon
931 ;; /defeated/.
932
933 ;; todo: find base money.
934
935
936 ;; note: 0xDFEA (in indexable mem) is the dex# of the currently-viewed Pokemon in
937 ;; in the pokedex. It's used for other purposes if there is none.
938
939 ;; note: 0x9D35 (index.) switches from 0xFF to 0x00 temporarily when
940 ;; you walk between areas.
941
942 ;; note: 0xD059 (index.) is the special battle type of your next battle:
943 ;; - 00 is a usual battle
944 ;; - 01 is a pre-scripted OLD MAN battle which always fails to catch the
945 ;; target Pokemon.
946 ;; - 02 is a safari zone battle
947 ;; - 03 obligates you to run away. (unused)
948 ;; - 04 is a pre-scripted OAK battle, which (temporarily) causes the
949 ;; enemy Pokemon to cry PIKAAA, and which always catches the target
950 ;; Pokemon. The target Pokemon is erased after the battle.
951 ;; - 05+ are glitch states in which you are sort of the Pokemon.
952
953
954 ;; note: 0x251A (in indexable mem): image decompression routine seems to begin here.
955
956 ;; note: 0x4845 (index): vending inventory is loaded here. possibly
957 ;; other things, too.
958 (comment
959 ;; temporarily intercept/adjust what pops out of the vending
960 ;; machine.
961 ;; (and how much it costs)
962
963 ;; located at 0x4845
964 ;; not to be confused with shop inventory, 0xCF7B
965 (do
966 (step (read-state "vend-menu"))
967 (write-memory! (rewrite-memory (vec(memory)) 0x4845 [2 0 1 0]))
968 (step @current-state [:a])
969 (step @current-state [])
970 (nstep @current-state 200) ))
927 971
928 972
929 ;; Note: There are two tile tables, one from 8000-8FFF, the other from 973 ;; Note: There are two tile tables, one from 8000-8FFF, the other from
930 ;; 8800-97FF. The latter contains symbols, possibly map tiles(?), with some japanese chars and stuff at the end. 974 ;; 8800-97FF. The latter contains symbols, possibly map tiles(?), with some japanese chars and stuff at the end.
931 (defn print-pixel-letters! 975 (defn print-pixel-letters!
932 "The pixel tiles representing letters. Neat!" 976 "The pixel tiles representing letters. Neat!"
933 ([] (print-pixel-letters! (read-state "oak-speaks"))) 977 ([] (print-pixel-letters! (read-state "oak-speaks")))
934 ([state] 978 ([state]
935 (map 979 (map
936 (comp 980 (comp
937 println 981 println
938 (partial map #(if (zero? %) \space 0)) 982 (partial map #(if (zero? %) \space 0))
939 #(if (< (count %) 8) 983 #(if (< (count %) 8)
940 (recur (cons 0 %)) 984 (recur (cons 0 %))
941 %) 985 %)
942 reverse bit-list) 986 reverse bit-list)
987
988 (take 0xFFF (drop 0x8800 (memory state))))))
989
990
991 ;; (defn test-2 []
992 ;; (loop [n 0
993 ;; pc-1 (pc-trail (-> state-defend (tick) (step [:a]) (step [:a]) (step []) (nstep 100)) 100000)
994 ;; pc-2 (pc-trail (-> state-speed (tick) (step [:a]) (step [:a])
995 ;; (step []) (nstep 100)) 100000)]
996 ;; (cond (empty? (drop n pc-1)) [pc-1 n]
997 ;; (not= (take 10 (drop n pc-1)) (take 10 pc-2))
998 ;; (recur pc-1 pc-2 (inc n))
999 ;; :else
1000 ;; [(take 1000 pc-2) n])))
1001
1002
1003
1004
1005 (defn test-3
1006 "Explore trainer data"
1007 ([] (test-3 0x3A289))
1008 ([start]
1009 (let [pokenames (vec(hxc-pokenames-raw))]
1010 (println
1011 (reduce
1012 str
1013 (map
1014 (fn [[adr lvl pkmn]]
1015 (str (format "%-11s %4d %02X %02X \t %05X\n"
1016
1017 (cond
1018 (zero? lvl) "+"
1019 (nil? (get pokenames (dec pkmn)))
1020 "-"
1021 :else
1022 (get pokenames (dec pkmn)))
1023 lvl
1024 pkmn
1025 lvl
1026 adr
1027 )))
1028 (map cons
1029 (take-nth 2 (drop start (range)))
1030 (partition 2
1031 (take 400;;703
1032 (drop
1033 start
1034 ;; 0x3A75D
1035 (rom)))))))))))
1036
1037 (defn search-memory* [mem codes k]
1038 (loop [index 0
1039 index-next 1
1040 start-match 0
1041 to-match codes
1042 matches []]
1043 (cond
1044 (>= index (count mem)) matches
1045
1046 (empty? to-match)
1047 (recur
1048 index-next
1049 (inc index-next)
1050 index-next
1051 codes
1052 (conj matches
1053 [(hex start-match) (take k (drop start-match mem))])
1054 )
1055
1056 (or (= (first to-match) \_) ;; wildcard
1057 (= (first to-match) (nth mem index)))
1058 (recur
1059 (inc index)
1060 index-next
1061 start-match
1062 (rest to-match)
1063 matches)
1064
1065 :else
1066 (recur
1067 index-next
1068 (inc index-next)
1069 index-next
1070 codes
1071 matches))))
943 1072
944 (take 0xFFF (drop 0x88000 (memory state)))))) 1073
1074 (defn search-pattern [ptn coll]
1075 (loop
1076 [index 0
1077 to-match ptn
1078 binds {}
1079
1080 next-index 1
1081 match-start 0
1082 matches []]
1083
1084 (cond
1085 (>= index (count coll)) matches
1086 (empty? to-match)
1087 (recur
1088 next-index
1089 ptn
1090 {}
1091 (inc next-index)
1092 next-index
1093 (conj match-start
1094 [(hex match-start) binds]))
1095
1096 :else
1097 (let [k (first to-match)
1098 v (nth coll index)]
1099 (cond
1100 (= k \_) ;; wildcard
1101 (recur
1102 (inc index)
1103 (rest to-match)
1104 binds
1105
1106 next-index
1107 match-start
1108 matches)
1109
1110 (keyword? k)
1111 (if (binds k)
1112 (if (= (binds k) v)
1113
1114 ;; consistent bindings
1115 (recur
1116 (inc index)
1117 (rest to-match)
1118 binds
1119
1120 next-index
1121 match-start
1122 matches)
1123
1124 ;; inconsistent bindings
1125 (recur
1126 next-index
1127 ptn
1128 {}
1129 (inc next-index)
1130 next-index
1131 matches))
1132
1133 (if ((set (vals binds)) v)
1134 ;; bindings are not unique
1135 (recur
1136 next-index
1137 ptn
1138 {}
1139 (inc next-index)
1140 next-index
1141 matches)
1142
1143 ;; bindings are unique
1144 (recur
1145 (inc index)
1146 (rest to-match)
1147 (assoc binds k v)
1148
1149 next-index
1150 match-start
1151 matches)))
1152
1153 :else ;; k is just a number
1154 (if (= k v)
1155 (recur
1156 (inc index)
1157 (rest to-match)
1158 binds
1159
1160 next-index
1161 match-start
1162 matches)
1163
1164 (recur
1165 next-index
1166 ptn
1167 {}
1168 (inc next-index)
1169 next-index
1170 matches)))))))
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180 (defn search-pattern* [ptn coll]
1181 (loop
1182 [
1183 binds {}
1184 index 0
1185 index-next 1
1186 start-match 0
1187 to-match ptn
1188 matches []]
1189
1190 (cond
1191 (>= index (count coll)) matches
1192 (empty? to-match)
1193 (recur
1194 {}
1195 index-next
1196 (inc index-next)
1197 index-next
1198 ptn
1199 (conj matches
1200 [(hex start-match) binds]))
1201
1202 :else
1203 (let [k (first to-match)
1204 v (nth coll index)]
1205 (cond
1206 (= k \_) ;; wildcard
1207 (recur
1208 binds
1209 (inc index)
1210 index-next
1211 start-match
1212 (rest to-match)
1213 matches)
1214
1215 (keyword? k)
1216 (if (binds k)
1217 (if (= (binds k) v)
1218 (recur
1219 binds
1220 (inc index)
1221 index-next
1222 start-match
1223 (rest to-match)
1224 matches)
1225 (recur
1226 {}
1227 index-next
1228 (inc index-next)
1229 index-next
1230 ptn
1231 matches))
1232 (if
1233 ;; every symbol must be bound to a different thing.
1234 ((set (vals binds)) v)
1235 (recur
1236 {}
1237 index-next
1238 (inc index-next)
1239 index-next
1240 ptn
1241 matches)
1242 (recur
1243 (assoc binds k v)
1244 (inc index)
1245 index-next
1246 start-match
1247 (rest to-match)
1248 matches))))))))
1249
1250
1251
1252
1253 ;; look for the rainbow badge in memory
1254 (println (reduce str (map #(str (first %) "\t" (vec(second %)) "\n") (search-memory (rom) [221] 10))))
945 1255
946 1256
947 (comment 1257 (comment
948 1258
949 (def hxc-later 1259 (def hxc-later