Mercurial > vba-clojure

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

     2 

     3 (ns com.aurellem.run.adv-choreo

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

     5                          items vbm characters money

     6                          rlm-assembly))

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

     8                           bootstrap-0 bootstrap-1 image

     9                           ram-display final-cut basic-choreo))

    10   (:require clojure.string)

    11   (:import java.awt.image.BufferedImage)

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

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

    14   (:import java.io.File))

    15 

    16 

    17 

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

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

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

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

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

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

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

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

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

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

    28 ;; will have a good psychological effect for the viewer

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

    30 ;; the game.

    31 

    32 

    33 ;; Symbol size and type.

    34 

    35 ;; use fonts from zophar's domain:

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

    37 

    38 ;; Green font on black background for matrix look.

    39 

    40 

    41 (defn program-data [base-address]

    42   (let [image-program

    43         (display-image-kernel

    44          base-address

    45 

    46          ;;pinkie-pie-mark

    47          test-image-color

    48 

    49          )

    50          

    51 

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

    53 

    54         initial-music-data

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

    56         

    57         data-lengths

    58         (map (comp count :data)

    59                    [(:kernel  initial-music-data)

    60                     (:voice-1 initial-music-data)

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

    62         addresses

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

    64 

    65         final-music-data

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

    67 

    68         music-program

    69         (concat

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

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

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

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

    74 

    75     (concat

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

    77 

    78      (infinite-loop) 

    79      ;;music-program

    80 

    81      )))

    82 

    83 

    84 

    85 

    86 (def glyphs

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

    88   (mapv #(ImageIO/read

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

    90           ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))

    91 

    92 (defn glyph-init-program

    93   [start-address]

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

    95         

    96         ;; write same pallet information to all pallettes

    97         A (flatten

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

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

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

   101             (select-LCD-bank 0)

   102             (write-byte SCX-register 0)

   103             (write-byte SCY-register 0)])

   104         B (flatten

   105            [(write-data 

   106              (+ start-address (count A))

   107              character-data-address

   108              (flatten

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

   110                    glyphs)))

   111 

   112             

   113             (write-byte

   114              LCD-control-register

   115              (Integer/parseInt

   116               (str

   117                "1"  ;; LCDC on/off

   118                "0"  ;; Window code area

   119                "0"  ;; Windowing on?

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

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

   122                "0"  ;; OBJ-block composition

   123                "0"  ;; OBJ-on flag 

   124                "1") ;; no-effect 

   125               2))])]

   126     (concat A B )))

   127 

   128 

   129  

   130 (defn glyph-display-program

   131   [start-address]

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

   133         load-data

   134         (flatten

   135          [;; data region

   136           0x18

   137           4

   138           0 0 0 0;; current row and column

   139           ;; save all registers

   140           0xC5 0xD5 0xE5 0xF5

   141 

   142           ;; load data from data region into registers

   143 

   144           0xF5 ;; push A, which contains current glyph

   145 

   146           0x21

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

   148           ;; load row and column into DE

   149           0x2A 0x57 ;; row -> D

   150           0x2A 0x5F ;; column -> E

   151 

   152 

   153           ])

   154 

   155 

   156         display-glyph

   157         (let [init*

   158               (flatten

   159                [(repeat 100 0)

   160                 ;; Reset HL to initial value

   161 

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

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

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

   165                 :clear-screen-length])

   166 

   167               clear-screen

   168               (flatten

   169                [;; save all registers

   170                 0xC5 0xD5 0xE5 0xF5

   171 

   172                 (select-LCD-bank 0)

   173                 ;; write 0x00 to memory locations

   174                 ;; 0x9800 to 0x9A34

   175                 0x21

   176                 0x00 0x98 ;; load 0x9800 into HL

   177 

   178                 

   179                 0x16 3 ;; 3 -> D

   180                 0x1E 190 ;; 188 -> E

   181 

   182                 0x3E 0 ;; 0-> A

   183 

   184                 ;; begin of do-while loop

   185                    0x22 ;; load 0 to 0x9800

   186                    0x1D ;; dec E

   187                    0x20

   188                    (->signed-8-bit -4)

   189                    0x15 ;; dec D

   190                    0x1E 190 ;; 188 -> E

   191                    0x20

   192                    (->signed-8-bit -8)

   193                 ;; end of do-while-loop

   194 

   195                 ;; restore all registers

   196                 0xF1 0xE1 0xD1 0xC1])

   197 

   198               ;; RLM: for TESTING ONLY!!!

   199               clear-screen (repeat 10 0)

   200               increment-row-column

   201               [;; D contains row and E contains column

   202                

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

   204                ;; column to 0 and increment row

   205                0x1C ;; inc E

   206                0x3E 20 0xBB ;; compare E to 20

   207                0x20

   208                3

   209                0x14

   210                0x1E 0

   211                

   212 

   213                0x3E 18

   214                0xBA

   215                0x20

   216                2

   217                0x16 0

   218 

   219                ;; 0x00 ;;0x1C ;; inc E

   220                ;; 0x3E 20 0xBB ;; compare E to 20

   221                ;; 0x20 ;; if E is 20

   222                ;;   3

   223                ;;   0x1E 0 ;; set E to zero

   224                ;;   0x00; 0x14   ;; (inc D) -> D

   225 

   226                ;; ;; every time row (D) reaches 18, set row to 0                

   227                ;; 0x3E 18 0xBA ;; compare D to 18

   228                ;; 0x20 ;; if D is 18

   229                ;;   2

   230                ;;   0x16 0

   231                ;; set D to zero

   232                ] 

   233                

   234               set-HL-from-row-and-column

   235               (flatten

   236               [;; formula for memory offset is:

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

   238                ;; (+ 0x97E0 (* 32 (+ 1 row)) column)

   239                0xD5 ;; push DE

   240 

   241                ;; RLM: this should be 0x9800, investigate

   242                0x21 0x00 0x98 ;; load HL with something

   243                

   244                0x06 0

   245                0x4B  ;; columns (E) -> BC

   246                0x09  ;; HL += columns

   247 

   248 

   249                0xAF ;; 0 -> A

   250                

   251                0x06 0

   252                0x0E 32     ;; load 32 into BC

   253 

   254                0xBA ;; CP A D

   255                0x20

   256                4

   257                ;;(+ 32 3)

   258                0x09 ;; HL += 32

   259                ;;(repeat 32 0x23)

   260                0x3C

   261                0x18

   262                ;;(->signed-8-bit (+ -6 -32))

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

   264                ;; 0x14 ;; inc D to handle case where D == 0

   265                ;; ;; D will never be > 20, so this will never overflow.

   266 

   267                ;; ;; do 

   268                ;;   0x09 ;; HL += 32

   269                ;;   0x15 ;; dec D

   270                ;; ;; while D != 0

   271                ;; 0x20 

   272                ;; (->signed-8-bit -4)

   273                

   274                0xD1 ;; pop DE

   275                ])

   276               

   277               render-glyph

   278               (flatten

   279                [;; Render each nybble of A as a character

   280                 ;; there are two characters to a glyph.

   281                 0x21

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

   283                 ;; load row and column into DE

   284                 0x2A 0x57 ;; row -> D

   285                 0x2A 0x5F ;; column -> E

   286 

   287                 

   288                 set-HL-from-row-and-column

   289 

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

   291                 0x3E 0xFF ;; RLM: TESTING set A = 0xFF

   292                 0xF5 ;; save A

   293 

   294                 0xE6 0xF0 ;; clear second nybble

   295                 0xCB 0x37 ;; swap nybbles

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

   297                 increment-row-column

   298 

   299 

   300                 set-HL-from-row-and-column

   301 

   302                 0xF1 ;; restore A

   303                 0xE6 0x0F ;; select second nybble

   304                 0x77 ;; store second nybble as character

   305                 increment-row-column

   306                  ])

   307 

   308               

   309               init (replace

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

   311               ]

   312           

   313               (concat init clear-screen render-glyph))

   314               

   315         cleanup

   316         ;; restore all registers

   317         (flatten

   318          [;; Reset HL to initial data-start value

   319           0x44 0x4D ;;HL -> BC

   320           

   321           0x21

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

   323           ;;0x23

   324           ;; write variables

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

   326           0x7B 0x22 ;; E -> columns

   327 

   328           0x78 0x22 ;; RLM: testing store HL

   329           0x79 0x22

   330 

   331 

   332           ])

   333          

   334         stack-cleanup

   335         [0xF1 0xE1 0xD1 0xC1]

   336         ]

   337     (concat load-data

   338             display-glyph

   339             cleanup stack-cleanup)))

   340 

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

   342 

   343 (defn glyph-bootstrap-program

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

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

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

   347 

   348         glyph-display (glyph-display-program

   349                        (+ (count init)

   350                           (count header)

   351                           start-address))

   352                        ;;(- (count (program-data 0)) 100))

   353 

   354         state-machine-start-address

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

   356         state-machine

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

   358         

   359         return-to-header

   360         (flatten 

   361          [0xC3

   362           (reverse  (disect-bytes-2

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

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

   365 

   366 

   367 

   368 (defn-memo begin-glyph-bootstrap

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

   370   ([script]

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

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

   373                                    (count glyph-init))

   374            glyph-program (glyph-bootstrap-program

   375                           main-glyph-start 0 0)]

   376        (->> script

   377             (do-nothing 2)

   378             ;; begin glyph program

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

   380            

   381             (write-RAM

   382              relocated-bootstrap-start

   383              (concat glyph-init glyph-program))

   384             (transfer-control relocated-bootstrap-start)

   385             (do-nothing 1)

   386 

   387             ))))

   388 

   389 (defn write-all-program-data

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

   391   ([script]

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

   393        (->> script

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

   395 

   396 (defn activate-program

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

   398   ([script]

   399      (->> script

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

   401           ;;(do-nothing 1800)

   402           (do-nothing 50)

   403           )))

   404 

   405 

   406 ;; possible screen writing programs

   407 

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

   409 ;; maybe have total length counter or something?

   410 

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

   412 ;; screen every 360 (* 18 20) gliphs

   413 

   414 ;; advantages -- very simple and low bandwidth

   415 ;; disadvantages -- hard to align counter

   416 

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

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

   419 ;; program.
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 01 Sep 2012 09:43:19 -0500
parents	5f09601abe8c
children	21e4ab461506