#!/usr/bin/newlisp

; gradient.lsp - L.M. July 2006

(load "postscript.lsp")

; show color gradients using the YUV color model
;
;  0     <= Y <= 1
; -0.436 <= U <= 0.436 range 0.872
; -0.615 <= V <= 0.615 range 1.230

(define (rgb-yuv r g b)
	((transpose (multiply 
					'((0.299 0.587 0.114)
					  (-0.147 -0.289 0.436)
					  (0.615 -0.515 -0.100))
					(list (list r) (list g) (list b)))) 0))

(define (yuv-rgb y u v)
	((transpose (multiply 
					'((1 -0.000039457070707 1.139827967171717)
					  (1 -0.394610164141414 -0.580500315656566)
					  (1 2.031999684343434 0.000481376262626))
					(list (list y) (list u) (list v)))) 0))

; Background
(ps:goto 0 0)
(ps:fill-color 0.0 0.0 0.2)
(ps:shape '((0 792) (90 612) (90 792) (90 612)) true)


; simple grey gradient
;----------------
(ps:line-width 2)
(dotimes (i 100)
	(set 'col (mul i  0.01))
	(ps:line-color col col col)
	(ps:goto 100 (+ i 50))
	(ps:drawto 200 (+ i 50)))

(ps:goto 300 100)
(dotimes (i 50)
	(set 'col (mul i  0.01))
	(ps:line-color col col col)
	(ps:circle (- 50 i)))

; YUV colormodel
;----------------
(dotimes (i 100)
	(apply ps:line-color (yuv-rgb (mul i 0.01) (mul i 0.00436) (mul i 0.00615)))
	(ps:goto 100 (+ i 200))
	(ps:drawto 200 (+ i 200)))

(ps:goto 300 250)
(dotimes (i 50)
	(apply ps:line-color (yuv-rgb (mul i 0.02) (mul i 0.00872) (mul i 0.0123)))
	(ps:circle (- 50 i)))

;----------------
(dotimes (i 100)
	(apply ps:line-color (yuv-rgb (mul i 0.01) (mul i 0.00436) (mul i -0.00615)))
	(ps:goto 100 (+ i 350))
	(ps:drawto 200 (+ i 350)))

(ps:goto 300 400)
(dotimes (i 50)
	(apply ps:line-color (yuv-rgb (mul i 0.02) (mul i 0.00872) (mul i -0.0123)))
	(ps:circle (- 50 i)))

;----------------
(dotimes (i 100)
	(apply ps:line-color (yuv-rgb (mul i 0.01) (mul i -0.00436) (mul i -0.00615)))
	(ps:goto 100 (+ i 500))
	(ps:drawto 200 (+ i 500)))

(ps:goto 300 550)
(dotimes (i 50)
	(apply ps:line-color (yuv-rgb (mul i 0.02) (mul i -0.00872) (mul i -0.0123)))
	(ps:circle (- 50 i)))

;----------------
(dotimes (i 100)
	(apply ps:line-color (yuv-rgb (mul i 0.01) (mul i -0.00436) (mul i 0.00615)))
	(ps:goto 100 (+ i 650))
	(ps:drawto 200 (+ i 650)))

(ps:goto 300 700)
(dotimes (i 50)
	(apply ps:line-color (yuv-rgb (mul i 0.02) (mul i -0.00872) (mul i 0.0123)))
	(ps:circle (- 50 i)))

; RGB
(ps:line-width 4)
(for (y 50 750 4)
	(ps:line-color (random) (random) (random))
	(ps:goto 400 y)
	(ps:drawto 500 y)
)

; Signature
(ps:line-color 0.5 0.5 0.5)
(ps:goto 425 10)
(ps:angle 90)
(ps:font "Helvetica" 10)
(ps:text "made with newLISP and postscript.lsp")

(ps:render)

(exit)