Mercurial > vba-clojure

annotate clojure/com/aurellem/items.clj @ 113:0831da75d2c5

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