(local pieces {0 {:curve [0 0]
                  :id 0
                  :name "T up"
                  :o 1
                  :r 3}
               1 {:curve [(- 1) nil]
                  :id 1
                  :name "T right"
                  :r 0}
               2 {:curve [1 (- 1)]
                  :id 2
                  :name "T down"
                  :o 1
                  :r 1}
               3 {:curve [1 nil]
                  :id 3
                  :name "T left"
                  :o 1
                  :r 2}
               4 {:curve [0 nil]
                  :id 4
                  :name "J left"
                  :o 1
                  :r 7}
               5 {:curve [0 0]
                  :id 5
                  :name "J up"
                  :o 1
                  :r 4}
               6 {:curve [(- 2) nil]
                  :id 6
                  :name "J right"
                  :r 5}
               7 {:curve [0 1]
                  :id 7
                  :name "J down"
                  :o 1
                  :r 6}
               8 {:curve [1 0]
                  :id 8
                  :name "Z sideways"
                  :o 1
                  :r 9}
               9 {:curve [(- 1) nil]
                  :id 9
                  :name "Z vertical"
                  :r 8}
               10 {:curve [0 nil]
                   :id 10
                   :name "square"
                   :o 1
                   :r 10}
               11 {:curve [0 (- 1)]
                   :id 11
                   :name "S sideways"
                   :o 1
                   :r 12}
               12 {:curve [1 nil]
                   :id 12
                   :name "S vertical"
                   :r 11}
               13 {:curve [0 nil]
                   :id 13
                   :name "L right"
                   :o 0
                   :r 16}
               14 {:curve [(- 1) 0]
                   :id 14
                   :name "L down"
                   :o 1
                   :r 13}
               15 {:curve [2 nil]
                   :id 15
                   :name "L left"
                   :o 1
                   :r 14}
               16 {:curve [0 0]
                   :id 16
                   :name "L up"
                   :o 1
                   :r 15}
               17 {:curve [nil nil]
                   :id 17
                   :name "I upright"
                   :r 18}
               18 {:curve [0 0 0]
                   :id 18
                   :name "I sideways"
                   :o 2
                   :r 17}})

(fn getpiece []
  (. pieces (memory.readbyte 66)))

(fn hasblock [x y]
  (not= (memory.readbyte (+ (+ 1024 x) (* y 10))) 239))

(fn rotate [piece]
  (print "rotating" (memory.readbyte 66) "to" piece.r)
  (while (not= (memory.readbyte 66) piece.r)
    (joypad.write 1 {:B true})
    (emu.frameadvance)
    (joypad.write 1 [])
    (emu.frameadvance)))

(local mismatchfactor 8)

(fn perfect? [rx p1 p2 p3]
  (or (= p1 nil)
      (and (= p2 nil) (= p1 (. rx 1)))
      (and (= p3 nil)
           (= p1 (. rx 1))
           (= (. rx 2) p2))
      (and (= p1 (. rx 1))
           (= p2 (. rx 2))
           (= p3 (. rx 3)))))

(fn positionscore [x piece relativefield absolutefield]
  (if (perfect? (. relativefield x) (unpack piece.curve))
      (- 19 (. absolutefield x))
      p3 500
      (let [p1 (or (. piece.curve 1) (. relativefield x 1))
            p2 (or (. piece.curve 2) (. relativefield x 2))]
        (* (+ (math.abs (- p1 (. (. relativefield x) 1)))
              (math.abs (- p2 (. (. relativefield x) 2))))
           mismatchfactor))))

(fn getscores [piece relativefield absolutefield]
  (let [hits []]
    (for [x 1 10]
      (tset hits x (positionscore x piece relativefield absolutefield)))
    hits))

(fn bestfor [piece relativefield absolutefield]
  (let [scores (getscores piece relativefield absolutefield)]
    (print "scores" piece.id scores)
    (var best 1)
    (each [x score (ipairs scores)]
      (when (< (. scores x) (. scores best))
        (set best x)))
    (values best (. scores best))))

(fn findtargetx [piece relativefield absolutefield]
  (var (bestpiece bestscore bestx) (values piece 100 1) tried [])
  (while (not (. tried piece))
    (let [(x score) (bestfor piece relativefield absolutefield)]
      (when (< score bestscore)
        (set (bestpiece bestscore bestx) (values piece score x))))
    (tset tried piece true)
    (set piece (. pieces piece.r)))
  (while (not= bestpiece (getpiece))
    (rotate (getpiece)))
  bestx)

(fn byteforcell [x y]
  (+ (- (+ 1024 x) 1) (* 10 (- y 1))))

(fn calculatefieldshape []
  (let [absolute []
        relativefield []]
    (for [x 1 10 1]
      (tset absolute x 21)
      (for [y 1 20]
        (let [cell (memory.readbyte (byteforcell x y))]
          (when (not= cell 239)
            (tset absolute x y)
            (lua "break")))))
    (for [x 1 10]
      (local this (. absolute x))
      (local nextone (or (. absolute (+ x 1)) 0))
      (local nextnext (or (. absolute (+ x 2)) 0))
      (tset relativefield x [(- nextone this) (- nextnext nextone)]))
    (values relativefield absolute)))

(fn newpiece [piece y]
  (let [(relativefield absolutefield) (calculatefieldshape)]
    (print "Field:" relativefield)
    (global targetx (findtargetx piece relativefield absolutefield))))

(fn movetotarget [x targetx]
  (if (= x targetx)
      (joypad.write 1 {:down true})
      (and targetx (< x targetx))
      (joypad.write 1 {:right true})
      (and targetx (> x targetx))
      (joypad.write 1 {:left true})))

(var prevy 20)

(fn isnewpiece [y]
  (> prevy y))

(while true
  (when (= (memory.readbyte 72) 1)
    (local piece (getpiece))
    (local x (- (+ (memory.readbyte 64) 1) (or piece.o 0)))
    (local y (+ (memory.readbyte 65) 1))
    (gui.text 10 10 (string.format "Hello tetris at %s,%s: going to %s"
                                   x y (or targetx "")))
    (when (isnewpiece y)
      (print "NEW PIECE" (memory.readbyte 66))
      (newpiece piece y))
    (movetotarget x targetx)
    (set prevy y))
  (emu.frameadvance))

Generated by Phil Hagelberg using scpaste at Wed Sep 9 21:26:42 2020. PDT. (original)