diff --git a/README.org b/README.org index 0787b8e..3a59822 100644 --- a/README.org +++ b/README.org @@ -257,7 +257,7 @@ If you are used to working with colors in hex, like in CSS, you can use =(hex-to If you don't care about fiddling with the exact values, but still need different colors, you can use one of the following functions. ***** =(lerp-color (start-color end-color amount &key (mode :hsb)))= -Lerp is a shorthand for [[https://en.wikipedia.org/wiki/Linear_interpolation][linear interpolation]]. This function takes the starting color and the ending color, and returns the color between them, which is an =AMOUNT= away from the starting color. When =AMOUNT= equals zero, the returned color equals the starting color, and when =AMOUNT= equals one, the ending color is returned. Amounts between zero and one give colors that are "in-between". These colors are calculated according to the specified =MODE=, which is =:HSB= by default, meaning that the resulting color's hue is between the starting and ending hue, as is the case with its saturation and brightness. +Lerp is a shorthand for [[https://en.wikipedia.org/wiki/Linear_interpolation][linear interpolation]]. This function takes the starting color and the ending color, and returns the color between them, which is an =AMOUNT= away from the starting color. When =AMOUNT= equals zero, the returned color equals the starting color, and when =AMOUNT= equals one, the ending color is returned. Amounts between zero and one give colors that are "in-between". These colors are calculated according to the specified =MODE=, which is =:HSB= by default, meaning that the resulting color's hue is between the starting and ending hue, as is the case with its saturation and brightness. Any other keyword will result in RGB interpolation. #+BEGIN_SRC lisp (defsketch lerp-test ((title "lerp-color") (width 400) (height 100)) @@ -469,7 +469,7 @@ The font can be specified using =(make-font &key face color size line-height ali (text title 0 0 100))) #+END_SRC -=align= can be =:left=, =:centre= or =:right=, and determines whether the x & y coordinates correspond to the left end, centre, or right end of the text box. =line-height= determines the vertical space given to a line of text, scaled according to the font size, i.e. =:line-height 1= leaves just enough space so that the text on two lines won't overlap. +=align= can be =:left=, =:center= or =:right=, and determines whether the x & y coordinates correspond to the left end, centre, or right end of the text box. =line-height= determines the vertical space given to a line of text, scaled according to the font size, i.e. =:line-height 1= leaves just enough space so that the text on two lines won't overlap. *** Images First =(load-resource filename ...)= to load the image from a given file, then =(draw image &key x y width height)= to draw the image with its top-left corner at =(x, y)= and with the given =width= and =height=. If not provided, default =(x,y)= is =(0,0)= and =width= & =height= are taken from the image. diff --git a/t/sun.png b/t/sun.png new file mode 100644 index 0000000..0ce408c Binary files /dev/null and b/t/sun.png differ diff --git a/t/super1.png b/t/super1.png new file mode 100644 index 0000000..8bb00ed Binary files /dev/null and b/t/super1.png differ diff --git a/t/supersketch.lisp b/t/supersketch.lisp new file mode 100644 index 0000000..72ed7cb --- /dev/null +++ b/t/supersketch.lisp @@ -0,0 +1,146 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (ql:quickload 'sketch)) + +(defpackage :supersketch + (:use :cl) + (:local-nicknames (:s :sketch))) + +(in-package supersketch) + +(s:defsketch super1 + ((s:width 400) + (s:height 400) + (s:title "Supersketch 1 (shapes, colour, pens, image)") + (pic (s:load-resource (s::relative-path "t/super1.png")))) + (s:background (s:gray 0.6)) + (s:rect 0 0 25 25) + (s:with-pen (s:make-pen :fill s:+red+ :stroke s:+blue+) + (s:circle 45 20 20)) + (s:with-pen (:weight 0 :fill (s:rgb 0 .8 .8)) + (s:ellipse 105 30 40 30)) + (s:with-pen (:weight 5 :stroke (s:hsb .1 .8 .6 .9)) + (s:line 145 25 180 25)) + (s:with-pen (:stroke (s:hash-color 10)) + (s:polyline 145 35 180 35 160 50)) + (s:with-pen (:fill (s:rgb-255 120 120 200)) + (s:polygon 185 20 250 25 200 50)) + (s:with-pen (:fill (s:hsb-360 300 50 80 200) :stroke (s:gray-255 20)) + (s:ngon 3 275 25 25 25)) + (s:with-pen (:fill (s:hex-to-color "#4bcdef")) + (s:ngon 4 325 25 25 25)) + (s:with-pen (:fill (s:lerp-color s:+red+ s:+blue+ .5)) + (s:ngon 5 375 25 25 25)) + (s:with-pen (:stroke (s:random-color)) + (s:bezier 0 75 25 100 50 60 125 75)) + (s:with-pen (s:make-pen :stroke s:+yellow+ :weight 4 :curve-steps 5) + (s:bezier 0 85 25 110 50 70 125 85)) + (s:with-pen (:fill (s:color-filter-grayscale s:+red+)) + (s:rect 130 85 20 40)) + (s:with-pen (:fill (s:color-filter-grayscale s:+indigo+ :average)) + (s:rect 150 85 20 40)) + (s:with-pen (:fill (s:color-filter-invert s:+red+)) + (s:rect 170 85 20 40)) + (s:with-pen (:fill (s:color-filter-rotate s:+red+)) + (s:rect 190 85 20 40)) + (s:with-pen (:fill (s:color-filter-hsb (s:hsb .5 .5 .5) + :hue .1 :saturation .1 :brightness .1)) + (s:rect 210 85 20 40)) + (let ((y (- (/ s:height 2) 20))) + (s:with-font (s:make-font :color s:+white+ + :size 10 + :line-height 1.2 + :align :center) + (s:text (format nil "Circle should be at center top of text box~%(Line 2) Image below should match (maybe system-dependent)") + (/ s:width 2) y)) + (s:circle (/ s:width 2) y 5) + (s:image pic 0 (+ y 60)))) + +(s:defsketch super2 + ((s:fullscreen t) + (s:title "Supersketch 2 (fullscreen, image)") + (sun (s:load-resource (s::relative-path "t/sun.png"))) + (cx (/ s:width 2)) + (cy (/ s:height 2)) + (swidth (s:image-width sun)) + (sheight (s:image-height sun)) + (pics + (list (s:crop sun 0 0 (/ swidth 2) (/ sheight 2)) + (s:crop sun (/ swidth 2) 0 (/ swidth 2) (/ sheight 2)) + (s:crop sun 0 (/ swidth 2) (/ swidth 2) (/ sheight 2)) + (s:crop sun (/ swidth 2) (/ swidth 2) (/ swidth 2) (/ sheight 2)))) + (t0 0)) + (s:circle (/ s:width 2) (/ s:height 2) 50) + (s:text "Circle should be in the middle Also testing image cropping." 0 0) + (loop for pic in pics + for (xmul ymul) in '((-1 -1) (1 -1) (-1 1) (1 1)) + do (s:image pic (+ cx (* xmul t0)) (+ cy (* ymul t0)))) + (setf t0 (mod (+ t0 .1) 40))) + +(s:defsketch super3 + ((s:resizable t) + (s:title "Supersketch 3 (resize, y-axis, text, close-on)") + (s:y-axis :up) + (s:close-on :space)) + (s:circle (/ s:width 2) (/ s:height 2) 50) + (s:text "Circle should stay in middle during window resize." 0 30) + (s:text "Exit with spacebar." 0 (/ s:height 2)) + (s:ngon 4 10 10 10 10) + (s:with-font (s:make-font :color s:+white+ :size 10) + (s:text "Square should be in bottom left." 0 (- s:height 20)))) + +(s:defsketch super4 + ((s:copy-pixels t) + (s:title "Supersketch 4 (copy-pixels)") + (i 0)) + ;; There should be 1 black circle (otherwise, first draw call has been + ;; overwritten somehow). + (s:with-pen (:fill (if (= 0 i) s:+black+ s:+white+)) + (s:circle (random s:width) (random s:height) 20)) + (incf i)) + +(defmethod s:setup ((instance super4) &key &allow-other-keys) + (s:background s:+blue+)) + +(s:defsketch super5 + ((s:title "Supersketch 5 (transforms, control flow))")) + (s:with-font (s:make-font :size 14) + (s:text "Red squares should get bigger, white squares should rotate." + 0 50)) + (s:with-identity-matrix + (s:translate (/ s:width 2) (/ s:height 2)) + (s:with-pen (:weight 3 :stroke s:+white+) + (loop repeat 10 + do (progn + (s:ngon 4 0 0 50 50) + (s:rotate (/ 360 10)))))) + (s:with-pen (:fill s:+red+) + (dotimes (i 3) + (let ((sfactor (+ 1 (/ i 3)))) + (s:with-translate ((* i 50) 0) + (s:with-scale (sfactor sfactor) + (s:rect 0 0 25 25))))))) + +(s:defsketch super6 + ((s:title "Supersketch 6 (input, control flow, canvas)") + (s:copy-pixels t) + (cvs (let ((cvs (s:make-canvas 50 50))) + (loop repeat 100 + do (s:canvas-paint cvs s:+blue+ (random 50) (random 50))) + cvs)) + (coords nil)) + (s:with-font (s:make-font :color s:+white+) + (s:text "Press 'd' to add square." 0 0) + (s:text "Click to draw canvas somewhere." 0 50)) + (if coords + (when coords + (s:draw cvs :x (first coords) :y (second coords)) + (setf coords nil)) + (s:rect (random s:width) (random s:height) 20 20)) + (s:stop-loop)) + +(defmethod s:on-key ((instance super6) (key (eql :d)) (state (eql :up))) + (s:start-loop)) + +(defmethod s:on-click ((instance super6) x y) + (setf (super6-coords instance) (list x y)) + (s:start-loop))