doc/examples.lisp

   1 ;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
   2 ;;;
   3 ;;; Redistribution and use in source and binary forms, with or without
   4 ;;; modification, are permitted provided that the following conditions
   5 ;;; are met:
   6 ;;;
   7 ;;;   * Redistributions of source code must retain the above copyright
   8 ;;;     notice, this list of conditions and the following disclaimer.
   9 ;;;
  10 ;;;   * Redistributions in binary form must reproduce the above
  11 ;;;     copyright notice, this list of conditions and the following
  12 ;;;     disclaimer in the documentation and/or other materials
  13 ;;;     provided with the distribution.
  14 ;;;
  15 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  16 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  17 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  18 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
  19 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  20 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  21 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  22 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  23 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  24 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  25 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  26 ;;;
  27 ;;; $Id: examples.lisp,v 1.4 2007/10/01 19:57:15 xach Exp $
  28
  29 (defpackage #:vecto-examples
  30   (:use #:cl #:vecto))
  31
  32 (in-package #:vecto-examples)
  33
  34 (defun radiant-lambda (file)
  35   (with-canvas (:width 90 :height 90)
  36     (let ((font (get-font "times.ttf"))
  37           (step (/ pi 7)))
  38       (set-font font 40)
  39       (translate 45 45)
  40       (draw-centered-string 0 -10 #(#x3BB))
  41       (set-rgb-stroke 1 0 0)
  42       (centered-circle-path 0 0 35)
  43       (stroke)
  44       (set-rgba-stroke 0 0 1.0 0.5)
  45       (set-line-width 4)
  46       (dotimes (i 14)
  47         (with-graphics-state
  48           (rotate (* i step))
  49           (move-to 30 0)
  50           (line-to 40 0)
  51           (stroke)))
  52       (save-png file))))
  53
  54 (defun feedlike-icon (file)
  55   (with-canvas (:width 100 :height 100)
  56     (set-rgb-fill 1.0 0.65 0.3)
  57     (rounded-rectangle 0 0 100 100 10 10)
  58     (fill-path)
  59     (set-rgb-fill 1.0 1.0 1.0)
  60     (centered-circle-path 20 20 10)
  61     (fill-path)
  62     (flet ((quarter-circle (x y radius)
  63              (move-to (+ x radius) y)
  64              (arc x y radius 0 (/ pi 2))))
  65       (set-rgb-stroke 1.0 1.0 1.0)
  66       (set-line-width 15)
  67       (quarter-circle 20 20 30)
  68       (stroke)
  69       (quarter-circle 20 20 60)
  70       (stroke))
  71     (rounded-rectangle 5 5 90 90 7 7)
  72     (set-gradient 50 90
  73                   1.0 1.0 1.0 0.7
  74                   50 20
  75                   1.0 1.0 1.0 0.0)
  76     (set-line-width 2)
  77     (set-rgba-stroke 1.0 1.0 1.0 0.1)
  78     (fill-and-stroke)
  79     (save-png file)))
  80
  81 (defun star-clipping (file)
  82   (with-canvas (:width 200 :height 200)
  83     (let ((size 100)
  84           (angle 0)
  85           (step (* 2 (/ (* pi 2) 5))))
  86       (translate size size)
  87       (move-to 0 size)
  88       (dotimes (i 5)
  89         (setf angle (+ angle step))
  90         (line-to (* (sin angle) size)
  91                  (* (cos angle) size)))
  92       (even-odd-clip-path)
  93       (end-path-no-op)
  94       (flet ((circle (distance)
  95                (set-rgba-fill distance 0 0
  96                               (- 1.0 distance))
  97                (centered-circle-path 0 0 (* size distance))
  98                (fill-path)))
  99         (loop for i downfrom 1.0 by 0.05
 100               repeat 20 do
 101               (circle i)))
 102       (save-png file))))
 103
 104 (defun gradient-example (file)
 105   (with-canvas (:width 200 :height 50)
 106     (set-gradient-fill 25 0
 107                        1 0 0 1
 108                        175 0
 109                        1 0 0 0)
 110     (rectangle 0 0 200 50)
 111     (fill-path)
 112     (save-png file)))
 113
 114 (defun gradient-bilinear-example (file)
 115   (with-canvas (:width 200 :height 50)
 116     (set-gradient-fill 25 0
 117                        1 0 0 1
 118                        175 0
 119                        1 0 0 0
 120                        :domain-function 'bilinear-domain)
 121     (rectangle 0 0 200 50)
 122     (fill-path)
 123     (save-png file)))
 124
 125