First prototype...

Palette works, but the instruction execution loop doesn't.
Needs further research.

Sound and keys are not implemented either.

5 files changed, 196 insertions, 0 deletions

diff --git a/bytepusher.scm b/bytepusher.scm
new file mode 100644
index 0000000..19cdeae
--- /dev/null
+++ b/bytepusher.scm
@@ -0,0 +1,188 @@
+(define-module (bytepusher)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (sdl2)
+  #:use-module (sdl2 render)
+  #:use-module (sdl2 surface)
+  #:use-module (sdl2 events)
+  #:use-module (sdl2 video)
+  #:use-module (sdl2 rect)
+  #:use-module (sdl2 image))
+
+(define width  256)
+(define height 256)
+
+(define keys (make-bitvector 16 #f))
+
+(define memory (make-bytevector (* 1024 1024 16)))
+
+
+;; key control ----
+(define (set-key! index)
+  (bitvector-set-bit! keys index))
+
+(define (clear-keys!)
+  (bitvector-clear-all-bits! keys))
+
+(define (keys->half)
+  (let loop ((i 0)
+             (acc 0))
+    (if (= i (bitvector-length keys))
+      acc
+      (loop (+ 1 i)
+            (+ acc (if (bitvector-bit-set? keys i) (expt 2 i) 0))))))
+;; ---- key control
+
+
+;; memory ----
+
+(define (get-pc)
+  (+ (bytevector-u16-ref memory 3 (endianness big))
+     (ash (bytevector-u8-ref memory 2) 16)))
+
+(define (set-pc! value)
+  (let ((pc value))
+    (bytevector-u16-set! memory 2 (ash pc -8)  (endianness big))
+    (bytevector-u8-set!  memory 4 (ash pc -16))))
+
+(define (get-addr pos)
+  (+ (bytevector-u16-ref memory (+ 1 pos) (endianness big))
+     (ash (bytevector-u8-ref memory pos) 16)))
+
+(define (get-initial-pixel)
+  (ash (bytevector-u8-ref memory 5) 16))
+
+(define (get-sample)
+  (bytevector-u16-ref memory 6 (endianness big)))
+
+(define (get-byte n)
+  (bytevector-u8-ref memory n))
+
+(define (set-byte! n v)
+  (bytevector-u8-set! memory n v))
+
+;; ---- memory
+
+
+;; colors ----
+
+; Only used to set the colormap, use the faster version is below
+(define (pixel->color pixel)
+  (if (> pixel 216)
+    0
+    (let* ((b (modulo pixel 6))
+           (g (modulo (/ (- pixel (modulo pixel  6))  6) 6))
+           (r (modulo (/ (- pixel (modulo pixel 36)) 36) 6)))
+      (+ #xFF (ash (* #x33 (+ (ash r 16) (ash g 8) b)) 8)))))
+
+(define colormap
+  (uint-list->bytevector
+    (map pixel->color (iota 256))
+    (endianness big)
+    4))
+
+(define (pixel->color-fast pixel)
+  (bytevector-u32-ref colormap (* 4 pixel) (endianness big)))
+
+;; ---- colors
+
+
+;; debug ----
+(define (get-pixels)
+  (let* ((initial   (get-initial-pixel))
+         (len       (* width height))
+         (base      (make-bytevector len)))
+    (bytevector-copy! memory initial base 0 len)
+    (uint-list->bytevector
+      (map pixel->color-fast (bytevector->u8-list base))
+      (endianness big)
+      4)))
+
+(define (peek-memory start end)
+  (for-each (lambda (i) (display "0x")
+              (display (number->string i 16))
+              (newline))
+            (take (drop (bytevector->u8-list memory) start) (- end start))))
+
+(define (display-state)
+  (sdl-init)
+  (call-with-window
+    (make-window #:title "BytePusher"
+                 #:size (list (* 4 width) (* 4 height)))
+    (lambda (w)
+      (call-with-renderer
+        (make-renderer w)
+        (lambda (renderer)
+          (set-renderer-scale! renderer 4 4)
+          (clear-renderer renderer)
+          (render-copy renderer
+                       (surface->texture
+                         renderer
+                         (bytevector->surface (get-pixels)
+                                              width
+                                              height
+                                              32
+                                              (* width 4))))
+          
+          (present-renderer renderer)
+          (sleep 10)))))
+  (sdl-quit))
+;; ---- debug
+
+
+;; main operation ----
+
+(define (load-program! path)
+  (call-with-input-file path
+    (lambda (p)
+      (let ((program (get-bytevector-all p)))
+        (bytevector-copy! program 0 memory 0 (bytevector-length program))))))
+
+(define (execute! instruction-addr)
+  (let ((a (get-addr (+ 0 instruction-addr)))
+        (b (get-addr (+ 3 instruction-addr)))
+        (c (get-addr (+ 6 instruction-addr))))
+    (set-byte! b (get-byte a))
+    (set-pc! c)))
+
+(define (loop-frame!)
+  (let loop ((count 65536))
+      (execute! (get-pc))
+      (unless (= count 0) (loop (- count 1)))))   
+
+(define (loop! renderer)
+  (set-renderer-scale! renderer 4 4)
+  (let loop ()
+    (let ((t0 (sdl-ticks)))
+      (loop-frame!)
+      (clear-renderer renderer)
+      ;; TODO: Too many copies, improve upstream in Guile-SDL2
+      (render-copy renderer
+                   (surface->texture
+                     renderer
+                     (bytevector->surface (get-pixels)
+                                          width
+                                          height
+                                          32
+                                          (* width 4))))
+      (present-renderer renderer)
+      (let ((t1 (sdl-ticks)))
+        (unless (> t1 (+ t0 1000/60))
+          (usleep (floor (* 1000 (- (+ t0 1000/60) t1))))))
+      (display (string-append
+                 "FPS: "
+                 (number->string
+                   (exact->inexact (/ 1000 (- (sdl-ticks) t0)))) "\n")))
+    (loop)))
+
+(define (main)
+  (load-program! "tests/palette.bp")
+  (sdl-init)
+  (call-with-window (make-window #:title "BytePusher"
+                                 #:size (list (* 4 width) (* 4 height)))
+    (lambda (w)
+      (call-with-renderer (make-renderer w) loop!)))
+  (sdl-quit))
+
+;; ---- main operation
diff --git a/manifest.scm b/manifest.scm
new file mode 100644
index 0000000..54d99a5
--- /dev/null
+++ b/manifest.scm
@@ -0,0 +1 @@
+(specification->manifest (list "guile" "guile-sdl2"))
diff --git a/tests/README.md b/tests/README.md
new file mode 100644
index 0000000..a729c09
--- /dev/null
+++ b/tests/README.md
@@ -0,0 +1,7 @@
+These tests are not written by myself. They are obtained from:
+
+https://esolangs.org/wiki/BytePusher
+
+I do not hold any copyright on them, and I don't know their license, but I'll
+keep them still, as they are found freely in the internet, shared by the
+author.
diff --git a/tests/nyan.bp b/tests/nyan.bp
new file mode 100644
index 0000000..b7b4400
--- /dev/null
+++ b/tests/nyan.bp
diff --git a/tests/palette.bp b/tests/palette.bp
new file mode 100644
index 0000000..06f1e03
--- /dev/null
+++ b/tests/palette.bp