From 3a42c1fa608c2ce1e17a6301f9f96bf20fce0a2e Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Wed, 2 Oct 2019 21:19:32 +0000 Subject: pst-turtle (2oct19) git-svn-id: svn://tug.org/texlive/trunk@52261 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/dvips/pst-turtle/pst-turtle.pro | 302 ++++++++++++++++++++++ 1 file changed, 302 insertions(+) create mode 100644 Master/texmf-dist/dvips/pst-turtle/pst-turtle.pro (limited to 'Master/texmf-dist/dvips/pst-turtle') diff --git a/Master/texmf-dist/dvips/pst-turtle/pst-turtle.pro b/Master/texmf-dist/dvips/pst-turtle/pst-turtle.pro new file mode 100644 index 00000000000..7bed96eb03f --- /dev/null +++ b/Master/texmf-dist/dvips/pst-turtle/pst-turtle.pro @@ -0,0 +1,302 @@ +% turtle.ps -- graphics turtle. +% @author Eric Laroche +% @version @(#)$Id: pst-turtle.pro 1092 2019-10-01 20:19:35Z herbert $ +% +% turtle.ps -- graphics turtle. +% Copyright (C) 1997-2001 Eric Laroche. +% +% This program is free software; +% you can redistribute it and/or modify it. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +% +% the '(graphics) turtle' is a 'cursor' that has a position (x and y +% coordinate), a heading and a pen up/down state. procedures as +% forward, left, etc. are used as drawing idioms. +% +% the turtle object consists of: cx cy phi penstate. cx and cy are the +% initialial coordinates, established when creating the turtle, they are +% the turtles zero coordinates. phi is the turtle heading, zero means +% in x direction (i.e. to the right), 90 means in the y direction (i.e. +% up). penstate is a boolean indicating whether the pen is down (true) +% or up (false). +% implicit to the turtle object is: currentpoint. +% +% note that using path constructing operators moveto, rmoveto, lineto, +% rlineto, arc, etc. will affect the turtle's state in a way that the +% turtle's current point is changed together with the postscript vm's +% current point by these operators. contrary the turtle's heading +% isn't affected by these operators. +% +% the turtle procedures indicate syntaxes using (an array +% containing the turtle state) as abstract turtle object. +% +% no syntax is indicated with the abbreviated function names. +% +% these procedures are not handling newpath, closepath, +% setlinewidth, setlinejoin, setlinecap, stroke, fill, etc. +% +% a current point must be set before using the turtle object and after +% starting a new path. i.e. a typical initialization sequence would be +% e.g. 'newpath 200 200 moveto turtle 90 setheading'. +% +% create a turtle object. +% this saves the current point as zero point to return to by 'home'. +% a turtle object is an array of: [cx cy phi penstate]. +% - turtle -> +% +% on stack: { x y } boolean N@name type InitXnode + +/tx@TurtleDict 50 dict def +tx@TurtleDict begin +% +/nodeCounter 0 def +/nodeCnt++ { nodeCounter 1 add /nodeCounter exch def } def + +%/saveNode { +% { currentpoint } +% false +% (N@Turtle) nodeCounter 2 string cvs concatstrings 32 rightTrim cvn +% 10 +% {InitPnode} +% tx@NodeDict begin NewNode end +% nodeCnt++ +%} def + +/saveNode { + tx@Dict begin + (Turtle) nodeCounter 2 string cvs concatstrings 32 rightTrim cvn { currentpoint } def + end +} def +% +/turtle { + % get initial position. + % initial position is current point. + 2 setlinejoin + currentpoint + % phi and penstate + 0 true + % note: not doing any newpath. + 4 array astore +} bind def + +% destroy a turtle object. +% note: this procedure serves for compatibility +% to older turtle formats. +% unturtle -> - +/unturtle { + % return to turtle object's initial position. + dup 0 get + 1 index 1 get % cx cy + moveto + % note: not doing any newpath. + pop % - +} bind def + +% return turtle object size. +% note: this procedure serves for compatibility +% to older turtle formats. +% - turtlesize -> 1 +/turtlesize { + % 1 entry on the stack (an array with cx cy phi penstate). + 1 +} bind def + +% normalize direction. phi must be >= 0 and < 360. +% normalizephi -> +/normalizephi { + dup 2 get % phi + % note: denormalized typically by less than two circles, + % so the loops won't take too long. + % cut while larger or equal 2 pi. + { + dup 360 % phi phi 360 + lt { + exit + } if + 360 sub + } loop + % increment while less zero. + { + dup 0 % phi phi 0 + ge { + exit + } if + 360 add + } loop + exch dup 2 + 4 -1 roll + put % +} bind def + +% relatively move to, action depending on penstate. +% dx dy pmoveto -> +/pmoveto { + % move or draw, depending on penstate + 2 index 3 get { + rlineto + } { + rmoveto + } ifelse +} def + +% where we are, from initial point (in setxy coordinates). +% xy -> x y +/xy { + currentpoint % x' y' + exch 2 index 0 get sub % y' x + exch 2 index 1 get sub % x y +} bind def + +% calculate relative movements from setxy coordinates. +% x y rxy -> x' y' +/rxy { + 3 -1 roll % x y + xy % x y x'' y'' + 5 -2 roll % x'' y'' x y + exch 4 -1 roll sub + exch 3 -1 roll sub % x' y' +} bind def + + +% logo language turtle functions + +% put penstate in 'up' position. +% logo language turtle function +% penup -> +/penup { + % false means 'up'. + dup 3 false put +} bind def + +% put penstate in 'down' position. +% logo language turtle function +% pendown -> +/pendown { + % true means 'down'. + dup 3 true put +} bind def + +% advance in current direction. +% logo language turtle function +% d forward -> +/forward { + % dx is d cos phi. + 1 index 2 get cos 1 index mul % d dx + % dy is d sin phi. + 2 index 2 get sin 3 -1 roll mul % dx dy + pmoveto + saveNode +} def + +% back up in current direction. +% logo language turtle function +% d back -> +/back { + neg + forward +} bind def + +% change direction to the left (counterclockwise, positive direction). +% logo language turtle function +% omega left -> +/left { + 1 index 2 get % omega phi + add % phi' + 1 index 2 3 -1 roll put + normalizephi +} bind def + +% change direction to the right (clockwise, negative direction). +% logo language turtle function +% omega right -> +/right { + neg + left +} bind def + +% move to a specified point. +% logo language turtle function +% x y setxy -> +/setxy { + rxy % x' y' + pmoveto % +} bind def + +% move to a specified point (only x changes). +% logo language turtle function +% x setx -> +/setx { + 0 rxy % x' y' + pop 0 pmoveto % +} bind def + +% move to a specified point (only y changes). +% logo language turtle function +% y sety -> +/sety { + 0 exch rxy % x' y' + exch pop 0 exch pmoveto % +} bind def + +% set the heading. +% logo language turtle function +% phi' setheading -> +/setheading { 1 index 2 3 -1 roll put normalizephi } bind def + +% set heading towards a point. +% logo language turtle function +% x y towards -> +/towards { + rxy % x' y' + % check if both zero. + 1 index 0 eq 1 index 0 eq and { + % set heading to zero. + pop pop 0 + } { + exch atan + } ifelse + setheading +} bind def + +% go home; heading to zero. +% logo language turtle function +% home -> +/home { 0 dup setxy 0 setheading } bind def + +% get x coordinate. +% logo language turtle function +% xcor -> cx x +/xcor { xy pop } bind def + +% get y coordinate. +% logo language turtle function +% ycor -> y +/ycor { xy exch pop } bind def + +% get heading. +% logo language turtle function +% heading -> phi +/heading { dup 2 get } bind def + +% get pen state. +% logo language turtle function +% note: only the turtle relevant stuff given. +% drawstate -> penstate +/drawstate { dup 3 get } bind def +% +% logo language turtle function abbreviations +% +/bk { back } bind def +/fd { forward } bind def +/lt { left } bind def +/pd { pendown } bind def +/pu { penup } bind def +/rt { right } bind def +/seth { setheading } bind def +% +end +% end of pst-turtle.pro + -- cgit v1.2.3