git @ Cat's Eye Technologies SixtyPical / 0850162
Improve game slightly. Add foldRoutine*, use in checker. Cat's Eye Technologies 8 years ago
4 changed file(s) with 77 addition(s) and 31 deletion(s). Raw diff Collapse all Expand all
+1
-0
README.markdown less more
182182 * `jsr (vector)`
183183 * `jmp routine`
184184 * insist on EOL after each instruction. need spacesWOEOL production
185 * `copy immediate word`
+43
-24
eg/game.60p less more
1717 ; ---------
1818
1919 reserve vector save_cinv
20
2021 assign word position $fb
22 assign word new_position $fd
23
2124 reserve word delta
2225 reserve byte value
2326 reserve word compare_target
4447 sta (position), y
4548 jsr read_stick
4649 jsr advance_pos
50 jsr check_new_position_in_bounds
51 if bcs {
52 jsr install_new_position
53 } else { }
4754
48 lda #$07 ; just past bottom of screen
49 sta >compare_target
50 lda #$e8
51 sta <compare_target
52 jsr compare_pos
53
54 if bcs {
55 jsr reset_position
56 } else {
57
58 lda #$04
59 sta >compare_target
60 lda #$00
61 sta <compare_target
62 jsr compare_pos
63
64 if bcc {
65 jsr reset_position
66 } else { }
67 }
6855 jmp (save_cinv)
6956 }
7057
7966 clc
8067 lda <position
8168 adc <delta
82 sta <position
69 sta <new_position
8370 lda >position
8471 adc >delta
72 sta >new_position
73 }
74
75 routine install_new_position {
76 lda <new_position
77 sta <position
78 lda >new_position
8579 sta >position
8680 }
8781
88 routine compare_pos {
89 lda >position
82 routine check_new_position_in_bounds {
83 lda #$07 ; just past bottom of screen
84 sta >compare_target
85 lda #$e8
86 sta <compare_target
87 jsr compare_new_pos
88
89 if bcs {
90 clc
91 } else {
92
93 lda #$04
94 sta >compare_target
95 lda #$00
96 sta <compare_target
97 jsr compare_new_pos
98
99 if bcc {
100 clc
101 } else {
102 sec
103 }
104 }
105 }
106
107 routine compare_new_pos {
108 lda >new_position
90109 cmp >compare_target
91110 if beq {
92 lda <position
111 lda <new_position
93112 cmp <compare_target
94113 } else {
95114 }
+6
-6
src/SixtyPical/Checker.hs less more
3737
3838 noUseOfUndeclaredRoutines p@(Program decls routines) =
3939 let
40 mappedProgram = mapProgramRoutines (checkInstr) p
40 undeclaredRoutines = foldProgramRoutines (checkInstr) 0 p
4141 in
42 mappedProgram == p
42 undeclaredRoutines == 0
4343 where
4444 routineNames = declaredRoutineNames p
4545 -- TODO also check COPYROUTINE here
46 checkInstr j@(JSR routName) =
46 checkInstr j@(JSR routName) acc =
4747 case routName `elem` routineNames of
48 True -> j
49 False -> (COPY A A)
50 checkInstr other = other
48 True -> acc
49 False -> error ("undeclared routine '" ++ routName ++ "'") -- acc + 1
50 checkInstr other acc = acc
5151
5252 -- -- -- -- -- --
5353
+27
-1
src/SixtyPical/Model.hs less more
124124 routineDeclared routName p =
125125 elem routName (declaredRoutineNames p)
126126
127 --
128
127129 mapBlock :: (Instruction -> Instruction) -> [Instruction] -> [Instruction]
128130 mapBlock = map
129131
136138 (mapRoutine f rout):(mapRoutines f routs)
137139
138140 mapProgramRoutines :: (Instruction -> Instruction) -> Program -> Program
139 mapProgramRoutines f (Program decls routs) = Program decls $ mapRoutines f routs
141 mapProgramRoutines f (Program decls routs) =
142 Program decls $ mapRoutines f routs
143
144 --
145
146 foldBlock :: (Instruction -> a -> a) -> a -> [Instruction] -> a
147 foldBlock = foldr
148
149 foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a
150 foldRoutine f a (Routine name instrs) =
151 foldBlock f a instrs
152
153 foldRoutines :: (Instruction -> a -> a) -> a -> [Routine] -> a
154 foldRoutines f a [] = a
155 foldRoutines f a (rout:routs) =
156 let
157 z = foldRoutine f a rout
158 in
159 foldRoutines f z routs
160
161 foldProgramRoutines :: (Instruction -> a -> a) -> a -> Program -> a
162 foldProgramRoutines f a (Program decls routs) =
163 foldRoutines f a routs
164
165 --
140166
141167 lookupDecl (Program decls _) name =
142168 lookupDecl' (filter (isLocationDecl) decls) name