Mercurial > vba-clojure

comparison clojure/com/aurellem/run/bootstrap_1.clj @ 414:0162dd315814

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
moved asseitem-writer assembly to rlm-assembly.
author Robert McIntyre <rlm@mit.edu>
date Sat, 14 Apr 2012 03:22:10 -0500
parents 1f14c1b8af7e
children f2f1e0b8c1c7
comparison
equal deleted inserted replaced
413:70e313aeaa91 414:0162dd315814
1 (ns com.aurellem.run.bootstrap-1 1 (ns com.aurellem.run.bootstrap-1
2 (:use (com.aurellem.gb saves gb-driver util constants 2 (:use (com.aurellem.gb saves gb-driver util constants
3 items vbm characters money)) 3 items vbm characters money
4 rlm-assembly))
4 (:use (com.aurellem.run util title save-corruption bootstrap-0)) 5 (:use (com.aurellem.run util title save-corruption bootstrap-0))
5 (:use (com.aurellem.exp item-bridge)) 6 (:use (com.aurellem.exp item-bridge))
6 (:import [com.aurellem.gb.gb_driver SaveState])) 7 (:import [com.aurellem.gb.gb_driver SaveState]))
7 8
8 (defn pc-item-writer-program
9 []
10 (let [limit 201
11 [target-high target-low] (disect-bytes-2 pokemon-list-start)]
12 (flatten
13 [[0x00 ;; (item-hack) set increment stack pointer no-op
14 0x1E ;; load limit into E
15 limit
16 0x3F ;; (item-hack) set carry flag no-op
17
18 ;; load 2 into C.
19 0x0E ;; C == 1 means input-first nybble
20 0x04 ;; C == 0 means input-second nybble
21
22 0x21 ;; load target into HL
23 target-low
24 target-high
25 0x37 ;; (item-hack) set carry flag no-op
26
27 0x00 ;; (item-hack) no-op
28 0x37 ;; (item-hack) set carry flag no-op
29
30 0x00 ;; (item-hack) no-op
31 0xF3 ;; disable interrupts
32 ;; Input Section
33
34 0x3E ;; load 0x20 into A, to measure buttons
35 0x10
36
37 0x00 ;; (item-hack) no-op
38 0xE0 ;; load A into [FF00]
39 0x00
40
41 0xF0 ;; load 0xFF00 into A to get
42 0x00 ;; button presses
43
44 0xE6
45 0x0F ;; select bottom four bits of A
46 0x37 ;; (item-hack) set carry flag no-op
47
48 0x00 ;; (item-hack) no-op
49 0xB8 ;; see if input is different (CP A B)
50
51 0x00 ;; (item-hack) (INC SP)
52 0x28 ;; repeat above steps if input is not different
53 ;; (jump relative backwards if B != A)
54 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
55
56 0x47 ;; load A into B
57
58 0x0D ;; dec C
59 0x37 ;; (item-hack) set-carry flag
60 ;; branch based on C:
61 0x20 ;; JR NZ
62 23 ;; skip "input second nybble" and "jump to target" below
63
64 ;; input second nybble
65
66 0x0C ;; inc C
67 0x0C ;; inc C
68
69 0x00 ;; (item-hack) no-op
70 0xE6 ;; select bottom bits
71 0x0F
72 0x37 ;; (item-hack) set-carry flag no-op
73
74 0x00 ;; (item-hack) no-op
75 0xB2 ;; (OR A D) -> A
76
77 0x22 ;; (do (A -> (HL)) (INC HL))
78
79 0x1D ;; (DEC E)
80
81 0x00 ;; (item-hack)
82 0x20 ;; jump back to input section if not done
83 0xDA ;; literal -36 == TM 18 (counter)
84 0x01 ;; (item-hack) set BC to literal (no-op)
85
86 ;; jump to target
87 0x00 ;; (item-hack) these two bytes can be anything.
88 0x01
89
90 0x00 ;; (item-hack) no-op
91 0xBF ;; (CP A A) ensures Z
92
93 0xCA ;; (item-hack) jump if Z
94 target-low
95 target-high
96 0x01 ;; (item-hack) will never be reached.
97
98 ;; input first nybble
99 0x00
100 0xCB
101 0x37 ;; swap nybbles on A
102
103 0x57 ;; A -> D
104
105 0x37 ;; (item-hack) set carry flag no-op
106 0x18 ;; relative jump backwards
107 0xCD ;; literal -51 == TM05; go back to input section
108 0x01 ;; (item-hack) will never reach this instruction
109
110 ]
111 (repeat 8 [0x00 0x01]);; these can be anything
112
113 [;; jump to actual program
114 0x00
115 0x37 ;; (item-hack) set carry flag no-op
116
117 0x2E ;; 0x3A -> L
118 0x3A
119
120
121 0x00 ;; (item-hack) no-op
122 0x26 ;; 0xD5 -> L
123 0xD5
124 0x01 ;; (item-hack) set-carry BC
125
126 0x00 ;; (item-hack) these can be anything
127 0x01
128
129 0x00
130 0xE9 ;; jump to (HL)
131 ]])))
132 9
133 (defn print-desired-item-layout [] 10 (defn print-desired-item-layout []
134 (clojure.pprint/pprint 11 (clojure.pprint/pprint
135 (raw-inventory->inventory (pc-item-writer-program)))) 12 (raw-inventory->inventory (pc-item-writer-program))))
136 13
880 [] (write-script! (launch-bootstrap-program) "control-checkpoint")) 757 [] (write-script! (launch-bootstrap-program) "control-checkpoint"))
881 758
882 (defn control-checkpoint [] 759 (defn control-checkpoint []
883 (read-script "control-checkpoint")) 760 (read-script "control-checkpoint"))
884 761
885 (defn no-consecutive-repeats? [seq]
886 (not (contains? (set(map - seq (rest seq))) 0)))
887
888 (defn byte->nybbles [byte]
889 [(bit-shift-right byte 4) (bit-and byte 0x0F)])
890
891 (defn bootstrap-pattern
892 "Given an assembly sequence, generate the keypresses required to
893 create that sequence in memory using the pc-item-writer
894 program. The assembly must not have any consecutive repeating
895 nybbles."
896 [assembly]
897 (let [nybbles (flatten (map byte->nybbles assembly))
898 moves (map (comp buttons (partial - 15)) nybbles)
899 header (map buttons
900 (concat (repeat
901 50
902 (- 15 (first nybbles)))
903 [(first nybbles)]))
904 tail (map buttons
905 (take
906 (- 201 (count moves))
907 (interleave (repeat 100 (last nybbles))
908 (repeat 1000 (- 15 (last nybbles))))))]
909 (assert (no-consecutive-repeats? nybbles))
910 (concat header moves tail)))
911
912 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF]) 762 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])
913 763
914 (defn test-pattern-writing 764 (defn test-pattern-writing
915 ([] (test-pattern-writing increasing-pattern)) 765 ([] (test-pattern-writing increasing-pattern))
916 ([pattern] 766 ([pattern]
926 0xD162 (+ 0xD162 (count pattern))) 776 0xD162 (+ 0xD162 (count pattern)))
927 (= (subvec (vec (memory (second pattern-insertion))) 777 (= (subvec (vec (memory (second pattern-insertion)))
928 0xD162 (+ 0xD162 (count pattern))) 778 0xD162 (+ 0xD162 (count pattern)))
929 pattern)))) 779 pattern))))
930 780
931 781 (defn-memo launch-main-bootstrap-program
932 782 ([] (launch-main-bootstrap-program
783 (control-checkpoint)
784 ;;(launch-bootstrap-program)
785 ))
786 ([script]
787 (->> script
788 (play-moves
789 (bootstrap-pattern (main-bootstrap-program))))))
790
791 (defn set-target-address
792 "Assumes that the game is under control of the main-bootstrap
793 program in MODE-SELECT mode, and sets the target address to which
794 jumps/writes will occur."
795 [target-address script]
796 (let [[target-high target-low] (disect-bytes-2 target-address)]
797 (->> script
798 (play-moves
799 (map buttons
800 [set-H-mode target-high 0x00
801 set-L-mode target-low 0x00])))))
802
803 (defn write-RAM
804 "Assumes that the game is under control of the main-bootstrap
805 program in MODE-SELECT mode, and rewrites RAM starting at
806 'start-address with 'new-ram."
807 [start-address new-ram script]
808 (->> script
809 (set-target-address start-address)
810 (play-moves [(buttons (count new-ram))])
811 (play-moves (map buttons new-ram))))
812
813 (defn transfer-control
814 "Assumes that the game is under control of the main-bootstrap
815 program in MODE-SELECT mode, and jumps to the target-address."
816 [target-address script]
817 (->> script
818 (set-target-address target-address)
819 (play-moves [(buttons jump-mode)])))
820
821 (defn-memo relocate-main-bootstrap
822 ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
823 ([script]
824 (let [target (+ 90 pokemon-box-1-address)]
825 (->> script
826 (write-RAM target (main-bootstrap-program target))
827 (transfer-control target)))))
828
829 (def mid-game-data
830 (subvec (vec (memory (mid-game)))
831 pokemon-list-start
832 (+ pokemon-list-start 700)))
833
834 (def mid-game-map-address 0x46BC)
835
836 (defn set-mid-game-data
837 ([] (set-mid-game-data (relocate-main-bootstrap)))
838 ([script]
839 (->> script
840 (write-RAM pokemon-list-start mid-game-data)
841 (transfer-control mid-game-map-address))))
842
843
844
845