Something went wrong. Try again.
A ray tracer in Coalton
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657(cl:defpackage #:ray/ppm (:use #:coalton #:coalton-prelude) (:local-nicknames (#:file #:coalton/file) (#:c #:ray/color) (#:math #:coalton/math) (#:la #:coalton/lisparray)) (:export #:save-image))
(cl:in-package #:ray/ppm)
(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 0) (cl:debug 0)))
(coalton-toplevel (inline) (declare write-pixel (file:FileStream Char * U8 * U8 * U8 -> Void)) (define (write-pixel stream r g b) (lisp (-> Void) (stream r g b) (cl:format stream "~D ~D ~D~%" r g b) (cl:values))))
(coalton-toplevel (declare write-pixels ((la:LispArray (la:LispArray U8)) * file:FileStream Char -> Void)) (define (write-pixels buffer stream) (for* ((i 0 (1+ i))) :repeat (la:length buffer) (let line = (la:aref buffer i)) (for* ((j 0 (+ 3 j))) :repeat (math:div (la:length line) 3) (let r = (la:aref line j)) (let g = (la:aref line (+ 1 j))) (let b = (la:aref line (+ 2 j))) (write-pixel stream r g b))))) (coalton-toplevel (declare write-header (UFix * UFix * UFix * file:FileStream Char -> Void)) (define (write-header width height colors stream) (lisp (-> Void) (width height colors stream) (cl:format stream "P3~%~D ~D~%~D~%" width height colors) (cl:values)))) (coalton-toplevel (declare save-image ((la:LispArray (la:LispArray U8)) * UFix * UFix * UFix -> Void)) (define (save-image buffer width height colors) (let result = (file:with-open-file "out.ppm" (fn (stream) (write-header width height colors stream) (write-pixels buffer stream) (Ok 0)) :direction file::Output :if-exists file::Supersede)) (match result ((Ok _) (print "Wrote file!")) ((Err errored) (match errored ((file:FileError str) (print "File error: ") (print str)) (_None (print "Unknown error occurred")))))))