puyo puyo

puyo.c7

(= puyo-board-size-x  6)
(= puyo-board-size-y  12)
(= title  "puyo puyo")
;(= width  puyo-board-size-x)
;(= height puyo-board-size-y)
(= width 35)
(= height 35)



(= macro (mac (sym params . body) 
	(list '= sym (cons 'mac (cons params body)))))

; (= macro (mac (sym params . body) 
;	(list '= sym (list 'mac params body))))
	
	
(macro func (sym params . body) (list '= sym (cons 'fn (cons params body))))
(macro when (x . body) 
	(list 'if x (cons 'do body)))
	

;NOTE calling these crashes program
(func > (left right) (< right left))
;(func >= (left right) (<= right left))

(macro ++ (x n) 
	(list '= x (list '+ x (or n 1))))
(macro -- (x n) 
	(list '= x (list '- x (or n 1))))



;for each car in lst, apply f
(func each (f lst) 
	(while lst 
		(f (car lst)) 
		(= lst (cdr lst))))
		


(macro foreach (item lst . body)
	(list 'do 
		(list 'let 'head lst)
		(list 'while 'head
			(list 'let item '(car head))
			(cons 'do body)
			(list '= 'head '(cdr head)))))
			

; get length of list
(func len (lst) 
	(let n 0) 
	(while lst 
		(= lst (cdr lst)) 
		(++ n)) 
	n)

; gets nth car, 0-based
(func nth (lst index)
	(while (< 0 index)
		(= lst (cdr lst))
		(-- index))
	(car lst))
	
(func setnth (lst index item)
	(while (< 0 index)
		(= lst (cdr lst))
		(-- index))
	(setcar lst item))

; push to head of list
(macro push (lst thing) 
	(list '= lst (list 'cons thing lst)))
	
(macro pop (lst) ;pop head off
	(list 'do
		(list 'let 'thing (list 'car lst))
		(list '= lst (list 'cdr lst))
		'thing))
		
		
; screen buffer 0x52a0
;(func clear-screen ()
	;0x52a0 = 20480 512 + 160
	;)


(func load-sprites (data)
    (let i (* 65 7 7)) ; start from "a" offset
    (each (fn (it)
        (poke (+ 0x4040 i) it)
        (++ i)
    ) data))
	
	
(func color-from-symbol (sym)
	;1 white
	;2 pink
	;3 orange	
	;4 light green
	;5 green
	;6 sky blue
	;7 purple
	(if 
		(is sym 'red)    2
		(is sym 'green)  5
		(is sym 'purple) 7
		(is sym 'orange) 3
		0))
		
(func get-rotated-dir (old-dir clockwise)
	(if clockwise
		(if 
			(is old-dir 'up)    'right
			(is old-dir 'right) 'down
			(is old-dir 'down)  'left
			(is old-dir 'left)  'up)
		(if
			(is old-dir 'up)    'left
			(is old-dir 'left)  'down
			(is old-dir 'down)  'right
			(is old-dir 'right)  'up)))
		

; doesn't check, just sets pos
(func set-puyo-pos (puyo nx ny)
	(setcar puyo nx)
	(setcar (cdr puyo) ny))
		
; NOTE this specifically doesn't check against player puyos!!!!!
(func is-occupied (x y)
	(let occupied nil)
	; first check if not out of bounds
	(if (< x 0) (= occupied t)
		(< y 0) (= occupied t)
		(<= puyo-board-size-x x) (= occupied t)
		(<= puyo-board-size-y y) (= occupied t))
	
	; if in bounds check against already 'set' puyos
	(if (not occupied)
	(foreach chain chains
		(foreach puyo chain
			(let px (nth puyo 0))	
			(let py (nth puyo 1))
			(if (and (is px x) (is py y)) (= occupied t) ;can I break out?
			))))
	occupied)
	

	

; if can't make and set puyo at pos, return nil
(func make-puyo (x y col)
	(if (is-occupied x y)	
		nil
		(list x y col)))


(func get-offset-for-puyo-rotation (dir)
	(let offset (list 0 0))
	(if (is dir 'left)  (setnth offset 0 -1)
		(is dir 'right) (setnth offset 0  1)
		(is dir 'up)    (setnth offset 1 -1)
		(is dir 'down)  (setnth offset 1  1))
	offset)
		


; if can't set either puyo, gameover
(func spawn-player ( )
	; 1 white, 2 pink, 3 orange, 4 light green, 5 green
	; 6 sky blue, 7 purple
	(let color-table (list 2 7 3 5))
	(let color-table-length (len color-table))
	(let col1 (nth color-table (rand (- color-table-length 1))))
	(let col2 (nth color-table (rand (- color-table-length 1))))
	
	(let head (make-puyo 2 1 col1))
	(let tail (make-puyo 2 2 col2))
	(when (or (not head) (not tail))
		(quit))

	(= player-dir 'down)
	(= player (list head tail)))
		

		
(func move-player-x (left)
	(let offset-x 0)
	(if (is left 'left)
		(-- offset-x)
		(++ offset-x))
	
		
	(let puyo1 (nth player 0))
	(let puyo2 (nth player 1))
		
	(let x1 (nth puyo1 0))
	(let y1 (nth puyo1 1))
	(let x2 (nth puyo2 0))
	(let y2 (nth puyo2 1))
	(++ x1 offset-x)
	(++ x2 offset-x)
	(when (and (not (is-occupied x1 y1)) (not (is-occupied x2 y2)))
		(setnth puyo1 0 x1)
		(setnth puyo2 0 x2)))

(func rotate-player (clockwise)
	(let new-dir (get-rotated-dir player-dir clockwise))
	(let offset (get-offset-for-puyo-rotation new-dir))
	(let nx (+ (nth (nth player 0) 0) (nth offset 0)))
	(let ny (+ (nth (nth player 0) 1) (nth offset 1)))

	(when (not (is-occupied nx ny))
		;(set-puyo-pos (cdr player) nx ny)
		(setnth (nth player 1) 0 nx)
		(setnth (nth player 1) 1 ny)
		(= player-dir new-dir)))



		
(func add-puyo-to-chains (puyo)
	(let x   (nth puyo 0))
	(let y   (nth puyo 1))
	(let col (nth puyo 2))
	
	; this doesn't do what I think it does
	(let puyo-chain (cons puyo nil))
	(push chains puyo) ; doing this for now just so we see puyos at least :]
)	
	
	;; okay so all we have to do is find surrounding puyo chains
	;; and append them to the puyo chain
	;; then those that we appended we must remove from the chains list
	;; and then add the puyo chain to the list
	;; but how do I easily remove specific lists from chains?
	;; NOTE get-chain-with hasn't been implemented yet
	
	;(let found-chain nil)
	;(= found-chain (get-chain-with (- x 1) y col)) ;find left
	;(when found-chain
	;	(push found-chain puyo-chain)
	;	(= last-chain-added-to found-chain))
		
	;(= found-chain (get-chain-with (+ x 1) y col)) ;find right
	;(when found-chain
	;	(push found-chain puyo-chain)
	;	(= last-chain-added-to found-chain))
		
	;(= found-chain (get-chain-with x (+ y 1) col)) ;find top
	;(when found-chain
	;	(push found-chain puyo-chain)
	;	(= last-chain-added-to found-chain))
		
	;(= found-chain (get-chain-with x (- y 1) col)) ;find bottom
	;(when found-chain
	;	(push found-chain puyo-chain)
	;	(= last-chain-added-to found-chain))	

		


(func draw-puyo (puyo)
	(let x   (nth puyo 0))
	(let y   (nth puyo 1))
	(let col (nth puyo 2))
	(color col)
	(put x y "O"))	
	


(func init ()
	(= tick 0)
	(= won nil)
	(spawn-player)
	(= chains  nil) ;each car is a chain of puyos of same color
)


(func keydown (k)
    (if
        (is k "escape") (quit)
    )
	
	
	(if player
		(if (is k "a") (move-player-x 'left)
			(is k "d") (move-player-x  'right)
			(is k "q") (rotate-player nil) ;counter clockwise
			(is k "r") (rotate-player t)   ;clockwise
			))
)

(func do-pos-match (x1 y1 x2 y2)
	(and (is x1 x2) (is y1 y2)))

(func move-puyo-down (puyo other out-landed)
	(let px (nth puyo 0))
	(let py (nth puyo 1))
	(let ox (nth other 0))
	(let oy (nth other 1))
	(++ py)
	(setnth out-landed 0 t)
	
	(func is-not-occupied (x y) (not (is-occupied x y)))
	
	(when (and (is-not-occupied px py) (not (do-pos-match px py ox oy)))
		(setnth puyo 1 py)
		(setnth out-landed 0 nil)))
		

; moves puyo all the way down
(func drop-puyo (puyo)
	(let px (nth puyo 0))
	(let py (nth puyo 1))
	(++ py)
	
	(while (not (is-not-occupied px py))
		(setnth puyo 1 py)
		(++ py)))
				


(func step ()
	;(fill 0 0 width height "z")
	 ; clear
    (color 15) (fill 0 0 width height "`")

	(when player
		 
		(when (is (% tick 14) 0)
			(let head (nth player 0))
			(let tail (nth player 1))
			(let landed (list t)) ;poor man's way of passing by reference

			; move the lower one first to avoid top "colliding" with bottom
			(if (> (nth head 1) (nth tail 1))
				(do 
					(move-puyo-down head tail landed)
					(if (car landed) (drop-puyo tail))
					(move-puyo-down tail head landed)
					(if (car landed) (drop-puyo head)))
				(do 
					(move-puyo-down tail head landed)
					(if (car landed) (drop-puyo head))	
					(move-puyo-down head tail landed))
					(if (car landed) (drop-puyo tail)))
						
			; both landed at this point
			(when (car landed)
				(add-puyo-to-chains head)
				(add-puyo-to-chains tail)
				(= player nil)
				(spawn-player)
				)
		)
			
		(when player
			(draw-puyo (nth player 0))
			(draw-puyo (nth player 1)))
	)

	;; NOTE this makes program crash
	;(foreach chain chains
	;	(foreach puyo chain
	;		(draw-puyo puyo)))
	;; so this doesn't crash...I guess I just don't know how to make these lists...
	(foreach puyo chains (draw-puyo puyo))
			
	(++ tick)
)