Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/items.clj @ 429:a69c4d0c1a3b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
investigating infinite loop in note-codes.
author Robert McIntyre <rlm@mit.edu>
date Mon, 23 Apr 2012 09:40:11 -0500
parents 79252378fd22
children 716752719a78
rev   line source
rlm@145 1 (ns com.aurellem.gb.items
rlm@145 2 (:use (com.aurellem.gb gb-driver util))
rlm@145 3 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@145 4
rlm@191 5 (defn game-name
rlm@191 6 "return pokemon-yellow header information"
rlm@191 7 []
rlm@145 8 (map char (subvec (vec (memory)) 0x134 0x142)))
rlm@145 9
rlm@145 10 (def item-list-start 0xD31C)
rlm@345 11 (def pc-item-list-start 0xD539)
rlm@345 12 (def pc-item-list-width 101)
rlm@345 13
rlm@145 14
rlm@173 15 (defn item-list
rlm@173 16 ([^SaveState state]
rlm@173 17 (subvec
rlm@173 18 (vec (memory state))
rlm@173 19 item-list-start
rlm@173 20 (+ item-list-start 255)))
rlm@173 21 ([] (item-list @current-state)))
rlm@345 22
rlm@345 23 (defn nth-item
rlm@345 24 ([^SaveState state n]
rlm@345 25 (let [mem (memory state)]
rlm@345 26 [(aget mem (+ item-list-start 1 (* 2 n)))
rlm@345 27 (aget mem (+ item-list-start 2 (* 2 n)))]))
rlm@345 28 ([n] (nth-item @current-state n)))
rlm@345 29
rlm@345 30
rlm@345 31 (defn nth-pc-item
rlm@345 32 ([^SaveState state n]
rlm@345 33 (let [mem (memory state)]
rlm@345 34 [(aget mem (+ pc-item-list-start 1 (* 2 n)))
rlm@345 35 (aget mem (+ pc-item-list-start 2 (* 2 n)))]))
rlm@345 36 ([n] (nth-pc-item @current-state n)))
rlm@345 37
rlm@345 38
rlm@145 39 (def item-code->item-name
rlm@145 40 (hash-map
rlm@145 41 0x01 :master-ball
rlm@145 42 0x02 :ultra-ball
rlm@145 43 0x03 :great-ball
rlm@145 44 0x04 :poke-ball
rlm@145 45 0x05 :town-map
rlm@145 46 0x06 :bicycle
rlm@181 47 0x07 :surfboard
rlm@145 48 0x08 :safari-ball
rlm@145 49 0x09 :pokedex
rlm@145 50 0x0A :moon-stone
rlm@145 51 0x0B :antidote
rlm@145 52 0x0C :burn-heal
rlm@145 53 0x0D :ice-heal
rlm@145 54 0x0E :awakening
rlm@145 55 0x0F :parlyz-heal
rlm@145 56 0x10 :full-restore
rlm@145 57 0x11 :max-potion
rlm@145 58 0x12 :hyper-potion
rlm@145 59 0x13 :super-potion
rlm@145 60 0x14 :potion
rlm@145 61 0x15 :boulderbadge
rlm@145 62 0x16 :cascadebadge
rlm@145 63 0x17 :thunderbadge
rlm@145 64 0x18 :rainbowbadge
rlm@145 65 0x19 :soulbadge
rlm@145 66 0x1A :marshbadge
rlm@145 67 0x1B :volcanobadge
rlm@145 68 0x1C :earthbadge
rlm@145 69 0x1D :escape-rope
rlm@145 70 0x1E :repel
rlm@145 71 0x1F :old-amber
rlm@145 72 0x20 :fire-stone
rlm@145 73 0x21 :thunderstone
rlm@145 74 0x22 :water-stone
rlm@145 75 0x23 :hp-up
rlm@145 76 0x24 :protein
rlm@145 77 0x25 :iron
rlm@145 78 0x26 :carbos
rlm@145 79 0x27 :calcium
rlm@145 80 0x28 :rare-candy
rlm@145 81 0x29 :dome-fossil
rlm@145 82 0x2A :helix-fossil
rlm@145 83 0x2B :secret-key
rlm@145 84 0x2D :bike-voucher
rlm@145 85 0x2E :x-accuracy
rlm@145 86 0x2F :leaf-stone
rlm@145 87 0x30 :card-key
rlm@145 88 0x31 :nugget
rlm@217 89 0x32 :pp-up-glitched
rlm@145 90 0x33 :poke-doll
rlm@145 91 0x34 :full-heal
rlm@145 92 0x35 :revive
rlm@145 93 0x36 :max-revive
rlm@145 94 0x37 :guard-spec
rlm@145 95 0x38 :super-repel
rlm@145 96 0x39 :max-repel
rlm@145 97 0x3A :dire-hit
rlm@145 98 0x3B :coin
rlm@145 99 0x3C :fresh-water
rlm@145 100 0x3D :soda-pop
rlm@145 101 0x3E :lemonade
rlm@145 102 0x3F :s.s.ticket
rlm@145 103 0x40 :gold-teeth
rlm@173 104 0x41 :x-attack
rlm@145 105 0x42 :x-defend
rlm@145 106 0x43 :x-speed
rlm@145 107 0x44 :x-special
rlm@145 108 0x45 :coin-case
rlm@145 109 0x46 :oaks-parcel
rlm@145 110 0x47 :itemfinder
rlm@145 111 0x48 :silph-scope
rlm@145 112 0x49 :poke-flute
rlm@145 113 0x4A :lift-key
rlm@145 114 0x4B :exp.all
rlm@145 115 0x4C :old-rod
rlm@145 116 0x4D :good-rod
rlm@145 117 0x4E :super-rod
rlm@145 118 0x4F :pp-up
rlm@145 119 0x50 :ether
rlm@145 120 0x51 :max-ether
rlm@145 121 0x52 :elixer
rlm@145 122 0x53 :max-elixer
rlm@145 123 0xC4 :HM01 ;; cut
rlm@145 124 0xC5 :HM02 ;; fly
rlm@145 125 0xC6 :HM03 ;; surf
rlm@145 126 0xC7 :HM04 ;; strength
rlm@145 127 0xC8 :HM05 ;; flash
rlm@145 128 0xC9 :TM01 ;; mega punch
rlm@145 129 0xCA :TM02 ;; razor wind
rlm@145 130 0xCB :TM03 ;; swords dance
rlm@145 131 0xCC :TM04 ;; whirlwind
rlm@145 132 0xCD :TM05 ;; mega kick
rlm@145 133 0xCE :TM06 ;; toxic
rlm@145 134 0xCF :TM07 ;; horn drill
rlm@145 135 0xD0 :TM08 ;; body slam
rlm@145 136 0xD1 :TM09 ;; take down
rlm@145 137 0xD2 :TM10 ;; double-edge
rlm@145 138 0xD3 :TM11 ;; bubblebeam
rlm@145 139 0xD4 :TM12 ;; water gun
rlm@145 140 0xD5 :TM13 ;; ice beam
rlm@145 141 0xD6 :TM14 ;; blizzard
rlm@145 142 0xD7 :TM15 ;; hyper beam
rlm@145 143 0xD8 :TM16 ;; pay day
rlm@145 144 0xD9 :TM17 ;; submission
rlm@145 145 0xDA :TM18 ;; counter
rlm@145 146 0xDB :TM19 ;; seismic toss
rlm@145 147 0xDC :TM20 ;; rage
rlm@145 148 0xDD :TM21 ;; mega drain
rlm@145 149 0xDE :TM22 ;; solarbeam
rlm@145 150 0xDF :TM23 ;; dragon rage
rlm@145 151 0xE0 :TM24 ;; thunderbolt
rlm@145 152 0xE1 :TM25 ;; thunder
rlm@145 153 0xE2 :TM26 ;; earthquake
rlm@145 154 0xE3 :TM27 ;; fissure
rlm@145 155 0xE4 :TM28 ;; dig
rlm@145 156 0xE5 :TM29 ;; psychic
rlm@145 157 0xE6 :TM30 ;; teleport
rlm@145 158 0xE7 :TM31 ;; mimic
rlm@145 159 0xE8 :TM32 ;; double team
rlm@145 160 0xE9 :TM33 ;; reflect
rlm@145 161 0xEA :TM34 ;; bide
rlm@145 162 0xEB :TM35 ;; metronome
rlm@145 163 0xEC :TM36 ;; self destruct
rlm@339 164 0xED :TM37 ;; egg bomb
rlm@145 165 0xEE :TM38 ;; fire blast
rlm@145 166 0xEF :TM39 ;; swift
rlm@145 167 0xF0 :TM40 ;; skull bash
rlm@145 168 0xF1 :TM41 ;; softboiled
rlm@145 169 0xF2 :TM42 ;; dream eater
rlm@145 170 0xF3 :TM43 ;; sky attack
rlm@145 171 0xF4 :TM44 ;; rest
rlm@145 172 0xF5 :TM45 ;; thunder wave
rlm@145 173 0xF6 :TM46 ;; psywave
rlm@145 174 0xF7 :TM47 ;; explosion
rlm@145 175 0xF8 :TM48 ;; rock slide
rlm@145 176 0xF9 :TM49 ;; tri attack
rlm@145 177 0xFA :TM50 ;; substitute
rlm@145 178 0xFB :TM51 ;; "cut"
rlm@145 179 0xFC :TM52 ;; "fly"
rlm@145 180 0xFD :TM53 ;; "surf"
rlm@145 181 0xFE :TM54 ;; "strength"
rlm@363 182 0xFF :TM55 ;; "flash" (also end-of-list-sentinel)
rlm@182 183 ))
rlm@145 184
rlm@145 185 (def item-name->item-code
rlm@145 186 (zipmap (vals item-code->item-name)
rlm@145 187 (keys item-code->item-name)))
rlm@145 188
rlm@339 189 (defn raw-inventory->inventory
rlm@339 190 [raw-inventory]
rlm@339 191 (map
rlm@145 192 (fn [[item-code quantity]]
rlm@145 193 [(item-code->item-name
rlm@145 194 item-code
rlm@181 195 item-code)
rlm@145 196 quantity])
rlm@145 197 (partition
rlm@145 198 2
rlm@339 199 raw-inventory)))
rlm@339 200
rlm@363 201 (defn total-held-items [state]
rlm@363 202 (aget (memory state) item-list-start))
rlm@363 203
rlm@363 204 (defn inventory
rlm@363 205 ([^SaveState state]
rlm@363 206 (let [items (item-list state)]
rlm@363 207 (raw-inventory->inventory
rlm@363 208 (take (* 2 (total-held-items state)) (next items)))))
rlm@363 209 ([] (inventory @current-state)))
rlm@145 210
rlm@145 211 (defn print-inventory
rlm@145 212 ([] (print-inventory @current-state))
rlm@145 213 ([^SaveState state]
rlm@145 214 (println
rlm@145 215 (let [inv (inventory state)]
rlm@145 216 (reduce
rlm@145 217 str
rlm@145 218 (concat
rlm@145 219 ["+-------------------+----------+\n"
rlm@145 220 "|##| Item | Quantity |\n"
rlm@145 221 "+--+----------------+----------+\n"]
rlm@145 222
rlm@145 223 (map
rlm@145 224 (fn [index [item-name quantity]]
rlm@145 225 (str
rlm@145 226 (format "|%-2d| %-14s | %3d |\n" index
rlm@145 227 (apply str (rest (str item-name)))
rlm@145 228 quantity)))
rlm@145 229 (range 0 (count inv)) inv)
rlm@145 230 ["+--+----------------+----------+\n"]))))
rlm@145 231 state))
rlm@145 232
rlm@145 233 (defn inventory-codes [inventory]
rlm@145 234 (flatten
rlm@145 235 (concat [(count inventory)]
rlm@145 236 (map (fn [[item-name quantity]]
rlm@181 237 [(item-name->item-code item-name item-name)
rlm@145 238 quantity]) inventory)
rlm@363 239 [(item-name->item-code :TM55)])))
rlm@145 240
rlm@145 241 (defn set-inv-mem [^SaveState state inv-codes]
rlm@145 242 (set-memory-range state item-list-start
rlm@145 243 inv-codes))
rlm@145 244
rlm@145 245
rlm@145 246 (defn set-inventory [^SaveState state new-inventory]
rlm@145 247 (set-inv-mem state (inventory-codes new-inventory)))
rlm@145 248
rlm@161 249 (defn give-items
rlm@145 250 ([^SaveState state items]
rlm@145 251 (set-inventory state
rlm@145 252 (concat items (inventory state))))
rlm@145 253 ([items]
rlm@161 254 (give-items @current-state items)))
rlm@145 255
rlm@145 256 (defn clear-inventory
rlm@145 257 ([^SaveState state]
rlm@145 258 (set-inventory state []))
rlm@145 259 ([] (clear-inventory @current-state)))
rlm@250 260
rlm@250 261