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         music-base-address (+ (count image-program) base-address)

    52 

    53         initial-music-data

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

    55         

    56         data-lengths

    57         (map (comp count :data)

    58                    [(:kernel  initial-music-data)

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

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

    61         addresses

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

    63 

    64         final-music-data

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

    66 

    67         music-program

    68         (concat

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

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

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

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

    73 

    74     (concat

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

    76      music-program)))

    77 

    78 (def glyphs

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

    80   (mapv #(ImageIO/read

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

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

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

    84 

    85 

    86 (defn glyph-init-program

    87   [start-address]

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

    89         

    90         ;; write same pallet information to all pallettes

    91         A (flatten

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

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

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

    95             (select-LCD-bank 0)

    96             (write-byte SCX-register 0)

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

    98         B (flatten

    99            [(write-data 

   100              (+ start-address (count A))

   101              character-data-address

   102              (flatten

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

   104                    glyphs)))

   105 

   106             

   107             (write-byte

   108              LCD-control-register

   109              (Integer/parseInt

   110               (str

   111                "1"  ;; LCDC on/off

   112                "0"  ;; Window code area

   113                "0"  ;; Windowing on?

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

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

   116                "0"  ;; OBJ-block composition

   117                "0"  ;; OBJ-on flag 

   118                "1") ;; no-effect 

   119               2))])]

   120     (concat A B )))

   121 

   122 

   123  

   124 (defn glyph-display-program

   125   [start-address]

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

   127         load-data

   128         (flatten

   129          [;; data region

   130           0x18

   131           2

   132           0 0;; current row and column

   133           ;; save all registers

   134           0xC5 0xD5 0xE5 0xF5

   135 

   136           ;; load data from data region into registers

   137 

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

   139 

   140           0x21

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

   142           ;; load row and column into DE

   143           0x2A 0x57 ;; row -> D

   144           0x2A 0x5F ;; column -> E

   145           ])

   146 

   147 

   148         display-glyph

   149         (let [init*

   150               (flatten

   151                [(repeat 100 0)

   152                 ;; Reset HL to initial value

   153 

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

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

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

   157                 :clear-screen-length])

   158 

   159               clear-screen

   160               (flatten

   161                [;; save all registers

   162                 0xC5 0xD5 0xE5 0xF5

   163 

   164                 (select-LCD-bank 0)

   165                 ;; write 0x00 to memory locations

   166                 ;; 0x9800 to 0x9A34

   167                 0x21

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

   169                 

   170                 0x16 3 ;; 3 -> D

   171                 0x1E 190 ;; 188 -> E

   172 

   173                 ;; Empty space Character ID

   174                 0x3E 16 ;; 0-> A

   175 

   176                 ;; begin of do-while loop

   177                    0x22 ;; load A to 0x9800

   178                    0x1D ;; dec E

   179                    0x20

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

   181                    0x15 ;; dec D

   182                    0x1E 190 ;; 188 -> E

   183                    0x20

   184                    (->signed-8-bit -8)

   185                 ;; end of do-while-loop

   186 

   187                 ;; restore all registers

   188                 0xF1 0xE1 0xD1 0xC1])

   189 

   190               

   191               increment-row-column

   192               [;; D contains row and E contains column

   193                

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

   195                ;; column to 0 and increment row

   196                0x1C ;; inc E

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

   198                0x20

   199                3

   200                0x14 ;; increment row

   201                0x1E 0 ;; set column to 0

   202                

   203 

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

   205                0x3E 18

   206                0xBA

   207                0x20

   208                2

   209                0x16 0] 

   210                

   211               set-HL-from-row-and-column

   212               (flatten

   213               [;; formula for memory offset is:

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

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

   216                

   217                0x06 0

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

   219                0x09  ;; HL += columns

   220 

   221 

   222                0xAF ;; 0 -> A

   223                

   224                0x06 0

   225                0x0E 32     ;; load 32 into BC

   226 

   227                0xBA ;; CP A D

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

   229                4

   230                0x09 ;; HL += 32

   231                0x3C

   232                0x18

   233 

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

   235               

   236               render-glyph

   237               (flatten

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

   239                 ;; there are two characters to a glyph.

   240 

   241                 set-HL-from-row-and-column

   242 

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

   244                 0xF5 ;; save A

   245 

   246                 0xE6 0xF0 ;; clear second nybble

   247                 0xCB 0x37 ;; swap nybbles

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

   249                 increment-row-column

   250 

   251 

   252                 set-HL-from-row-and-column

   253 

   254                 0xF1 ;; restore A

   255                 0xE6 0x0F ;; select second nybble

   256                 0x77 ;; store second nybble as character

   257                 increment-row-column])

   258 

   259               

   260               init (replace

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

   262               ]

   263           

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

   265               

   266         cleanup

   267         ;; restore all registers

   268         (flatten

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

   270           0x21

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

   272           ;;0x23

   273           ;; write variables

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

   275           0x7B 0x22 ;; E -> columns

   276           ])

   277          

   278         stack-cleanup

   279         [0xF1 0xE1 0xD1 0xC1]

   280         ]

   281     (concat load-data

   282             display-glyph

   283             cleanup stack-cleanup)))

   284 

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

   286 

   287 (defn glyph-bootstrap-program

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

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

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

   291 

   292         glyph-display (glyph-display-program

   293                        (+ (count init)

   294                           (count header)

   295                           start-address))

   296 

   297         state-machine-start-address

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

   299         state-machine

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

   301         

   302         return-to-header

   303         (flatten 

   304          [0xC3

   305           (reverse  (disect-bytes-2

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

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

   308 

   309 (defn-memo begin-glyph-bootstrap

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

   311   ([script]

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

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

   314                                    (count glyph-init))

   315            glyph-program (glyph-bootstrap-program

   316                           main-glyph-start 0 0)]

   317        (->> script

   318             (do-nothing 2)

   319             ;; begin glyph program

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

   321            

   322             (write-RAM

   323              relocated-bootstrap-start

   324              (concat glyph-init glyph-program))

   325             (transfer-control relocated-bootstrap-start)

   326             (do-nothing 1)))))

   327 

   328 (defn write-all-program-data

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

   330   ([script]

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

   332        (->> script

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

   334 

   335 (defn activate-program

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

   337   ([script]

   338      (->> script

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

   340           (do-nothing 1800))))

   341 

   342 

   343 ;; possible screen writing programs

   344 

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

   346 ;; maybe have total length counter or something?

   347 

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

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

   350 

   351 ;; advantages -- very simple and low bandwidth

   352 ;; disadvantages -- hard to align counter

   353 

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

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

   356 ;; program.
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 01 Sep 2012 10:15:04 -0500
parents	6e9368c371d5
children	ba185915c24f