• R/O
  • HTTP
  • SSH
  • HTTPS

提交

标签
No Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#windowsobjective-ccocoa誰得qtpythonphprubygameguibathyscaphec計画中(planning stage)翻訳omegatframeworktwitterdomtestvb.netdirectxゲームエンジンbtronarduinopreviewer

A categorical programming language


Commit MetaInfo

修订版44f9b79e409a4a3fea7cb1280bf0ae88707ba26f (tree)
时间2021-09-29 15:10:42
作者Corbin <cds@corb...>
CommiterCorbin

Log Message

Start drawing pictures.

更改概述

差异

--- a/cammy.sh
+++ b/cammy.sh
@@ -1,6 +1,7 @@
11 #!@bash@/bin/bash
22
3-set -eux -o pipefail
3+# set -x
4+set -eu -o pipefail
45
56 export CHICKEN_REPOSITORY_PATH=@CHICKEN_REPOSITORY_PATH@
67 export CHICKEN_INCLUDE_PATH=@CHICKEN_INCLUDE_PATH@
@@ -12,9 +13,11 @@ movelist="@movelist@/bin/movelist"
1213 # Configure a temporary directory.
1314 tmpdir=$(mktemp -d)
1415
15-# Get the hive and the program to compile.
16-hive="$1"
17-input="$2"
16+# Get the compilation mode, hive, and program to compile.
17+mode="$1"
18+printf "Compilation mode: %s\n" "$mode"
19+hive="$2"
20+input="$3"
1821
1922 fullname=$(basename -- $input)
2023 name="${fullname%.*}"
@@ -28,7 +31,7 @@ ty=$($movelist type-check <"$tmpdir/program.cammy")
2831
2932 # Compute the final piece.
3033 sed -i -e 's,case,cammy-case,g' -e 's,cons,cammy-cons,g' -e 's,map,cammy-map,g' "$tmpdir/program.cammy"
31-cat stub.scm <(echo '(cammy-run') "$tmpdir/program.cammy" <(echo "'$ty)") >"$tmpdir/$name.scm"
34+cat stub.scm <(printf '(cammy-%s' "$1") "$tmpdir/program.cammy" <(echo "'$ty)") >"$tmpdir/$name.scm"
3235 # Compile with Chicken.
3336 @chicken@/bin/csc -static -O3 -o "$name" "$tmpdir/$name.scm"
3437
--- /dev/null
+++ b/hive/v3/triple.cammy
@@ -0,0 +1 @@
1+(pair @0 (pair @1 @2))
--- a/stub.scm
+++ b/stub.scm
@@ -1,6 +1,7 @@
1-(import (srfi 6) (srfi 144) (srfi 189))
1+(import (srfi 4) (srfi 6) (srfi 144) (srfi 189))
22 (import (chicken condition) (chicken format) (chicken process-context) (chicken string))
33 (import (matchable))
4+(import (stb-image-write))
45
56 (define id (lambda (x) x))
67 (define (comp f g) (lambda (x) (g (f x))))
@@ -39,8 +40,8 @@
3940 (define (fold x f)
4041 (lambda (l) (if (null? l) (x '()) (f (cons (car l) ((fold x f) (cdr l)))))))
4142
42-(define f-zero (flonum 0.0))
43-(define f-one (flonum 1.0))
43+(define f-zero (lambda (x) (flonum 0.0)))
44+(define f-one (lambda (x) (flonum 1.0)))
4445 (define (f-negate x) (fl- x))
4546 (define (f-lt xy) (fl<? (car xy) (cdr xy)))
4647 (define (f-add xy) (fl+ (car xy) (cdr xy)))
@@ -71,8 +72,10 @@
7172 (pair2 (p2 args2)) (y (car pair2)) (args3 (cdr pair2)))
7273 (cons (cons x y) args3))))
7374
75+(define (argv) (map read-string (command-line-arguments)))
76+
7477 (define (parse-args parser)
75- (parser (map read-string (command-line-arguments))))
78+ (parser (argv)))
7679
7780 (define ty-parse (match-lambda
7881 ['N arg-nat]
@@ -80,8 +83,49 @@
8083 [('list x) (arg-list (ty-parse x))]
8184 [('pair x y) (arg-pair (ty-parse x) (ty-parse y))]))
8285
83-(define (cammy-run program ty)
86+; Run a program once using argv for parameters.
87+(define (cammy-oneshot program ty)
8488 (let*
8589 ((input (car (parse-args (ty-parse (car ty)))))
8690 (rv (program input)))
8791 (begin (display rv) (newline))))
92+
93+
94+(define (viewport width height)
95+ (let*
96+ ((aspect (/ width height))
97+ (iw (/ width))
98+ (ih (/ height))
99+ (dw (* 0.5 iw))
100+ (dh (* 0.5 ih)))
101+ (lambda (i)
102+ (let ((w (modulo i width)) (h (/ i width)))
103+ (cons (+ dw (* iw w)) (+ dh (* ih h)))))))
104+
105+(define (finish-channel c)
106+ (inexact->exact (round (* 255 (max 0.0 (min 1.0 c))))))
107+
108+(define ((draw-pixel program vp) i)
109+ (let*
110+ ((color (program (vp i)))
111+ (r (car color))
112+ (g (car (cdr color)))
113+ (b (cdr (cdr color))))
114+ (map finish-channel (list r g b))))
115+
116+(define (count-to i) (if (eqv? 0 i) '() (cons (- i 1) (count-to (- i 1)))))
117+
118+(define ((draw-png program width height))
119+ (let
120+ ((vp (viewport width height))
121+ (indices (count-to (* width height))))
122+ (write-png (list->u8vector
123+ (flatten (map (draw-pixel program vp) indices)))
124+ width height 3)))
125+
126+; Run a program repeatedly and draw the results.
127+(define (cammy-draw program ty)
128+ (match (argv)
129+ [(width height filename)
130+ (with-output-to-file filename
131+ (draw-png program width height))]))