├── .github └── workflows │ └── kai.yml ├── .gitignore ├── LICENSE ├── README.md ├── docs ├── README.md └── index.html ├── examples ├── img1.png ├── img2.png └── main.lisp ├── kai-example.asd ├── kai-test.asd ├── kai.asd ├── src ├── converter.lisp ├── gr │ ├── GR.lisp │ ├── build.lisp │ └── cl-gr.lisp ├── interface.lisp ├── kai.lisp ├── plotly │ ├── generate.lisp │ └── launch.lisp └── util.lisp └── tests └── main.lisp /.github/workflows/kai.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: CI 4 | 5 | # Controls when the action will run. Triggers the workflow on push or pull request 6 | # events but only for the master branch 7 | on: 8 | push: 9 | branches: [ master ] 10 | pull_request: 11 | branches: [ master ] 12 | 13 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 14 | jobs: 15 | # This workflow contains a single job called "build" 16 | build: 17 | # The type of runner that the job will run on 18 | runs-on: ${{ matrix.os }} 19 | strategy: 20 | matrix: 21 | lisp: [sbcl-bin] 22 | os: [ubuntu-latest, macOS-latest] 23 | 24 | steps: 25 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 26 | - uses: actions/checkout@v2 27 | 28 | # Runs a single command using the runners shell 29 | - name: apt 30 | run: which apt-get >/dev/null && sudo apt-get -yq update && sudo apt-get -yq install build-essential libcurl4-gnutls-dev automake autoconf || true 31 | 32 | - name: brew 33 | run: which brew >/dev/null && brew install automake autoconf || true 34 | 35 | - name: Install Roswell 36 | env: 37 | LISP: ${{ matrix.lisp }} 38 | run: | 39 | curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh 40 | - name: Install Rove 41 | run: ros install rove 42 | 43 | - name: Run tests 44 | run: | 45 | PATH="~/.roswell/bin:$PATH" 46 | rove kai.asd 47 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Yusuke Kominami 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Kai 2 | 3 | Kai is a plotter library for Common Lisp. 4 | 5 | ![img1](./examples/img1.png) 6 | ![img2](./examples/img2.png) 7 | 8 | ## Installation 9 | 10 | ### Roswell 11 | 12 | With [roswell](https://github.com/roswell/roswell), install this repository. 13 | 14 | ```bash 15 | $ ros install komi1230/kai 16 | ``` 17 | 18 | And setup roswell REPL and load with Quicklisp: 19 | 20 | ```lisp 21 | (ql:quickload :kai) 22 | ``` 23 | 24 | ### ASDF 25 | 26 | First, clone this repository and load this: 27 | 28 | In terminal: 29 | 30 | ```bash 31 | $ git clone https://github.com/komi1230/kai 32 | ``` 33 | 34 | And load with ASDF: 35 | 36 | ```lisp 37 | (asdf:load-system :kai) 38 | ``` 39 | 40 | ## How to use 41 | 42 | Check [example](https://github.com/komi1230/kai/blob/master/examples/main.lisp) 43 | 44 | Prepare some data: 45 | 46 | ```lisp 47 | ;; x-axis 48 | (defparameter x 49 | (loop for i from 0 below 10 by 0.1 50 | collect i)) 51 | 52 | ;; y-axis 53 | (defparameter y 54 | (mapcar #'sin x)) 55 | ``` 56 | 57 | This example uses List data but Array is also OK. 58 | 59 | ### Scatter plot 60 | 61 | ```lisp 62 | (kai:line x y) 63 | ``` 64 | 65 | or 66 | 67 | ```lisp 68 | (kai:line y) 69 | ``` 70 | 71 | You can add some options: 72 | 73 | ```lisp 74 | (kai:line y 75 | :color :magenta 76 | :width 10) 77 | ``` 78 | 79 | ### Style (Not Necessary) 80 | 81 | ```lisp 82 | (kai:title "hogehoge plot") 83 | ``` 84 | 85 | ### Show 86 | 87 | ```lisp 88 | (kai:show) 89 | ``` 90 | 91 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | # Docs of Kai 2 | 3 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | This is Kai's API references. 2 | -------------------------------------------------------------------------------- /examples/img1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/komi1230/kai/7481aae3ca11a79c117dd6fbc4e3bf2122a89627/examples/img1.png -------------------------------------------------------------------------------- /examples/img2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/komi1230/kai/7481aae3ca11a79c117dd6fbc4e3bf2122a89627/examples/img2.png -------------------------------------------------------------------------------- /examples/main.lisp: -------------------------------------------------------------------------------- 1 | ;;;; scatter.lisp - A collection of scatter plotting 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file is composed of a collection of exampeles of plotting. 7 | ;;; Here's codes are mainly deal scatter plotting. 8 | 9 | (in-package :cl-user) 10 | (defpackage :kai-example 11 | (:use :cl) 12 | (:import-from :kai 13 | :title 14 | :line 15 | :pie 16 | :box 17 | :heatmap 18 | :contour 19 | :line3d 20 | :surface 21 | :fillarea 22 | :marker 23 | :marker3d 24 | :xaxis 25 | :yaxis 26 | :show) 27 | (:export :line 28 | :marker-example 29 | :pie-chart 30 | :sunburst-chart 31 | :heatmap-chart 32 | :box-chart 33 | :contour-chart 34 | :line3d 35 | :marker3d-example 36 | :surface-chart)) 37 | (in-package :kai-example) 38 | 39 | 40 | ;;;; Parameters 41 | ;;; 42 | ;;; These are parameters to plot in the figure. 43 | 44 | (defparameter x-data-index 45 | (loop for i from 0 below 10 46 | collect i)) 47 | 48 | (defparameter x-data-random 49 | (loop for i from 0 below 100 50 | collect (random 10.0))) 51 | 52 | (defparameter y-data-10 53 | (loop for i from 0 below 10 54 | collect (random 10.0))) 55 | 56 | (defparameter y-data-100 57 | (loop for i from 0 below 100 58 | collect (random 10.0))) 59 | 60 | (defparameter z-data-100 61 | (loop for i from 0 below 100 62 | collect (random 10.0))) 63 | 64 | (defparameter pie-label 65 | '("Residential" "Non-Residential" "Utility")) 66 | 67 | (defparameter pie-data 68 | '(19 26 55)) 69 | 70 | (defparameter box-data 71 | (loop :repeat 50 72 | :collect (random 100.0))) 73 | 74 | (defparameter heatmap-data 75 | (loop :repeat 100 76 | :collect (loop :repeat 100 77 | :collect (random 10.0)))) 78 | 79 | (defparameter contour-data 80 | (loop :repeat 20 81 | :collect (loop :repeat 20 82 | :collect (random 10.0)))) 83 | 84 | 85 | ;;;; Basic plotting 86 | ;;; 87 | ;;; Line and scatter 88 | 89 | (defun line-chart () 90 | (line x-data-index 91 | y-data-10) 92 | (title "Line plot example") 93 | (xaxis (list :|title| "X axis")) 94 | (yaxis (list :|title| "Y axis")) 95 | (show)) 96 | 97 | (defun marker-example () 98 | (marker x-data-random 99 | y-data-100 100 | :size 20) 101 | (title "Marker plot example") 102 | (show)) 103 | 104 | (defun fill-chart () 105 | (fillarea '(1 2 3) 106 | '(2 1 3) 107 | '(5 2 7) 108 | :color :aqua) 109 | (title "Fill chart with line plotting") 110 | (show)) 111 | 112 | 113 | ;;;; Pie chart 114 | ;;; 115 | ;;; pie cahrt with labels 116 | 117 | (defun pie-chart () 118 | (pie pie-data pie-label) 119 | (title "Pie chart example") 120 | (show)) 121 | 122 | 123 | ;;;; Box 124 | ;;; 125 | ;;; box plots example 126 | 127 | (defun box-chart () 128 | (box box-data) 129 | (title "Box chart example") 130 | (show)) 131 | 132 | 133 | ;;;; Heatmap 134 | ;;; 135 | ;;; heatmap example 136 | 137 | (defun heatmap-chart () 138 | (heatmap heatmap-data 139 | :showscale t) 140 | (title "Heatmap example") 141 | (show)) 142 | 143 | 144 | ;;;; Contour 145 | ;;; 146 | ;;; Contour example 147 | 148 | (defun contour-chart () 149 | (contour contour-data 150 | :showscale t) 151 | (title "Contour example") 152 | (show)) 153 | 154 | 155 | ;;;; Scatter3D 156 | ;;; 157 | ;;; scatter3d plots: line and marker 158 | 159 | (defun line3d-example () 160 | (line3d x-data-random 161 | y-data-100 162 | z-data-100) 163 | (title "Line3D plot example") 164 | (show)) 165 | 166 | (defun marker3d-example () 167 | (marker3d x-data-random 168 | y-data-100 169 | z-data-100) 170 | (title "Marker3D plot example") 171 | (show)) 172 | 173 | 174 | ;;;; Surface 175 | ;;; 176 | ;;; surface chart-example 177 | 178 | (defun surface-chart () 179 | (surface contour-data) 180 | (title "Surface chart example") 181 | (show)) 182 | -------------------------------------------------------------------------------- /kai-example.asd: -------------------------------------------------------------------------------- 1 | (defsystem "kai-example" 2 | :version "0.1.8" 3 | :author "Yusuke Kominami" 4 | :license "MIT License" 5 | :depends-on ("kai") 6 | :serial t 7 | :components ((:module "examples" 8 | :components 9 | ((:file "main")))) 10 | :description "Examples of Kai" 11 | :long-description #.(with-open-file (stream (merge-pathnames 12 | #p"README.md" 13 | (or *load-pathname* *compile-file-pathname*)) 14 | :if-does-not-exist nil 15 | :direction :input))) 16 | -------------------------------------------------------------------------------- /kai-test.asd: -------------------------------------------------------------------------------- 1 | (defsystem "kai-test" 2 | :author "" 3 | :license "" 4 | :depends-on ("rove") 5 | :components ((:module "tests" 6 | :components 7 | ((:file "main")))) 8 | :description "Test system for kai" 9 | :perform (test-op (op c) 10 | (symbol-call :rove :run c))) 11 | -------------------------------------------------------------------------------- /kai.asd: -------------------------------------------------------------------------------- 1 | (defsystem "kai" 2 | :version "0.2.1" 3 | :author "Yusuke Kominami" 4 | :license "MIT License" 5 | :depends-on ("dexador" 6 | "cl-who" 7 | "cl-css" 8 | "jonathan") 9 | :serial t 10 | :components ((:module "src" 11 | :components 12 | ((:file "util") 13 | (:file "converter") 14 | (:module "plotly" 15 | :serial t 16 | :depends-on ("converter") 17 | :components 18 | ((:file "generate") 19 | (:file "launch"))) 20 | (:file "interface") 21 | (:file "kai")))) 22 | :in-order-to ((test-op (test-op :kai-test))) 23 | :description "Plotter for Common Lisp" 24 | :long-description #.(with-open-file (stream (merge-pathnames 25 | #p"README.md" 26 | (or *load-pathname* *compile-file-pathname*)) 27 | :if-does-not-exist nil 28 | :direction :input))) 29 | -------------------------------------------------------------------------------- /src/converter.lisp: -------------------------------------------------------------------------------- 1 | ;;;; converter.lisp --- JSON generator from Common Lisp codes 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file is composed of a collection of JSON file generator. 7 | ;;; Kai can be used with a variety of backends. 8 | ;;; Here we use JSON and provide a common platform for a variety of 9 | ;;; backends. 10 | 11 | (in-package :cl-user) 12 | (defpackage :kai.converter 13 | (:use :cl) 14 | (:import-from :kai.util 15 | :symbol-downcase) 16 | (:export :plotly-code)) 17 | (in-package :kai.converter) 18 | 19 | 20 | 21 | ;;;; Color 22 | ;;; 23 | ;;; List of color code 24 | 25 | (defparameter *colors* (make-hash-table)) 26 | 27 | (setf (gethash (intern "ALICEBLUE" "KEYWORD") *colors*) '(240 248 255) 28 | (gethash (intern "ANTIQUEWHITE" "KEYWORD") *colors*) '(250 235 215) 29 | (gethash (intern "AQUA" "KEYWORD") *colors*) '(0 255 255) 30 | (gethash (intern "AQUAMARINE" "KEYWORD") *colors*) '(127 255 212) 31 | (gethash (intern "AZURE" "KEYWORD") *colors*) '(240 255 255) 32 | (gethash (intern "BEIGE" "KEYWORD") *colors*) '(245 245 220) 33 | (gethash (intern "BISQUE" "KEYWORD") *colors*) '(255 228 196) 34 | (gethash (intern "BLACK" "KEYWORD") *colors*) '(0 0 0) 35 | (gethash (intern "BLANCHEDALMOND" "KEYWORD") *colors*) '(255 235 205) 36 | (gethash (intern "BLUE" "KEYWORD") *colors*) '(0 0 255) 37 | (gethash (intern "BLUEVIOLET" "KEYWORD") *colors*) '(138 43 226) 38 | (gethash (intern "BROWN" "KEYWORD") *colors*) '(165 42 42) 39 | (gethash (intern "BURLYWOOD" "KEYWORD") *colors*) '(222 184 135) 40 | (gethash (intern "CADETBLUE" "KEYWORD") *colors*) '(95 158 160) 41 | (gethash (intern "CHARTREUSE" "KEYWORD") *colors*) '(127 255 0) 42 | (gethash (intern "CHOCOLATE" "KEYWORD") *colors*) '(210 105 30) 43 | (gethash (intern "CORAL" "KEYWORD") *colors*) '(255 127 80) 44 | (gethash (intern "CORNFLOWERBLUE" "KEYWORD") *colors*) '(100 149 237) 45 | (gethash (intern "CORNSILK" "KEYWORD") *colors*) '(255 248 220) 46 | (gethash (intern "CRIMSON" "KEYWORD") *colors*) '(220 20 60) 47 | (gethash (intern "CYAN" "KEYWORD") *colors*) '(0 255 255) 48 | (gethash (intern "DARKBLUE" "KEYWORD") *colors*) '(0 0 139) 49 | (gethash (intern "DARKCYAN" "KEYWORD") *colors*) '(0 139 139) 50 | (gethash (intern "DARKGOLDENROD" "KEYWORD") *colors*) '(184 134 11) 51 | (gethash (intern "DARKGRAY" "KEYWORD") *colors*) '(169 169 169) 52 | (gethash (intern "DARKGREEN" "KEYWORD") *colors*) '(0 100 0) 53 | (gethash (intern "DARKGREY" "KEYWORD") *colors*) '(169 169 169) 54 | (gethash (intern "DARKKHAKI" "KEYWORD") *colors*) '(189 183 107) 55 | (gethash (intern "DARKMAGENTA" "KEYWORD") *colors*) '(139 0 139) 56 | (gethash (intern "DARKOLIVEGREEN" "KEYWORD") *colors*) '(85 107 47) 57 | (gethash (intern "DARKORANGE" "KEYWORD") *colors*) '(255 140 0) 58 | (gethash (intern "DARKORCHID" "KEYWORD") *colors*) '(153 50 204) 59 | (gethash (intern "DARKRED" "KEYWORD") *colors*) '(139 0 0) 60 | (gethash (intern "DARKSALMON" "KEYWORD") *colors*) '(233 150 122) 61 | (gethash (intern "DARKSEAGREEN" "KEYWORD") *colors*) '(143 188 143) 62 | (gethash (intern "DARKSLATEBLUE" "KEYWORD") *colors*) '(72 61 139) 63 | (gethash (intern "DARKSLATEGRAY" "KEYWORD") *colors*) '(47 79 79) 64 | (gethash (intern "DARKSLATEGREY" "KEYWORD") *colors*) '(47 79 79) 65 | (gethash (intern "DARKTURQUOISE" "KEYWORD") *colors*) '(0 206 209) 66 | (gethash (intern "DARKVIOLET" "KEYWORD") *colors*) '(148 0 211) 67 | (gethash (intern "DEEPPINK" "KEYWORD") *colors*) '(255 20 147) 68 | (gethash (intern "DEEPSKYBLUE" "KEYWORD") *colors*) '(0 191 255) 69 | (gethash (intern "DIMGRAY" "KEYWORD") *colors*) '(105 105 105) 70 | (gethash (intern "DIMGREY" "KEYWORD") *colors*) '(105 105 105) 71 | (gethash (intern "DODGERBLUE" "KEYWORD") *colors*) '(30 144 255) 72 | (gethash (intern "FIREBRICK" "KEYWORD") *colors*) '(178 34 34) 73 | (gethash (intern "FLORALWHITE" "KEYWORD") *colors*) '(255 250 240) 74 | (gethash (intern "FORESTGREEN" "KEYWORD") *colors*) '(34 139 34) 75 | (gethash (intern "FUCHSIA" "KEYWORD") *colors*) '(255 0 255) 76 | (gethash (intern "GAINSBORO" "KEYWORD") *colors*) '(220 220 220) 77 | (gethash (intern "GHOSTWHITE" "KEYWORD") *colors*) '(248 248 255) 78 | (gethash (intern "GOLD" "KEYWORD") *colors*) '(255 215 0) 79 | (gethash (intern "GOLDENROD" "KEYWORD") *colors*) '(218 165 32) 80 | (gethash (intern "GRAY" "KEYWORD") *colors*) '(128 128 128) 81 | (gethash (intern "GREEN" "KEYWORD") *colors*) '(0 128 0) 82 | (gethash (intern "GREENYELLOW" "KEYWORD") *colors*) '(173 255 47) 83 | (gethash (intern "GREY" "KEYWORD") *colors*) '(128 128 128) 84 | (gethash (intern "HONEYDEW" "KEYWORD") *colors*) '(240 255 240) 85 | (gethash (intern "HOTPINK" "KEYWORD") *colors*) '(255 105 180) 86 | (gethash (intern "INDIANRED" "KEYWORD") *colors*) '(205 92 92) 87 | (gethash (intern "INDIGO" "KEYWORD") *colors*) '(75 0 130) 88 | (gethash (intern "IVORY" "KEYWORD") *colors*) '(255 255 240) 89 | (gethash (intern "KHAKI" "KEYWORD") *colors*) '(240 230 140) 90 | (gethash (intern "LAVENDER" "KEYWORD") *colors*) '(230 230 250) 91 | (gethash (intern "LAVENDERBLUSH" "KEYWORD") *colors*) '(255 240 245) 92 | (gethash (intern "LAWNGREEN" "KEYWORD") *colors*) '(124 252 0) 93 | (gethash (intern "LEMONCHIFFON" "KEYWORD") *colors*) '(255 250 205) 94 | (gethash (intern "LIGHTBLUE" "KEYWORD") *colors*) '(173 216 230) 95 | (gethash (intern "LIGHTCORAL" "KEYWORD") *colors*) '(240 128 128) 96 | (gethash (intern "LIGHTCYAN" "KEYWORD") *colors*) '(224 255 255) 97 | (gethash (intern "LIGHTGOLDENRODYELLOW" "KEYWORD") *colors*) '(250 250 210) 98 | (gethash (intern "LIGHTGRAY" "KEYWORD") *colors*) '(211 211 211) 99 | (gethash (intern "LIGHTGREEN" "KEYWORD") *colors*) '(144 238 144) 100 | (gethash (intern "LIGHTGREY" "KEYWORD") *colors*) '(211 211 211) 101 | (gethash (intern "LIGHTPINK" "KEYWORD") *colors*) '(255 182 193) 102 | (gethash (intern "LIGHTSALMON" "KEYWORD") *colors*) '(255 160 122) 103 | (gethash (intern "LIGHTSEAGREEN" "KEYWORD") *colors*) '(32 178 170) 104 | (gethash (intern "LIGHTSKYBLUE" "KEYWORD") *colors*) '(135 206 250) 105 | (gethash (intern "LIGHTSLATEGRAY" "KEYWORD") *colors*) '(119 136 153) 106 | (gethash (intern "LIGHTSLATEGREY" "KEYWORD") *colors*) '(119 136 153) 107 | (gethash (intern "LIGHTSTEELBLUE" "KEYWORD") *colors*) '(176 196 222) 108 | (gethash (intern "LIGHTYELLOW" "KEYWORD") *colors*) '(255 255 224) 109 | (gethash (intern "LIME" "KEYWORD") *colors*) '(0 255 0) 110 | (gethash (intern "LIMEGREEN" "KEYWORD") *colors*) '(50 205 50) 111 | (gethash (intern "LINEN" "KEYWORD") *colors*) '(250 240 230) 112 | (gethash (intern "MAGENTA" "KEYWORD") *colors*) '(255 0 255) 113 | (gethash (intern "MAROON" "KEYWORD") *colors*) '(128 0 0) 114 | (gethash (intern "MEDIUMAQUAMARINE" "KEYWORD") *colors*) '(102 205 170) 115 | (gethash (intern "MEDIUMBLUE" "KEYWORD") *colors*) '(0 0 205) 116 | (gethash (intern "MEDIUMORCHID" "KEYWORD") *colors*) '(186 85 211) 117 | (gethash (intern "MEDIUMPURPLE" "KEYWORD") *colors*) '(147 112 219) 118 | (gethash (intern "MEDIUMSEAGREEN" "KEYWORD") *colors*) '(60 179 113) 119 | (gethash (intern "MEDIUMSLATEBLUE" "KEYWORD") *colors*) '(123 104 238) 120 | (gethash (intern "MEDIUMSPRINGGREEN" "KEYWORD") *colors*) '(0 250 154) 121 | (gethash (intern "MEDIUMTURQUOISE" "KEYWORD") *colors*) '(72 209 204) 122 | (gethash (intern "MEDIUMVIOLETRED" "KEYWORD") *colors*) '(199 21 133) 123 | (gethash (intern "MIDNIGHTBLUE" "KEYWORD") *colors*) '(25 25 112) 124 | (gethash (intern "MINTCREAM" "KEYWORD") *colors*) '(245 255 250) 125 | (gethash (intern "MISTYROSE" "KEYWORD") *colors*) '(255 228 225) 126 | (gethash (intern "MOCCASIN" "KEYWORD") *colors*) '(255 228 181) 127 | (gethash (intern "NAVAJOWHITE" "KEYWORD") *colors*) '(255 222 173) 128 | (gethash (intern "NAVY" "KEYWORD") *colors*) '(0 0 128) 129 | (gethash (intern "OLDLACE" "KEYWORD") *colors*) '(253 245 230) 130 | (gethash (intern "OLIVE" "KEYWORD") *colors*) '(128 128 0) 131 | (gethash (intern "OLIVEDRAB" "KEYWORD") *colors*) '(107 142 35) 132 | (gethash (intern "ORANGE" "KEYWORD") *colors*) '(255 165 0) 133 | (gethash (intern "ORANGERED" "KEYWORD") *colors*) '(255 69 0) 134 | (gethash (intern "ORCHID" "KEYWORD") *colors*) '(218 112 214) 135 | (gethash (intern "PALEGOLDENROD" "KEYWORD") *colors*) '(238 232 170) 136 | (gethash (intern "PALEGREEN" "KEYWORD") *colors*) '(152 251 152) 137 | (gethash (intern "PALETURQUOISE" "KEYWORD") *colors*) '(175 238 238) 138 | (gethash (intern "PALEVIOLETRED" "KEYWORD") *colors*) '(219 112 147) 139 | (gethash (intern "PAPAYAWHIP" "KEYWORD") *colors*) '(255 239 213) 140 | (gethash (intern "PEACHPUFF" "KEYWORD") *colors*) '(255 218 185) 141 | (gethash (intern "PERU" "KEYWORD") *colors*) '(205 133 63) 142 | (gethash (intern "PINK" "KEYWORD") *colors*) '(255 192 203) 143 | (gethash (intern "PLUM" "KEYWORD") *colors*) '(221 160 221) 144 | (gethash (intern "POWDERBLUE" "KEYWORD") *colors*) '(176 224 230) 145 | (gethash (intern "PURPLE" "KEYWORD") *colors*) '(128 0 128) 146 | (gethash (intern "REBECCAPURPLE" "KEYWORD") *colors*) '(102 51 153) 147 | (gethash (intern "RED" "KEYWORD") *colors*) '(255 0 0) 148 | (gethash (intern "ROSYBROWN" "KEYWORD") *colors*) '(188 143 143) 149 | (gethash (intern "ROYALBLUE" "KEYWORD") *colors*) '(65 105 225) 150 | (gethash (intern "SADDLEBROWN" "KEYWORD") *colors*) '(139 69 19) 151 | (gethash (intern "SALMON" "KEYWORD") *colors*) '(250 128 114) 152 | (gethash (intern "SANDYBROWN" "KEYWORD") *colors*) '(244 164 96) 153 | (gethash (intern "SEAGREEN" "KEYWORD") *colors*) '(46 139 87) 154 | (gethash (intern "SEASHELL" "KEYWORD") *colors*) '(255 245 238) 155 | (gethash (intern "SIENNA" "KEYWORD") *colors*) '(160 82 45) 156 | (gethash (intern "SILVER" "KEYWORD") *colors*) '(192 192 192) 157 | (gethash (intern "SKYBLUE" "KEYWORD") *colors*) '(135 206 235) 158 | (gethash (intern "SLATEBLUE" "KEYWORD") *colors*) '(106 90 205) 159 | (gethash (intern "SLATEGRAY" "KEYWORD") *colors*) '(112 128 144) 160 | (gethash (intern "SLATEGREY" "KEYWORD") *colors*) '(112 128 144) 161 | (gethash (intern "SNOW" "KEYWORD") *colors*) '(255 250 250) 162 | (gethash (intern "SPRINGGREEN" "KEYWORD") *colors*) '(0 255 127) 163 | (gethash (intern "STEELBLUE" "KEYWORD") *colors*) '(70 130 180) 164 | (gethash (intern "TAN" "KEYWORD") *colors*) '(210 180 140) 165 | (gethash (intern "TEAL" "KEYWORD") *colors*) '(0 128 128) 166 | (gethash (intern "THISTLE" "KEYWORD") *colors*) '(216 191 216) 167 | (gethash (intern "TOMATO" "KEYWORD") *colors*) '(255 99 71) 168 | (gethash (intern "TURQUOISE" "KEYWORD") *colors*) '(64 224 208) 169 | (gethash (intern "VIOLET" "KEYWORD") *colors*) '(238 130 238) 170 | (gethash (intern "WHEAT" "KEYWORD") *colors*) '(245 222 179) 171 | (gethash (intern "WHITE" "KEYWORD") *colors*) '(255 255 255) 172 | (gethash (intern "WHITESMOKE" "KEYWORD") *colors*) '(245 245 245) 173 | (gethash (intern "YELLOW" "KEYWORD") *colors*) '(255 255 0) 174 | (gethash (intern "YELLOWGREEN" "KEYWORD") *colors*) '(154 205 50)) 175 | 176 | 177 | (defun get-color (c) 178 | (gethash c *colors*)) 179 | 180 | 181 | (defun plotly-get-color (c) 182 | (let ((color (get-color c))) 183 | (format nil "rgb(~A, ~A, ~A)" 184 | (first color) 185 | (second color) 186 | (third color)))) 187 | 188 | 189 | ;;;; Ploly converter 190 | ;;; 191 | ;;; Plotly accepts data just like json, so here we provide 192 | ;;; convert latent expression generated by interface.lisp 193 | ;;; to json-like style. 194 | 195 | 196 | (defun plotly-line (data) 197 | (symbol-downcase 198 | `(:x ,(cdr (assoc :x data)) 199 | :y ,(cdr (assoc :y data)) 200 | :type "scatter" 201 | :mode "lines" 202 | ,@(if (assoc :name data) 203 | (symbol-downcase 204 | (list :name (cdr (assoc :name data))))) 205 | :line ,(symbol-downcase 206 | `(:color ,(plotly-get-color (cdr (assoc :color data))) 207 | ,@(if (assoc :width data) 208 | (symbol-downcase 209 | (list :width (cdr (assoc :width data)))))))))) 210 | 211 | 212 | (defun plotly-marker (data) 213 | (symbol-downcase 214 | `(:x ,(cdr (assoc :x data)) 215 | :y ,(cdr (assoc :y data)) 216 | :type "scatter" 217 | :mode "markers" 218 | ,@(if (assoc :name data) 219 | (symbol-downcase 220 | (list :name (cdr (assoc :name data))))) 221 | :marker ,(symbol-downcase 222 | `(:color ,(plotly-get-color (cdr (assoc :color data))) 223 | ,@(if (assoc :width data) 224 | (symbol-downcase 225 | (list :width (cdr (assoc :width data)))))))))) 226 | 227 | 228 | (defun plotly-fill (data) 229 | (list 230 | (symbol-downcase 231 | `(:x ,(cdr (assoc :x data)) 232 | :y ,(cdr (assoc :y0 data)) 233 | :type "scatter" 234 | :mode "lines" 235 | :line ,(symbol-downcase 236 | `(:color ,(plotly-get-color (cdr (assoc :color data))))))) 237 | (symbol-downcase 238 | `(:x ,(cdr (assoc :x data)) 239 | :y ,(cdr (assoc :y1 data)) 240 | :type "scatter" 241 | :mode "lines" 242 | :fill "tonexty" 243 | :fillcolor (plotly-get-color (cdr (assoc :color data))) 244 | :line ,(symbol-downcase 245 | `(:color ,(plotly-get-color (cdr (assoc :color data))))))))) 246 | 247 | 248 | (defun plotly-errorbar (data) 249 | (symbol-downcase 250 | `(:x ,(cdr (assoc :x data)) 251 | :y ,(cdr (assoc :y data)) 252 | :type "scatter" 253 | :mode "marker" 254 | :fill "tonexty" 255 | :marker (:color ,(plotly-get-color (cdr (assoc :color data)))) 256 | ,@(let ((errx (assoc :error-x data))) 257 | (if errx 258 | (symbol-downcase 259 | `(:error_x 260 | ,(symbol-downcase 261 | `(:type "data" 262 | :symmetric :false 263 | :color ,(plotly-get-color (cdr (assoc :color data))) 264 | ,@(if (consp (cadr errx)) 265 | (list :array (caddr errx) 266 | :arrayminus (cadr errx)) 267 | (list :array (cdr errx))))))))) 268 | ,@(let ((erry (assoc :error-y data))) 269 | (if erry 270 | (symbol-downcase 271 | `(:error_y 272 | (symbol-downcase 273 | `(:type "data" 274 | :symmetric :false 275 | :color ,(plotly-get-color (cdr (assoc :color data))) 276 | ,@(if (consp (cadr erry)) 277 | (list :array (caddr erry) 278 | :arrayminus (cadr erry)) 279 | (list :array (cdr erry)))))))))))) 280 | 281 | 282 | (defun plotly-bar (data) 283 | (symbol-downcase 284 | `(:x ,(cdr (assoc :x data)) 285 | :y ,(cdr (assoc :y data)) 286 | :type "bar" 287 | ,@(if (assoc :name data) 288 | (symbol-downcase 289 | (list :name (cdr (assoc :name data)))))))) 290 | 291 | 292 | (defun plotly-pie (data) 293 | (symbol-downcase 294 | `(:values ,(cdr (assoc :values data)) 295 | :labels ,(cdr (assoc :labels data)) 296 | :type "pie" 297 | ,@(if (assoc :name data) 298 | (symbol-downcase 299 | (list :name (cdr (assoc :name data)))))))) 300 | 301 | 302 | (defun plotly-box (data) 303 | (symbol-downcase 304 | `(:y ,(cdr (assoc :y data)) 305 | :type "box" 306 | ,@(if (assoc :name data) 307 | (symbol-downcase 308 | (list :name (cdr (assoc :name data))))) 309 | :boxmean ,(cdr (assoc :boxmean data)) 310 | :boxpoints ,(cdr (assoc :boxpoints data)) 311 | :marker (:color ,(plotly-get-color (cdr (assoc :color data))))))) 312 | 313 | 314 | (defun plotly-heatmap (data) 315 | (symbol-downcase 316 | `(:z ,(cdr (assoc :z data)) 317 | :type "heatmap" 318 | :showscale ,(cdr (assoc :showscale data))))) 319 | 320 | 321 | (defun plotly-contour (data) 322 | (symbol-downcase 323 | `(:z ,(cdr (assoc :z data)) 324 | :type "contour" 325 | :showscale ,(cdr (assoc :showscale data)) 326 | :autocontour ,(cdr (assoc :autocontour data))))) 327 | 328 | 329 | (defun plotly-line3d (data) 330 | (symbol-downcase 331 | `(:x ,(cdr (assoc :x data)) 332 | :y ,(cdr (assoc :y data)) 333 | :z ,(cdr (assoc :z data)) 334 | :type "scatter3d" 335 | :mode "lines" 336 | ,@(if (assoc :name data) 337 | (symbol-downcase 338 | (list :name (cdr (assoc :name data))))) 339 | :line ,(symbol-downcase 340 | `(:color ,(plotly-get-color (cdr (assoc :color data))) 341 | ,@(if (assoc :width data) 342 | (symbol-downcase 343 | (list :width (cdr (assoc :width data)))))))))) 344 | 345 | 346 | (defun plotly-marker3d (data) 347 | (symbol-downcase 348 | `(:x ,(cdr (assoc :x data)) 349 | :y ,(cdr (assoc :y data)) 350 | :z ,(cdr (assoc :z data)) 351 | :type "scatter3d" 352 | :mode "markers" 353 | ,@(if (assoc :name data) 354 | (symbol-downcase 355 | (list :name (cdr (assoc :name data))))) 356 | :marker ,(symbol-downcase 357 | `(:color ,(plotly-get-color (cdr (assoc :color data))) 358 | ,@(if (assoc :width data) 359 | (symbol-downcase 360 | (list :width (cdr (assoc :width data)))))))))) 361 | 362 | 363 | (defun plotly-surface (data) 364 | (symbol-downcase 365 | `(:z ,(cdr (assoc :z data)) 366 | :type "surface" 367 | ,@(if (assoc :name data) 368 | (symbol-downcase 369 | (list :name (cdr (assoc :name data)))))))) 370 | 371 | 372 | (defun plotly-convert (data) 373 | (let ((chart-type (cdr (assoc :type data)))) 374 | (cond 375 | ((equal chart-type "line") (list (plotly-line data))) 376 | ((equal chart-type "marker") (list (plotly-marker data))) 377 | ((equal chart-type "fill") (plotly-fill data)) 378 | ((equal chart-type "errorbar") (list (plotly-errorbar data))) 379 | ((equal chart-type "bar") (list (plotly-bar data))) 380 | ((equal chart-type "pie") (list (plotly-pie data))) 381 | ((equal chart-type "box") (list (plotly-box data))) 382 | ((equal chart-type "heatmap") (list (plotly-heatmap data))) 383 | ((equal chart-type "contour") (list (plotly-contour data))) 384 | ((equal chart-type "line3d") (list (plotly-line3d data))) 385 | ((equal chart-type "marker3d") (list (plotly-marker3d data))) 386 | ((equal chart-type "surface") (list (plotly-surface data)))))) 387 | 388 | 389 | (defun to-json (param) 390 | (let ((jonathan:*false-value* :false) 391 | (jonathan:*null-value* :null) 392 | (jonathan:*empty-array-value* :empty-array) 393 | (jonathan:*empty-object-value* :empty-object)) 394 | (jonathan:to-json param))) 395 | 396 | 397 | (defun plotly-code (states) 398 | (mapcar #'to-json 399 | (apply #'append 400 | (mapcar #'plotly-convert states)))) 401 | 402 | 403 | 404 | ;;;; GR regularizer 405 | ;;; 406 | ;;; Accordings in GR is expressed with relative values between 407 | ;;; 0 and 1. Here we provide accordings regularizer. 408 | 409 | (defun min-max (lst) 410 | (cons (apply #'min lst) 411 | (apply #'max lst))) 412 | 413 | 414 | (defun regularize (lst) 415 | (let* ((tmp-min-max (min-max lst)) 416 | (range (- (cdr tmp-min-max) 417 | (car tmp-min-max)))) 418 | (mapcar #'(lambda (x) 419 | (/ (- x (car tmp-min-max)) 420 | range)) 421 | lst))) 422 | 423 | 424 | 425 | ;;;; Sort argument data 426 | ;;; 427 | ;;; To plot sorted data, provide sort functions for Multiple 428 | ;;; arguments. 429 | 430 | (defun sort-data (&rest data) 431 | (labels ((concat (ls) 432 | (if (every #'null ls) 433 | nil 434 | (cons (mapcar #'car ls) 435 | (concat (mapcar #'cdr ls))))) 436 | (sort-l (l) 437 | (sort (copy-list l) 438 | #'(lambda (x y) 439 | (< (car x) (car y))))) 440 | (separate (l) 441 | (case (length (car l)) 442 | (2 (list (mapcar #'first l) 443 | (mapcar #'second l))) 444 | (3 (list (mapcar #'first l) 445 | (mapcar #'second l) 446 | (mapcar #'third l)))))) 447 | (separate (sort-l (concat data))))) 448 | -------------------------------------------------------------------------------- /src/gr/GR.lisp: -------------------------------------------------------------------------------- 1 | ;;;; GR.lisp --- A collection of API for GR 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file is composed of a collection of API for GR. These APIs 7 | ;;; are mainly just bindings to gr.h 8 | ;;; 9 | ;;; see: https://github.com/jheinen/GR.jl/blob/master/src/GR.jl 10 | 11 | (in-package :cl-user) 12 | (defpackage :kai.GR.GR 13 | (:use :cl) 14 | (:import-from :kai.util 15 | :make-kai-cache 16 | :data-alloc 17 | :free 18 | :string-alloc 19 | :string-free 20 | :arr-aref 21 | :flatten) 22 | (:export :init 23 | :openws 24 | :closews 25 | :inqdspsize 26 | :activatews 27 | :deactivatews 28 | :polyline 29 | :polymarker 30 | :text 31 | :inqtext 32 | :fillarea 33 | :cellarray 34 | :nonuniformcellarray 35 | :polarcellarray 36 | :gdp 37 | :spline 38 | :gridit 39 | :setlinetype 40 | :inqlinetype 41 | :setlinewidth 42 | :inqlinewidth 43 | :setlinecolorind 44 | :inqlinecolorind 45 | :setmarkertype 46 | :inqmarkertype 47 | :setmarkersize 48 | :inqmarkersize 49 | :setmarkercolorind 50 | :inqmarkercolorind 51 | :settextfontprec 52 | :setcharexpan 53 | :setcharspace 54 | :settextcolorind 55 | :inqtextcolorind 56 | :setcharheight 57 | :inqcharheight 58 | :setcharup 59 | :settextpath 60 | :settextalign 61 | :setfillintstyle 62 | :inqfillintstyle 63 | :setfillstyle 64 | :inqfillstyle 65 | :setfillcolorind 66 | :inqfillcolorind 67 | :setcolorrep 68 | :setwindow 69 | :inqwindow 70 | :setviewport 71 | :inqviewport 72 | :selntran 73 | :setclip 74 | :setwswindow 75 | :setwsviewport 76 | :createseg 77 | :copysegws 78 | :redrawsegws 79 | :setsegtran 80 | :closeseg 81 | :emergencyclosegks 82 | :updategks 83 | :setspace 84 | :inqspace 85 | :setscale 86 | :inqscale 87 | :textext 88 | :inqtextext 89 | :axes 90 | :axeslbl 91 | :grid 92 | :grid3d 93 | :verrorbars 94 | :herrorbars 95 | :polyline3d 96 | :polymarker3d 97 | :axes3d 98 | :titles3d 99 | :surface 100 | :contour 101 | :contourf 102 | :tricontour 103 | :hexbin 104 | :setcolormap 105 | :inqcolormap 106 | :setcolormapfromrgb 107 | :colorbar 108 | :inqcolor 109 | :inqcolorfromrgb 110 | :hsvtorgb 111 | :tick 112 | :validaterange 113 | :adjustlimits 114 | :adjustrange 115 | :beginprint 116 | :beginprinttext 117 | :endprint 118 | :ndctowc 119 | :wctondc 120 | :wc3towc 121 | :drawrect 122 | :fillrect 123 | :drawarc 124 | :fillarc 125 | :drawpath 126 | :setarrowstyle 127 | :setarrowsize 128 | :drawarrow 129 | :readimage 130 | :drawimage 131 | :importgraphics 132 | :setshadow 133 | :settransparency 134 | :setcoordxform 135 | :begingraphics 136 | :endgraphics 137 | :getgraphics 138 | :drawgraphics 139 | :mathtex 140 | :inqmathtex 141 | :setregenflags 142 | :inqregenflags 143 | :savestate 144 | :restorestate 145 | :selectcontext 146 | :destroycontext 147 | :uselinespec 148 | :delaunay 149 | :reducepoints 150 | :trisurface 151 | :gradient 152 | :quiver 153 | :interp2 154 | :version 155 | :shade 156 | :shadepoints 157 | :shadelines 158 | :panzoom 159 | :path 160 | :setborderwidth 161 | :setbordercolorind 162 | :setprojectiontype 163 | :setperspectiveprojection 164 | :settransformationparameters 165 | :setorthographicprojection 166 | :setwindow3d)) 167 | (in-package :kai.GR.GR) 168 | 169 | 170 | ;;;; Bindings 171 | ;;; 172 | ;;; We have to wrap GR functions with CFFI. 173 | 174 | 175 | ;; Initialize GR states 176 | 177 | (cffi:defcfun ("gr_initgr" initgr) :void) 178 | 179 | (cffi:defcfun ("gr_opengks" opengks) :void) 180 | 181 | (cffi:defcfun ("gr_closegks" closegks) :void) 182 | 183 | 184 | ;;;; Check display size 185 | ;;; 186 | ;;; To plot some data, we have to check windows size. 187 | 188 | (cffi:defcfun ("gr_inqdspsize" gr-inqdspsize) :void 189 | (mwidth (:pointer :double)) 190 | (mheight (:pointer :double)) 191 | (width (:pointer :int)) 192 | (height (:pointer :int))) 193 | 194 | (defun inqdspsize () 195 | (let ((mwidth (data-alloc '(0) :double)) 196 | (mheight (data-alloc '(0) :double)) 197 | (width (data-alloc '(0) :int)) 198 | (height (data-alloc '(0) :int))) 199 | (gr-inqdspsize mwidth 200 | mheight 201 | width 202 | height) 203 | (let ((-mwidth (arr-aref mwidth :double 0)) 204 | (-mheight (arr-aref mheight :double 0)) 205 | (-width (arr-aref width :int 0)) 206 | (-height (arr-aref height :int 0))) 207 | (free mwidth mheight width height) 208 | (list -mwidth -mheight -width -height)))) 209 | 210 | 211 | 212 | #| 213 | openws(workstation_id::Int, connection, workstation_type::Int) 214 | 215 | Open a graphical workstation. 216 | 217 | workstation_id : 218 | A workstation identifier. 219 | 220 | connection : 221 | A connection identifier. 222 | 223 | workstation_type : 224 | The desired workstation type. 225 | 226 | Available workstation types: 227 | 228 | +-------------+------------------------------------------------------+ 229 | | 5|Workstation Independent Segment Storage | 230 | +-------------+------------------------------------------------------+ 231 | | 7, 8|Computer Graphics Metafile (CGM binary, clear text) | 232 | +-------------+------------------------------------------------------+ 233 | | 41|Windows GDI | 234 | +-------------+------------------------------------------------------+ 235 | | 51|Mac Quickdraw | 236 | +-------------+------------------------------------------------------+ 237 | | 61 - 64|PostScript (b/w, color) | 238 | +-------------+------------------------------------------------------+ 239 | | 101, 102|Portable Document Format (plain, compressed) | 240 | +-------------+------------------------------------------------------+ 241 | | 210 - 213|X Windows | 242 | +-------------+------------------------------------------------------+ 243 | | 214|Sun Raster file (RF) | 244 | +-------------+------------------------------------------------------+ 245 | | 215, 218|Graphics Interchange Format (GIF87, GIF89) | 246 | +-------------+------------------------------------------------------+ 247 | | 216|Motif User Interface Language (UIL) | 248 | +-------------+------------------------------------------------------+ 249 | | 320|Windows Bitmap (BMP) | 250 | +-------------+------------------------------------------------------+ 251 | | 321|JPEG image file | 252 | +-------------+------------------------------------------------------+ 253 | | 322|Portable Network Graphics file (PNG) | 254 | +-------------+------------------------------------------------------+ 255 | | 323|Tagged Image File Format (TIFF) | 256 | +-------------+------------------------------------------------------+ 257 | | 370|Xfig vector graphics file | 258 | +-------------+------------------------------------------------------+ 259 | | 371|Gtk | 260 | +-------------+------------------------------------------------------+ 261 | | 380|wxWidgets | 262 | +-------------+------------------------------------------------------+ 263 | | 381|Qt4 | 264 | +-------------+------------------------------------------------------+ 265 | | 382|Scaleable Vector Graphics (SVG) | 266 | +-------------+------------------------------------------------------+ 267 | | 390|Windows Metafile | 268 | +-------------+------------------------------------------------------+ 269 | | 400|Quartz | 270 | +-------------+------------------------------------------------------+ 271 | | 410|Socket driver | 272 | +-------------+------------------------------------------------------+ 273 | | 415|0MQ driver | 274 | +-------------+------------------------------------------------------+ 275 | | 420|OpenGL | 276 | +-------------+------------------------------------------------------+ 277 | | 430|HTML5 Canvas | 278 | +-------------+------------------------------------------------------+ 279 | |# 280 | 281 | (cffi:defcfun ("gr_openws" gr-openws) :void 282 | (workstation-id :int) 283 | (connection (:pointer :char)) 284 | (type :int)) 285 | 286 | (defun openws (ws-id connection type) 287 | (let ((conn-data (string-alloc connection))) 288 | (gr-openws ws-id 289 | conn-data 290 | type))) 291 | 292 | 293 | #| 294 | closews(workstation_id::Int) 295 | 296 | Close the specified workstation. 297 | 298 | workstation_id : 299 | A workstation identifier. 300 | |# 301 | 302 | (cffi:defcfun ("gr_closews" gr-closews) :void 303 | (workstation-id :int)) 304 | 305 | (defun closews (ws-id) 306 | (gr-closews ws-id)) 307 | 308 | 309 | #| 310 | activatews(workstation_id::Int) 311 | 312 | Activate the specified workstation. 313 | 314 | workstation_id : 315 | A workstation identifier. 316 | 317 | |# 318 | 319 | (cffi:defcfun ("gr_activatews" gr-activatews) :void 320 | (workstation-id :int)) 321 | 322 | (defun activatews (ws-id) 323 | (gr-activatews ws-id)) 324 | 325 | 326 | #| 327 | deactivatews(workstation_id::Int) 328 | 329 | Deactivate the specified workstation. 330 | 331 | workstation_id : 332 | A workstation identifier. 333 | |# 334 | 335 | (cffi:defcfun ("gr_deactivatews" gr-deactivatews) :void 336 | (workstation-id :int)) 337 | 338 | (defun deactivatews (ws-id) 339 | (gr-deactivatews ws-id)) 340 | 341 | 342 | ;; Configure the specified workstation 343 | 344 | (cffi:defcfun ("gr_configurews" configurews) :void) 345 | 346 | 347 | ;; Clear the specified workstation 348 | (cffi:defcfun ("gr_clearws" clearws) :void) 349 | 350 | 351 | ;; Update the specified workstation 352 | (cffi:defcfun ("gr_updatews" updatews) :void) 353 | 354 | 355 | #| 356 | polyline 357 | 358 | Draw a polyline using the current line attributes, starting from the 359 | first data point and ending at the last data point. 360 | 361 | x : 362 | A list containing the X coordinates 363 | 364 | y : 365 | A list containing the Y coordinates 366 | 367 | |# 368 | 369 | (cffi:defcfun ("gr_polyline" gr-polyline) :void 370 | (n :int) 371 | (x (:pointer :double)) 372 | (y (:pointer :double))) 373 | 374 | (defun polyline (x y) 375 | (assert (= (length x) (length y))) 376 | (let ((x-data (data-alloc x :double)) 377 | (y-data (data-alloc y :double))) 378 | (gr-polyline (length x) 379 | x-data 380 | y-data) 381 | (free x-data 382 | y-data))) 383 | 384 | 385 | #| 386 | polymarker 387 | 388 | Draw marker symbols centered at the given data points. 389 | 390 | x : 391 | A list containing the X coordinates 392 | 393 | y : 394 | A list containing the Y coordinates 395 | 396 | |# 397 | 398 | (cffi:defcfun ("gr_polymarker" gr-polymarker) :void 399 | (n :int) 400 | (x (:pointer :double)) 401 | (y (:pointer :double))) 402 | 403 | (defun polymarker (x y) 404 | (assert (= (length x) (length y))) 405 | (let ((x-data (data-alloc x :double)) 406 | (y-data (data-alloc y :double))) 407 | (gr-polymarker (length x) 408 | x-data 409 | y-data) 410 | (free x-data) 411 | (free y-data))) 412 | 413 | 414 | #| 415 | text(x::Real, y::Real, string) 416 | 417 | Draw a text at position `x`, `y` using the current text attributes. 418 | 419 | x : 420 | The X coordinate of starting position of the text string 421 | 422 | y : 423 | The Y coordinate of starting position of the text string 424 | 425 | strin` : 426 | The text to be drawn 427 | 428 | The values for x and y are in normalized device coordinates. 429 | The attributes that control the appearance of text are text font and precision, 430 | character expansion factor, character spacing, text color index, character 431 | height, character up vector, text path and text alignment. 432 | |# 433 | 434 | (cffi:defcfun ("gr_text" gr-text) :void 435 | (x :double) 436 | (y :double) 437 | (str (:pointer :char))) 438 | 439 | (defun text (x y str) 440 | (let ((str-data (string-alloc str))) 441 | (gr-text (coerce x 'double-float) 442 | (coerce y 'double-float) 443 | str-data) 444 | (string-free str-data))) 445 | 446 | (cffi:defcfun ("gr_inqtext" gr-inqtext) :void 447 | (x :double) 448 | (y :double) 449 | (str (:pointer :char)) 450 | (tbx (:pointer :double)) 451 | (tby (:pointer :double))) 452 | 453 | (defun inqtext (x y str) 454 | (let ((str-data (string-alloc str)) 455 | (tbx (data-alloc '(0 0 0 0) :double)) 456 | (tby (data-alloc '(0 0 0 0) :double))) 457 | (gr-inqtext (coerce x 'double-float) 458 | (coerce y 'double-float) 459 | str-data 460 | tbx 461 | tby) 462 | (let ((-tbx (loop for i below 4 463 | collect (arr-aref tbx :double i))) 464 | (-tby (loop for i below 4 465 | collect (arr-aref tby :double i)))) 466 | (free tbx tby) 467 | (string-free str-data) 468 | (list -tbx -tby)))) 469 | 470 | 471 | #| 472 | fillarea(x, y) 473 | 474 | Allows you to specify a polygonal shape of an area to be filled. 475 | 476 | x : 477 | A list containing the X coordinates 478 | y : 479 | A list containing the Y coordinates 480 | 481 | The attributes that control the appearance of fill areas are fill area interior 482 | style, fill area style index and fill area color index. 483 | |# 484 | 485 | (cffi:defcfun ("gr_fillarea" gr-fillarea) :void 486 | (n :int) 487 | (x (:pointer :double)) 488 | (y (:pointer :double))) 489 | 490 | (defun fillarea (x y) 491 | (assert (= (length x) (length y))) 492 | (let ((x-data (data-alloc x :double)) 493 | (y-data (data-alloc y :double))) 494 | (gr-fillarea (length x) 495 | (data-alloc x :double) 496 | (data-alloc y :double)) 497 | (free x-data 498 | y-data))) 499 | 500 | 501 | #| 502 | cellarray(xmin::Real, xmax::Real, ymin::Real, ymax::Real, dimx::Int, dimy::Int, color) 503 | 504 | Display rasterlike images in a device-independent manner. The cell array 505 | function partitions a rectangle given by two corner points into DIMX X DIMY 506 | cells, each of them colored individually by the corresponding color index 507 | of the given cell array. 508 | 509 | xmin, ymin : 510 | Lower left point of the rectangle 511 | 512 | xmax, ymax : 513 | Upper right point of the rectangle 514 | 515 | dimx, dimy : 516 | X and Y dimension of the color index array 517 | 518 | color : 519 | Color index array 520 | 521 | The values for xmin, xmax, ymin and ymax are in world coordinates. 522 | |# 523 | 524 | (cffi:defcfun ("gr_cellarray" gr-cellarray) :void 525 | (xmin :double) 526 | (xmax :double) 527 | (ymin :double) 528 | (ymax :double) 529 | (dimx :int) 530 | (dimy :int) 531 | (scol :int) 532 | (srow :int) 533 | (ncol :int) 534 | (nrow :int) 535 | (color (:pointer :int))) 536 | 537 | (defun cellarray (xmin xmax ymin ymax dimx dimy color) 538 | (let ((color-data (data-alloc (flatten color) :int))) 539 | (gr-cellarray (coerce xmin 'double-float) 540 | (coerce xmax 'double-float) 541 | (coerce ymin 'double-float) 542 | (coerce ymax 'double-float) 543 | dimx 544 | dimy 545 | 1 ; scol 546 | 1 ; srow 547 | dimx ; ncol 548 | dimy ; nrow 549 | color-data) 550 | (free color-data))) 551 | 552 | 553 | #| 554 | nonuniformcellarray(x, y, dimx::Int, dimy::Int, color) 555 | 556 | Display a two dimensional color index array with nonuniform cell sizes. 557 | 558 | x, y : 559 | X and Y coordinates of the cell edges 560 | 561 | dimx, dimy : 562 | X and Y dimension of the color index array 563 | 564 | color : 565 | Color index array 566 | 567 | The values for x and y are in world coordinates. x must contain dimx + 1 elements 568 | and y must contain dimy + 1 elements. The elements i and i+1 are respectively the edges 569 | of the i-th cell in X and Y direction. 570 | |# 571 | 572 | (cffi:defcfun ("gr_nonuniformcellarray" gr-nonuniformcellarray) :void 573 | (x (:pointer :double)) 574 | (y (:pointer :double)) 575 | (dimx :int) 576 | (dimy :int) 577 | (scol :int) 578 | (srow :int) 579 | (ncol :int) 580 | (nrow :int) 581 | (color (:pointer :int))) 582 | 583 | (defun nonuniformcellarray (x y dimx dimy color) 584 | (let ((color-data (data-alloc (flatten color) :int))) 585 | (gr-nonuniformcellarray (data-alloc x :double) 586 | (data-alloc y :double) 587 | dimx 588 | dimy 589 | 1 590 | 1 591 | dimx 592 | dimy 593 | color-data) 594 | (free color-data))) 595 | 596 | 597 | #| 598 | polarcellarray(xorg::Real, yorg::Real, phimin::Real, phimax::Real, rmin::Real, rmax::Real, imphi::Int, dimr::Int, color) 599 | 600 | Display a two dimensional color index array mapped to a disk using polar 601 | coordinates. 602 | 603 | xorg : 604 | X coordinate of the disk center in world coordinates 605 | 606 | yorg : 607 | Y coordinate of the disk center in world coordinates 608 | 609 | phimin : 610 | start angle of the disk sector in degrees 611 | 612 | phimax : 613 | end angle of the disk sector in degrees 614 | 615 | rmin : 616 | inner radius of the punctured disk in world coordinates 617 | 618 | rmax : 619 | outer radius of the punctured disk in world coordinates 620 | 621 | dimiphi, dimr : 622 | Phi (X) and iR (Y) dimension of the color index array 623 | 624 | color : 625 | Color index array 626 | 627 | The two dimensional color index array is mapped to the resulting image by 628 | interpreting the X-axis of the array as the angle and the Y-axis as the raidus. 629 | The center point of the resulting disk is located at xorg, yorg and the 630 | radius of the disk is `rmax`. 631 | |# 632 | 633 | (cffi:defcfun ("gr_polarcellarray" gr-polarcellarray) :void 634 | (xorg :double) 635 | (yorg :double) 636 | (phimin :double) 637 | (phimax :double) 638 | (rmin :double) 639 | (rmax :double) 640 | (dimphi :int) 641 | (dimr :int) 642 | (scol :int) 643 | (srow :int) 644 | (ncol :int) 645 | (nrow :int) 646 | (color (:pointer :int))) 647 | 648 | (defun polarcellarray (xorg yorg phimin phimax rmin rmax dimphi dimr color) 649 | (let ((color-data (data-alloc (flatten color) :int))) 650 | (gr-polarcellarray (coerce xorg 'double-float) 651 | (coerce yorg 'double-float) 652 | (coerce phimin 'double-float) 653 | (coerce phimax 'double-float) 654 | (coerce rmin 'double-float) 655 | (coerce rmax 'double-float) 656 | dimphi 657 | dimr 658 | 1 659 | 1 660 | dimphi 661 | dimr 662 | color-data) 663 | (free color-data))) 664 | 665 | 666 | #| 667 | gdp(x, y, primid, datrec) 668 | 669 | Generates a generalized drawing primitive (GDP) of the type you specify, 670 | using specified points and any additional information contained in a data 671 | record. 672 | 673 | x : 674 | A list containing the X coordinates 675 | 676 | y : 677 | A list containing the Y coordinates 678 | 679 | primid : 680 | Primitive identifier 681 | 682 | datrec : 683 | Primitive data record 684 | |# 685 | 686 | (cffi:defcfun ("gr_gdp" gr-gdp) :void 687 | (n :int) 688 | (x (:pointer :double)) 689 | (y (:pointer :double)) 690 | (primid :int) 691 | (ldr :int) 692 | (datrec (:pointer :int))) 693 | 694 | (defun gdp (x y primid datrec) 695 | (assert (= (length x) (length y))) 696 | (let ((x-data (data-alloc x :double)) 697 | (y-data (data-alloc y :double)) 698 | (datrec-data (data-alloc datrec :int))) 699 | (gr-gdp (length x) 700 | x-data 701 | y-data 702 | primid 703 | (length primid) 704 | datrec-data) 705 | (free x-data 706 | y-data 707 | datrec-data))) 708 | 709 | 710 | #| 711 | spline(x, y, m, method) 712 | 713 | Generate a cubic spline-fit, starting from the first data point and 714 | ending at the last data point. 715 | 716 | x : 717 | A list containing the X coordinates 718 | 719 | y : 720 | A list containing the Y coordinates 721 | 722 | m : 723 | The number of points in the polygon to be drawn (m > len(x)) 724 | 725 | method : 726 | The smoothing method 727 | 728 | The values for x and y are in world coordinates. The attributes that 729 | control the appearance of a spline-fit are linetype, linewidth and color 730 | index. 731 | 732 | If method is > 0, then a generalized cross-validated smoothing spline is calculated. 733 | If method is 0, then an interpolating natural cubic spline is calculated. 734 | If method is < -1, then a cubic B-spline is calculated. 735 | |# 736 | 737 | (cffi:defcfun ("gr_spline" gr-spline) :void 738 | (n :int) 739 | (px (:pointer :double)) 740 | (py (:pointer :double)) 741 | (m :int) 742 | (method :int)) 743 | 744 | (defun spline (x y m method) 745 | (assert (= (length x) (length y))) 746 | (let ((x-data (data-alloc x :double)) 747 | (y-data (data-alloc y :double))) 748 | (gr-spline (length x) 749 | x-data 750 | y-data 751 | m 752 | method) 753 | (free x-data 754 | y-data))) 755 | 756 | (cffi:defcfun ("gr_gridit" gr-gridit) :void 757 | (nd :int) 758 | (xd (:pointer :double)) 759 | (yd (:pointer :double)) 760 | (zd (:pointer :double)) 761 | (nx :int) 762 | (ny :int) 763 | (x (:pointer :double)) 764 | (y (:pointer :double)) 765 | (z (:pointer :double))) 766 | 767 | (defun gridit (xd yd zd nx ny) 768 | (assert (= (length xd) (length yd) (length zd))) 769 | (let ((xd-data (data-alloc xd :double)) 770 | (yd-data (data-alloc yd :double)) 771 | (zd-data (data-alloc zd :double)) 772 | (x-data (data-alloc (loop for i from 1 to nx 773 | collect i) 774 | :double)) 775 | (y-data (data-alloc (loop for i from 1 to ny 776 | collect i) 777 | :double)) 778 | (z-data (data-alloc (loop for i from 1 to (* nx ny) 779 | collect i) 780 | :double))) 781 | (gr-gridit (length xd) 782 | xd-data 783 | yd-data 784 | zd-data 785 | nx 786 | ny 787 | x-data 788 | y-data 789 | z-data) 790 | (free xd-data 791 | yd-data 792 | zd-data 793 | x-data 794 | y-data 795 | z-data))) 796 | 797 | 798 | #| 799 | setlinetype(style::Int) 800 | 801 | Specify the line style for polylines. 802 | 803 | style : 804 | The polyline line style 805 | 806 | The available line types are: 807 | 808 | +---------------------------+----+---------------------------------------------------+ 809 | |LINETYPE_SOLID | 1|Solid line | 810 | +---------------------------+----+---------------------------------------------------+ 811 | |LINETYPE_DASHED | 2|Dashed line | 812 | +---------------------------+----+---------------------------------------------------+ 813 | |LINETYPE_DOTTED | 3|Dotted line | 814 | +---------------------------+----+---------------------------------------------------+ 815 | |LINETYPE_DASHED_DOTTED | 4|Dashed-dotted line | 816 | +---------------------------+----+---------------------------------------------------+ 817 | |LINETYPE_DASH_2_DOT | -1|Sequence of one dash followed by two dots | 818 | +---------------------------+----+---------------------------------------------------+ 819 | |LINETYPE_DASH_3_DOT | -2|Sequence of one dash followed by three dots | 820 | +---------------------------+----+---------------------------------------------------+ 821 | |LINETYPE_LONG_DASH | -3|Sequence of long dashes | 822 | +---------------------------+----+---------------------------------------------------+ 823 | |LINETYPE_LONG_SHORT_DASH | -4|Sequence of a long dash followed by a short dash | 824 | +---------------------------+----+---------------------------------------------------+ 825 | |LINETYPE_SPACED_DASH | -5|Sequence of dashes double spaced | 826 | +---------------------------+----+---------------------------------------------------+ 827 | |LINETYPE_SPACED_DOT | -6|Sequence of dots double spaced | 828 | +---------------------------+----+---------------------------------------------------+ 829 | |LINETYPE_DOUBLE_DOT | -7|Sequence of pairs of dots | 830 | +---------------------------+----+---------------------------------------------------+ 831 | |LINETYPE_TRIPLE_DOT | -8|Sequence of groups of three dots | 832 | +---------------------------+----+---------------------------------------------------+ 833 | 834 | |# 835 | 836 | (cffi:defcfun ("gr_setlinetype" gr-setlinetype) :void 837 | (linetype :int)) 838 | 839 | (defun setlinetype (linetype) 840 | (gr-setlinetype linetype)) 841 | 842 | 843 | (cffi:defcfun ("gr_inqlinetype" gr-inqlinetype) :void 844 | (linetype (:pointer :int))) 845 | 846 | (defun inqlinetype (linetype) 847 | (let ((linetype-data (data-alloc linetype :double))) 848 | (gr-inqlinetype linetype-data) 849 | (free linetype-data))) 850 | 851 | 852 | 853 | #| 854 | setlinewidth(width::Real) 855 | 856 | Define the line width of subsequent polyline output primitives. 857 | 858 | width : 859 | The polyline line width scale factor 860 | 861 | The line width is calculated as the nominal line width generated 862 | on the workstation multiplied by the line width scale factor. 863 | This value is mapped by the workstation to the nearest available line width. 864 | The default line width is 1.0, or 1 times the line width generated on the graphics device. 865 | 866 | |# 867 | 868 | (cffi:defcfun ("gr_setlinewidth" gr-setlinewidth) :void 869 | (width :double)) 870 | 871 | (defun setlinewidth (width) 872 | (gr-setlinetype (coerce width 'double-float))) 873 | 874 | 875 | (cffi:defcfun ("gr_inqlinewidth" gr-inqlinewidth) :void 876 | (width (:pointer :double))) 877 | 878 | (defun inqlinewidth (width) 879 | (let ((width-data (data-alloc width :double))) 880 | (gr-inqlinewidth width-data) 881 | (free width-data))) 882 | 883 | 884 | #| 885 | setlinecolorind(color::Int) 886 | 887 | Define the color of subsequent polyline output primitives. 888 | 889 | color : 890 | The polyline color index (COLOR < 1256) 891 | 892 | |# 893 | 894 | (cffi:defcfun ("gr_setlinecolorind" gr-setlinecolorind) :void 895 | (color :int)) 896 | 897 | (defun setlinecolorind (color) 898 | (gr-setlinecolorind color)) 899 | 900 | 901 | (cffi:defcfun ("gr_inqlinecolorind" gr-inqlinecolorind) :void 902 | (coli (:pointer :int))) 903 | 904 | (defun inqlinecolorind (coli) 905 | (let ((coli-data (data-alloc coli :int))) 906 | (gr-inqlinecolorind coli-data) 907 | (free coli-data))) 908 | 909 | 910 | #| 911 | setmarkertype(mtype::Int) 912 | 913 | Specifiy the marker type for polymarkers. 914 | 915 | style : 916 | The polymarker marker type 917 | 918 | The available marker types are: 919 | 920 | +-----------------------------+-----+------------------------------------------------+ 921 | |MARKERTYPE_DOT | 1|Smallest displayable dot | 922 | +-----------------------------+-----+------------------------------------------------+ 923 | |MARKERTYPE_PLUS | 2|Plus sign | 924 | +-----------------------------+-----+------------------------------------------------+ 925 | |MARKERTYPE_ASTERISK | 3|Asterisk | 926 | +-----------------------------+-----+------------------------------------------------+ 927 | |MARKERTYPE_CIRCLE | 4|Hollow circle | 928 | +-----------------------------+-----+------------------------------------------------+ 929 | |MARKERTYPE_DIAGONAL_CROSS | 5|Diagonal cross | 930 | +-----------------------------+-----+------------------------------------------------+ 931 | |MARKERTYPE_SOLID_CIRCLE | -1|Filled circle | 932 | +-----------------------------+-----+------------------------------------------------+ 933 | |MARKERTYPE_TRIANGLE_UP | -2|Hollow triangle pointing upward | 934 | +-----------------------------+-----+------------------------------------------------+ 935 | |MARKERTYPE_SOLID_TRI_UP | -3|Filled triangle pointing upward | 936 | +-----------------------------+-----+------------------------------------------------+ 937 | |MARKERTYPE_TRIANGLE_DOWN | -4|Hollow triangle pointing downward | 938 | +-----------------------------+-----+------------------------------------------------+ 939 | |MARKERTYPE_SOLID_TRI_DOWN | -5|Filled triangle pointing downward | 940 | +-----------------------------+-----+------------------------------------------------+ 941 | |MARKERTYPE_SQUARE | -6|Hollow square | 942 | +-----------------------------+-----+------------------------------------------------+ 943 | |MARKERTYPE_SOLID_SQUARE | -7|Filled square | 944 | +-----------------------------+-----+------------------------------------------------+ 945 | |MARKERTYPE_BOWTIE | -8|Hollow bowtie | 946 | +-----------------------------+-----+------------------------------------------------+ 947 | |MARKERTYPE_SOLID_BOWTIE | -9|Filled bowtie | 948 | +-----------------------------+-----+------------------------------------------------+ 949 | |MARKERTYPE_HGLASS | -10|Hollow hourglass | 950 | +-----------------------------+-----+------------------------------------------------+ 951 | |MARKERTYPE_SOLID_HGLASS | -11|Filled hourglass | 952 | +-----------------------------+-----+------------------------------------------------+ 953 | |MARKERTYPE_DIAMOND | -12|Hollow diamond | 954 | +-----------------------------+-----+------------------------------------------------+ 955 | |MARKERTYPE_SOLID_DIAMOND | -13|Filled Diamond | 956 | +-----------------------------+-----+------------------------------------------------+ 957 | |MARKERTYPE_STAR | -14|Hollow star | 958 | +-----------------------------+-----+------------------------------------------------+ 959 | |MARKERTYPE_SOLID_STAR | -15|Filled Star | 960 | +-----------------------------+-----+------------------------------------------------+ 961 | |MARKERTYPE_TRI_UP_DOWN | -16|Hollow triangles pointing up and down overlaid | 962 | +-----------------------------+-----+------------------------------------------------+ 963 | |MARKERTYPE_SOLID_TRI_RIGHT | -17|Filled triangle point right | 964 | +-----------------------------+-----+------------------------------------------------+ 965 | |MARKERTYPE_SOLID_TRI_LEFT | -18|Filled triangle pointing left | 966 | +-----------------------------+-----+------------------------------------------------+ 967 | |MARKERTYPE_HOLLOW PLUS | -19|Hollow plus sign | 968 | +-----------------------------+-----+------------------------------------------------+ 969 | |MARKERTYPE_SOLID PLUS | -20|Solid plus sign | 970 | +-----------------------------+-----+------------------------------------------------+ 971 | |MARKERTYPE_PENTAGON | -21|Pentagon | 972 | +-----------------------------+-----+------------------------------------------------+ 973 | |MARKERTYPE_HEXAGON | -22|Hexagon | 974 | +-----------------------------+-----+------------------------------------------------+ 975 | |MARKERTYPE_HEPTAGON | -23|Heptagon | 976 | +-----------------------------+-----+------------------------------------------------+ 977 | |MARKERTYPE_OCTAGON | -24|Octagon | 978 | +-----------------------------+-----+------------------------------------------------+ 979 | |MARKERTYPE_STAR_4 | -25|4-pointed star | 980 | +-----------------------------+-----+------------------------------------------------+ 981 | |MARKERTYPE_STAR_5 | -26|5-pointed star (pentagram) | 982 | +-----------------------------+-----+------------------------------------------------+ 983 | |MARKERTYPE_STAR_6 | -27|6-pointed star (hexagram) | 984 | +-----------------------------+-----+------------------------------------------------+ 985 | |MARKERTYPE_STAR_7 | -28|7-pointed star (heptagram) | 986 | +-----------------------------+-----+------------------------------------------------+ 987 | |MARKERTYPE_STAR_8 | -29|8-pointed star (octagram) | 988 | +-----------------------------+-----+------------------------------------------------+ 989 | |MARKERTYPE_VLINE | -30|verical line | 990 | +-----------------------------+-----+------------------------------------------------+ 991 | |MARKERTYPE_HLINE | -31|horizontal line | 992 | +-----------------------------+-----+------------------------------------------------+ 993 | |MARKERTYPE_OMARK | -32|o-mark | 994 | +-----------------------------+-----+------------------------------------------------+ 995 | Polymarkers appear centered over their specified coordinates. 996 | 997 | |# 998 | 999 | (cffi:defcfun ("gr_setmarkertype" gr-setmarkertype) :void 1000 | (markertype :int)) 1001 | 1002 | (defun setmarkertype (markertype) 1003 | (gr-setlinetype markertype)) 1004 | 1005 | 1006 | (cffi:defcfun ("gr_inqmarkertype" gr-inqmarkertype) :void 1007 | (markertype (:pointer :int))) 1008 | 1009 | (defun inqmarkertype (markertype) 1010 | (let ((markertype-data (data-alloc markertype :int))) 1011 | (gr-inqmarkertype markertype-data) 1012 | (free markertype-data))) 1013 | 1014 | 1015 | #| 1016 | setmarkersize(mtype::Real) 1017 | 1018 | Specify the marker size for polymarkers. 1019 | 1020 | size : 1021 | Scale factor applied to the nominal marker size 1022 | 1023 | The polymarker size is calculated as the nominal size generated on the graphics device 1024 | multiplied by the marker size scale factor. 1025 | 1026 | |# 1027 | 1028 | (cffi:defcfun ("gr_setmarkersize" gr-setmarkersize) :void 1029 | (markersize :double)) 1030 | 1031 | (defun setmarkersize (markersize) 1032 | (gr-setmarkersize (coerce markersize 'double-float))) 1033 | 1034 | 1035 | (cffi:defcfun ("gr_inqmarkersize" gr-inqmarkersize) :void 1036 | (markersize (:pointer :double))) 1037 | 1038 | (defun inqmarkersize (markersize) 1039 | (let ((markersize-data (data-alloc markersize :double))) 1040 | (gr-inqmarkersize markersize-data) 1041 | (free markersize-data))) 1042 | 1043 | 1044 | #| 1045 | setmarkercolorind(color::Int) 1046 | 1047 | Define the color of subsequent polymarker output primitives. 1048 | 1049 | color : 1050 | The polymarker color index (COLOR < 1256) 1051 | 1052 | |# 1053 | 1054 | (cffi:defcfun ("gr_setmarkercolorind" gr-setmarkercolorind) :void 1055 | (color :int)) 1056 | 1057 | (defun setmarkercolorind (color) 1058 | (gr-setmarkercolorind color)) 1059 | 1060 | 1061 | (cffi:defcfun ("gr_inqmarkercolorind" gr-inqmarkercolorind) :void 1062 | (color (:pointer :int))) 1063 | 1064 | (defun inqmarkercolorind (color) 1065 | (let ((color-data (data-alloc color :int))) 1066 | (gr-inqmarkercolorind color-data) 1067 | (free color-data))) 1068 | 1069 | 1070 | 1071 | #| 1072 | settextfontprec(font::Int, precision::Int) 1073 | 1074 | Specify the text font and precision for subsequent text output primitives. 1075 | 1076 | font : 1077 | Text font (see tables below) 1078 | 1079 | precision : 1080 | Text precision (see table below) 1081 | 1082 | The available text fonts are: 1083 | 1084 | +--------------------------------------+-----+ 1085 | |FONT_TIMES_ROMAN | 101| 1086 | +--------------------------------------+-----+ 1087 | |FONT_TIMES_ITALIC | 102| 1088 | +--------------------------------------+-----+ 1089 | |FONT_TIMES_BOLD | 103| 1090 | +--------------------------------------+-----+ 1091 | |FONT_TIMES_BOLDITALIC | 104| 1092 | +--------------------------------------+-----+ 1093 | |FONT_HELVETICA | 105| 1094 | +--------------------------------------+-----+ 1095 | |FONT_HELVETICA_OBLIQUE | 106| 1096 | +--------------------------------------+-----+ 1097 | |FONT_HELVETICA_BOLD | 107| 1098 | +--------------------------------------+-----+ 1099 | |FONT_HELVETICA_BOLDOBLIQUE | 108| 1100 | +--------------------------------------+-----+ 1101 | |FONT_COURIER | 109| 1102 | +--------------------------------------+-----+ 1103 | |FONT_COURIER_OBLIQUE | 110| 1104 | +--------------------------------------+-----+ 1105 | |FONT_COURIER_BOLD | 111| 1106 | +--------------------------------------+-----+ 1107 | |FONT_COURIER_BOLDOBLIQUE | 112| 1108 | +--------------------------------------+-----+ 1109 | |FONT_SYMBOL | 113| 1110 | +--------------------------------------+-----+ 1111 | |FONT_BOOKMAN_LIGHT | 114| 1112 | +--------------------------------------+-----+ 1113 | |FONT_BOOKMAN_LIGHTITALIC | 115| 1114 | +--------------------------------------+-----+ 1115 | |FONT_BOOKMAN_DEMI | 116| 1116 | +--------------------------------------+-----+ 1117 | |FONT_BOOKMAN_DEMIITALIC | 117| 1118 | +--------------------------------------+-----+ 1119 | |FONT_NEWCENTURYSCHLBK_ROMAN | 118| 1120 | +--------------------------------------+-----+ 1121 | |FONT_NEWCENTURYSCHLBK_ITALIC | 119| 1122 | +--------------------------------------+-----+ 1123 | |FONT_NEWCENTURYSCHLBK_BOLD | 120| 1124 | +--------------------------------------+-----+ 1125 | |FONT_NEWCENTURYSCHLBK_BOLDITALIC | 121| 1126 | +--------------------------------------+-----+ 1127 | |FONT_AVANTGARDE_BOOK | 122| 1128 | +--------------------------------------+-----+ 1129 | |FONT_AVANTGARDE_BOOKOBLIQUE | 123| 1130 | +--------------------------------------+-----+ 1131 | |FONT_AVANTGARDE_DEMI | 124| 1132 | +--------------------------------------+-----+ 1133 | |FONT_AVANTGARDE_DEMIOBLIQUE | 125| 1134 | +--------------------------------------+-----+ 1135 | |FONT_PALATINO_ROMAN | 126| 1136 | +--------------------------------------+-----+ 1137 | |FONT_PALATINO_ITALIC | 127| 1138 | +--------------------------------------+-----+ 1139 | |FONT_PALATINO_BOLD | 128| 1140 | +--------------------------------------+-----+ 1141 | |FONT_PALATINO_BOLDITALIC | 129| 1142 | +--------------------------------------+-----+ 1143 | |FONT_ZAPFCHANCERY_MEDIUMITALIC | 130| 1144 | +--------------------------------------+-----+ 1145 | |FONT_ZAPFDINGBATS | 131| 1146 | +--------------------------------------+-----+ 1147 | 1148 | The available text precisions are: 1149 | 1150 | +---------------------------+---+--------------------------------------+ 1151 | |TEXT_PRECISION_STRING | 0|String precision (higher quality) | 1152 | +---------------------------+---+--------------------------------------+ 1153 | |TEXT_PRECISION_CHAR | 1|Character precision (medium quality) | 1154 | +---------------------------+---+--------------------------------------+ 1155 | |TEXT_PRECISION_STROKE | 2|Stroke precision (lower quality) | 1156 | +---------------------------+---+--------------------------------------+ 1157 | 1158 | The appearance of a font depends on the text precision value specified. 1159 | STRING, CHARACTER or STROKE precision allows for a greater or lesser 1160 | realization of the text primitives, for efficiency. STRING is the default 1161 | precision for GR and produces the highest quality output. 1162 | 1163 | |# 1164 | 1165 | (cffi:defcfun ("gr_settextfontprec" gr-settextfontprec) :void 1166 | (font :int) 1167 | (precision :int)) 1168 | 1169 | (defun settextfontprec (font precision) 1170 | (gr-settextfontprec font precision)) 1171 | 1172 | 1173 | #| 1174 | setcharexpan(factor::Real) 1175 | 1176 | Set the current character expansion factor (width to height ratio). 1177 | 1178 | factor : 1179 | Text expansion factor applied to the nominal text width-to-height ratio 1180 | 1181 | setcharexpan defines the width of subsequent text output primitives. The expansion 1182 | factor alters the width of the generated characters, but not their height. The default 1183 | text expansion factor is 1, or one times the normal width-to-height ratio of the text. 1184 | 1185 | |# 1186 | 1187 | (cffi:defcfun ("gr_setcharexpan" gr-setcharexpan) :void 1188 | (factor :double)) 1189 | 1190 | (defun setcharexpan (factor) 1191 | (gr-setcharexpan (coerce factor 'double-float))) 1192 | 1193 | 1194 | (cffi:defcfun ("gr_setcharspace" gr-setcharspace) :void 1195 | (spacing :double)) 1196 | 1197 | (defun setcharspace (spacing) 1198 | (gr-setcharspace (coerce spacing 'double-float))) 1199 | 1200 | 1201 | #| 1202 | settextcolorind(color::Int) 1203 | 1204 | Sets the current text color index. 1205 | 1206 | color : 1207 | The text color index (COLOR < 1256) 1208 | 1209 | settextcolorind defines the color of subsequent text output primitives. 1210 | GR uses the default foreground color (black=1) for the default text color index. 1211 | 1212 | |# 1213 | 1214 | (cffi:defcfun ("gr_settextcolorind" gr-settextcolorind) :void 1215 | (color :int)) 1216 | 1217 | (defun settextcolorind (color) 1218 | (gr-settextcolorind color)) 1219 | 1220 | 1221 | (cffi:defcfun ("gr_inqtextcolorind" gr-inqtextcolorind) :void 1222 | (color (:pointer :int))) 1223 | 1224 | (defun inqtextcolorind (color) 1225 | (let ((color-data (data-alloc color :int))) 1226 | (gr-inqtextcolorind color-data) 1227 | (free color-data))) 1228 | 1229 | 1230 | #| 1231 | setcharheight(height::Real) 1232 | 1233 | Set the current character height. 1234 | 1235 | height : 1236 | Text height value 1237 | 1238 | setcharheight defines the height of subsequent text output primitives. Text height 1239 | is defined as a percentage of the default window. GR uses the default text height of 1240 | 0.027 (2.7% of the height of the default window). 1241 | 1242 | |# 1243 | 1244 | (cffi:defcfun ("gr_setcharheight" gr-setcharheight) :void 1245 | (height :double)) 1246 | 1247 | (defun setcharheight (height) 1248 | (gr-setcharheight (coerce height 'double-float))) 1249 | 1250 | 1251 | (cffi:defcfun ("gr_inqcharheight" gr-inqcharheight) :void 1252 | (height (:pointer :double))) 1253 | 1254 | (defun inqcharheight (height) 1255 | (let ((height-data (data-alloc height :double))) 1256 | (gr-inqcharheight height-data) 1257 | (free height-data))) 1258 | 1259 | 1260 | #| 1261 | setcharup(ux::Real, uy::Real) 1262 | 1263 | Set the current character text angle up vector. 1264 | 1265 | ux, uy : 1266 | Text up vector 1267 | 1268 | setcharup defines the vertical rotation of subsequent text output primitives. 1269 | The text up vector is initially set to (0, 1), horizontal to the baseline. 1270 | 1271 | |# 1272 | 1273 | (cffi:defcfun ("gr_setcharup" gr-setcharup) :void 1274 | (ux :double) 1275 | (uy :double)) 1276 | 1277 | (defun setcharup (ux uy) 1278 | (gr-setcharup (coerce ux 'double-float) 1279 | (coerce uy 'double-float))) 1280 | 1281 | 1282 | #| 1283 | settextpath(path::Int) 1284 | 1285 | Define the current direction in which subsequent text will be drawn. 1286 | 1287 | path : 1288 | Text path (see table below) 1289 | 1290 | +----------------------+---+---------------+ 1291 | |TEXT_PATH_RIGHT | 0|left-to-right | 1292 | +----------------------+---+---------------+ 1293 | |TEXT_PATH_LEFT | 1|right-to-left | 1294 | +----------------------+---+---------------+ 1295 | |TEXT_PATH_UP | 2|downside-up | 1296 | +----------------------+---+---------------+ 1297 | |TEXT_PATH_DOWN | 3|upside-down | 1298 | +----------------------+---+---------------+ 1299 | |# 1300 | 1301 | (cffi:defcfun ("gr_settextpath" gr-settextpath) :void 1302 | (path :int)) 1303 | 1304 | (defun settextpath (path) 1305 | (gr-settextpath path)) 1306 | 1307 | 1308 | #| 1309 | settextalign(horizontal::Int, vertical::Int) 1310 | 1311 | Set the current horizontal and vertical alignment for text. 1312 | 1313 | horizontal : 1314 | Horizontal text alignment (see the table below) 1315 | 1316 | vertical : 1317 | Vertical text alignment (see the table below) 1318 | 1319 | settextalign specifies how the characters in a text primitive will be aligned 1320 | in horizontal and vertical space. The default text alignment indicates horizontal left 1321 | alignment and vertical baseline alignment. 1322 | 1323 | +-------------------------+---+----------------+ 1324 | |TEXT_HALIGN_NORMAL | 0| | 1325 | +-------------------------+---+----------------+ 1326 | |TEXT_HALIGN_LEFT | 1|Left justify | 1327 | +-------------------------+---+----------------+ 1328 | |TEXT_HALIGN_CENTER | 2|Center justify | 1329 | +-------------------------+---+----------------+ 1330 | |TEXT_HALIGN_RIGHT | 3|Right justify | 1331 | +-------------------------+---+----------------+ 1332 | +-------------------------+---+------------------------------------------------+ 1333 | |TEXT_VALIGN_NORMAL | 0| | 1334 | +-------------------------+---+------------------------------------------------+ 1335 | |TEXT_VALIGN_TOP | 1|Align with the top of the characters | 1336 | +-------------------------+---+------------------------------------------------+ 1337 | |TEXT_VALIGN_CAP | 2|Aligned with the cap of the characters | 1338 | +-------------------------+---+------------------------------------------------+ 1339 | |TEXT_VALIGN_HALF | 3|Aligned with the half line of the characters | 1340 | +-------------------------+---+------------------------------------------------+ 1341 | |TEXT_VALIGN_BASE | 4|Aligned with the base line of the characters | 1342 | +-------------------------+---+------------------------------------------------+ 1343 | |TEXT_VALIGN_BOTTOM | 5|Aligned with the bottom line of the characters | 1344 | +-------------------------+---+------------------------------------------------+ 1345 | |# 1346 | 1347 | (cffi:defcfun ("gr_settextalign" gr-settextalign) :void 1348 | (horizontal :int) 1349 | (vertical :int)) 1350 | 1351 | (defun settextalign (horizontal vertical) 1352 | (gr-settextalign horizontal vertical)) 1353 | 1354 | 1355 | #| 1356 | setfillintstyle(style::Int) 1357 | 1358 | 1359 | Set the fill area interior style to be used for fill areas. 1360 | 1361 | style : 1362 | The style of fill to be used 1363 | 1364 | setfillintstyle defines the interior style for subsequent fill area output 1365 | primitives. The default interior style is HOLLOW. 1366 | 1367 | +---------+---+--------------------------------------------------------------------------------+ 1368 | |HOLLOW | 0|No filling. Just draw the bounding polyline | 1369 | +---------+---+--------------------------------------------------------------------------------+ 1370 | |SOLID | 1|Fill the interior of the polygon using the fill color index | 1371 | +---------+---+--------------------------------------------------------------------------------+ 1372 | |PATTERN | 2|Fill the interior of the polygon using the style index as a pattern index | 1373 | +---------+---+--------------------------------------------------------------------------------+ 1374 | |HATCH | 3|Fill the interior of the polygon using the style index as a cross-hatched style | 1375 | +---------+---+--------------------------------------------------------------------------------+ 1376 | 1377 | |# 1378 | 1379 | (cffi:defcfun ("gr_setfillintstyle" gr-setfillinstyle) :void 1380 | (style :int)) 1381 | 1382 | (defun setfillintstyle (style) 1383 | (gr-setfillinstyle style)) 1384 | 1385 | 1386 | (cffi:defcfun ("gr_inqfillintstyle" gr-inqfillinstyle) :void 1387 | (style (:pointer :int))) 1388 | 1389 | (defun inqfillintstyle (style) 1390 | (let ((style-data (data-alloc style :int))) 1391 | (gr-inqfillinstyle style-data) 1392 | (free style-data))) 1393 | 1394 | 1395 | #| 1396 | setfillstyle(index::Int) 1397 | 1398 | Sets the fill style to be used for subsequent fill areas. 1399 | 1400 | index : 1401 | The fill style index to be used 1402 | 1403 | setfillstyle specifies an index when PATTERN fill or HATCH fill is requested by the 1404 | setfillintstyle function. If the interior style is set to PATTERN, the fill style 1405 | index points to a device-independent pattern table. If interior style is set to HATCH 1406 | the fill style index indicates different hatch styles. If HOLLOW or SOLID is specified 1407 | for the interior style, the fill style index is unused. 1408 | 1409 | |# 1410 | 1411 | (cffi:defcfun ("gr_setfillstyle" gr-setfillstyle) :void 1412 | (index :int)) 1413 | 1414 | (defun setfillstyle (index) 1415 | (gr-setfillstyle index)) 1416 | 1417 | 1418 | (cffi:defcfun ("gr_inqfillstyle" gr-inqfillstyle) :void 1419 | (index (:pointer :int))) 1420 | 1421 | (defun inqfillstyle (index) 1422 | (let ((index-data (data-alloc index :int))) 1423 | (gr-inqfillstyle index-data) 1424 | (free index-data))) 1425 | 1426 | 1427 | #| 1428 | setfillcolorind(color::Int) 1429 | 1430 | Sets the current fill area color index. 1431 | 1432 | color : 1433 | The fill area color index (COLOR < 1256) 1434 | 1435 | setfillcolorind defines the color of subsequent fill area output primitives. 1436 | GR uses the default foreground color (black=1) for the default fill area color index. 1437 | 1438 | |# 1439 | 1440 | (cffi:defcfun ("gr_setfillcolorind" gr-setfillcolorind) :void 1441 | (color :int)) 1442 | 1443 | (defun setfillcolorind (color) 1444 | (gr-setfillcolorind color)) 1445 | 1446 | 1447 | (cffi:defcfun ("gr_inqfillcolorind" gr-inqfillcolorind) :void 1448 | (color (:pointer :int))) 1449 | 1450 | (defun inqfillcolorind (color) 1451 | (let ((color-data (data-alloc color :int))) 1452 | (gr-inqfillcolorind color-data) 1453 | (free color-data))) 1454 | 1455 | 1456 | #| 1457 | setcolorrep(index::Int, red::Real, green::Real, blue::Real) 1458 | 1459 | `setcolorrep` allows to redefine an existing color index representation by specifying 1460 | an RGB color triplet. 1461 | 1462 | index : 1463 | Color index in the range 0 to 1256 1464 | 1465 | red : 1466 | Red intensity in the range 0.0 to 1.0 1467 | 1468 | green : 1469 | Green intensity in the range 0.0 to 1.0 1470 | 1471 | blue: 1472 | Blue intensity in the range 0.0 to 1.0 1473 | 1474 | |# 1475 | 1476 | (cffi:defcfun ("gr_setcolorrep" gr-setcolorrep) :void 1477 | (index :int) 1478 | (red :double) 1479 | (green :double) 1480 | (blue :double)) 1481 | 1482 | (defun setcolorrep (index red green blue) 1483 | (gr-setcolorrep index 1484 | (coerce red 'double-float) 1485 | (coerce green 'double-float) 1486 | (coerce blue 'double-float))) 1487 | 1488 | 1489 | #| 1490 | setwindow(xmin::Real, xmax::Real, ymin::Real, ymax::Real) 1491 | 1492 | setwindow establishes a window, or rectangular subspace, of world coordinates to be 1493 | plotted. If you desire log scaling or mirror-imaging of axes, use the SETSCALE function. 1494 | 1495 | xmin : 1496 | The left horizontal coordinate of the window (`xmin` < `xmax`). 1497 | 1498 | xmax : 1499 | The right horizontal coordinate of the window. 1500 | 1501 | ymin : 1502 | The bottom vertical coordinate of the window (`ymin` < `ymax`). 1503 | 1504 | ymax : 1505 | The top vertical coordinate of the window. 1506 | 1507 | setwindow defines the rectangular portion of the World Coordinate space (WC) to be 1508 | associated with the specified normalization transformation. The WC window and the 1509 | Normalized Device Coordinates (NDC) viewport define the normalization transformation 1510 | through which all output primitives are mapped. The WC window is mapped onto the 1511 | rectangular NDC viewport which is, in turn, mapped onto the display surface of the 1512 | open and active workstation, in device coordinates. By default, GR uses the range 1513 | [0,1] x [0,1], in world coordinates, as the normalization transformation window. 1514 | 1515 | |# 1516 | 1517 | (cffi:defcfun ("gr_setwindow" gr-setwindow) :void 1518 | (xmin :double) 1519 | (xmax :double) 1520 | (ymin :double) 1521 | (ymax :double)) 1522 | 1523 | (defun setwindow (xmin xmax ymin ymax) 1524 | (gr-setwindow (coerce xmin 'double-float) 1525 | (coerce xmax 'double-float) 1526 | (coerce ymin 'double-float) 1527 | (coerce ymax 'double-float))) 1528 | 1529 | 1530 | (cffi:defcfun ("gr_inqwindow" gr-inqwindow) :void 1531 | (xmin (:pointer :double)) 1532 | (xmax (:pointer :double)) 1533 | (ymin (:pointer :double)) 1534 | (ymax (:pointer :double))) 1535 | 1536 | (defun inqwindow () 1537 | (let ((xmin (data-alloc '(0) :double)) 1538 | (xmax (data-alloc '(0) :doubl)) 1539 | (ymin (data-alloc '(0) :doubl)) 1540 | (ymax (data-alloc '(0) :doubl))) 1541 | (gr-inqwindow xmin xmax ymin ymax) 1542 | (let ((-xmin (arr-aref xmin :double 0)) 1543 | (-xmax (arr-aref xmax :double 0)) 1544 | (-ymin (arr-aref ymin :double 0)) 1545 | (-ymax (arr-aref ymax :double 0))) 1546 | (free xmin xmax ymin ymax) 1547 | (list -xmin -xmax -ymin -ymax)))) 1548 | 1549 | 1550 | #| 1551 | setviewport(xmin::Real, xmax::Real, ymin::Real, ymax::Real) 1552 | 1553 | setviewport establishes a rectangular subspace of normalized device coordinates. 1554 | 1555 | xmin : 1556 | The left horizontal coordinate of the viewport. 1557 | 1558 | xmax : 1559 | The right horizontal coordinate of the viewport (0 <= xmin < xmax <= 1). 1560 | 1561 | ymin : 1562 | The bottom vertical coordinate of the viewport. 1563 | 1564 | ymax : 1565 | The top vertical coordinate of the viewport (0 <= ymin < ymax <= 1). 1566 | 1567 | setviewport defines the rectangular portion of the Normalized Device Coordinate 1568 | (NDC) space to be associated with the specified normalization transformation. The 1569 | NDC viewport and World Coordinate (WC) window define the normalization transformation 1570 | through which all output primitives pass. The WC window is mapped onto the rectangular 1571 | NDC viewport which is, in turn, mapped onto the display surface of the open and active 1572 | workstation, in device coordinates. 1573 | 1574 | |# 1575 | 1576 | (cffi:defcfun ("gr_setviewport" gr-setviewport) :void 1577 | (xmin :double) 1578 | (xmax :double) 1579 | (ymin :double) 1580 | (ymax :double)) 1581 | 1582 | (defun setviewport (xmin xmax ymin ymax) 1583 | (gr-setviewport (coerce xmin 'double-float) 1584 | (coerce xmax 'double-float) 1585 | (coerce ymin 'double-float) 1586 | (coerce ymax 'double-float))) 1587 | 1588 | 1589 | (cffi:defcfun ("gr_inqviewport" gr-inqviewport) :void 1590 | (xmin (:pointer :double)) 1591 | (xmax (:pointer :double)) 1592 | (ymin (:pointer :double)) 1593 | (ymax (:pointer :double))) 1594 | 1595 | (defun inqviewport () 1596 | (let ((xmin (data-alloc '(0) :double)) 1597 | (xmax (data-alloc '(0) :double)) 1598 | (ymin (data-alloc '(0) :double)) 1599 | (ymax (data-alloc '(0) :double))) 1600 | (gr-inqviewport xmin xmax ymin ymax) 1601 | (let ((-xmin (arr-aref xmin :double 0)) 1602 | (-xmax (arr-aref xmax :double 0)) 1603 | (-ymin (arr-aref ymin :double 0)) 1604 | (-ymax (arr-aref ymax :double 0))) 1605 | (free xmin xmax ymin ymax) 1606 | (list -xmin -xmax -ymin -ymax)))) 1607 | 1608 | 1609 | #| 1610 | selntran(transform::Int) 1611 | 1612 | selntran selects a predefined transformation from world coordinates to normalized 1613 | device coordinates. 1614 | 1615 | transform : 1616 | A normalization transformation number. 1617 | 1618 | +------+----------------------------------------------------------------------------------------------------+ 1619 | | 0|Selects the identity transformation in which both the window and viewport have the range of 0 to 1 | 1620 | +------+----------------------------------------------------------------------------------------------------+ 1621 | | >= 1|Selects a normalization transformation as defined by setwindow and setviewport | 1622 | +------+----------------------------------------------------------------------------------------------------+ 1623 | 1624 | |# 1625 | 1626 | (cffi:defcfun ("gr_selntran" gr-selntran) :void 1627 | (transform :int)) 1628 | 1629 | (defun selntran (transform) 1630 | (gr-selntran transform)) 1631 | 1632 | 1633 | #| 1634 | setclip(indicator::Int) 1635 | 1636 | Set the clipping indicator. 1637 | 1638 | indicator : 1639 | An indicator specifying whether clipping is on or off. 1640 | 1641 | +----+---------------------------------------------------------------+ 1642 | | 0|Clipping is off. Data outside of the window will be drawn. | 1643 | +----+---------------------------------------------------------------+ 1644 | | 1|Clipping is on. Data outside of the window will not be drawn. | 1645 | +----+---------------------------------------------------------------+ 1646 | 1647 | setclip enables or disables clipping of the image drawn in the current window. 1648 | Clipping is defined as the removal of those portions of the graph that lie outside of 1649 | the defined viewport. If clipping is on, GR does not draw generated output primitives 1650 | past the viewport boundaries. If clipping is off, primitives may exceed the viewport 1651 | boundaries, and they will be drawn to the edge of the workstation window. 1652 | By default, clipping is on. 1653 | 1654 | |# 1655 | 1656 | (cffi:defcfun ("gr_setclip" gr-setclip) :void 1657 | (indicator :int)) 1658 | 1659 | (defun setclip (indicator) 1660 | (gr-setclip indicator)) 1661 | 1662 | 1663 | #| 1664 | setwswindow(xmin::Real, xmax::Real, ymin::Real, ymax::Real) 1665 | 1666 | Set the area of the NDC viewport that is to be drawn in the workstation window. 1667 | 1668 | xmin : 1669 | The left horizontal coordinate of the workstation window. 1670 | 1671 | xmax : 1672 | The right horizontal coordinate of the workstation window (0 <= `xmin` < `xmax` <= 1). 1673 | 1674 | ymin : 1675 | The bottom vertical coordinate of the workstation window. 1676 | 1677 | ymax : 1678 | The top vertical coordinate of the workstation window (0 <= ymin < ymax <= 1). 1679 | 1680 | setwswindow defines the rectangular area of the Normalized Device Coordinate space 1681 | to be output to the device. By default, the workstation transformation will map the 1682 | range [0,1] x [0,1] in NDC onto the largest square on the workstation’s display 1683 | surface. The aspect ratio of the workstation window is maintained at 1 to 1. 1684 | 1685 | |# 1686 | 1687 | (cffi:defcfun ("gr_setwswindow" gr-setwswindow) :void 1688 | (xmin :double) 1689 | (xmax :double) 1690 | (ymin :double) 1691 | (ymax :double)) 1692 | 1693 | (defun setwswindow (xmin xmax ymin ymax) 1694 | (gr-setwswindow (coerce xmin 'double-float) 1695 | (coerce xmax 'double-float) 1696 | (coerce ymin 'double-float) 1697 | (coerce ymax 'double-float))) 1698 | 1699 | 1700 | #| 1701 | setwsviewport(xmin::Real, xmax::Real, ymin::Real, ymax::Real) 1702 | 1703 | Define the size of the workstation graphics window in meters. 1704 | 1705 | xmin : 1706 | The left horizontal coordinate of the workstation viewport. 1707 | 1708 | xmax : 1709 | The right horizontal coordinate of the workstation viewport. 1710 | 1711 | ymin : 1712 | The bottom vertical coordinate of the workstation viewport. 1713 | 1714 | ymax : 1715 | The top vertical coordinate of the workstation viewport. 1716 | 1717 | setwsviewport places a workstation window on the display of the specified size in 1718 | meters. This command allows the workstation window to be accurately sized for a 1719 | display or hardcopy device, and is often useful for sizing graphs for desktop 1720 | publishing applications. 1721 | 1722 | |# 1723 | 1724 | (cffi:defcfun ("gr_setwsviewport" gr-setwsviewport) :void 1725 | (xmin :double) 1726 | (xmax :double) 1727 | (ymin :double) 1728 | (ymax :double)) 1729 | 1730 | (defun setwsviewport (xmin xmax ymin ymax) 1731 | (gr-setwsviewport (coerce xmin 'double-float) 1732 | (coerce xmax 'double-float) 1733 | (coerce ymin 'double-float) 1734 | (coerce ymax 'double-float))) 1735 | 1736 | 1737 | (cffi:defcfun ("gr_createseg" gr-createseg) :void 1738 | (segment :int)) 1739 | 1740 | (defun createseg (segment) 1741 | (gr-createseg segment)) 1742 | 1743 | 1744 | (cffi:defcfun ("gr_copysegws" gr-copysegws) :void 1745 | (segment :int)) 1746 | 1747 | (defun copysegws (segment) 1748 | (gr-copysegws segment)) 1749 | 1750 | 1751 | (cffi:defcfun ("gr_redrawsegws" gr-redrawsegws) :void) 1752 | 1753 | (defun redrawsegws () 1754 | (gr-redrawsegws)) 1755 | 1756 | 1757 | (cffi:defcfun ("gr_setsegtran" gr-setsegtran) :void 1758 | (segment :int) 1759 | (fx :double) 1760 | (fy :double) 1761 | (transx :double) 1762 | (transy :double) 1763 | (phi :double) 1764 | (scalex :double) 1765 | (scaley :double)) 1766 | 1767 | (defun setsegtran (segment fx fy transx transy phi scalex scaley) 1768 | (gr-setsegtran segment 1769 | (coerce fx 'double-float) 1770 | (coerce fy 'double-float) 1771 | (coerce transx 'double-float) 1772 | (coerce transy 'double-float) 1773 | (coerce phi 'double-float) 1774 | (coerce scalex 'double-float) 1775 | (coerce scaley 'double-float))) 1776 | 1777 | 1778 | (cffi:defcfun ("gr_closeseg" gr-closeseg) :void) 1779 | 1780 | (defun closeseg () 1781 | (gr-closeseg)) 1782 | 1783 | 1784 | (cffi:defcfun ("gr_emergencyclosegks" gr-emergencyclosegks) :void) 1785 | 1786 | (defun emergencyclosegks () 1787 | (gr-emergencyclosegks)) 1788 | 1789 | 1790 | (cffi:defcfun ("gr_updategks" gr-updategks) :void) 1791 | 1792 | (defun updategks () 1793 | (gr-updategks)) 1794 | 1795 | 1796 | #| 1797 | setspace(zmin::Real, zmax::Real, rotation::Int, tilt::Int) 1798 | 1799 | Set the abstract Z-space used for mapping three-dimensional output primitives into 1800 | the current world coordinate space. 1801 | 1802 | zmin : 1803 | Minimum value for the Z-axis. 1804 | 1805 | zmax : 1806 | Maximum value for the Z-axis. 1807 | 1808 | rotation : 1809 | Angle for the rotation of the X axis, in degrees. 1810 | 1811 | tilt : 1812 | Viewing angle of the Z axis in degrees. 1813 | 1814 | setspace establishes the limits of an abstract Z-axis and defines the angles for 1815 | rotation and for the viewing angle (tilt) of a simulated three-dimensional graph, 1816 | used for mapping corresponding output primitives into the current window. 1817 | These settings are used for all subsequent three-dimensional output primitives until 1818 | other values are specified. Angles of rotation and viewing angle must be specified 1819 | between 0° and 90°. 1820 | |# 1821 | 1822 | (cffi:defcfun ("gr_setspace" gr-setspace) :int 1823 | (zmin :double) 1824 | (zmax :double) 1825 | (rotation :int) 1826 | (tilt :int)) 1827 | 1828 | (defun setspace (zmin zmax rotation tilt) 1829 | (gr-setspace (coerce zmin 'double-float) 1830 | (coerce zmax 'double-float) 1831 | rotation 1832 | tilt)) 1833 | 1834 | (cffi:defcfun ("gr_inqspace" gr-inqspace) :void 1835 | (zmin (:pointer :double)) 1836 | (zmax (:pointer :double)) 1837 | (rotation (:pointer :int)) 1838 | (tilt (:pointer :int))) 1839 | 1840 | (defun inqspace (zmin zmax rotation tilt) 1841 | (let ((zmin-data (data-alloc zmin :double)) 1842 | (zmax-data (data-alloc zmax :double)) 1843 | (rotation-data (data-alloc rotation :int)) 1844 | (tilt-data (data-alloc tilt :int))) 1845 | (gr-inqspace zmin-data 1846 | zmax-data 1847 | rotation-data 1848 | tilt-data) 1849 | (free zmin-data 1850 | zmax-data 1851 | rotation-data 1852 | tilt-data))) 1853 | 1854 | 1855 | #| 1856 | setscale(options::Int) 1857 | 1858 | setscale sets the type of transformation to be used for subsequent GR output 1859 | primitives. 1860 | 1861 | options : 1862 | Scale specification (see Table below) 1863 | 1864 | +---------------+--------------------+ 1865 | |OPTION_X_LOG |Logarithmic X-axis | 1866 | +---------------+--------------------+ 1867 | |OPTION_Y_LOG |Logarithmic Y-axis | 1868 | +---------------+--------------------+ 1869 | |OPTION_Z_LOG |Logarithmic Z-axis | 1870 | +---------------+--------------------+ 1871 | |OPTION_FLIP_X |Flip X-axis | 1872 | +---------------+--------------------+ 1873 | |OPTION_FLIP_Y |Flip Y-axis | 1874 | +---------------+--------------------+ 1875 | |OPTION_FLIP_Z |Flip Z-axis | 1876 | +---------------+--------------------+ 1877 | 1878 | setscale defines the current transformation according to the given scale 1879 | specification which may be or'ed together using any of the above options. GR uses 1880 | these options for all subsequent output primitives until another value is provided. 1881 | The scale options are used to transform points from an abstract logarithmic or 1882 | semi-logarithmic coordinate system, which may be flipped along each axis, into the 1883 | world coordinate system. 1884 | 1885 | Note: When applying a logarithmic transformation to a specific axis, the system 1886 | assumes that the axes limits are greater than zero. 1887 | 1888 | |# 1889 | 1890 | (cffi:defcfun ("gr_setscale" gr-setscale) :int 1891 | (options :int)) 1892 | 1893 | (defun setscale (options) 1894 | (gr-setscale options)) 1895 | 1896 | 1897 | (cffi:defcfun ("gr_inqscale" gr-inqscale) :void 1898 | (options (:pointer :int))) 1899 | 1900 | (defun inqscale () 1901 | (let ((options (data-alloc '(0) :int))) 1902 | (gr-inqscale options) 1903 | (let ((opt-data (arr-aref options :int 0))) 1904 | (free options) 1905 | opt-data))) 1906 | 1907 | 1908 | #| 1909 | textext(x::Real, y::Real, string) 1910 | 1911 | Draw a text at position x, y using the current text attributes. Strings can be 1912 | defined to create basic mathematical expressions and Greek letters. 1913 | 1914 | x : 1915 | The X coordinate of starting position of the text string 1916 | 1917 | y : 1918 | The Y coordinate of starting position of the text string 1919 | 1920 | string : 1921 | The text to be drawn 1922 | 1923 | The values for X and Y are in normalized device coordinates. 1924 | The attributes that control the appearance of text are text font and precision, 1925 | character expansion factor, character spacing, text color index, character 1926 | height, character up vector, text path and text alignment. 1927 | 1928 | The character string is interpreted to be a simple mathematical formula. 1929 | The following notations apply: 1930 | 1931 | Subscripts and superscripts: These are indicated by carets ('^') and underscores 1932 | ('_'). If the sub/superscript contains more than one character, it must be enclosed 1933 | in curly braces ('{}'). 1934 | 1935 | Fractions are typeset with A '/' B, where A stands for the numerator and B for the 1936 | denominator. 1937 | 1938 | To include a Greek letter you must specify the corresponding keyword after a 1939 | backslash ('\') character. The text translator produces uppercase or lowercase 1940 | Greek letters depending on the case of the keyword. 1941 | 1942 | +--------+---------+ 1943 | |Letter |Keyword | 1944 | +--------+---------+ 1945 | |Α α |alpha | 1946 | +--------+---------+ 1947 | |Β β |beta | 1948 | +--------+---------+ 1949 | |Γ γ |gamma | 1950 | +--------+---------+ 1951 | |Δ δ |delta | 1952 | +--------+---------+ 1953 | |Ε ε |epsilon | 1954 | +--------+---------+ 1955 | |Ζ ζ |zeta | 1956 | +--------+---------+ 1957 | |Η η |eta | 1958 | +--------+---------+ 1959 | |Θ θ |theta | 1960 | +--------+---------+ 1961 | |Ι ι |iota | 1962 | +--------+---------+ 1963 | |Κ κ |kappa | 1964 | +--------+---------+ 1965 | |Λ λ |lambda | 1966 | +--------+---------+ 1967 | |Μ μ |mu | 1968 | +--------+---------+ 1969 | |Ν ν |nu | 1970 | +--------+---------+ 1971 | |Ξ ξ |xi | 1972 | +--------+---------+ 1973 | |Ο ο |omicron | 1974 | +--------+---------+ 1975 | |Π π |pi | 1976 | +--------+---------+ 1977 | |Ρ ρ |rho | 1978 | +--------+---------+ 1979 | |Σ σ |sigma | 1980 | +--------+---------+ 1981 | |Τ τ |tau | 1982 | +--------+---------+ 1983 | |Υ υ |upsilon | 1984 | +--------+---------+ 1985 | |Φ φ |phi | 1986 | +--------+---------+ 1987 | |Χ χ |chi | 1988 | +--------+---------+ 1989 | |Ψ ψ |psi | 1990 | +--------+---------+ 1991 | |Ω ω |omega | 1992 | +--------+---------+ 1993 | For more sophisticated mathematical formulas, you should use the `gr.mathtex` 1994 | function. 1995 | |# 1996 | 1997 | (cffi:defcfun ("gr_textext" gr-textext) :int 1998 | (x :double) 1999 | (y :double) 2000 | (str (:pointer :char))) 2001 | 2002 | (defun textext (x y str) 2003 | (let ((str-data (string-alloc str))) 2004 | (gr-textext (coerce x 'double-float) 2005 | (coerce y 'double-float) 2006 | str-data) 2007 | (string-free str-data))) 2008 | 2009 | (cffi:defcfun ("gr_inqtextext" gr-inqtextext) :void 2010 | (x :double) 2011 | (y :double) 2012 | (str (:pointer :char)) 2013 | (tbx (:pointer :double)) 2014 | (tby (:pointer :double))) 2015 | 2016 | (defun inqtextext (x y str) 2017 | (let ((str-data (string-alloc str)) 2018 | (tbx (data-alloc '(0 0 0 0) :double)) 2019 | (tby (data-alloc '(0 0 0 0) :double))) 2020 | (gr-inqtextext (coerce x 'double-float) 2021 | (coerce y 'double-float) 2022 | str-data 2023 | tbx 2024 | tby) 2025 | (let ((-tbx (loop for i below 4 2026 | collect (arr-aref tbx :double i))) 2027 | (-tby (loop for i below 4 2028 | collect (arr-aref tby :double i)))) 2029 | (free tbx tby) 2030 | (string-free str-data) 2031 | (list -tbx -tby)))) 2032 | 2033 | #| 2034 | axes(x_tick::Real, y_tick::Real, x_org::Real, y_org::Real, major_x::Int, major_y::Int, tick_size::Real) 2035 | 2036 | Draw X and Y coordinate axes with linearly and/or logarithmically spaced tick marks. 2037 | 2038 | x_tick, y_tick : 2039 | The interval between minor tick marks on each axis. 2040 | 2041 | x_org, y_org : 2042 | The world coordinates of the origin (point of intersection) of the X 2043 | and Y axes. 2044 | 2045 | major_x, major_y : 2046 | Unitless integer values specifying the number of minor tick intervals 2047 | between major tick marks. Values of 0 or 1 imply no minor ticks. 2048 | Negative values specify no labels will be drawn for the associated axis. 2049 | 2050 | tick_size : 2051 | The length of minor tick marks specified in a normalized device 2052 | coordinate unit. Major tick marks are twice as long as minor tick marks. 2053 | A negative value reverses the tick marks on the axes from inward facing 2054 | to outward facing (or vice versa). 2055 | 2056 | Tick marks are positioned along each axis so that major tick marks fall on the axes 2057 | origin (whether visible or not). Major tick marks are labeled with the corresponding 2058 | data values. Axes are drawn according to the scale of the window. Axes and tick marks 2059 | are drawn using solid lines; line color and width can be modified using the 2060 | setlinetype and setlinewidth functions. Axes are drawn according to 2061 | the linear or logarithmic transformation established by the setscale function. 2062 | |# 2063 | 2064 | (cffi:defcfun ("gr_axes" gr-axes) :void 2065 | (x-tick :double) 2066 | (y-tick :double) 2067 | (x-org :double) 2068 | (y-org :double) 2069 | (major-x :int) 2070 | (major-y :int) 2071 | (tick-size :double)) 2072 | 2073 | (defun axes (x-tick y-tick x-org y-org major-x major-y tick-size) 2074 | (gr-axes (coerce x-tick 'double-float) 2075 | (coerce y-tick 'double-float) 2076 | (coerce x-org 'double-float) 2077 | (coerce y-org 'double-float) 2078 | major-x 2079 | major-y 2080 | (coerce tick-size 'double-float))) 2081 | 2082 | 2083 | #| 2084 | function axeslbl(x_tick::Real, y_tick::Real, x_org::Real, y_org::Real, major_x::Int, major_y::Int, tick_size::Real, fpx::Function, fpy::Function) 2085 | 2086 | Draw X and Y coordinate axes with linearly and/or logarithmically spaced tick marks. 2087 | 2088 | Tick marks are positioned along each axis so that major tick marks fall on the 2089 | axes origin (whether visible or not). Major tick marks are labeled with the 2090 | corresponding data values. Axes are drawn according to the scale of the window. 2091 | Axes and tick marks are drawn using solid lines; line color and width can be 2092 | modified using the `setlinetype` and `setlinewidth` functions. 2093 | Axes are drawn according to the linear or logarithmic transformation established 2094 | by the `setscale` function. 2095 | 2096 | x_tick, y_tick : 2097 | The interval between minor tick marks on each axis. 2098 | 2099 | x_org, y_org : 2100 | The world coordinates of the origin (point of intersection) of the X 2101 | and Y axes. 2102 | 2103 | major_x, major_y : 2104 | Unitless integer values specifying the number of minor tick intervals 2105 | between major tick marks. Values of 0 or 1 imply no minor ticks. 2106 | Negative values specify no labels will be drawn for the associated axis. 2107 | 2108 | tick_size : 2109 | The length of minor tick marks specified in a normalized device 2110 | coordinate unit. Major tick marks are twice as long as minor tick marks. 2111 | A negative value reverses the tick marks on the axes from inward facing 2112 | to outward facing (or vice versa). 2113 | 2114 | fx, fy : 2115 | Functions that returns a label for a given tick on the X or Y axis. 2116 | Those functions should have the following arguments: 2117 | x, y : 2118 | Normalized device coordinates of the label in X and Y directions. 2119 | 2120 | svalue : 2121 | Internal string representation of the text drawn at (x,y). 2122 | 2123 | value : 2124 | Floating point representation of the label drawn at (x,y). 2125 | |# 2126 | 2127 | (cffi:defcfun ("gr_axeslbl" gr-axeslbl) :void 2128 | (x-tick :double) 2129 | (y-tick :double) 2130 | (x-org :double) 2131 | (y-org :double) 2132 | (major-x :double) 2133 | (major-y :double) 2134 | (tick-size :double) 2135 | (fpx :pointer) 2136 | (fpy :pointer)) 2137 | 2138 | 2139 | (defun axeslbl (x-tick y-tick x-org y-org 2140 | major-x major-y tick-size fx fy) 2141 | 2142 | (cffi:defcallback fpx :void 2143 | ((a :double) 2144 | (b :double) 2145 | (str (:pointer :char)) 2146 | (c :double)) 2147 | (eval (list fx a b str c))) 2148 | 2149 | (cffi:defcallback fpy :void 2150 | ((a :double) 2151 | (b :double) 2152 | (str (:pointer :char)) 2153 | (c :double)) 2154 | (eval (list fy a b str c))) 2155 | 2156 | (gr-axeslbl x-tick y-tick x-org y-org 2157 | major-x major-y tick-size 2158 | (cffi:callback fpx) (cffi:callback fpy))) 2159 | 2160 | 2161 | #| 2162 | grid(x_tick::Real, y_tick::Real, x_org::Real, y_org::Real, major_x::Int, major_y::Int) 2163 | 2164 | Draw a linear and/or logarithmic grid. 2165 | 2166 | x_tick, y_tick : 2167 | The length in world coordinates of the interval between minor grid 2168 | lines. 2169 | 2170 | x_org, y_org : 2171 | The world coordinates of the origin (point of intersection) of the grid. 2172 | 2173 | major_x, major_y : 2174 | Unitless integer values specifying the number of minor grid lines 2175 | between major grid lines. Values of 0 or 1 imply no grid lines. 2176 | 2177 | Major grid lines correspond to the axes origin and major tick marks whether visible 2178 | or not. Minor grid lines are drawn at points equal to minor tick marks. Major grid 2179 | lines are drawn using black lines and minor grid lines are drawn using gray lines. 2180 | |# 2181 | 2182 | (cffi:defcfun ("gr_grid" gr-grid) :void 2183 | (x-tick :double) 2184 | (y-tick :double) 2185 | (x-org :double) 2186 | (y-org :double) 2187 | (major-x :int) 2188 | (major-y :int)) 2189 | 2190 | (defun grid (x-tick y-tick x-org y-org major-x major-y) 2191 | (gr-grid (coerce x-tick 'double-float) 2192 | (coerce y-tick 'double-float) 2193 | (coerce x-org 'double-float) 2194 | (coerce y-org 'double-float) 2195 | major-x 2196 | major-y)) 2197 | 2198 | 2199 | (cffi:defcfun ("gr_grid3d" gr-grid3d) :void 2200 | (x-tick :double) 2201 | (y-tick :double) 2202 | (z-tick :double) 2203 | (x-org :double) 2204 | (y-org :double) 2205 | (z-org :double) 2206 | (major-x :int) 2207 | (major-y :int) 2208 | (major-z :int)) 2209 | 2210 | (defun grid3d (x-tick y-tick z-tick x-org y-org z-org 2211 | major-x major-y major-z) 2212 | (gr-grid3d (coerce x-tick 'double-float) 2213 | (coerce y-tick 'double-float) 2214 | (coerce z-tick 'double-float) 2215 | (coerce x-org 'double-float) 2216 | (coerce y-org 'double-float) 2217 | (coerce z-org 'double-float) 2218 | major-x 2219 | major-y 2220 | major-z)) 2221 | 2222 | 2223 | #| 2224 | verrorbars(px, py, e1, e2) 2225 | 2226 | Draw a standard vertical error bar graph. 2227 | 2228 | px : 2229 | A list of length N containing the X coordinates 2230 | 2231 | py : 2232 | A list of length N containing the Y coordinates 2233 | 2234 | e1 : 2235 | The absolute values of the lower error bar data 2236 | 2237 | e2 : 2238 | The absolute values of the upper error bar data 2239 | |# 2240 | 2241 | (cffi:defcfun ("gr_verrorbars" gr-verrorbars) :void 2242 | (n :int) 2243 | (px (:pointer :double)) 2244 | (py (:pointer :double)) 2245 | (e1 (:pointer :double)) 2246 | (e2 (:pointer :double))) 2247 | 2248 | (defun verrorbars (px py e1 e2) 2249 | (assert (= (length px) 2250 | (length py) 2251 | (length e1) 2252 | (length e2))) 2253 | (let ((px-data (data-alloc px :double)) 2254 | (py-data (data-alloc py :double)) 2255 | (e1-data (data-alloc e1 :double)) 2256 | (e2-data (data-alloc e2 :double))) 2257 | (gr-verrorbars (length px) 2258 | px-data 2259 | py-data 2260 | e1-data 2261 | e2-data) 2262 | (free px-data 2263 | py-data 2264 | e1-data 2265 | e2-data))) 2266 | 2267 | 2268 | 2269 | #| 2270 | herrorbars(px, py, e1, e2) 2271 | 2272 | Draw a standard horizontal error bar graph. 2273 | 2274 | px : 2275 | A list of length N containing the X coordinates 2276 | 2277 | py : 2278 | A list of length N containing the Y coordinates 2279 | 2280 | e1 : 2281 | The absolute values of the lower error bar data 2282 | 2283 | e2 : 2284 | The absolute values of the upper error bar data 2285 | |# 2286 | 2287 | (cffi:defcfun ("gr_herrorbars" gr-herrorbars) :void 2288 | (n :int) 2289 | (px (:pointer :double)) 2290 | (py (:pointer :double)) 2291 | (e1 (:pointer :double)) 2292 | (e2 (:pointer :double))) 2293 | 2294 | (defun herrorbars (px py e1 e2) 2295 | (assert (= (length px) 2296 | (length py) 2297 | (length e1) 2298 | (length e2))) 2299 | (let ((px-data (data-alloc px :double)) 2300 | (py-data (data-alloc py :double)) 2301 | (e1-data (data-alloc e1 :double)) 2302 | (e2-data (data-alloc e2 :double))) 2303 | (gr-herrorbars (length px) 2304 | px-data 2305 | py-data 2306 | e1-data 2307 | e2-data) 2308 | (free px-data 2309 | py-data 2310 | e1-data 2311 | e2-data))) 2312 | 2313 | 2314 | #| 2315 | polyline3d(px, py, pz) 2316 | 2317 | Draw a 3D curve using the current line attributes, starting from the 2318 | first data point and ending at the last data point. 2319 | 2320 | x : 2321 | A list of length N containing the X coordinates 2322 | 2323 | y : 2324 | A list of length N containing the Y coordinates 2325 | 2326 | z : 2327 | A list of length N containing the Z coordinates 2328 | 2329 | The values for x, y and z are in world coordinates. The attributes that 2330 | control the appearance of a polyline are linetype, linewidth and color 2331 | index. 2332 | |# 2333 | 2334 | (cffi:defcfun ("gr_polyline3d" gr-polyline3d) :void 2335 | (n :int) 2336 | (px (:pointer :double)) 2337 | (py (:pointer :double)) 2338 | (pz (:pointer :double))) 2339 | 2340 | (defun polyline3d (x y z) 2341 | (assert (= (length x) 2342 | (length y) 2343 | (length z))) 2344 | (let ((x-data (data-alloc x :double)) 2345 | (y-data (data-alloc y :double)) 2346 | (z-data (data-alloc z :double))) 2347 | (gr-polyline3d (length x) 2348 | x-data 2349 | y-data 2350 | z-data) 2351 | (free x-data 2352 | y-data 2353 | z-data))) 2354 | 2355 | 2356 | #| 2357 | polymarker3d(px, py, pz) 2358 | 2359 | Draw marker symbols centered at the given 3D data points. 2360 | 2361 | x : 2362 | A list of length N containing the X coordinates 2363 | 2364 | y : 2365 | A list of length N containing the Y coordinates 2366 | 2367 | z : 2368 | A list of length N containing the Z coordinates 2369 | 2370 | The values for x, y and z are in world coordinates. The attributes 2371 | that control the appearance of a polymarker are marker type, marker size 2372 | scale factor and color index. 2373 | |# 2374 | 2375 | (cffi:defcfun ("gr_polymarker3d" gr-polymarker3d) :void 2376 | (n :int) 2377 | (px (:pointer :double)) 2378 | (py (:pointer :double)) 2379 | (pz (:pointer :double))) 2380 | 2381 | (defun polymarker3d (x y z) 2382 | (assert (= (length x) 2383 | (length y) 2384 | (length z))) 2385 | (let ((x-data (data-alloc x :double)) 2386 | (y-data (data-alloc y :double)) 2387 | (z-data (data-alloc z :double))) 2388 | (gr-polymarker3d (length x) 2389 | x-data 2390 | y-data 2391 | z-data) 2392 | (free x-data 2393 | y-data 2394 | z-data))) 2395 | 2396 | 2397 | (cffi:defcfun ("gr_axes3d" gr-axes3d) :void 2398 | (x-tick :double) 2399 | (y-tick :double) 2400 | (z-tick :double) 2401 | (x-org :double) 2402 | (y-org :double) 2403 | (z-org :double) 2404 | (major-x :int) 2405 | (major-y :int) 2406 | (major-z :int) 2407 | (tick-size :double)) 2408 | 2409 | (defun axes3d (x-tick y-tick z-tick x-org y-org z-org 2410 | major-x major-y major-z tick-size) 2411 | (gr-axes3d (coerce x-tick 'double-float) 2412 | (coerce y-tick 'double-float) 2413 | (coerce z-tick 'double-float) 2414 | (coerce x-org 'double-float) 2415 | (coerce y-org 'double-float) 2416 | (coerce z-org 'double-float) 2417 | major-x 2418 | major-y 2419 | major-z 2420 | (coerce tick-size 'double-float))) 2421 | 2422 | 2423 | #| 2424 | titles3d(x_title, y_title, z_title) 2425 | 2426 | Display axis titles just outside of their respective axes. 2427 | 2428 | x_title, y_title, z_title : 2429 | The text to be displayed on each axis 2430 | 2431 | |# 2432 | 2433 | (cffi:defcfun ("gr_titles3d" gr-titles3d) :void 2434 | (x-title (:pointer :char)) 2435 | (y-title (:pointer :char)) 2436 | (z-title (:pointer :char))) 2437 | 2438 | (defun titles3d (x-title y-title z-title) 2439 | (let ((x-data (string-alloc x-title)) 2440 | (y-data (string-alloc y-title)) 2441 | (z-data (string-alloc z-title))) 2442 | (gr-titles3d x-data 2443 | y-data 2444 | z-data) 2445 | (string-free x-data 2446 | y-data 2447 | z-data))) 2448 | 2449 | 2450 | 2451 | #| 2452 | surface(px, py, pz, option::Int) 2453 | 2454 | Draw a three-dimensional surface plot for the given data points. 2455 | 2456 | x : 2457 | A list containing the X coordinates 2458 | 2459 | y : 2460 | A list containing the Y coordinates 2461 | 2462 | z : 2463 | A list of length len(x) * len(y) or an appropriately dimensioned 2464 | array containing the Z coordinates 2465 | 2466 | option : 2467 | Surface display option (see table below) 2468 | 2469 | x and y define a grid. z is a singly dimensioned array containing at least 2470 | nx * ny data points. Z describes the surface height at each point on the grid. 2471 | Data is ordered as shown in the following table: 2472 | 2473 | +------------------+--+--------------------------------------------------------------+ 2474 | |LINES | 0|Use X Y polylines to denote the surface | 2475 | +------------------+--+--------------------------------------------------------------+ 2476 | |MESH | 1|Use a wire grid to denote the surface | 2477 | +------------------+--+--------------------------------------------------------------+ 2478 | |FILLED_MESH | 2|Applies an opaque grid to the surface | 2479 | +------------------+--+--------------------------------------------------------------+ 2480 | |Z_SHADED_MESH | 3|Applies Z-value shading to the surface | 2481 | +------------------+--+--------------------------------------------------------------+ 2482 | |COLORED_MESH | 4|Applies a colored grid to the surface | 2483 | +------------------+--+--------------------------------------------------------------+ 2484 | |CELL_ARRAY | 5|Applies a grid of individually-colored cells to the surface | 2485 | +------------------+--+--------------------------------------------------------------+ 2486 | |SHADED_MESH | 6|Applies light source shading to the 3-D surface | 2487 | +------------------+--+--------------------------------------------------------------+ 2488 | |# 2489 | 2490 | (cffi:defcfun ("gr_surface" gr-surface) :void 2491 | (nx :int) 2492 | (ny :int) 2493 | (px (:pointer :double)) 2494 | (py (:pointer :double)) 2495 | (pz (:pointer :double)) 2496 | (option :int)) 2497 | 2498 | (defun surface (x y z &key (option 1)) 2499 | (assert (= (length (flatten z)) 2500 | (* (length x) (length y)))) 2501 | (let ((x-data (data-alloc x :double)) 2502 | (y-data (data-alloc y :double)) 2503 | (z-data (data-alloc (flatten z) :double))) 2504 | (gr-surface (length x) 2505 | (length y) 2506 | x-data 2507 | y-data 2508 | z-data 2509 | option) 2510 | (free x-data 2511 | y-data 2512 | z-data))) 2513 | 2514 | 2515 | #| 2516 | contour(px, py, h, pz, major_h::Int) 2517 | 2518 | Draw contours of a three-dimensional data set whose values are specified over a 2519 | rectangular mesh. Contour lines may optionally be labeled. 2520 | 2521 | x : 2522 | A list containing the X coordinates 2523 | 2524 | y : 2525 | A list containing the Y coordinates 2526 | 2527 | h : 2528 | A list containing the Z coordinate for the height values 2529 | 2530 | z : 2531 | A list of length `len(x)` * `len(y)` or an appropriately dimensioned 2532 | array containing the Z coordinates 2533 | 2534 | major_h : 2535 | Directs GR to label contour lines. For example, a value of 3 would label 2536 | every third line. A value of 1 will label every line. A value of 0 2537 | produces no labels. To produce colored contour lines, add an offset 2538 | of 1000 to major_h. 2539 | |# 2540 | 2541 | (cffi:defcfun ("gr_contour" gr-contour) :void 2542 | (nx :int) 2543 | (ny :int) 2544 | (nh :int) 2545 | (px (:pointer :double)) 2546 | (py (:pointer :double)) 2547 | (h (:pointer :double)) 2548 | (pz (:pointer :double)) 2549 | (major-h :int)) 2550 | 2551 | (defun contour (x y h z major-h) 2552 | (assert (= (length (flatten z)) 2553 | (* (length x) (length y)))) 2554 | (let ((x-data (data-alloc x :double)) 2555 | (y-data (data-alloc y :double)) 2556 | (h-data (data-alloc h :double)) 2557 | (z-data (data-alloc z :double))) 2558 | (gr-contour (length x) 2559 | (length y) 2560 | (length h) 2561 | x-data 2562 | y-data 2563 | h-data 2564 | z-data 2565 | major-h) 2566 | (free x-data 2567 | y-data 2568 | h-data 2569 | z-data))) 2570 | 2571 | 2572 | #| 2573 | contourf(px, py, h, pz, major_h::Int) 2574 | 2575 | Draw filled contours of a three-dimensional data set whose values are 2576 | specified over a rectangular mesh. 2577 | 2578 | x : 2579 | A list containing the X coordinates 2580 | 2581 | y : 2582 | A list containing the Y coordinates 2583 | 2584 | h : 2585 | A list containing the Z coordinate for the height values 2586 | 2587 | z : 2588 | A list of length len(x) * len(y) or an appropriately dimensioned 2589 | array containing the Z coordinates 2590 | 2591 | major_h : 2592 | (intended for future use) 2593 | |# 2594 | 2595 | (cffi:defcfun ("gr_contourf" gr-contourf) :void 2596 | (nx :int) 2597 | (ny :int) 2598 | (nh :int) 2599 | (px (:pointer :double)) 2600 | (py (:pointer :double)) 2601 | (h (:pointer :double)) 2602 | (pz (:pointer :double)) 2603 | (major-h :int)) 2604 | 2605 | (defun contourf (x y h z major-h) 2606 | (assert (= (length (flatten z)) 2607 | (* (length x) (length y)))) 2608 | (let ((x-data (data-alloc x :double)) 2609 | (y-data (data-alloc y :double)) 2610 | (h-data (data-alloc h :double)) 2611 | (z-data (data-alloc z :double))) 2612 | (gr-contourf (length x) 2613 | (length y) 2614 | (length h) 2615 | x-data 2616 | y-data 2617 | h-data 2618 | z-data 2619 | major-h) 2620 | (free x-data 2621 | y-data 2622 | h-data 2623 | z-data))) 2624 | 2625 | 2626 | #| 2627 | tricontour(x, y, z, levels) 2628 | 2629 | Draw a contour plot for the given triangle mesh. 2630 | 2631 | x : 2632 | A list containing the X coordinates 2633 | 2634 | y : 2635 | A list containing the Y coordinates 2636 | 2637 | z : 2638 | A list containing the Z coordinates 2639 | 2640 | levels : 2641 | A list containing the contour levels 2642 | 2643 | |# 2644 | 2645 | (cffi:defcfun ("gr_tricontour" gr-tricontour) :void 2646 | (npoints :int) 2647 | (x (:pointer :double)) 2648 | (y (:pointer :double)) 2649 | (z (:pointer :double)) 2650 | (nlebels :int) 2651 | (lebels (:pointer :double))) 2652 | 2653 | (defun tricontour (x y z levels) 2654 | (let ((x-data (data-alloc x :double)) 2655 | (y-data (data-alloc y :double)) 2656 | (z-data (data-alloc z :double)) 2657 | (levels-data (data-alloc levels :double))) 2658 | (gr-tricontour (length x) 2659 | x-data 2660 | y-data 2661 | z-data 2662 | (length levels) 2663 | levels-data) 2664 | (free x-data 2665 | y-data 2666 | z-data 2667 | levels-data))) 2668 | 2669 | 2670 | (cffi:defcfun ("gr_hexbin" gr-hexbin) :int 2671 | (n :int) 2672 | (x (:pointer :double)) 2673 | (y (:pointer :double)) 2674 | (nbins :int)) 2675 | 2676 | (defun hexbin (x y nbins) 2677 | (assert (= (length x) 2678 | (length y))) 2679 | (let* ((x-data (data-alloc x :double)) 2680 | (y-data (data-alloc y :double)) 2681 | (nhexbin (gr-hexbin (length x) 2682 | x-data 2683 | y-data 2684 | nbins))) 2685 | (free x-data 2686 | y-data) 2687 | nhexbin)) 2688 | 2689 | 2690 | (cffi:defcfun ("gr_setcolormap" gr-setcolormap) :void 2691 | (index :int)) 2692 | 2693 | (defun setcolormap (index) 2694 | (gr-setcolormap index)) 2695 | 2696 | 2697 | (cffi:defcfun ("gr_inqcolormap" gr-inqcolormap) :void 2698 | (index (:pointer :int))) 2699 | 2700 | (defun inqcolormap (index) 2701 | (let ((index-data (data-alloc index :int))) 2702 | (gr-inqcolormap index-data) 2703 | (free index-data))) 2704 | 2705 | 2706 | (cffi:defcfun ("gr_setcolormapfromrgb" gr-setcolormapfromrgb) :void 2707 | (n :int) 2708 | (r (:pointer :double)) 2709 | (g (:pointer :double)) 2710 | (b (:pointer :double)) 2711 | (x (:pointer :double))) 2712 | 2713 | (defun setcolormapfromrgb (r g b &rest position) 2714 | (assert (= (length r) 2715 | (length g) 2716 | (length b))) 2717 | (let ((r-data (data-alloc r :double)) 2718 | (g-data (data-alloc g :double)) 2719 | (b-data (data-alloc b :double)) 2720 | (pos-data (if (null position) 2721 | (cffi:null-pointer) 2722 | (data-alloc (flatten position) :double)))) 2723 | (gr-setcolormapfromrgb (length r) 2724 | r-data 2725 | g-data 2726 | b-data 2727 | pos-data) 2728 | (free r-data 2729 | g-data 2730 | b-data 2731 | pos-data))) 2732 | 2733 | 2734 | (cffi:defcfun ("gr_colorbar" gr-colorbar) :void) 2735 | 2736 | (defun colorbar () 2737 | (gr-colorbar)) 2738 | 2739 | 2740 | (cffi:defcfun ("gr_inqcolor" gr-inqcolor) :void 2741 | (color :int) 2742 | (rgb (:pointer :int))) 2743 | 2744 | (defun inqcolor (color) 2745 | (let ((rgb (data-alloc '(0) :int))) 2746 | (gr-inqcolor color rgb) 2747 | (let ((data (cffi:mem-aref rgb :int 0))) 2748 | (free rgb) 2749 | data))) 2750 | 2751 | 2752 | (cffi:defcfun ("gr_inqcolorfromrgb" gr-inqcolorfromrgb) :int 2753 | (r :double) 2754 | (g :double) 2755 | (b :double)) 2756 | 2757 | (defun inqcolorfromrgb (r g b) 2758 | (gr-inqcolorfromrgb (coerce r 'double-float) 2759 | (coerce g 'double-float) 2760 | (coerce b 'double-float))) 2761 | 2762 | 2763 | (cffi:defcfun ("gr_hsvtorgb" gr-hsvtorgb) :void 2764 | (h :double) 2765 | (s :double) 2766 | (v :double) 2767 | (r (:pointer :double)) 2768 | (g (:pointer :double)) 2769 | (b (:pointer :double))) 2770 | 2771 | (defun hsvtorgb (h s v) 2772 | (let ((r (data-alloc '(0) :double)) 2773 | (g (data-alloc '(0) :double)) 2774 | (b (data-alloc '(0) :double))) 2775 | (gr-hsvtorgb (coerce h 'double-float) 2776 | (coerce s 'double-float) 2777 | (coerce v 'double-float) 2778 | r 2779 | g 2780 | b) 2781 | (let ((-r (arr-aref r :double 0)) 2782 | (-g (arr-aref g :double 0)) 2783 | (-b (arr-aref b :double 0))) 2784 | (free r g b) 2785 | (list -r -g -b)))) 2786 | 2787 | 2788 | (cffi:defcfun ("gr_tick" gr-tick) :double 2789 | (amin :double) 2790 | (amax :double)) 2791 | 2792 | (defun tick (amin amax) 2793 | (gr-tick (coerce amin 'double-float) 2794 | (coerce amax 'double-float))) 2795 | 2796 | 2797 | (cffi:defcfun ("gr_validaterange" gr-validaterange) :int 2798 | (amin :double) 2799 | (amax :double)) 2800 | 2801 | (defun validaterange (amin amax) 2802 | (gr-validaterange (coerce amin 'double-float) 2803 | (coerce amax 'double-float))) 2804 | 2805 | 2806 | (cffi:defcfun ("gr_adjustlimits" gr-adjustlimits) :void 2807 | (amin (:pointer :double)) 2808 | (amax (:pointer :double))) 2809 | 2810 | (defun adjustlimits (amin amax) 2811 | (let ((amin-data (data-alloc amin :double)) 2812 | (amax-data (data-alloc amax :double))) 2813 | (gr-adjustlimits amin-data 2814 | amax-data) 2815 | (let ((-amin (arr-aref amin-data :double 0)) 2816 | (-amax (arr-aref amax-data :double 0))) 2817 | (free amin-data 2818 | amax-data) 2819 | (list -amin -amax)))) 2820 | 2821 | 2822 | (cffi:defcfun ("gr_adjustrange" gr-adjustrange) :void 2823 | (amin (:pointer :double)) 2824 | (amax (:pointer :double))) 2825 | 2826 | (defun adjustrange (amin amax) 2827 | (let ((amin-data (data-alloc (list amin) :double)) 2828 | (amax-data (data-alloc (list amax) :double))) 2829 | (gr-adjustrange amin-data 2830 | amax-data) 2831 | (let ((-amin (arr-aref amin-data :double 0)) 2832 | (-amax (arr-aref amax-data :double 0))) 2833 | (free amin-data 2834 | amax-data) 2835 | (list -amin -amax)))) 2836 | 2837 | 2838 | 2839 | #| 2840 | beginprint(pathname) 2841 | 2842 | Open and activate a print device. 2843 | 2844 | pathname : 2845 | Filename for the print device. 2846 | 2847 | beginprint opens an additional graphics output device. The device type is obtained 2848 | from the given file extension. The following file types are supported: 2849 | 2850 | +-------------+---------------------------------------+ 2851 | |.ps, .eps |PostScript | 2852 | +-------------+---------------------------------------+ 2853 | |.pdf |Portable Document Format | 2854 | +-------------+---------------------------------------+ 2855 | |.bmp |Windows Bitmap (BMP) | 2856 | +-------------+---------------------------------------+ 2857 | |.jpeg, .jpg |JPEG image file | 2858 | +-------------+---------------------------------------+ 2859 | |.png |Portable Network Graphics file (PNG) | 2860 | +-------------+---------------------------------------+ 2861 | |.tiff, .tif |Tagged Image File Format (TIFF) | 2862 | +-------------+---------------------------------------+ 2863 | |.fig |Xfig vector graphics file | 2864 | +-------------+---------------------------------------+ 2865 | |.svg |Scalable Vector Graphics | 2866 | +-------------+---------------------------------------+ 2867 | |.wmf |Windows Metafile | 2868 | +-------------+---------------------------------------+ 2869 | |# 2870 | 2871 | (cffi:defcfun ("gr_beginprint" gr-beginprint) :void 2872 | (pathname (:pointer :char))) 2873 | 2874 | (defun beginprint (pathname) 2875 | (let ((pathname-data (string-alloc pathname))) 2876 | (gr-beginprint pathname-data) 2877 | (string-free pathname-data))) 2878 | 2879 | 2880 | 2881 | #| 2882 | beginprintext(pathname, mode, fmt, orientation) 2883 | 2884 | Open and activate a print device with the given layout attributes. 2885 | 2886 | pathname : 2887 | Filename for the print device. 2888 | mode : 2889 | Output mode (Color, GrayScale) 2890 | fmt : 2891 | Output format (see table below) 2892 | orientation : 2893 | Page orientation (Landscape, Portait) 2894 | 2895 | The available formats are: 2896 | 2897 | +-----------+---------------+ 2898 | |A4 |0.210 x 0.297 | 2899 | +-----------+---------------+ 2900 | |B5 |0.176 x 0.250 | 2901 | +-----------+---------------+ 2902 | |Letter |0.216 x 0.279 | 2903 | +-----------+---------------+ 2904 | |Legal |0.216 x 0.356 | 2905 | +-----------+---------------+ 2906 | |Executive |0.191 x 0.254 | 2907 | +-----------+---------------+ 2908 | |A0 |0.841 x 1.189 | 2909 | +-----------+---------------+ 2910 | |A1 |0.594 x 0.841 | 2911 | +-----------+---------------+ 2912 | |A2 |0.420 x 0.594 | 2913 | +-----------+---------------+ 2914 | |A3 |0.297 x 0.420 | 2915 | +-----------+---------------+ 2916 | |A5 |0.148 x 0.210 | 2917 | +-----------+---------------+ 2918 | |A6 |0.105 x 0.148 | 2919 | +-----------+---------------+ 2920 | |A7 |0.074 x 0.105 | 2921 | +-----------+---------------+ 2922 | |A8 |0.052 x 0.074 | 2923 | +-----------+---------------+ 2924 | |A9 |0.037 x 0.052 | 2925 | +-----------+---------------+ 2926 | |B0 |1.000 x 1.414 | 2927 | +-----------+---------------+ 2928 | |B1 |0.500 x 0.707 | 2929 | +-----------+---------------+ 2930 | |B10 |0.031 x 0.044 | 2931 | +-----------+---------------+ 2932 | |B2 |0.500 x 0.707 | 2933 | +-----------+---------------+ 2934 | |B3 |0.353 x 0.500 | 2935 | +-----------+---------------+ 2936 | |B4 |0.250 x 0.353 | 2937 | +-----------+---------------+ 2938 | |B6 |0.125 x 0.176 | 2939 | +-----------+---------------+ 2940 | |B7 |0.088 x 0.125 | 2941 | +-----------+---------------+ 2942 | |B8 |0.062 x 0.088 | 2943 | +-----------+---------------+ 2944 | |B9 |0.044 x 0.062 | 2945 | +-----------+---------------+ 2946 | |C5E |0.163 x 0.229 | 2947 | +-----------+---------------+ 2948 | |Comm10E |0.105 x 0.241 | 2949 | +-----------+---------------+ 2950 | |DLE |0.110 x 0.220 | 2951 | +-----------+---------------+ 2952 | |Folio |0.210 x 0.330 | 2953 | +-----------+---------------+ 2954 | |Ledger |0.432 x 0.279 | 2955 | +-----------+---------------+ 2956 | |Tabloid |0.279 x 0.432 | 2957 | +-----------+---------------+ 2958 | 2959 | |# 2960 | 2961 | (cffi:defcfun ("gr_beginprinttext" gr-beginprinttext) :void 2962 | (pahtname (:pointer :char)) 2963 | (mode (:pointer :char)) 2964 | (fmt (:pointer :char)) 2965 | (orientation (:pointer :char))) 2966 | 2967 | (defun beginprinttext (pathname mode fmt orientation) 2968 | (let ((pathname-data (string-alloc pathname)) 2969 | (mode-data (string-alloc mode)) 2970 | (fmt-data (string-alloc fmt)) 2971 | (orientation-data (string-alloc orientation))) 2972 | (gr-beginprinttext pathname-data 2973 | mode-data 2974 | fmt-data 2975 | orientation-data) 2976 | (string-free pathname-data 2977 | mode-data 2978 | fmt-data 2979 | orientation-data))) 2980 | 2981 | 2982 | (cffi:defcfun ("gr_endprint" gr-endprint) :void) 2983 | 2984 | (defun endprint () 2985 | (gr-endprint)) 2986 | 2987 | 2988 | (cffi:defcfun ("gr_ndctowc" gr-ndctowc) :void 2989 | (x (:pointer :double)) 2990 | (y (:pointer :double))) 2991 | 2992 | (defun ndctowc (x y) 2993 | (let ((x-data (data-alloc (list x) :double)) 2994 | (y-data (data-alloc (list y) :double))) 2995 | (gr-ndctowc x-data 2996 | y-data) 2997 | (let ((-x (arr-aref x-data :double 0)) 2998 | (-y (arr-aref y-data :double 0))) 2999 | (free x-data 3000 | y-data) 3001 | (list -x -y)))) 3002 | 3003 | 3004 | (cffi:defcfun ("gr_wctondc" gr-wctondc) :void 3005 | (x (:pointer :double)) 3006 | (y (:pointer :double))) 3007 | 3008 | (defun wctondc (x y) 3009 | (let ((x-data (data-alloc (list x) :double)) 3010 | (y-data (data-alloc (list y) :double))) 3011 | (gr-wctondc x-data 3012 | y-data) 3013 | (let ((-x (arr-aref x-data :double 0)) 3014 | (-y (arr-aref y-data :double 0))) 3015 | (free x-data 3016 | y-data) 3017 | (list -x -y)))) 3018 | 3019 | 3020 | (cffi:defcfun ("gr_wc3towc" gr-wc3towc) :void 3021 | (x (:pointer :double)) 3022 | (y (:pointer :double)) 3023 | (z (:pointer :double))) 3024 | 3025 | (defun wc3towc (x y z) 3026 | (let ((x-data (data-alloc (list x) :double)) 3027 | (y-data (data-alloc (list y) :double)) 3028 | (z-data (data-alloc (list z) :double))) 3029 | (gr-wc3towc x-data 3030 | y-data 3031 | z-data) 3032 | (let ((-x (arr-aref x-data :double 0)) 3033 | (-y (arr-aref y-data :double 0)) 3034 | (-z (arr-aref z-data :double 0))) 3035 | (free x-data 3036 | y-data 3037 | z-data) 3038 | (list -x -y -z)))) 3039 | 3040 | 3041 | #| 3042 | drawrect(xmin::Real, xmax::Real, ymin::Real, ymax::Real) 3043 | 3044 | Draw a rectangle using the current line attributes. 3045 | 3046 | xmin : 3047 | Lower left edge of the rectangle 3048 | xmax : 3049 | Lower right edge of the rectangle 3050 | ymin : 3051 | Upper left edge of the rectangle 3052 | ymax : 3053 | Upper right edge of the rectangle 3054 | |# 3055 | 3056 | (cffi:defcfun ("gr_drawrect" gr-drawrect) :void 3057 | (xmin :double) 3058 | (xmax :double) 3059 | (ymin :double) 3060 | (ymax :double)) 3061 | 3062 | (defun drawrect (xmin xmax ymin ymax) 3063 | (gr-drawrect (coerce xmin 'double-float) 3064 | (coerce xmax 'double-float) 3065 | (coerce ymin 'double-float) 3066 | (coerce ymax 'double-float))) 3067 | 3068 | 3069 | #| 3070 | fillrect(xmin::Real, xmax::Real, ymin::Real, ymax::Real) 3071 | 3072 | Draw a filled rectangle using the current fill attributes. 3073 | 3074 | xmin : 3075 | Lower left edge of the rectangle 3076 | xmax : 3077 | Lower right edge of the rectangle 3078 | ymin : 3079 | Upper left edge of the rectangle 3080 | ymax : 3081 | Upper right edge of the rectangle 3082 | |# 3083 | 3084 | (cffi:defcfun ("gr_fillrect" gr-fillrect) :void 3085 | (xmin :double) 3086 | (xmax :double) 3087 | (ymin :double) 3088 | (ymax :double)) 3089 | 3090 | (defun fillrect (xmin xmax ymin ymax) 3091 | (gr-fillrect (coerce xmin 'double-float) 3092 | (coerce xmax 'double-float) 3093 | (coerce ymin 'double-float) 3094 | (coerce ymax 'double-float))) 3095 | 3096 | 3097 | #| 3098 | drawarc(xmin::Real, xmax::Real, ymin::Real, ymax::Real, a1::Real, a2::Real) 3099 | 3100 | Draw a circular or elliptical arc covering the specified rectangle. 3101 | 3102 | xmin : 3103 | Lower left edge of the rectangle 3104 | xmax : 3105 | Lower right edge of the rectangle 3106 | ymin : 3107 | Upper left edge of the rectangle 3108 | ymax : 3109 | Upper right edge of the rectangle 3110 | a1 : 3111 | The start angle 3112 | a2 : 3113 | The end angle 3114 | 3115 | The resulting arc begins at a1 and ends at a2 degrees. Angles are interpreted 3116 | such that 0 degrees is at the 3 o'clock position. The center of the arc is the center 3117 | of the given rectangle. 3118 | |# 3119 | 3120 | (cffi:defcfun ("gr_drawarc" gr-drawarc) :void 3121 | (xmin :double) 3122 | (xmax :double) 3123 | (ymin :double) 3124 | (ymax :double) 3125 | (a1 :double) 3126 | (a2 :double)) 3127 | 3128 | (defun drawarc (xmin xmax ymin ymax a1 a2) 3129 | (gr-drawarc (coerce xmin 'double-float) 3130 | (coerce xmax 'double-float) 3131 | (coerce ymin 'double-float) 3132 | (coerce ymax 'double-float) 3133 | (coerce a1 'double-float) 3134 | (coerce a2 'double-float))) 3135 | 3136 | 3137 | #| 3138 | fillarc(xmin::Real, xmax::Real, ymin::Real, ymax::Real, a1::Real, a2::Real) 3139 | 3140 | Fill a circular or elliptical arc covering the specified rectangle. 3141 | 3142 | xmin : 3143 | Lower left edge of the rectangle 3144 | xmax : 3145 | Lower right edge of the rectangle 3146 | ymin : 3147 | Upper left edge of the rectangle 3148 | ymax : 3149 | Upper right edge of the rectangle 3150 | a1 : 3151 | The start angle 3152 | a2 : 3153 | The end angle 3154 | 3155 | The resulting arc begins at a1 and ends at a2 degrees. Angles are interpreted 3156 | such that 0 degrees is at the 3 o'clock position. The center of the arc is the center 3157 | of the given rectangle. 3158 | |# 3159 | 3160 | (cffi:defcfun ("gr_fillarc" gr-fillarc) :void 3161 | (xmin :double) 3162 | (xmax :double) 3163 | (ymin :double) 3164 | (ymax :double) 3165 | (a1 :double) 3166 | (a2 :double)) 3167 | 3168 | (defun fillarc (xmin xmax ymin ymax a1 a2) 3169 | (gr-fillarc (coerce xmin 'double-float) 3170 | (coerce xmax 'double-float) 3171 | (coerce ymin 'double-float) 3172 | (coerce ymax 'double-float) 3173 | (coerce a1 'double-float) 3174 | (coerce a2 'double-float))) 3175 | 3176 | 3177 | #| 3178 | drawpath(points, codes, fill::Int) 3179 | 3180 | Draw simple and compound outlines consisting of line segments and bezier curves. 3181 | 3182 | points : 3183 | (N, 2) array of (x, y) vertices 3184 | codes : 3185 | N-length array of path codes 3186 | fill : 3187 | A flag indication whether resulting path is to be filled or not 3188 | 3189 | The following path codes are recognized: 3190 | 3191 | +----------+-----------------------------------------------------------+ 3192 | | STOP|end the entire path | 3193 | +----------+-----------------------------------------------------------+ 3194 | | MOVETO|move to the given vertex | 3195 | +----------+-----------------------------------------------------------+ 3196 | | LINETO|draw a line from the current position to the given vertex | 3197 | +----------+-----------------------------------------------------------+ 3198 | | CURVE3|draw a quadratic Bézier curve | 3199 | +----------+-----------------------------------------------------------+ 3200 | | CURVE4|draw a cubic Bézier curve | 3201 | +----------+-----------------------------------------------------------+ 3202 | | CLOSEPOLY|draw a line segment to the start point of the current path | 3203 | +----------+-----------------------------------------------------------+ 3204 | |# 3205 | 3206 | (cffi:defcstruct vertex-t 3207 | (x :double) 3208 | (y :double)) 3209 | 3210 | (cffi:defcfun ("gr_drawpath" gr-drawpath) :void 3211 | (n :int) 3212 | (vertices :pointer) 3213 | (codes (:pointer :unsigned-char)) 3214 | (fill :int)) 3215 | 3216 | (defun drawpath (points codes fill) 3217 | (let ((c (string-alloc codes))) 3218 | (cffi:with-foreign-object (v '(:struct vertex-t)) 3219 | (setf (cffi:foreign-slot-value v '(:struct vertex-t) 'x) (car points) 3220 | (cffi:foreign-slot-value v '(:struct vertex-t) 'y) (cadr points)) 3221 | (gr-drawpath (length codes) 3222 | v 3223 | c 3224 | fill)) 3225 | (string-free c))) 3226 | 3227 | 3228 | #| 3229 | setarrowstyle(style::Int) 3230 | 3231 | Set the arrow style to be used for subsequent arrow commands. 3232 | 3233 | `style` : 3234 | The arrow style to be used 3235 | 3236 | setarrowstyle defines the arrow style for subsequent arrow primitives. 3237 | The default arrow style is 1. 3238 | 3239 | +---+----------------------------------+ 3240 | | 1|simple, single-ended | 3241 | +---+----------------------------------+ 3242 | | 2|simple, single-ended, acute head | 3243 | +---+----------------------------------+ 3244 | | 3|hollow, single-ended | 3245 | +---+----------------------------------+ 3246 | | 4|filled, single-ended | 3247 | +---+----------------------------------+ 3248 | | 5|triangle, single-ended | 3249 | +---+----------------------------------+ 3250 | | 6|filled triangle, single-ended | 3251 | +---+----------------------------------+ 3252 | | 7|kite, single-ended | 3253 | +---+----------------------------------+ 3254 | | 8|filled kite, single-ended | 3255 | +---+----------------------------------+ 3256 | | 9|simple, double-ended | 3257 | +---+----------------------------------+ 3258 | | 10|simple, double-ended, acute head | 3259 | +---+----------------------------------+ 3260 | | 11|hollow, double-ended | 3261 | +---+----------------------------------+ 3262 | | 12|filled, double-ended | 3263 | +---+----------------------------------+ 3264 | | 13|triangle, double-ended | 3265 | +---+----------------------------------+ 3266 | | 14|filled triangle, double-ended | 3267 | +---+----------------------------------+ 3268 | | 15|kite, double-ended | 3269 | +---+----------------------------------+ 3270 | | 16|filled kite, double-ended | 3271 | +---+----------------------------------+ 3272 | | 17|double line, single-ended | 3273 | +---+----------------------------------+ 3274 | | 18|double line, double-ended | 3275 | +---+----------------------------------+ 3276 | |# 3277 | 3278 | (cffi:defcfun ("gr_setarrowstyle" gr-setarrowstyle) :void 3279 | (style :int)) 3280 | 3281 | (defun setarrowstyle (style) 3282 | (gr-setarrowstyle style)) 3283 | 3284 | 3285 | #| 3286 | setarrowsize(size::Real) 3287 | 3288 | Set the arrow size to be used for subsequent arrow commands. 3289 | 3290 | size : 3291 | The arrow size to be used 3292 | 3293 | setarrowsize defines the arrow size for subsequent arrow primitives. 3294 | The default arrow size is 1. 3295 | |# 3296 | 3297 | (cffi:defcfun ("gr_setarrowsize" gr-setarrowsize) :void 3298 | (size :double)) 3299 | 3300 | (defun setarrowsize (size) 3301 | (gr-setarrowsize (coerce size 'double-float))) 3302 | 3303 | 3304 | #| 3305 | drawarrow(x1::Real, y1::Real, x2::Real, y2::Real) 3306 | 3307 | Draw an arrow between two points. 3308 | 3309 | x1, y1 : 3310 | Starting point of the arrow (tail) 3311 | x2, y2 : 3312 | Head of the arrow 3313 | 3314 | Different arrow styles (angles between arrow tail and wing, optionally filled 3315 | heads, double headed arrows) are available and can be set with the `setarrowstyle` 3316 | function. 3317 | |# 3318 | 3319 | (cffi:defcfun ("gr_drawarrow" gr-drawarrow) :void 3320 | (x1 :double) 3321 | (y1 :double) 3322 | (x2 :double) 3323 | (y2 :double)) 3324 | 3325 | (defun drawarrow (x1 y1 x2 y2) 3326 | (gr-drawarrow (coerce x1 'double-float) 3327 | (coerce y1 'double-float) 3328 | (coerce x2 'double-float) 3329 | (coerce y2 'double-float))) 3330 | 3331 | 3332 | (cffi:defcfun ("gr_readimage" gr-readimage) :void 3333 | (path (:pointer :char)) 3334 | (width (:pointer :int)) 3335 | (height (:pointer :int)) 3336 | (data (:pointer (:pointer :int)))) 3337 | 3338 | (defun readimage (path) 3339 | (let ((path-data (string-alloc path)) 3340 | (w (data-alloc '(0) :int)) 3341 | (h (data-alloc '(0) :int)) 3342 | (data (cffi:foreign-alloc :pointer 3343 | :initial-element 3344 | (data-alloc '(0) :int)))) 3345 | (gr-readimage path-data 3346 | w 3347 | h 3348 | data) 3349 | (let ((-w (arr-aref w :int 0)) 3350 | (-h (arr-aref h :int 0)) 3351 | (img (loop for i below (arr-aref h :int 0) 3352 | collect (loop for j below (arr-aref w :int 0) 3353 | collect (arr-aref (arr-aref data :pointer 0) 3354 | :int 3355 | (+ j 3356 | (* i (arr-aref w :int 0)))))))) 3357 | (string-free path-data) 3358 | (free w h data) 3359 | (list -w -h img)))) 3360 | 3361 | 3362 | #|| 3363 | drawimage(xmin::Real, xmax::Real, ymin::Real, ymax::Real, width::Int, height::Int, data, model::Int = 0) 3364 | 3365 | Draw an image into a given rectangular area. 3366 | 3367 | xmin, ymin : 3368 | First corner point of the rectangle 3369 | xmax, ymax : 3370 | Second corner point of the rectangle 3371 | width, height : 3372 | The width and the height of the image 3373 | data : 3374 | An array of color values dimensioned width by height 3375 | model : 3376 | Color model (default=0) 3377 | 3378 | The available color models are: 3379 | 3380 | +-----------------------+---+-----------+ 3381 | |MODEL_RGB | 0| AABBGGRR| 3382 | +-----------------------+---+-----------+ 3383 | |MODEL_HSV | 1| AAVVSSHH| 3384 | +-----------------------+---+-----------+ 3385 | 3386 | The points (xmin, ymin) and (xmax, ymax) are world coordinates defining 3387 | diagonally opposite corner points of a rectangle. This rectangle is divided into 3388 | `width` by `height` cells. The two-dimensional array `data` specifies colors 3389 | for each cell. 3390 | 3391 | |# 3392 | 3393 | (cffi:defcfun ("gr_drawimage" gr-drawimage) :void 3394 | (xmin :double) 3395 | (xmax :double) 3396 | (ymin :double) 3397 | (ymax :double) 3398 | (width :int) 3399 | (height :int) 3400 | (data (:pointer :int)) 3401 | (model :int)) 3402 | 3403 | (defun drawimage (xmin xmax ymin ymax width height data model) 3404 | (let ((img (data-alloc (flatten data) :int))) 3405 | (gr-drawimage (coerce xmin 'double-float) 3406 | (coerce xmax 'double-float) 3407 | (coerce ymin 'double-float) 3408 | (coerce ymax 'double-float) 3409 | width 3410 | height 3411 | img 3412 | model) 3413 | (free img))) 3414 | 3415 | 3416 | (cffi:defcfun ("gr_importgraphics" gr-importgraphics) :int 3417 | (path (:pointer :char))) 3418 | 3419 | (defun importgraphics (path) 3420 | (let* ((path-data (string-alloc path)) 3421 | (ret (gr-importgraphics path-data))) 3422 | (string-free path-data) 3423 | ret)) 3424 | 3425 | 3426 | #| 3427 | setshadow(offsetx::Real, offsety::Real, blur::Real) 3428 | 3429 | setshadow allows drawing of shadows, realized by images painted underneath, 3430 | and offset from, graphics objects such that the shadow mimics the effect of a light 3431 | source cast on the graphics objects. 3432 | 3433 | offsetx : 3434 | An x-offset, which specifies how far in the horizontal direction the 3435 | shadow is offset from the object 3436 | offsety : 3437 | A y-offset, which specifies how far in the vertical direction the shadow 3438 | is offset from the object 3439 | blur : 3440 | A blur value, which specifies whether the object has a hard or a diffuse 3441 | edge 3442 | 3443 | |# 3444 | 3445 | (cffi:defcfun ("gr_setshadow" gr-setshadow) :void 3446 | (offsetx :double) 3447 | (offsety :double) 3448 | (blur :double)) 3449 | 3450 | (defun setshadow (offsetx offsety blur) 3451 | (gr-setshadow (coerce offsetx 'double-float) 3452 | (coerce offsety 'double-float) 3453 | (coerce blur 'double-float))) 3454 | 3455 | 3456 | #| 3457 | settransparency(alpha::Real) 3458 | 3459 | Set the value of the alpha component associated with GR colors. 3460 | 3461 | alpha : 3462 | An alpha value (0.0 - 1.0) 3463 | 3464 | |# 3465 | 3466 | (cffi:defcfun ("gr_settransparency" gr-settransparency) :void 3467 | (alpha :double)) 3468 | 3469 | (defun settransparency (alpha) 3470 | (gr-settransparency (coerce alpha 'double-float))) 3471 | 3472 | 3473 | #| 3474 | setcoordxform(mat) 3475 | 3476 | Change the coordinate transformation according to the given matrix. 3477 | 3478 | mat[3][2] : 3479 | 2D transformation matrix 3480 | |# 3481 | 3482 | (cffi:defcfun ("gr_setcoordxform" gr-setcoordxform) :void 3483 | (mat (:pointer :double))) 3484 | 3485 | (defun setcoordxform (mat) 3486 | (assert (= (length (flatten mat)) 6)) 3487 | (let ((mat-data (data-alloc (flatten mat) :double))) 3488 | (gr-setcoordxform mat-data) 3489 | (free mat-data))) 3490 | 3491 | 3492 | #| 3493 | begingraphics(path) 3494 | 3495 | Open a file for graphics output. 3496 | 3497 | path : 3498 | Filename for the graphics file. 3499 | 3500 | begingraphics allows to write all graphics output into a XML-formatted file until 3501 | the `endgraphics` functions is called. The resulting file may later be imported with 3502 | the `importgraphics` function. 3503 | 3504 | |# 3505 | 3506 | (cffi:defcfun ("gr_begingraphics" gr-begingraphics) :void 3507 | (path (:pointer :char))) 3508 | 3509 | (defun begingraphics (path) 3510 | (let ((path-data (string-alloc path))) 3511 | (gr-begingraphics path-data) 3512 | (string-free path-data))) 3513 | 3514 | 3515 | (cffi:defcfun ("gr_endgraphics" gr-endgraphics) :void) 3516 | 3517 | (defun endgraphics () 3518 | (gr-endgraphics)) 3519 | 3520 | 3521 | (cffi:defcfun ("gr_getgraphics" gr-getgraphics) (:pointer :char)) 3522 | 3523 | (defun getgraphics () 3524 | (cffi:foreign-string-to-lisp (gr-getgraphics))) 3525 | 3526 | 3527 | (cffi:defcfun ("gr_drawgraphics" gr-drawgraphics) :int 3528 | (str (:pointer :char))) 3529 | 3530 | (defun drawgraphics (str) 3531 | (let* ((str-data (string-alloc str)) 3532 | (ret (gr-drawgraphics str-data))) 3533 | (string-free str-data) 3534 | ret)) 3535 | 3536 | 3537 | #| 3538 | mathtex(x::Real, y::Real, string) 3539 | 3540 | Generate a character string starting at the given location. Strings can be defined 3541 | to create mathematical symbols and Greek letters using LaTeX syntax. 3542 | 3543 | x, y : 3544 | Position of the text string specified in world coordinates 3545 | string : 3546 | The text string to be drawn 3547 | 3548 | |# 3549 | 3550 | (cffi:defcfun ("gr_mathtex" gr-mathtex) :void 3551 | (x :double) 3552 | (y :double) 3553 | (str (:pointer :char))) 3554 | 3555 | (defun mathtex (x y str) 3556 | (let ((str-data (string-alloc str))) 3557 | (gr-mathtex (coerce x 'double-float) 3558 | (coerce y 'double-float) 3559 | str-data) 3560 | (string-free str-data))) 3561 | 3562 | 3563 | (cffi:defcfun ("gr_inqmathtex" gr-inqmathtex) :void 3564 | (x :double) 3565 | (y :double) 3566 | (str (:pointer :char)) 3567 | (tbx (:pointer :double)) 3568 | (tby (:pointer :double))) 3569 | 3570 | (defun inqmathtex (x y str) 3571 | (let ((str-data (string-alloc str)) 3572 | (tbx-data (data-alloc '(0 0 0 0) :double)) 3573 | (tby-data (data-alloc '(0 0 0 0) :double))) 3574 | (gr-inqmathtex (coerce x 'double-float) 3575 | (coerce y 'double-float) 3576 | str-data 3577 | tbx-data 3578 | tby-data) 3579 | (let ((tbx (loop for i below 4 3580 | collect (arr-aref tbx-data :double i))) 3581 | (tby (loop for j below 4 3582 | collect (arr-aref tby-data :double j)))) 3583 | (string-free str-data) 3584 | (free tbx-data tby-data) 3585 | (list tbx tby)))) 3586 | 3587 | 3588 | (cffi:defcfun ("gr_setregenflags" gr-setregenflags) :void 3589 | (flags :int)) 3590 | 3591 | (defun setregenflags (&rest flags) 3592 | (gr-setregenflags (if (null flags) 3593 | flags 3594 | 0))) 3595 | 3596 | 3597 | (cffi:defcfun ("gr_inqregenflags" gr-inqregenflags) :int) 3598 | 3599 | (defun inqregenflags () 3600 | (gr-inqregenflags)) 3601 | 3602 | 3603 | (cffi:defcfun ("gr_savestate" gr-savestate) :void) 3604 | 3605 | (defun savestate () 3606 | (gr-savestate)) 3607 | 3608 | 3609 | (cffi:defcfun ("gr_restorestate" gr-restorestate) :void) 3610 | 3611 | (defun restorestate () 3612 | (gr-restorestate)) 3613 | 3614 | 3615 | (cffi:defcfun ("gr_selectcontext" gr-selectcontext) :void 3616 | (context :int)) 3617 | 3618 | (defun selectcontext (context) 3619 | (gr-selectcontext context)) 3620 | 3621 | 3622 | (cffi:defcfun ("gr_destroycontext" gr-destroycontext) :void 3623 | (context :int)) 3624 | 3625 | (defun destroycontext (context) 3626 | (gr-selectcontext context)) 3627 | 3628 | 3629 | (cffi:defcfun ("gr_uselinespec" gr-uselinespec) :int 3630 | (linespec (:pointer :char))) 3631 | 3632 | (defun uselinespec (linespec) 3633 | (let* ((linespec-data (string-alloc linespec)) 3634 | (ret (gr-uselinespec linespec-data))) 3635 | (string-free linespec-data) 3636 | ret)) 3637 | 3638 | 3639 | (cffi:defcfun ("gr_delaunay" gr-delaunay) :void 3640 | (npoints :int) 3641 | (x (:pointer :double)) 3642 | (y (:pointer :double)) 3643 | (ntri (:pointer :int)) 3644 | (triangles (:pointer (:pointer :int)))) 3645 | 3646 | (defun delaunay (x y) 3647 | (assert (= (length x) 3648 | (length y))) 3649 | (let ((x-data (data-alloc x :double)) 3650 | (y-data (data-alloc y :double)) 3651 | (dim-data (data-alloc '(3) :int)) 3652 | (ntri-data (data-alloc '(0) :int)) 3653 | (triangles-data (cffi:foreign-alloc :poiter 3654 | :initial-element 3655 | (data-alloc '(0) :int)))) 3656 | (gr-delaunay (length x) 3657 | x-data 3658 | y-data 3659 | ntri-data 3660 | triangles-data) 3661 | (let* ((-ntri (arr-aref ntri-data :int 0)) 3662 | (-tri (loop for i below (arr-aref dim-data :int 0) 3663 | collect (loop for j below -ntri 3664 | collect (arr-aref (arr-aref triangles-data :pointer 0) 3665 | :int 3666 | (+ j 3667 | (* i -ntri))))))) 3668 | (free x-data 3669 | y-data 3670 | dim-data 3671 | ntri-data 3672 | triangles-data) 3673 | (list -ntri 3674 | -tri)))) 3675 | 3676 | 3677 | (cffi:defcfun ("gr_reducepoints" gr-reducepoints) :void 3678 | (n :int) 3679 | (x (:pointer :double)) 3680 | (y (:pointer :double)) 3681 | (points :int) 3682 | (x-array (:pointer :double)) 3683 | (y-array (:pointer :double))) 3684 | 3685 | (defun reducepoints (xd yd n) 3686 | (assert (= (length xd) 3687 | (length yd))) 3688 | (let* ((nd (length xd)) 3689 | (xd-data (data-alloc xd :double)) 3690 | (yd-data (data-alloc yd :double)) 3691 | (x (data-alloc (loop for i from 1 to n 3692 | collect i) 3693 | :double)) 3694 | (y (data-alloc (loop for i from 1 to n 3695 | collect i) 3696 | :double))) 3697 | (gr-reducepoints nd 3698 | xd-data 3699 | yd-data 3700 | n 3701 | x 3702 | y) 3703 | (let ((-x (loop for i below n 3704 | collect (arr-aref x :double i))) 3705 | (-y (loop for i below n 3706 | collect (arr-aref y :double i)))) 3707 | (free xd-data 3708 | yd-data 3709 | x 3710 | y) 3711 | (list -x -y)))) 3712 | 3713 | 3714 | #| 3715 | trisurface(x, y, z) 3716 | 3717 | Draw a triangular surface plot for the given data points. 3718 | 3719 | x : 3720 | A list containing the X coordinates 3721 | y : 3722 | A list containing the Y coordinates 3723 | z : 3724 | A list containing the Z coordinates 3725 | 3726 | |# 3727 | 3728 | (cffi:defcfun ("gr_trisurface" gr-trisurface) :void 3729 | (n :int) 3730 | (px (:pointer :double)) 3731 | (py (:pointer :double)) 3732 | (pz (:pointer :double))) 3733 | 3734 | (defun trisurface (x y z) 3735 | (let ((n (min (length x) 3736 | (length y) 3737 | (length z))) 3738 | (x-data (data-alloc x :double)) 3739 | (y-data (data-alloc y :double)) 3740 | (z-data (data-alloc z :double))) 3741 | (gr-trisurface n 3742 | x-data 3743 | y-data 3744 | z-data) 3745 | (free x-data 3746 | y-data 3747 | z-data))) 3748 | 3749 | 3750 | (cffi:defcfun ("gr_gradient" gr-gradient) :void 3751 | (nx :int) 3752 | (ny :int) 3753 | (x (:pointer :double)) 3754 | (y (:pointer :double)) 3755 | (z (:pointer :double)) 3756 | (u (:pointer :double)) 3757 | (v (:pointer :double))) 3758 | 3759 | (defun gradient (x y z) 3760 | (assert (= (length (flatten z)) 3761 | (* (length x) (length y)))) 3762 | (let ((x-data (data-alloc x :double)) 3763 | (y-data (data-alloc y :double)) 3764 | (z-data (data-alloc (flatten z) :double)) 3765 | (u-data (data-alloc (loop for i from 1 to (* (length x) 3766 | (length y)) 3767 | collect i) 3768 | :double)) 3769 | (v-data (data-alloc (loop for i from 1 to (* (length x) 3770 | (length y)) 3771 | collect i) 3772 | :double))) 3773 | (gr-gradient (length x) 3774 | (length y) 3775 | x-data 3776 | y-data 3777 | z-data 3778 | u-data 3779 | v-data) 3780 | (let ((u (loop for i below (length y) 3781 | collect (loop for j below (length x) 3782 | collect (arr-aref u-data 3783 | :double 3784 | (+ j 3785 | (* i (length x))))))) 3786 | (v (loop for i below (length y) 3787 | collect (loop for j below (length x) 3788 | collect (arr-aref v-data 3789 | :double 3790 | (+ j 3791 | (* i (length x)))))))) 3792 | (free x-data 3793 | y-data 3794 | z-data 3795 | u-data 3796 | v-data) 3797 | (list u v)))) 3798 | 3799 | 3800 | (cffi:defcfun ("gr_quiver" gr-quiver) :void 3801 | (nx :int) 3802 | (ny :int) 3803 | (x (:pointer :double)) 3804 | (y (:pointer :double)) 3805 | (u (:pointer :double)) 3806 | (v (:pointer :double)) 3807 | (color :int)) 3808 | 3809 | (defun quiver (x y u v &key (color t)) 3810 | (let ((x-data (data-alloc x :double)) 3811 | (y-data (data-alloc y :double)) 3812 | (u-data (data-alloc (flatten u) :double)) 3813 | (v-data (data-alloc (flatten v) :double)) 3814 | (c (if color 1 0))) 3815 | (gr-quiver (length x) 3816 | (length y) 3817 | x-data 3818 | y-data 3819 | u-data 3820 | v-data 3821 | c) 3822 | (free x-data 3823 | y-data 3824 | u-data 3825 | v-data))) 3826 | 3827 | 3828 | #| 3829 | interp2(x y z xq yq method=0 extrapval=0 ) 3830 | 3831 | Interpolation in two dimensions using one of four different methods. 3832 | The input points are located on a grid, described by `nx`, `ny`, `x`, `y` and `z`. 3833 | The target grid ist described by `nxq`, `nyq`, `xq` and `yq` and the output 3834 | is written to `zq` as a field of `nxq * nyq` values. 3835 | 3836 | nx : 3837 | The number of the input grid's x-values 3838 | ny : 3839 | The number of the input grid's y-values 3840 | x : 3841 | Pointer to the input grid's x-values 3842 | y : 3843 | Pointer to the input grid's y-values 3844 | z : 3845 | Pointer to the input grid's z-values (num. of values: nx * ny) 3846 | nxq : 3847 | The number of the target grid's x-values 3848 | nyq : 3849 | The number of the target grid's y-values 3850 | xq : 3851 | Pointer to the target grid's x-values 3852 | yq : 3853 | Pointer to the target grid's y-values 3854 | zq : 3855 | Pointer to the target grids's z-values, used for output 3856 | method : 3857 | Used method for interpolation 3858 | extrapval : 3859 | The extrapolation value 3860 | 3861 | The available methods for interpolation are the following: 3862 | 3863 | +-----------------+---+-------------------------------------------+ 3864 | | INTERP2_NEAREST | 0 | Nearest neighbour interpolation | 3865 | +-----------------+---+-------------------------------------------+ 3866 | | INTERP2_LINEAR | 1 | Linear interpolation | 3867 | +-----------------+---+-------------------------------------------+ 3868 | | INTERP_2_SPLINE | 2 | Interpolation using natural cubic splines | 3869 | +-----------------+---+-------------------------------------------+ 3870 | | INTERP2_CUBIC | 3 | Cubic interpolation | 3871 | +-----------------+---+-------------------------------------------+ 3872 | 3873 | 3874 | |# 3875 | 3876 | (cffi:defcfun ("gr_interp2" gr-interp2) :void 3877 | (nx :int) 3878 | (ny :int) 3879 | (x (:pointer :double)) 3880 | (y (:pointer :double)) 3881 | (z (:pointer :double)) 3882 | (nxq :int) 3883 | (nyq :int) 3884 | (xq (:pointer :double)) 3885 | (yq (:pointer :double)) 3886 | (zq (:pointer :double)) 3887 | (method :int) 3888 | (extrapval :double)) 3889 | 3890 | (defun interp2 (x y z xq yq &key (method 0) (extrapval 0)) 3891 | (let ((x-data (data-alloc x :double)) 3892 | (y-data (data-alloc y :double)) 3893 | (z-data (data-alloc z :double)) 3894 | (xq-data (data-alloc xq :double)) 3895 | (yq-data (data-alloc yq :double)) 3896 | (zq-data (data-alloc (loop for i from 1 to (* (length x) 3897 | (length y)) 3898 | collect i) 3899 | :double))) 3900 | (gr-interp2 (length x) 3901 | (length y) 3902 | x-data 3903 | y-data 3904 | z-data 3905 | (length xq) 3906 | (length yq) 3907 | xq-data 3908 | yq-data 3909 | zq-data 3910 | method 3911 | (coerce extrapval 'double-float)) 3912 | (free x-data 3913 | y-data 3914 | z-data 3915 | xq-data 3916 | yq-data 3917 | zq-data))) 3918 | 3919 | 3920 | (cffi:defcfun ("gr_version" gr-version) (:pointer :char)) 3921 | 3922 | (defun version () 3923 | (cffi:foreign-string-to-lisp (gr-version))) 3924 | 3925 | 3926 | #| 3927 | shade() 3928 | 3929 | +-----------------+---+ 3930 | | XFORM_BOOLEAN | 0 | 3931 | +-----------------+---+ 3932 | | XFORM_LINEAR | 1 | 3933 | +-----------------+---+ 3934 | | XFORM_LOG | 2 | 3935 | +-----------------+---+ 3936 | | XFORM_LOGLOG | 3 | 3937 | +-----------------+---+ 3938 | | XFORM_CUBIC | 4 | 3939 | +-----------------+---+ 3940 | | XFORM_EQUALIZED | 5 | 3941 | +-----------------+---+ 3942 | 3943 | |# 3944 | 3945 | (cffi:defcfun ("gr_shade" gr-shade) :void 3946 | (n :int) 3947 | (x (:pointer :double)) 3948 | (y (:pointer :double)) 3949 | (lines :int) 3950 | (xform :int) 3951 | (roi (:pointer :double)) 3952 | (w :int) 3953 | (h :int) 3954 | (bins (:pointer :int))) 3955 | 3956 | (defun shade (x y roi w h &key (lines 0) (xform 0)) 3957 | (let ((x-data (data-alloc x :double)) 3958 | (y-data (data-alloc y :double)) 3959 | (roi-data (data-alloc roi :double)) 3960 | (bins-data (data-alloc (loop for i below (* w h) 3961 | collect 0) 3962 | :int))) 3963 | (gr-shade (min (length x) (length y)) 3964 | x-data 3965 | y-data 3966 | lines 3967 | xform 3968 | roi-data 3969 | w 3970 | h 3971 | bins-data) 3972 | (free x-data 3973 | y-data 3974 | roi-data 3975 | bins-data))) 3976 | 3977 | 3978 | #| 3979 | shadepoints(x y dims=[1200 1200] xform=1) 3980 | 3981 | Display a point set as a aggregated and rasterized image. 3982 | 3983 | x : 3984 | A pointer to the X coordinates 3985 | y : 3986 | A pointer to the Y coordinates 3987 | w : 3988 | The width of the grid used for rasterization 3989 | h : 3990 | The height of the grid used for rasterization 3991 | xform : 3992 | The transformation type used for color mapping 3993 | 3994 | The values for `x` and `y` are in world coordinates. 3995 | 3996 | The available transformation types are: 3997 | 3998 | +----------------+---+--------------------+ 3999 | |XFORM_BOOLEAN | 0|boolean | 4000 | +----------------+---+--------------------+ 4001 | |XFORM_LINEAR | 1|linear | 4002 | +----------------+---+--------------------+ 4003 | |XFORM_LOG | 2|logarithmic | 4004 | +----------------+---+--------------------+ 4005 | |XFORM_LOGLOG | 3|double logarithmic | 4006 | +----------------+---+--------------------+ 4007 | |XFORM_CUBIC | 4|cubic | 4008 | +----------------+---+--------------------+ 4009 | |XFORM_EQUALIZED | 5|histogram equalized | 4010 | +----------------+---+--------------------+ 4011 | |# 4012 | 4013 | 4014 | (cffi:defcfun ("gr_shadepoints" gr-shadepoints) :void 4015 | (n :int) 4016 | (x (:pointer :double)) 4017 | (y (:pointer :double)) 4018 | (xform :int) 4019 | (w :int) 4020 | (h :int)) 4021 | 4022 | (defun shadepoints (x y w h &key (xform 1)) 4023 | (assert (= (length x) 4024 | (length y))) 4025 | (let ((x-data (data-alloc x :double)) 4026 | (y-data (data-alloc y :double))) 4027 | (gr-shadepoints (length x) 4028 | x-data 4029 | y-data 4030 | xform 4031 | w 4032 | h) 4033 | (free x-data 4034 | y-data))) 4035 | 4036 | 4037 | (cffi:defcfun ("gr_shadelines" gr-shadelines) :void 4038 | (n :int) 4039 | (x (:pointer :double)) 4040 | (y (:pointer :double)) 4041 | (xform :int) 4042 | (w :int) 4043 | (h :int)) 4044 | 4045 | (defun shadelines (x y w h &key (xform 1)) 4046 | (assert (= (length x) 4047 | (length y))) 4048 | (let ((x-data (data-alloc x :double)) 4049 | (y-data (data-alloc y :double))) 4050 | (gr-shadelines (length x) 4051 | x-data 4052 | y-data 4053 | xform 4054 | w 4055 | h) 4056 | (free x-data 4057 | y-data))) 4058 | 4059 | 4060 | (cffi:defcfun ("gr_panzoom" gr-panzoom) :void 4061 | (x :double) 4062 | (y :double) 4063 | (xzoom :double) 4064 | (yzoom :double) 4065 | (xmin (:pointer :double)) 4066 | (xmax (:pointer :double)) 4067 | (ymin (:pointer :double)) 4068 | (ymax (:pointer :double))) 4069 | 4070 | (defun panzoom (x y zoom) 4071 | (let ((xmin-data (data-alloc '(0) :double)) 4072 | (xmax-data (data-alloc '(0) :double)) 4073 | (ymin-data (data-alloc '(0) :double)) 4074 | (ymax-data (data-alloc '(0) :double))) 4075 | (gr-panzoom (coerce x 'double-float) 4076 | (coerce y 'double-float) 4077 | (coerce zoom 'double-float) 4078 | (coerce zoom 'double-float) 4079 | xmin-data 4080 | xmax-data 4081 | ymin-data 4082 | ymax-data) 4083 | (free xmin-data 4084 | xmax-data 4085 | ymin-data 4086 | ymax-data))) 4087 | 4088 | 4089 | #| 4090 | path(x, y, codes) 4091 | 4092 | Draw paths using the given vertices and path codes. 4093 | 4094 | `x` : 4095 | A list containing the X coordinates 4096 | `y` : 4097 | A list containing the Y coordinates 4098 | `codes` : 4099 | A list containing the path codes 4100 | 4101 | The values for `x` and `y` are in world coordinates. 4102 | The `codes` describe several path primitives that can be used to create compound paths. 4103 | The following path codes are recognized: 4104 | 4105 | +----------+---------------------------------+-------------------+-------------------+ 4106 | | Code | Description | X | Y | 4107 | +----------+---------------------------------+-------------------+-------------------+ 4108 | | M, m | move | x | y | 4109 | +----------+---------------------------------+-------------------+-------------------+ 4110 | | L, l | line | x | y | 4111 | +----------+---------------------------------+-------------------+-------------------+ 4112 | | Q, q | quadratic Bezier | x1, x2 | y1, y2 | 4113 | +----------+---------------------------------+-------------------+-------------------+ 4114 | | C, c | cubic Bezier | x1, x2, x3 | y1, y2, y3 | 4115 | +----------+---------------------------------+-------------------+-------------------+ 4116 | | A, a | arc | rx, a1, reserved | ry, a2, reserved | 4117 | +----------+---------------------------------+-------------------+-------------------+ 4118 | | Z | close path | | | 4119 | +----------+---------------------------------+-------------------+-------------------+ 4120 | | S | stroke | | | 4121 | +----------+---------------------------------+-------------------+-------------------+ 4122 | | s | close path and stroke | | | 4123 | +----------+---------------------------------+-------------------+-------------------+ 4124 | | f | close path and fill | | | 4125 | +----------+---------------------------------+-------------------+-------------------+ 4126 | | F | close path, fill and stroke | | | 4127 | +----------+---------------------------------+-------------------+-------------------+ 4128 | 4129 | - Move: `M`, `m` 4130 | Moves the current position to (`x`, `y`). The new position is either absolute (`M`) or relative to the current 4131 | position (`m`). The initial position of :code:`path` is (0, 0). 4132 | 4133 | Example: 4134 | 4135 | >>> (path '(0.5 -0.1) '(0.2 0.1) "Mm") 4136 | 4137 | The first move command in this example moves the current position to the absolute coordinates (0.5, 0.2). The 4138 | second move to performs a movement by (-0.1, 0.1) relative to the current position resulting in the point 4139 | (0.4, 0.3). 4140 | 4141 | - Line: `L`, `l` 4142 | Draws a line from the current position to the given position (`x`, `y`). The end point of the line is either 4143 | absolute (`L`) or relative to the current position (`l`). The current position is set to the end point of the 4144 | line. 4145 | 4146 | Example: 4147 | 4148 | >>> (path '(0.1 0.5 0.0) '(0.1 0.1 0.2) "MLlS") 4149 | 4150 | The first line to command draws a straight line from the current position (0.1, 0.1) to the absolute position 4151 | (0.5, 0.1) resulting in a horizontal line. The second line to command draws a vertical line relative to the 4152 | current position resulting in the end point (0.5, 0.3). 4153 | 4154 | - Quadratic Bezier curve: `Q`, `q` 4155 | Draws a quadratic bezier curve from the current position to the end point (`x2`, `y2`) using (`x1`, `y1`) as the 4156 | control point. Both points are either absolute (`Q`) or relative to the current position (`q`). The current 4157 | 4158 | position is set to the end point of the bezier curve. 4159 | 4160 | Example: 4161 | 4162 | >>> (path '(0.1 0.3 0.5 0.2 0.4) '(0.1 0.2 0.1 0.1 0.0) "MQqS") 4163 | 4164 | This example will generate two bezier curves whose start and end points are each located at y=0.1. As the control 4165 | points are horizontally in the middle of each bezier curve with a higher y value both curves are symmetrical 4166 | and bend slightly upwards in the middle. The current position is set to (0.9, 0.1) at the end. 4167 | 4168 | - Cubic Bezier curve: `C`, `c` 4169 | Draws a cubic bezier curve from the current position to the end point (`x3`, `y3`) using (`x1`, `y1`) and 4170 | (`x2`, `y2`) as the control points. All three points are either absolute (`C`) or relative to the current position 4171 | (`c`). The current position is set to the end point of the bezier curve. 4172 | 4173 | Example: 4174 | 4175 | >>> (path '(0.1 0.2 0.3 0.4 0.1 0.2 0.3) 4176 | ... '(0.1 0.2 0.0 0.1 0.1 -0.1 0.0) 4177 | ... "MCcS") 4178 | 4179 | This example will generate two bezier curves whose start and end points are each located at y=0.1. As the control 4180 | points are equally spaced along the x-axis and the first is above and the second is below the start and end 4181 | points this creates a wave-like shape for both bezier curves. The current position is set to (0.8, 0.1) at the 4182 | end. 4183 | 4184 | - Ellipctical arc: `A`, `a` 4185 | Draws an elliptical arc starting at the current position. The major axis of the ellipse is aligned with the x-axis 4186 | and the minor axis is aligned with the y-axis of the plot. `rx` and `ry` are the ellipses radii along the major 4187 | and minor axis. `a1` and `a2` define the start and end angle of the arc in radians. The current position is set 4188 | to the end point of the arc. If `a2` is greater than `a1` the arc is drawn counter-clockwise, otherwise it is 4189 | drawn clockwise. The `a` and `A` commands draw the same arc. The third coordinates of the `x` and `y` array are 4190 | ignored and reserved for future use. 4191 | 4192 | Examples: 4193 | 4194 | >>> (path '(0.1 0.2 (/ -3.14159 2) 0.0) '(0.1 0.4 (/ 3.14159 2) 0.0) "MAS") 4195 | 4196 | This example draws an arc starting at (0.1, 0.1). As the start angle -pi/2 is smaller than the end angle pi/2 the 4197 | arc is drawn counter-clockwise. In this case the right half of an ellipse with an x radius of 0.2 and a y radius 4198 | of 0.4 is shown. Therefore the current position is set to (0.1, 0.9) at the end. 4199 | >>> path([0.1, 0.2, 3.14159 / 2, 0.0], [0.9, 0.4, -3.14159 / 2, 0.0], "MAS") 4200 | This examples draws the same arc as the previous one. The only difference is that the starting point is now at 4201 | (0.1, 0.9) and the start angle pi/2 is greater than the end angle -pi/2 so that the ellipse arc is drawn 4202 | clockwise. Therefore the current position is set to (0.1, 0.1) at the end. 4203 | 4204 | - Close path: `Z` 4205 | Closes the current path by connecting the current position to the target position of the last move command 4206 | (`m` or `M`) with a straight line. If no move to was performed in this path it connects the current position to 4207 | (0, 0). When the path is stroked this line will also be drawn. 4208 | 4209 | - Stroke path: `S`, `s` 4210 | Strokes the path with the current border width and border color (set with :code:`gr.setborderwidth` and 4211 | :code:`gr.setbordercolorind`). In case of `s` the path is closed beforehand, which is equivalent to `ZS`. 4212 | 4213 | - Fill path: `F`, `f` 4214 | Fills the current path using the even-odd-rule using the current fill color. Filling a path implicitly closes 4215 | the path. The fill color can be set using :code:`gr.setfillcolorind`. In case of `F` the path is also 4216 | stroked using the current border width and color afterwards. 4217 | 4218 | |# 4219 | 4220 | (cffi:defcfun ("gr_path" gr-path) :void 4221 | (n :int) 4222 | (x (:pointer :double)) 4223 | (y (:pointer :double)) 4224 | (codes (:pointer :char))) 4225 | 4226 | (defun path (x y codes) 4227 | (assert (= (length x) 4228 | (length y))) 4229 | (let ((x-data (data-alloc x :double)) 4230 | (y-data (data-alloc y :double)) 4231 | (code-data (string-alloc codes))) 4232 | (gr-path (length x) 4233 | x-data 4234 | y-data 4235 | code-data) 4236 | (free x-data y-data) 4237 | (string-free code-data))) 4238 | 4239 | 4240 | #| 4241 | setborderwidth(width::Real) 4242 | 4243 | Define the border width of subsequent path output primitives. 4244 | 4245 | `width` : 4246 | The border width scale factor 4247 | 4248 | |# 4249 | 4250 | (cffi:defcfun ("gr_setborderwidth" gr-setborderwidth) :void 4251 | (width :double)) 4252 | 4253 | (defun setborderwidth (width) 4254 | (gr-setborderwidth (coerce width 'double-float))) 4255 | 4256 | 4257 | #| 4258 | setbordercolorind(color::Int) 4259 | 4260 | Define the color of subsequent path output primitives. 4261 | 4262 | `color` : 4263 | The border color index (COLOR < 1256) 4264 | 4265 | |# 4266 | 4267 | (cffi:defcfun ("gr_setbordercolorind" gr-setbordercolorind) :void 4268 | (color :int)) 4269 | 4270 | (defun setbordercolorind (color) 4271 | (gr-setbordercolorind color)) 4272 | 4273 | 4274 | #| 4275 | setprojectiontype(int flag) 4276 | 4277 | Set the projection type with this flag. 4278 | 4279 | flag : 4280 | projection type 4281 | 4282 | The available options are: 4283 | 4284 | +---------------------------+---+--------------+ 4285 | |GR_PROJECTION_DEFAULT | 0|default | 4286 | +---------------------------+---+--------------+ 4287 | |GR_PROJECTION_ORTHOGRAPHIC | 1|orthographic | 4288 | +---------------------------+---+--------------+ 4289 | |GR_PROJECTION_PERSPECTIVE | 2|perspective | 4290 | +---------------------------+---+--------------+ 4291 | 4292 | |# 4293 | 4294 | (cffi:defcfun ("gr_setprojectiontype" gr-setprojectiontype) :void 4295 | (flag :int)) 4296 | 4297 | (defun setprojectiontype (flag) 4298 | (gr-setprojectiontype flag)) 4299 | 4300 | 4301 | (cffi:defcfun ("gr_setperspectiveprojection" gr-setperspectiveprojection) :void 4302 | (near-plane :double) 4303 | (far-plane :double) 4304 | (fov :double)) 4305 | 4306 | (defun setperspectiveprojection (near far fov) 4307 | (gr-setperspectiveprojection (coerce near 'double-float) 4308 | (coerce far 'double-float) 4309 | (coerce fov 'double-float))) 4310 | 4311 | 4312 | (cffi:defcfun ("gr_settransformationparameters" gr-settransformationparameters) :void 4313 | (camera-pos-x :double) 4314 | (camera-pos-y :double) 4315 | (camera-pos-z :double) 4316 | (up-x :double) 4317 | (up-y :double) 4318 | (up-z :double) 4319 | (focus-point-x :double) 4320 | (focus-point-y :double) 4321 | (focus-point-z :double)) 4322 | 4323 | (defun settransformationparameters (camera-x camera-y camera-z 4324 | up-x up-y up-z 4325 | focus-x focus-y focus-z) 4326 | (gr-settransformationparameters (coerce camera-x 'double-float) 4327 | (coerce camera-y 'double-float) 4328 | (coerce camera-z 'double-float) 4329 | (coerce up-x 'double-float) 4330 | (coerce up-y 'double-float) 4331 | (coerce up-z 'double-float) 4332 | (coerce focus-x 'double-float) 4333 | (coerce focus-y 'double-float) 4334 | (coerce focus-z 'double-float))) 4335 | 4336 | 4337 | (cffi:defcfun ("gr_setorthographicprojection" gr-setorthographicprojection) :void 4338 | (left :double) 4339 | (right :double) 4340 | (bottom :double) 4341 | (top :double) 4342 | (near :double) 4343 | (far :double)) 4344 | 4345 | (defun setorthographicprojection (left right bottom top 4346 | near far) 4347 | (gr-setorthographicprojection (coerce left 'double-float) 4348 | (coerce right 'double-float) 4349 | (coerce bottom 'double-float) 4350 | (coerce top 'double-float) 4351 | (coerce near 'double-float) 4352 | (coerce far 'double-float))) 4353 | 4354 | 4355 | (cffi:defcfun ("gr_setwindow3d" gr-setwindow3d) :void 4356 | (xmin :double) 4357 | (xmax :double) 4358 | (ymin :double) 4359 | (ymax :double) 4360 | (zmin :double) 4361 | (zmax :double)) 4362 | 4363 | (defun setwindow3d (xmin xmax ymin ymax zmin zmax) 4364 | (gr-setwindow3d (coerce xmin 'double-float) 4365 | (coerce xmax 'double-float) 4366 | (coerce ymin 'double-float) 4367 | (coerce ymax 'double-float) 4368 | (coerce zmin 'double-float) 4369 | (coerce zmax 'double-float))) 4370 | 4371 | 4372 | -------------------------------------------------------------------------------- /src/gr/build.lisp: -------------------------------------------------------------------------------- 1 | ;;;; build.lisp --- Donwloader of binaries of GR 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file is composed of download functions, which is branched to 7 | ;;; OS types. 8 | ;;; 9 | ;;; see: https://github.com/jheinen/GR.jl/blob/master/deps/build.jl 10 | 11 | (in-package :cl-user) 12 | (defpackage :kai.gr.build 13 | (:use :cl) 14 | (:import-from :kai.util 15 | :download-file 16 | :get-os 17 | :make-kai-cache)) 18 | (in-package :kai.gr.build) 19 | 20 | 21 | ;;;; GR version 22 | ;;; 23 | ;;; There are many GR versions, so we decide a version to be installed. 24 | 25 | (defparameter *gr-version* "0.48.0") 26 | 27 | 28 | ;;;; URL branches and install 29 | ;;; 30 | ;;; We can get GR binaries via network, but the URLs is 31 | ;;; branched depending on OS. 32 | ;;; Here we implement a function to provide a proper URL. 33 | 34 | ;; macOS 35 | (defun install-gr-mac () 36 | (let* ((url "https://github.com/sciapp/gr/releases/download/v0.48.0/gr-0.48.0-Darwin-x86_64.tar.gz") 37 | (register-cmd "/System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Support/lsregister -f") 38 | (kai-cache-dir (make-kai-cache "gr")) 39 | (tarball-path (merge-pathnames "gr.tar.gz" 40 | kai-cache-dir)) 41 | (gksterm-path (merge-pathnames "Applications/GKSTerm.app" 42 | kai-cache-dir))) 43 | (download-file tarball-path url) 44 | (uiop:run-program (format nil "tar xvf ~A -C ~A" 45 | tarball-path kai-cache-dir) 46 | :output nil) 47 | (uiop:run-program (format nil "mv ~A/gr/* ~A/ && rm -fr ~A/gr" 48 | kai-cache-dir kai-cache-dir kai-cache-dir)) 49 | (uiop:run-program (format nil "~A ~A" register-cmd gksterm-path) 50 | :output nil))) 51 | 52 | 53 | ;; Linux 54 | (defun install-gr-linux () 55 | (let* ((base-url "https://github.com/sciapp/gr/releases/download") 56 | (id (string-downcase (get-dist "ID"))) 57 | (id-like (string-downcase (get-dist "ID_LIKE"))) 58 | (os ((cond 59 | ((equal id "redhat") 60 | (if (> (digit-char-p 61 | (aref (redhat-version) 62 | 0)) 63 | 7) 64 | "Redhat" 65 | (error "You should upgrade OS version"))) 66 | ((or (equal id "ubuntu") 67 | (equal id-like "ubuntu")) 68 | "Ubuntu") 69 | ((or (equal id "debian") 70 | (equal id-like "debian") 71 | (equal_id "raspbian")) 72 | "Debian") 73 | ((or (equal id "arch") 74 | (equal id-like "arch")) 75 | "ArchLinux") 76 | ((equal id "opensuse-tumbleweed") 77 | "CentOS")))) 78 | (arch (cond 79 | ((equal (machine-type) "X86-64") 80 | "x86_64") 81 | ((or (equal (machine-type) "ARM") 82 | (equal (machine-type) "ARM64")) 83 | "armhf"))) 84 | (tarball-path (merge-pathnames "gr.tar.gz" 85 | kai-cache-dir)) 86 | (ka-cache-dir (make-kai-cache "gr"))) 87 | (donwload-file tarball-path 88 | (format nil "~A/v~A/gr-~A-~A-~A.tar.gz" 89 | base-url *gr-version* 90 | *gr-version* os arch)) 91 | (uiop:run-program (format nil "tar xvf ~A -C ~A" 92 | tarball-path kai-cache-dir)) 93 | (uiop:run-program (format nil "mv ~A/gr/* ~A/ && rm -fr ~A/gr" 94 | kai-cache-dir kai-cache-dir kai-cache-dir)))) 95 | 96 | 97 | ;; Windows 98 | (defun install-gr-windows () 99 | (error "Sorry, I am not familiar with Windows environment. I'm waiting for your PR.")) 100 | 101 | 102 | 103 | (defun install-gr () 104 | #+(or win32 mswindows windows) ; Windows 105 | (install-gr-windows) 106 | #+(or macos darwin) ; macOS 107 | (install-gr-mac) 108 | #-(or win32 mswindows macos darwin windows) ;Linux 109 | (install-gr-linux)) 110 | 111 | -------------------------------------------------------------------------------- /src/gr/cl-gr.lisp: -------------------------------------------------------------------------------- 1 | ;;;; cl-gr.lisp --- An interface for GR 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file is a bridge between API of GR and Kai. 7 | ;;; ref) https://github.com/JuliaPlots/Plots.jl/blob/master/src/backends/gr.jl 8 | 9 | (in-package :cl-user) 10 | (defpackage :kai.GR.cl-gr 11 | (:use :cl) 12 | (:import-from :kai.util 13 | :make-kai-cache) 14 | (:import-from :kai.GR.GR 15 | :init 16 | :openws 17 | :closews 18 | :inqdspsize 19 | :activatews 20 | :deactivatews 21 | :polyline 22 | :polymarker 23 | :text 24 | :inqtext 25 | :fillarea 26 | :cellarray 27 | :nonuniformcellarray 28 | :polarcellarray 29 | :gdp 30 | :spline 31 | :gridit 32 | :setlinetype 33 | :inqlinetype 34 | :setlinewidth 35 | :inqlinewidth 36 | :setlinecolorind 37 | :inqlinecolorind 38 | :setmarkertype 39 | :inqmarkertype 40 | :setmarkersize 41 | :inqmarkersize 42 | :setmarkercolorind 43 | :inqmarkercolorind 44 | :settextfontprec 45 | :setcharexpan 46 | :setcharspace 47 | :settextcolorind 48 | :inqtextcolorind 49 | :setcharheight 50 | :inqcharheight 51 | :setcharup 52 | :settextpath 53 | :settextalign 54 | :setfillintstyle 55 | :inqfillintstyle 56 | :setfillstyle 57 | :inqfillstyle 58 | :setfillcolorind 59 | :inqfillcolorind 60 | :setcolorrep 61 | :setwindow 62 | :inqwindow 63 | :setviewport 64 | :inqviewport 65 | :selntran 66 | :setclip 67 | :setwswindow 68 | :setwsviewport 69 | :createseg 70 | :copysegws 71 | :redrawsegws 72 | :setsegtran 73 | :closeseg 74 | :emergencyclosegks 75 | :updategks 76 | :setspace 77 | :inqspace 78 | :setscale 79 | :inqscale 80 | :textext 81 | :inqtextext 82 | :axes 83 | :axeslbl 84 | :grid 85 | :grid3d 86 | :verrorbars 87 | :herrorbars 88 | :polyline3d 89 | :polymarker3d 90 | :axes3d 91 | :titles3d 92 | :surface 93 | :contour 94 | :contourf 95 | :tricontour 96 | :hexbin 97 | :setcolormap 98 | :inqcolormap 99 | :setcolormapfromrgb 100 | :colorbar 101 | :inqcolor 102 | :inqcolorfromrgb 103 | :hsvtorgb 104 | :tick 105 | :validaterange 106 | :adjustlimits 107 | :adjustrange 108 | :beginprint 109 | :beginprinttext 110 | :endprint 111 | :ndctowc 112 | :wctondc 113 | :wc3towc 114 | :drawrect 115 | :fillrect 116 | :drawarc 117 | :fillarc 118 | :drawpath 119 | :setarrowstyle 120 | :setarrowsize 121 | :drawarrow 122 | :readimage 123 | :drawimage 124 | :importgraphics 125 | :setshadow 126 | :settransparency 127 | :setcoordxform 128 | :begingraphics 129 | :endgraphics 130 | :getgraphics 131 | :drawgraphics 132 | :mathtex 133 | :inqmathtex 134 | :setregenflags 135 | :inqregenflags 136 | :savestate 137 | :restorestate 138 | :selectcontext 139 | :destroycontext 140 | :uselinespec 141 | :delaunay 142 | :reducepoints 143 | :trisurface 144 | :gradient 145 | :quiver 146 | :interp2 147 | :version 148 | :shade 149 | :shadepoints 150 | :shadelines 151 | :panzoom 152 | :path 153 | :setborderwidth 154 | :setbordercolorind 155 | :setprojectiontype 156 | :setperspectiveprojection 157 | :settransformationparameters 158 | :setorthographicprojection 159 | :setwindow3d) 160 | (:export :init)) 161 | (in-package :kai.GR.cl-gr) 162 | 163 | 164 | 165 | ;;;; Setup 166 | ;;; 167 | ;;; We load some shared files (.dll or .so) to make bindings to 168 | ;;; GR API. 169 | 170 | ;; Shared files 171 | (defparameter libGR 172 | #+(or win32 mswindows windows) ; Windows 173 | "libGR.dll" 174 | #-(or win32 mswindows windows) ; macOS or Linux 175 | "libGR.so") 176 | 177 | (defparameter libGR3 178 | #+(or win32 mswindows windows) ; Windows 179 | "libGR3.dll" 180 | #-(or win32 mswindows windows) ; macOS or Linux 181 | "libGR3.so") 182 | 183 | (defparameter libGRM 184 | #+(or win32 mswindows windows) ; Windows 185 | "libGRM.dll" 186 | #-(or win32 mswindows windows) ; macOS or Linux 187 | "libGRM.so") 188 | 189 | 190 | ;; Environment variables and load libraries 191 | (defun gr-init () 192 | (let ((kai-cache-dir (namestring (make-kai-cache "gr")))) 193 | ;; Set environment variables 194 | (setf (uiop:getenv "GRDIR") kai-cache-dir) 195 | (setf (uiop:getenv "GKS_FONTPATH") kai-cache-dir) 196 | (setf (uiop:getenv "GKS_USE_CAIRO_PNG") "true") 197 | 198 | ;; Load shared objects 199 | (cffi:load-foreign-library 200 | (merge-pathnames (format nil "lib/~A" libGR) 201 | (make-kai-cache "gr"))))) 202 | 203 | 204 | 205 | 206 | ;;;; GR plot type 207 | ;;; 208 | ;;; GR has many types of plot for line and marker. 209 | ;;; And also GR has some choices of fonts. 210 | 211 | (defun gr-linetype (ltype) 212 | (let ((table (list (cons :auto 1) 213 | (cons :solid 1) 214 | (cons :dash 2) 215 | (cons :dot 3) 216 | (cons :dashdot 4) 217 | (cons :dashdotdot -1)))) 218 | (cdr (assoc ltype table)))) 219 | 220 | 221 | (defun gr-markertype (mtype) 222 | (let ((table (list (cons :auto 1) 223 | (cons :none -1) 224 | (cons :circle -1) 225 | (cons :rect -7) 226 | (cons :diamond -13) 227 | (cons :utriangle -3) 228 | (cons :dtriangle -5) 229 | (cons :ltriangle -18) 230 | (cons :rtriangle -17) 231 | (cons :pentagon -21) 232 | (cons :hexagon -22) 233 | (cons :heptagon -23) 234 | (cons :octagon -24) 235 | (cons :cross 2) 236 | (cons :xcross 5) 237 | (cons :+ 2) 238 | (cons :x 5) 239 | (cons :star4 -25) 240 | (cons :star5 -26) 241 | (cons :star6 -27) 242 | (cons :star7 -28) 243 | (cons :star8 -29) 244 | (cons :vline -30) 245 | (cons :hline -31)))) 246 | (cdr (assoc mtype table)))) 247 | 248 | 249 | (defun gr-arrowstyle (astyle) 250 | (let ((table (list (cons :simple 1) 251 | (cons :hollow 3) 252 | (cons :filled 4) 253 | (cons :triangle 5) 254 | (cons :filledtriangle 6) 255 | (cons :closed 6) 256 | (cons :open 5)))) 257 | (cdr (assoc astyle table)))) 258 | 259 | 260 | (defun gr-halign (pos) 261 | (let ((table (list (cons :left 1) 262 | (cons :center 2) 263 | (cons :right 3)))) 264 | (cdr (assoc pos table)))) 265 | 266 | 267 | (defun gr-valign (pos) 268 | (let ((table (list (cons :top 1) 269 | (cons :center 3) 270 | (cons :bottom 5)))) 271 | (cdr (assoc pos table)))) 272 | 273 | 274 | (defun gr-font-family (font-type) 275 | (let ((table (list (cons :times 1) 276 | (cons :helvetica 5) 277 | (cons :courier 9) 278 | (cons :bookman 14) 279 | (cons :newcenturyschlbk 18) 280 | (cons :avantgarde 22) 281 | (cons :palatino 26)))) 282 | (cdr (assoc font-type table)))) 283 | 284 | 285 | (defun gr-vector-font (font-type) 286 | (let ((table (list (cons :serif-roman 232) 287 | (cons :sans-serif 233)))) 288 | (cdr (assoc font-type table)))) 289 | 290 | 291 | ;;;; Color 292 | ;;; 293 | ;;; GR designates color not as RGB but as color index. 294 | ;;; This color index is set by INQCOLORFROMRGB. 295 | ;;; When we input some RGB to this function, this returns 296 | ;;; color index. 297 | ;;; color-rgb is 3-element list: like '(255 80 125) 298 | ;;; When we set some color of line or marker, we use this system. 299 | ;;; Note: "ind" means "index." 300 | 301 | ;; get color index from RGB (as List) and Alpha (as Keyword) 302 | (defun gr-getcolorind (color-rgb &key (alpha 1)) 303 | (settransparency alpha) 304 | (apply #'inqcolorfromrgb color-rgb)) 305 | 306 | (defun gr-linecolor (color-rgb) 307 | (setlinecolorind (gr-getcolorind color-rgb))) 308 | 309 | (defun gr-markercolor (color-rgb) 310 | (setmarkercolorind (gr-getcolorind color-rgb))) 311 | 312 | (defun gr-fillcolor (color-rgb) 313 | (setfillcolorind (gr-getcolorind color-rgb))) 314 | 315 | (defun gr-bordercolor (color-rgb) 316 | (setbordercolorind (gr-getcolorind color-rgb))) 317 | 318 | (defun gr-textcolor (color-rgb) 319 | (settextcolorind (gr-getcolorind color-rgb))) 320 | 321 | 322 | ;; Transparency 323 | (defun gr-transparency (alpha) 324 | (let ((a (cond 325 | ((< alpha 0) 0) 326 | ((> alpha 1) 1) 327 | (t alpha)))) 328 | (settransparency a))) 329 | 330 | 331 | 332 | ;;;; Text 333 | ;;; 334 | ;;; GR can provide some functions to write texts in a window. 335 | ;;; This is branched to normal text and TeX text. 336 | 337 | (defun gr-inqtext (x y text) 338 | (let ((len (length text))) 339 | (cond 340 | ((and (equal #\$ (aref text 0)) 341 | (equal #\$ (aref text (1- len)))) 342 | (inqmathtex x y (subseq text 1 (1- len)))) 343 | ((find #\\ text :test #'equal) 344 | (inqtextext x y text)) 345 | (t 346 | (inqtext x y text))))) 347 | 348 | 349 | (defun gr-text (x y text) 350 | (let ((len (length text))) 351 | (cond 352 | ((and (equal #\$ (aref text 0)) 353 | (equal #\$ (aref text (1- len)))) 354 | (mathtex x y (subseq text 1 (1- len)))) 355 | ((find #\\ text :test #'equal) 356 | (textext x y text)) 357 | (t 358 | (text x y text))))) 359 | 360 | 361 | 362 | ;;;; Axis 363 | ;;; 364 | ;;; Set polar axis or grid axis. 365 | 366 | ;; To Do: Polar Axis 367 | 368 | ;; To Do: Axis Limits 369 | 370 | 371 | 372 | 373 | ;;;; Fill Viewport 374 | ;;; 375 | ;;; Set Fill viewport. 376 | ;;; Viewport is 4-element list: like '(0 1 0 1) 377 | 378 | (defun gr-fill-viewport (viewport &key (color '(255 255 255))) 379 | (let ((intstyle-solid 1)) 380 | (savestate) 381 | (selntran 0) 382 | (setscale 0) 383 | (setfillintstyle intstyle-solid) 384 | (gr-fillcolor color) 385 | (apply #'fillrect viewport) 386 | (selntran 1) 387 | (restorestate))) 388 | 389 | 390 | 391 | ;;;; Check window information 392 | ;;; 393 | ;;; Here we check environment on window information; 394 | ;;; width, height, DPI (Dots per inch) 395 | ;;; Note: 0.0254 is some coefficient to calculate DPI. 396 | 397 | (defun gr-window-info () 398 | (let* ((win-info (inqdspsize))) 399 | (list (cons :width-meter (first win-info)) 400 | (cons :height-meter (second win-info)) 401 | (cons :width-px (third win-info)) 402 | (cons :height-px (fourth win-info)) 403 | (cons :dpi (* 0.0254 (/ (third win-info) 404 | (first win-info))))))) 405 | 406 | 407 | ;;;; Display intialization 408 | ;;; 409 | ;;; Window should be initialized before plotting to adjust 410 | ;;; window size, background color, viewport and etc... 411 | 412 | (defun gr-display-init () 413 | (let* ((win-info (gr-window-info)) 414 | (width-meter (cdr (assoc :width-meter win-info))) 415 | (height-meter (cdr (assoc :height-meter win-info)))) 416 | (emergencyclosegks) 417 | (clearws) 418 | (if (> width-meter height-meter) 419 | (let* ((msize (* width-meter 0.45)) 420 | (ratio (/ (cdr (assoc :height-meter win-info)) 421 | (cdr (assoc :width-meter win-info))))) 422 | (setwsviewport 0 423 | msize 424 | 0 425 | (* msize ratio)) 426 | (setwswindow 0 427 | 1 428 | 0 429 | ratio)) 430 | (let* ((msize (* height-meter 0.45)) 431 | (ratio (/ (cdr (assoc :width-meter win-info)) 432 | (cdr (assoc :height-meter win-info))))) 433 | (setwsviewport 0 434 | (* msize ratio) 435 | 0 436 | msize) 437 | (setwswindow 0 438 | ratio 439 | 0 440 | 1))) 441 | (updatews))) 442 | 443 | 444 | ;;;; Polyline 445 | ;;; 446 | ;;; Draw line segments, splitting x/y into contiguous/finite segments. 447 | ;;; Here you can draw arrow in the start or the end of data. 448 | 449 | ;; Plot line and draw arrow 450 | (defun gr-polyline (x y &key 451 | (arrowside :none) 452 | (arrowstyle :simple)) 453 | (assert (= (length x) (length y))) 454 | (polyline x y) 455 | (if (find arrowside '(:head :both)) 456 | (progn 457 | (setarrowstyle (gr-arrowstyle arrowstyle)) 458 | (drawarrow (cadr x) 459 | (cadr y) 460 | (car x) 461 | (car y)))) 462 | (if (find arrowside '(:tail :both)) 463 | (progn 464 | (setarrowstyle (gr-arrowstyle arrowstyle)) 465 | (drawarrow (car (last x 2)) 466 | (car (last y 2)) 467 | (car (last x 1)) 468 | (car (last y 1)))))) 469 | 470 | 471 | ;; Plot 3D-line and draw arrow 472 | ;; Note: GR doesn't provide 3D arrow. 473 | (defun gr-polyline3d (x y z) 474 | (assert (= (length x) (length y) (length z))) 475 | (polyline3d x y z)) 476 | 477 | -------------------------------------------------------------------------------- /src/interface.lisp: -------------------------------------------------------------------------------- 1 | ;;;; converter.lisp --- JSON generator from Common Lisp codes 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file is composed of a collection of JSON file generator. 7 | ;;; Kai can be used with a variety of backends. 8 | ;;; Here we use JSON and provide a common platform for a variety of 9 | ;;; backends. 10 | 11 | (in-package :cl-user) 12 | (defpackage :kai.interface 13 | (:use :cl) 14 | (:import-from :kai.util 15 | :convert-data 16 | :symbol-downcase 17 | :check-file-exist 18 | :make-kai-cache) 19 | (:import-from :kai.plotly.generate 20 | :download-plotlyjs 21 | :save-html 22 | :save-js) 23 | (:import-from :kai.plotly.launch 24 | :open-browser) 25 | (:export :*state* 26 | :*style* 27 | :reset! 28 | :line 29 | :marker 30 | :errorbar 31 | :fillarea 32 | :bar 33 | :pie 34 | :box 35 | :heatmap 36 | :contour 37 | :line3d 38 | :marker3d 39 | :surface 40 | :title 41 | :xaxis 42 | :yaxis 43 | :showlegend 44 | :show)) 45 | (in-package :kai.interface) 46 | 47 | 48 | 49 | ;;;; State 50 | ;;; 51 | ;;; To make it able to plot multiple graph, we have a state as list. 52 | 53 | (defparameter *state* '()) 54 | 55 | (defparameter *style* '()) 56 | 57 | (defun reset! () 58 | (setf *state* '()) 59 | (setf *style* '()) 60 | T) 61 | 62 | (defparameter *palette* 63 | #("blue" "red" "green" "yellow" "cyan" "magenta")) 64 | 65 | (defun choose-color (color supplied-p) 66 | (if supplied-p 67 | color 68 | (aref *palette* 69 | (mod (length *state*) 70 | (length *palette*))))) 71 | 72 | 73 | 74 | ;;;; Scatter and Line 75 | ;;; 76 | ;;; This covers scatter and line plotting and their options. 77 | 78 | ;; Line2D 79 | (defun line (&rest data) 80 | (push (apply #'-line (apply #'convert-data data)) 81 | *state*) 82 | T) 83 | 84 | (defun -line (x 85 | y 86 | &key 87 | (color "blue" c) 88 | (width 1 w) 89 | (name "" n)) 90 | (remove-if #'null 91 | `((:x . ,x) 92 | (:y . ,y) 93 | (:type . "line") 94 | (:color . ,(choose-color color c)) 95 | ,(if w (cons :width width)) 96 | ,(if n (cons :name name))))) 97 | 98 | 99 | ;; Marker2D 100 | (defun marker (&rest data) 101 | (push (apply #'-marker (apply #'convert-data data)) 102 | *state*) 103 | T) 104 | 105 | (defun -marker (x 106 | y 107 | &key 108 | (color "blue" c) 109 | (size 5 s) 110 | (name "" n)) 111 | (remove-if #'null 112 | `((:x . ,x) 113 | (:y . ,y) 114 | (:type . "marker") 115 | (:color . ,(choose-color color c)) 116 | ,(if s (cons :size size)) 117 | ,(if n (cons :name name))))) 118 | 119 | 120 | ;; fill 121 | (defun fillarea (&rest data) 122 | (push (apply #'-fillarea data) 123 | *state*) 124 | T) 125 | 126 | (defun -fillarea (x 127 | y0 128 | y1 129 | &key 130 | (color "blue" c) 131 | (name "" n)) 132 | (remove-if #'null 133 | `((:x . ,x) 134 | (:y0 . ,y0) 135 | (:y1 . ,y1) 136 | (:type . "fill") 137 | (:color . ,(choose-color color c)) 138 | ,(if n (cons :name name))))) 139 | 140 | 141 | ;; ErrorBar 142 | (defun errorbar (&rest data) 143 | (push (apply #'-errorbar (apply #'convert-data data)) 144 | *state*) 145 | T) 146 | 147 | (defun -errorbar (x 148 | y 149 | &key 150 | (error-x '()) 151 | (error-y '()) 152 | (color "blue" c) 153 | (name "" n)) 154 | (assert (or error-x error-y)) 155 | (remove-if #'null 156 | `((:x . ,x) 157 | (:y . ,y) 158 | (:type . "errorbar") 159 | (:color . ,(choose-color color c)) 160 | ,(if n (cons :name name)) 161 | ,(if (not (null error-x)) 162 | (cons :error-x error-x)) 163 | ,(if (not (null error-y)) 164 | (cons :error-y error-y))))) 165 | 166 | 167 | ;; Bar plot 168 | (defun bar (&rest data) 169 | (push (apply #'-bar (apply #'convert-data data)) 170 | *state*) 171 | T) 172 | 173 | (defun -bar (x 174 | y 175 | &key 176 | (name "" n)) 177 | (remove-if #'null 178 | `((:x . ,x) 179 | (:y . ,y) 180 | (:type . "bar") 181 | ,(if n (cons :name name))))) 182 | 183 | 184 | ;; Pie chart 185 | (defun pie (&rest data) 186 | (push (apply #'-pie data) 187 | *state*) 188 | T) 189 | 190 | (defun -pie (values 191 | labels 192 | &key 193 | (name "" n)) 194 | (remove-if #'null 195 | `((:values . ,values) 196 | (:labels . ,labels) 197 | (:type . "pie") 198 | ,(if n (cons :name name))))) 199 | 200 | 201 | ;; Box plots 202 | (defun box (&rest data) 203 | (push (apply #'-box data) 204 | *state*) 205 | T) 206 | 207 | (defun -box (y 208 | &key 209 | (color "blue" c) 210 | (name "" n) 211 | (boxmean t) 212 | (boxpoints :false)) 213 | (remove-if #'null 214 | `((:y . ,y) 215 | (:type . "box") 216 | (:color . ,(choose-color color c)) 217 | (:boxmean . ,boxmean) 218 | (:boxpoints . ,boxpoints) 219 | ,(if n (cons :name name))))) 220 | 221 | 222 | ;; Heatmap 223 | (defun heatmap (&rest data) 224 | (push (apply #'-heatmap data) 225 | *state*) 226 | T) 227 | 228 | (defun -heatmap (z 229 | &key 230 | (showscale :false)) 231 | `((:z . ,z) 232 | (:type . "heatmap") 233 | (:showscale . ,showscale))) 234 | 235 | 236 | ;; Contour 237 | (defun contour (&rest data) 238 | (push (apply #'-contour data) 239 | *state*) 240 | T) 241 | 242 | (defun -contour (z 243 | &key 244 | (showscale :false) 245 | (autocontour :false)) 246 | `((:z . ,z) 247 | (:type . "contour") 248 | (:showscale . ,showscale) 249 | (:autocontour . ,autocontour))) 250 | 251 | 252 | ;; Line3D 253 | (defun line3d (&rest data) 254 | (push (apply #'-line3d data) 255 | *state*) 256 | T) 257 | 258 | (defun -line3d (x 259 | y 260 | z 261 | &key 262 | (color "blue" c) 263 | (width 1 w) 264 | (name "" n)) 265 | (remove-if #'null 266 | `((:x . ,x) 267 | (:y . ,y) 268 | (:z . ,z) 269 | (:type . "line3d") 270 | (:color . ,(choose-color color c)) 271 | ,(if w (cons :width width)) 272 | ,(if n (cons :name name))))) 273 | 274 | 275 | ;; Marker3D 276 | (defun marker3d (&rest data) 277 | (push (apply #'-marker3d data) 278 | *state*) 279 | T) 280 | 281 | (defun -marker3d (x 282 | y 283 | z 284 | &key 285 | (color "blue" c) 286 | (size 5 s) 287 | (name "" n)) 288 | (remove-if #'null 289 | `((:x . ,x) 290 | (:y . ,y) 291 | (:z . ,z) 292 | (:type . "marker3d") 293 | (:color . ,(choose-color color c)) 294 | ,(if s (cons :size size)) 295 | ,(if n (cons :name name))))) 296 | 297 | 298 | ;; Surface 299 | (defun surface (&rest data) 300 | (push (apply #'-surface data) 301 | *state*) 302 | T) 303 | 304 | (defun -surface (z 305 | &key 306 | (name "" n)) 307 | (remove-if #'null 308 | `((:z . ,z) 309 | (:type . "surface") 310 | ,(if n (cons :name name))))) 311 | 312 | 313 | 314 | ;;;; Layout 315 | ;;; 316 | ;;; To attach title or axis options to the graph. 317 | 318 | (defun title (text) 319 | "Set title for the graph" 320 | (setf (getf *style* :|title|) text) 321 | T) 322 | 323 | (defun xaxis (options) 324 | "Set X axis options" 325 | (setf (getf *style* :|xaxis|) options) 326 | T) 327 | 328 | (defun yaxis (options) 329 | "Set Y axis options" 330 | (setf (getf *style* :|yaxis|) options) 331 | T) 332 | 333 | (defun showlegend () 334 | "Show legend on the graph" 335 | (setf (getf *style* :|showlegend|) t) 336 | T) 337 | 338 | 339 | 340 | ;;;; Plot 341 | ;;; 342 | ;;; Launch viewer and draw traces and styles. 343 | 344 | (defun show () 345 | (ensure-directories-exist 346 | (make-kai-cache "plotly")) 347 | (if (not (check-file-exist "plotly" 348 | "kai.html")) 349 | (save-html)) 350 | (if (not (check-file-exist "plotly" 351 | "plotly-latest.min.js")) 352 | (download-plotlyjs)) 353 | (save-js *state* *style*) 354 | (open-browser) 355 | (reset!) 356 | T) 357 | -------------------------------------------------------------------------------- /src/kai.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | 3 | (defpackage :kai 4 | (:use :cl) 5 | (:import-from :kai.interface 6 | :line 7 | :marker 8 | :fillarea 9 | :errorbar 10 | :bar 11 | :pie 12 | :box 13 | :heatmap 14 | :contour 15 | :line3d 16 | :marker3d 17 | :surface 18 | :title 19 | :xaxis 20 | :yaxis 21 | :showlegend 22 | :show 23 | :reset! 24 | :*state* 25 | :*style*) 26 | (:export :line 27 | :marker 28 | :fillarea 29 | :errorbar 30 | :bar 31 | :pie 32 | :box 33 | :heatmap 34 | :contour 35 | :line3d 36 | :marker3d 37 | :surface 38 | :title 39 | :xaxis 40 | :yaxis 41 | :showlegend 42 | :show 43 | :reset! 44 | :*state* 45 | :*style*)) 46 | (in-package :kai) 47 | 48 | -------------------------------------------------------------------------------- /src/plotly/generate.lisp: -------------------------------------------------------------------------------- 1 | ;;;; generate.lisp --- File generator and downloader 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file is composed of a collection of functions of file generator 7 | ;;; and file donwloader. 8 | 9 | (in-package :cl-user) 10 | 11 | (defpackage :kai.plotly.generate 12 | (:use :cl) 13 | (:import-from :kai.converter 14 | :to-json 15 | :plotly-code) 16 | (:import-from :kai.util 17 | :make-kai-cache 18 | :download-file) 19 | (:export :download-file 20 | :download-plotlyjs 21 | :save-html 22 | :save-js)) 23 | (in-package :kai.plotly.generate) 24 | 25 | 26 | ;;;; Donwload client 27 | ;;; 28 | ;;; When using Plotly, plotly-latest.js is needed. 29 | ;;; Here is a set of file donwload client and file checker. 30 | (defun download-plotlyjs () 31 | (download-file (merge-pathnames "plotly-latest.min.js" 32 | (make-kai-cache "plotly")) 33 | "https://cdn.plot.ly/plotly-latest.min.js")) 34 | 35 | 36 | ;;;; HTML generator 37 | ;;; 38 | ;;; Create HTML file to plot in the browser. 39 | ;;; This file will be saved in the cache directory. 40 | 41 | (defun generate-html () 42 | (let ((style (cl-css:css `((html :height 100%) 43 | (body :height 100% 44 | :display flex 45 | :justify-content center 46 | :align-items center)))) 47 | (plotly-path (namestring (merge-pathnames "plotly-latest.min.js" 48 | (make-kai-cache "plotly")))) 49 | (my-plot (namestring (merge-pathnames "kai.js" 50 | (make-kai-cache "plotly"))))) 51 | (who:with-html-output-to-string (_) 52 | (:html 53 | (:head 54 | (:style (who:str style)) 55 | (:script :type "text/javascript" :src plotly-path)) 56 | (:body 57 | (:div :id "myDiv") 58 | (:script :type "text/javascript" :src my-plot)))))) 59 | 60 | 61 | (defun save-html () 62 | (let ((html-path (namestring (merge-pathnames "kai.html" 63 | (make-kai-cache "plotly")))) 64 | (content (generate-html))) 65 | (with-open-file (s html-path :direction :output 66 | :if-exists :supersede) 67 | (format s "~A" content)))) 68 | 69 | 70 | 71 | 72 | (defun generate-js (states style) 73 | (let* ((json-traces (plotly-code states)) 74 | (traces (format nil "~{~A~}~3&" 75 | (loop for i below (length json-traces) 76 | collect (format nil "var trace~A = ~A;~3&" 77 | i (nth i json-traces))))) 78 | (layout (format nil "var layout = ~A;~3&" (to-json style))) 79 | (data (format nil "var data = [~{~A~}];~3&" 80 | (loop for i below (length json-traces) 81 | collect (format nil "trace~A, " i)))) 82 | (final-set (format nil "Plotly.newPlot('myDiv', data, layout)"))) 83 | (format nil "~A~A~A~A" traces layout data final-set))) 84 | 85 | 86 | (defun save-js (states style) 87 | (let ((js-path (namestring (merge-pathnames "kai.js" 88 | (make-kai-cache "plotly")))) 89 | (content (generate-js states style))) 90 | (with-open-file (s js-path :direction :output 91 | :if-exists :supersede) 92 | (format s "~A" content)))) 93 | -------------------------------------------------------------------------------- /src/plotly/launch.lisp: -------------------------------------------------------------------------------- 1 | ;;;; launch.lisp --- File opener 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file handles opening js files with system commands. 7 | 8 | (in-package :cl-user) 9 | 10 | (defpackage :kai.plotly.launch 11 | (:use :cl) 12 | (:import-from :kai.util 13 | :check-file-exist) 14 | (:export :open-browser)) 15 | (in-package :kai.plotly.launch) 16 | 17 | 18 | 19 | ;;;; Open browser 20 | ;;; 21 | ;;; When launching js file in the browser, we use system command 22 | ;;; to open browser. 23 | (defun open-browser () 24 | (let ((path-to-html (check-file-exist "plotly" "kai.html"))) 25 | (uiop:run-program #+(or win32 mswindows windows) 26 | (format nil "explorer file:///~A" path-to-html) 27 | #+(or macos darwin) 28 | (format nil "open ~A" path-to-html) 29 | #-(or win32 mswindows macos darwin windows) 30 | (format nil "xdg-open ~A" path-to-html)))) 31 | -------------------------------------------------------------------------------- /src/util.lisp: -------------------------------------------------------------------------------- 1 | ;;;; util.lisp --- A collection of utility functions 2 | ;;; 3 | ;;; This code has been placed in the Public Domain. All warranties 4 | ;;; are disclaimed. 5 | ;;; 6 | ;;; This file is composed of a collection of utility functions for 7 | ;;; plotting. This checks type and shape of input data. 8 | 9 | 10 | (in-package :cl-user) 11 | (defpackage :kai.util 12 | (:use :cl) 13 | (:export :convert-data 14 | :check-shape-type 15 | :find-min-max 16 | :to-array 17 | :sort-input 18 | :flatten 19 | :data-alloc 20 | :free 21 | :string-alloc 22 | :string-free 23 | :arr-aref 24 | :make-kai-cache 25 | :check-file-exist)) 26 | (in-package :kai.util) 27 | 28 | 29 | ;;;; Input style converter 30 | ;;; 31 | ;;; When getting input data, we accept variable length args. 32 | ;;; We cannot realize to accept one or two args with some options by 33 | ;;; standard style, so we papare such a function to convert args. 34 | 35 | (defun convert-data (&rest data) 36 | (let ((x (car data)) 37 | (y (cadr data))) 38 | (if (or (consp x) ; check first data 39 | (vectorp x)) 40 | (if (or (consp y) ; check second data 41 | (vectorp y)) 42 | data 43 | `(,(loop for i below (length x) collect i) 44 | ,x 45 | ,@(cdr data))) 46 | (error "Invalid input")))) 47 | 48 | 49 | ;;;; Type checker 50 | ;;; 51 | ;;; Here we will accept input data whose type is integer or float. 52 | ;;; Input data has to be one-dimensional array or list. 53 | 54 | (defun type-check (data) 55 | (every #'numberp data)) 56 | 57 | 58 | ;;;; Flatten 59 | ;;; 60 | ;;; To adjust dimensions of input data 61 | 62 | (defun flatten (lst) 63 | (if (null lst) 64 | nil 65 | (if (atom lst) 66 | (list lst) 67 | (append (flatten (car lst)) 68 | (flatten (cdr lst)))))) 69 | 70 | 71 | ;;;; Symbol Converter 72 | ;;; 73 | ;;; We will get input data as list. 74 | ;;; When using plotly as backend, we have to convert list data to JSON. 75 | ;;; In converting list data to JSON, symbols will be converted as capital texts. 76 | ;;; Here we provide a function to prevent this. 77 | 78 | (defun make-keyword (name) 79 | (values (intern name "KEYWORD"))) 80 | 81 | (defun symbol-downcase (data) 82 | (mapcar #'(lambda (x) 83 | (if (keywordp x) 84 | (make-keyword (string-downcase (symbol-name x))) 85 | x)) 86 | data)) 87 | 88 | 89 | 90 | ;;;; Ensure directories and files 91 | ;;; 92 | ;;; When plotting, Kai depends on some files. 93 | ;;; Here we check file path. 94 | ;;; Check if .cache file exists in the home directory. 95 | ;;; And create cache directory for Kai. 96 | 97 | (defun make-kai-cache (dir-name) 98 | (ensure-directories-exist 99 | (merge-pathnames (format nil ".cache/kai/~A/" dir-name) 100 | (user-homedir-pathname)))) 101 | 102 | (defun check-file-exist (dir filename) 103 | (probe-file (merge-pathnames filename 104 | (make-kai-cache dir)))) 105 | 106 | 107 | 108 | ;;;; Download 109 | ;;; 110 | ;;; When setting up, we have to get some files via networks. 111 | ;;; Multiple backends need to download resources, so we implement 112 | ;;; a download client here. 113 | 114 | (defun download-file (filename uri) 115 | (dex:fetch uri filename 116 | :if-exists :supersede)) 117 | 118 | 119 | ;;;; OS Distribution 120 | ;;; 121 | ;;; SBCL can get an informatioin about OS, but it is very abstract. 122 | ;;; Because we can find whether the OS is Linux, but we cannot find 123 | ;;; which distribution the OS is. 124 | 125 | (defun redhat-version () 126 | (let* ((content (uiop:read-file-lines "/etc/redhat-release")) 127 | (trim-before (subseq content 128 | (+ 8 (search "release" content)))) 129 | (trim-after (subseq trim-before 130 | 0 131 | (search " " trim-before)))) 132 | trim-after)) 133 | 134 | 135 | (defun get-dist (key) 136 | (if (probe-file #P"/etc/redhat-release") 137 | "redhat" 138 | (loop :for file :in (uiop:directory-files "/etc/" "*-release") 139 | :do (loop :for line :in (uiop:read-file-lines file) 140 | :if (uiop:string-prefix-p (format nil "~A=" key) line) 141 | :do (return-from get-dist (subseq line (1+ (length key)))))))) 142 | 143 | 144 | 145 | 146 | ;;;; Memory allocation and free for Array 147 | ;;; 148 | ;;; When drawing graph, we have to provide data as array pointer 149 | ;;; to drawing function. 150 | 151 | (defun data-alloc (lst type) 152 | (cffi:foreign-alloc type 153 | :initial-contents 154 | (mapcar #'(lambda (x) 155 | (case type 156 | (:int (coerce x 'integer)) 157 | (:float (coerce x 'single-float)) 158 | (:double (coerce x 'double-float)))) 159 | lst))) 160 | 161 | (defun free (&rest vars) 162 | (loop for var in vars 163 | do (cffi:foreign-free var))) 164 | 165 | (defun string-alloc (str) 166 | (cffi:foreign-string-alloc str)) 167 | 168 | (defun string-free (&rest strs) 169 | (loop for str in strs 170 | do (cffi:foreign-string-free str))) 171 | 172 | (defun arr-aref (arr type index) 173 | (cffi:mem-aref arr type index)) 174 | -------------------------------------------------------------------------------- /tests/main.lisp: -------------------------------------------------------------------------------- 1 | (defpackage kai-test 2 | (:use :cl 3 | :rove 4 | :kai)) 5 | (in-package :kai-test) 6 | 7 | ;; NOTE: To run this test file, execute `(asdf:test-system :kai)' in your Lisp. 8 | 9 | (teardown 10 | (reset!)) 11 | 12 | (deftest test-target-kai 13 | (testing "Initial setup" 14 | (ok (equal kai:*state* '())) 15 | (ok (equal kai:*style* '()))) 16 | 17 | (testing "Line" 18 | (ok (kai:line '(1 2 3) :color :red))) 19 | 20 | (testing "Marker" 21 | (ok (kai:marker '(1 2 3) :color :red))) 22 | 23 | (testing "Bar plot" 24 | (ok (kai:bar '(10 20 30)))) 25 | 26 | (testing "Pie chart" 27 | (ok (kai:pie '(1 2 3) 28 | '("hoge" "foo" "bar")))) 29 | 30 | (testing "Box chart" 31 | (ok (kai:box '(1 2 3)))) 32 | 33 | (testing "Heatmap chart" 34 | (ok (kai:heatmap '((1 2) (3 4))))) 35 | 36 | (testing "Contour chart" 37 | (ok (kai:contour '((1 2) (3 4))))) 38 | 39 | (testing "Line3D plot" 40 | (ok (kai:line3d '(1 2 3) 41 | '(1 2 3) 42 | '(1 2 3)))) 43 | 44 | (testing "Marker3D plot" 45 | (ok (kai:marker3d '(1 2 3) 46 | '(1 2 3) 47 | '(1 2 3)))) 48 | 49 | (testing "Surface plot" 50 | (ok (kai:surface '((1 2) (3 4)))))) 51 | --------------------------------------------------------------------------------