;;;; "Advanced Choreography" -- this is the final video for this project.

 

 (ns com.aurellem.run.adv-choreo

   (:use (com.aurellem.gb saves gb-driver util constants

                          items vbm characters money

                          rlm-assembly))

   (:use (com.aurellem.run util music title save-corruption

                           bootstrap-0 bootstrap-1 image

                           ram-display final-cut basic-choreo))

   (:require clojure.string)

   (:import java.awt.image.BufferedImage)

   (:import (javax.imageio ImageWriteParam IIOImage ImageIO))

   (:import [com.aurellem.gb.gb_driver SaveState])

   (:import java.io.File))

 

 

 

 ;; Use the gameboy's screen to display the new programming

 ;; instead of a side window. This will make it look much

 ;; cooler and create a terminal-like effect as the game is

 ;; being reprogramed. To do this, use a fixed data entry

 ;; region in ram, and run a program that translates this

 ;; region into the screen. Every time this data entry region

 ;; is full, run a program that copies the data to the

 ;; appropriate region in memory. This will cost ~15 seconds

 ;; at the beginning to set up, and then should have minimal

 ;; overhead (~5%) for the rest of the data transfer, but

 ;; will have a good psychological effect for the viewer

 ;; since he can see that something is actually happening in

 ;; the game.

 

 

 ;; Symbol size and type.

 

 ;; use fonts from zophar's domain:

 ;; http://www.zophar.net/utilities/fonts/8x8-font-archive.html

 

 ;; Green font on black background for matrix look.

 

 

 (defn program-data [base-address]

   (let [image-program

         (display-image-kernel

          base-address

 

          pinkie-pie-mark

          ;;test-image-color

          )

          

 

         music-base-address (+ (count image-program) base-address)

 

         initial-music-data

         (midi-bytes pony-csv 0 0 0 0)

         

         data-lengths

         (map (comp count :data)

                    [(:kernel  initial-music-data)

                     (:voice-1 initial-music-data)

                     (:voice-2 initial-music-data)]);; noise not needed

         addresses

         (map (partial + music-base-address) (reductions + 0 data-lengths))

 

         final-music-data

         (apply (partial midi-bytes pony-csv) addresses)

 

         music-program

         (concat

          (:data (:kernel  final-music-data))

          (:data (:voice-1 final-music-data))

          (:data (:voice-2 final-music-data))

          (:data (:noise   final-music-data)))]

 

     (concat

      image-program ;; image program falls through to music program

      music-program)))

 

 (def glyphs

   "The sixteen 8x8 glyphs which make up the \"terminal\" font."

   (mapv #(ImageIO/read

           (File. user-home (str "proj/vba-clojure/font/" % ".png")))

         ["0" "1" "2" "3" "4" "5" "6" "7" "8"

          "9" "A" "B" "C" "D" "E" "F" "_"]))

 

 

 (defn glyph-init-program

   [start-address]

   (let [zero-glyph (image->gb-image (glyphs 0))

         

         ;; write same pallet information to all pallettes

         A (flatten

            [(write-byte LCD-control-register 0x00);; disable LCD protection

             (set-palettes bg-palette-select bg-palette-data

                           (repeat 8 (first (:palettes zero-glyph))))

             (select-LCD-bank 0)

             (write-byte SCX-register 0)

             (write-byte SCY-register 0)])

         B (flatten

            [(write-data 

              (+ start-address (count A))

              character-data-address

              (flatten

               (map (comp gb-tile->bytes first :tiles image->gb-image)

                    glyphs)))

 

             

             (write-byte

              LCD-control-register

              (Integer/parseInt

               (str

                "1"  ;; LCDC on/off

                "0"  ;; Window code area

                "0"  ;; Windowing on?

                "1"  ;; BG tile base (1 = 0x8000)

                "0"  ;; BG-1 or BG-2 ?

                "0"  ;; OBJ-block composition

                "0"  ;; OBJ-on flag 

                "1") ;; no-effect 

               2))])]

     (concat A B )))

 

 

  

 (defn glyph-display-program

   [start-address]

   (let [data-start (+ 2 start-address)

         load-data

         (flatten

          [;; data region

           0x18

           2

           0 0;; current row and column

           ;; save all registers

           0xC5 0xD5 0xE5 0xF5

 

           ;; load data from data region into registers

 

           0xF5 ;; push A, which contains current glyph

 

           0x21

           (reverse (disect-bytes-2 data-start))

           ;; load row and column into DE

           0x2A 0x57 ;; row -> D

           0x2A 0x5F ;; column -> E

           ])

 

 

         display-glyph

         (let [init*

               (flatten

                [;; clear screen if we are at 0,0

                 0x7A 0xB3 ;; D->A, OR E A ==> (= D E 0)

                 0x20 ;; skip clear-screen if D and E are not both zero

                 :clear-screen-length])

 

               clear-screen

               (flatten

                [;; save all registers

                 0xC5 0xD5 0xE5 0xF5

 

                 (select-LCD-bank 0)

                 ;; write 0x00 to memory locations

                 ;; 0x9800 to 0x9A34

                 0x21

                 0x00 0x98 ;; load 0x9800 into HL

                 

                 0x16 3 ;; 3 -> D

                 0x1E 190 ;; 190 -> E

 

                 ;; Empty space Character ID

                 0x3E 16 ;; 0-> A

 

                 ;; begin of do-while loop

                    0x22 ;; load A to 0x9800

                    0x1D ;; dec E

                    0x20

                    (->signed-8-bit -4)

                    0x15 ;; dec D

                    0x1E 190 ;; 188 -> E

                    0x20

                    (->signed-8-bit -8)

                 ;; end of do-while-loop

 

                 ;; restore all registers

                 0xF1 0xE1 0xD1 0xC1])

 

               

               increment-row-column

               [;; D contains row and E contains column

                

                ;; every time column (E) reaches 20, set

                ;; column to 0 and increment row

                0x1C ;; inc E

                0x3E 20 0xBB ;; compare E to 20

                0x20

                3

                0x14 ;; increment row

                0x1E 0 ;; set column to 0

                

 

                ;; if row==18, set row to 0

                0x3E 18

                0xBA

                0x20

                2

                0x16 0] 

                

               set-HL-from-row-and-column

               (flatten

               [;; formula for memory offset is:

                ;; (+ 0x9800 (* 32 row) column) == 

                0x21 0x00 0x98 ;; load HL with 0x9800

                

                0x06 0

                0x4B  ;; columns (E) -> BC

                0x09  ;; HL += columns

 

 

                0xAF ;; 0 -> A

                

                0x06 0

                0x0E 32     ;; load 32 into BC

 

                0xBA ;; CP A D

                0x28 ;; skip this next section if A == D

                4

                0x09 ;; HL += 32

                0x3C

                0x18

 

                (->signed-8-bit -7)])

               

               render-glyph

               (flatten

                [;; Render each nybble of A as a character

                 ;; there are two characters to a glyph.

 

                 set-HL-from-row-and-column

 

                 0xF1 ;; pop A, now A is equal to key input

                 0xF5 ;; save A

 

                 0xE6 0xF0 ;; clear second nybble

                 0xCB 0x37 ;; swap nybbles

                 0x77 ;; store A in video RAM as a character (pun)

                 increment-row-column

 

 

                 set-HL-from-row-and-column

 

                 0xF1 ;; restore A

                 0xE6 0x0F ;; select second nybble

                 0x77 ;; store second nybble as character

                 increment-row-column])

 

               

               init (replace

                     {:clear-screen-length (count clear-screen)} init*)

               ]

           

               (concat init clear-screen render-glyph))

               

         cleanup

         ;; restore all registers

         (flatten

          [;; Reset HL to initial data-start value

           0x21

           (reverse (disect-bytes-2 data-start))

           ;;0x23

           ;; write variables

           0x7A 0x22 ;; D -> rows       -> to RAM

           0x7B 0x22 ;; E -> columns

           ])

          

         stack-cleanup

         [0xF1 0xE1 0xD1 0xC1]

         ]

     (concat load-data

             display-glyph

             cleanup stack-cleanup)))

 

 (def main-program-base-address 0xC000)

 

 (defn glyph-bootstrap-program

   [start-address delay-count total-glyph-count]

   (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B

         header (concat  (frame-metronome) (read-user-input))

 

         glyph-display (glyph-display-program

                        (+ (count init)

                           (count header)

                           start-address))

 

         state-machine-start-address

         (+ start-address (count init) (count header) (count glyph-display))

         state-machine

         (bootstrap-state-machine state-machine-start-address)

         

         return-to-header

         (flatten 

          [0xC3

           (reverse  (disect-bytes-2

                      (+ (count init) start-address)))])]

     (concat init header glyph-display state-machine return-to-header)))

 

 (defn-memo begin-glyph-bootstrap

   ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))

   ([script]

      (let [glyph-init (glyph-init-program relocated-bootstrap-start)

            main-glyph-start (+ relocated-bootstrap-start

                                    (count glyph-init))

            glyph-program (glyph-bootstrap-program

                           main-glyph-start 0 0)]

        (->> script

             (do-nothing 2)

             ;; begin glyph program

             (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music

            

             (write-RAM

              relocated-bootstrap-start

              (concat glyph-init glyph-program))

             (transfer-control relocated-bootstrap-start)

             (do-nothing 1)))))

 

 (defn-memo write-all-program-data

   ([] (write-all-program-data (begin-glyph-bootstrap)))

   ([script]

      (let [base-address main-program-base-address]

        (->> script

             (write-RAM base-address (program-data base-address))))))

 

 (defn-memo activate-program

   ([] (activate-program (write-all-program-data)))

   ([script]

      (->> script

           (transfer-control main-program-base-address)

           (do-nothing 1800)

           (play-moves [[:a]]))))

 

 (def advanced-render-dir

   (File. user-home "proj/vba-clojure/render/advanced"))

 

 (defn advanced-steps [] (first (activate-program)))

 

 (def gb-button-bar

   (File. user-home "/proj/vba-clojure/images/gb-button-bar.png"))

 

 (def gb-button-mark

   (File. user-home "/proj/vba-clojure/images/gb-button-mark.png"))

 

 (defn adv-write-move-image! [move target-file]

   (let [buttons (set move)

         key-positions

         {:l [23 23]

          :u [33 11]

          :r [46 23]

          :d [33 36]

          

          :start  [65 24]

          :select [80 24]

 

          :b  [100 25]

          :a  [121 25]}]

     (let [command

           (flatten 

            ["convert"

             (.getCanonicalPath gb-button-bar)

             (map

              (fn [key]

                (let [[x y] (key-positions key)]

                  [(.getCanonicalPath gb-button-mark)

                   "-geometry" (str "+" x "+" y) "-composite"]))

              move)

             (.getCanonicalPath target-file)])]

       (apply  clojure.java.shell/sh command))))

 

 (defn adv-composite-frames-command

   [move-image screenshot target]

   ["convert"

    screenshot

    move-image "-append"

    target])

 

 (defn adv-generate-composite-frames!

   [^File rendered-dir]

   (let [final-frames (File. rendered-dir "final")

         _ (.mkdir final-frames)

         move-images (file-names (File. rendered-dir "moves"))

         screenshots (file-names (File. rendered-dir "frames"))

         targets (map #(.getCanonicalPath

                        (File. final-frames (format "%07d.png" %)))

                      (range (count screenshots)))]

     (dorun

      (map

       (comp

        (partial apply clojure.java.shell/sh)

        flatten

        (partial apply adv-composite-frames-command)

        (fn [a b  d] (println d) [a b d]))

       move-images screenshots targets))))

 

 (defn write-advanced-script!

   [] (write-script! (activate-program) "advanced"))

                     

 (defn advanced-script []

   (read-script "advanced"))

 

 (defn advanced-step-1! []

   (render-files!

    advanced-render-dir

    adv-write-move-image!

    false

    (root) (first (advanced-script))))

 

 (defn advanced-step-2! []

   (adv-generate-composite-frames!

    advanced-render-dir))

 

 (defn advanced-step-3! [] (final-cut! advanced-render-dir))

 

 

 

 

 ;; possible screen writing programs

 

 ;; (program needs to stop executing at some point)

 ;; maybe have total length counter or something?

 

 ;; automatic counter that reads from program-start and clears the

 ;; screen every 360 (* 18 20) gliphs

 

 ;; advantages -- very simple and low bandwidth

 ;; disadvantages -- hard to align counter

 

 ;; implementation -- refactor main-bootstrap-program to provide a

 ;; state-machine code-section which can be recombined into another

 ;; program.