Skip to content

Commit a1ab835

Browse files
objecthubobjecthub
committed
Support current-turtle in library (lispkit draw turtle). Include sample code.
1 parent fd20a20 commit a1ab835

File tree

3 files changed

+157
-33
lines changed

3 files changed

+157
-33
lines changed

‎LispKit.xcodeproj/project.pbxproj

+4
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@
2828
CC14F4B31F93AE04000FB1E0 /* AvlTrees.scm in Copy examples */ = {isa = PBXBuildFile; fileRef = CC14F4AE1F9385BF000FB1E0 /* AvlTrees.scm */; };
2929
CC1AAE3B1CC3CF0F00D1806F /* LispKit.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = CCAD52BA1C48403800DBD8EE /* LispKit.framework */; };
3030
CC1AAE3C1CC3CF0F00D1806F /* LispKit.framework in Embed Frameworks */ = {isa = PBXBuildFile; fileRef = CCAD52BA1C48403800DBD8EE /* LispKit.framework */; settings = {ATTRIBUTES = (CodeSignOnCopy, RemoveHeadersOnCopy, ); }; };
31+
CC1EA5C9214E6CD8006BBE7E /* Turtle.scm in Copy examples */ = {isa = PBXBuildFile; fileRef = CC1EA5C8214E6BF3006BBE7E /* Turtle.scm */; };
3132
CC201A6D1DBD72C100045A4D /* LibraryRegistry.swift in Sources */ = {isa = PBXBuildFile; fileRef = CC201A6C1DBD72C100045A4D /* LibraryRegistry.swift */; };
3233
CC2345411F655BD800C38817 /* datatype.sld in Copy pre-installed LispKit libraries */ = {isa = PBXBuildFile; fileRef = CC2345401F655B8B00C38817 /* datatype.sld */; };
3334
CC2345431F655C0A00C38817 /* Datatypes.scm in Resources */ = {isa = PBXBuildFile; fileRef = CC2345421F655C0A00C38817 /* Datatypes.scm */; };
@@ -280,6 +281,7 @@
280281
dstPath = LispKit/Resources/Examples;
281282
dstSubfolderSpec = 7;
282283
files = (
284+
CC1EA5C9214E6CD8006BBE7E /* Turtle.scm in Copy examples */,
283285
CC26264420FA007800AC08E8 /* Plot.scm in Copy examples */,
284286
CC5E474320D45AE500F21B03 /* Coroutines.scm in Copy examples */,
285287
CC4385BE20BB5F3400055289 /* Compiler.scm in Copy examples */,
@@ -455,6 +457,7 @@
455457
CC14F4AE1F9385BF000FB1E0 /* AvlTrees.scm */ = {isa = PBXFileReference; indentWidth = 2; lastKnownFileType = text; path = AvlTrees.scm; sourceTree = "<group>"; tabWidth = 2; };
456458
CC14F4AF1F939486000FB1E0 /* Features.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = Features.swift; sourceTree = "<group>"; };
457459
CC14F4B11F93A455000FB1E0 /* FeatureRequirement.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = FeatureRequirement.swift; sourceTree = "<group>"; };
460+
CC1EA5C8214E6BF3006BBE7E /* Turtle.scm */ = {isa = PBXFileReference; lastKnownFileType = text; path = Turtle.scm; sourceTree = "<group>"; };
458461
CC201A6C1DBD72C100045A4D /* LibraryRegistry.swift */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.swift; path = LibraryRegistry.swift; sourceTree = "<group>"; };
459462
CC2345401F655B8B00C38817 /* datatype.sld */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = datatype.sld; sourceTree = "<group>"; };
460463
CC2345421F655C0A00C38817 /* Datatypes.scm */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = Datatypes.scm; sourceTree = "<group>"; };
@@ -1094,6 +1097,7 @@
10941097
CC4385BD20BB5EE200055289 /* Compiler.scm */,
10951098
CC14F4AE1F9385BF000FB1E0 /* AvlTrees.scm */,
10961099
CC26264320FA003700AC08E8 /* Plot.scm */,
1100+
CC1EA5C8214E6BF3006BBE7E /* Turtle.scm */,
10971101
CC750BD71F5AC68900CD82A2 /* PDF.scm */,
10981102
CC4385BB20BAB79500055289 /* HTTP.scm */,
10991103
);

‎Sources/LispKit/Resources/Examples/Turtle.scm

+106
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,106 @@
1+
;;; Turtle graphics
2+
;;;
3+
;;; This is a demo of library (lispkit draw turtle). Three differerent fractal curves
4+
;;; are drawn and saved as individual pages in a PDF document. These examples are based
5+
;;; on the sample code for LILA, a historic Lisp interpreter for Mac OS 8.
6+
;;; (see http://zenger.org/lila/).
7+
;;;
8+
;;; Usage: (save-graphics "turtle-demo.pdf")
9+
;;;
10+
;;; Author: Matthias Zenger
11+
;;; Copyright © 2018 Matthias Zenger. All rights reserved.
12+
;;; Original copyright © 1994-03-06 Matthias Zenger
13+
;;;
14+
;;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file
15+
;;; except in compliance with the License. You may obtain a copy of the License at
16+
;;;
17+
;;; http://www.apache.org/licenses/LICENSE-2.0
18+
;;;
19+
;;; Unless required by applicable law or agreed to in writing, software distributed under the
20+
;;; License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
21+
;;; either express or implied. See the License for the specific language governing permissions
22+
;;; and limitations under the License.
23+
24+
25+
(import (lispkit draw)
26+
(lispkit draw turtle))
27+
28+
(define (fern size min)
29+
(if (>= size min)
30+
(begin
31+
(forward (* 0.18 size))
32+
(turn 4)
33+
(fern (* 0.82 size) min)
34+
(turn 58)
35+
(fern (* 0.40 size) min)
36+
(turn -122)
37+
(fern (* 0.40 size) min)
38+
(turn 60)
39+
(forward (* -0.18 size)))))
40+
41+
(define (fern-page)
42+
(display "Drawing fern page")
43+
(newline)
44+
(parameterize ((current-turtle (make-turtle 200 200 2.0)))
45+
(pen-color (color 0.0 0.5 0.0))
46+
(pen-size 0.3)
47+
(move -60 100)
48+
(heading -50)
49+
(fern 300.0 2.0)
50+
(list (turtle-drawing (current-turtle)) (size 610 460))))
51+
52+
(define (ccurve len angle min)
53+
(cond ((< len min)
54+
(heading angle)
55+
(forward len))
56+
(else
57+
(ccurve (* len 0.7071) (+ angle 45) min)
58+
(ccurve (* len 0.7071) (- angle 45) min))))
59+
60+
(define (ccurve-page)
61+
(display "Drawing c-curve page")
62+
(newline)
63+
(parameterize ((current-turtle (make-turtle 200 200 2.0)))
64+
(pen-color (color 0.0 0.0 0.5))
65+
(pen-size 0.3)
66+
(move -5 -25)
67+
(ccurve 120.0 0 1.0)
68+
(list (turtle-drawing (current-turtle)) (size 610 460))))
69+
70+
(define (dragon len angle min)
71+
(define ang2 (- 90 angle))
72+
(define (sdragon size positive)
73+
(cond ((< size min)
74+
(forward size))
75+
(positive
76+
(turn angle)
77+
(sdragon (* size 0.7071) #t)
78+
(turn -90)
79+
(sdragon (* size 0.7071) #f)
80+
(turn ang2))
81+
(else
82+
(turn (- ang2))
83+
(sdragon (* size 0.7071) #t)
84+
(turn 90)
85+
(sdragon (* size 0.7071) #f)
86+
(turn (- angle)))))
87+
(heading angle)
88+
(sdragon len #t))
89+
90+
(define (dragon-page)
91+
(display "Drawing dragon page")
92+
(newline)
93+
(parameterize ((current-turtle (make-turtle 200 200 2.0)))
94+
(pen-color (color 0.7 0.0 0.0))
95+
(pen-size 0.3)
96+
(move 10 -47)
97+
(dragon 180.0 90 1.0)
98+
(list (turtle-drawing (current-turtle)) (size 610 460))))
99+
100+
(define (save-graphics filename)
101+
(let ((pages (list (fern-page) (ccurve-page) (dragon-page))))
102+
(display "Saving drawings in PDF file ")
103+
(display filename)
104+
(newline)
105+
(save-drawings filename pages "Demo of library (lispkit draw turtle)")))
106+

‎Sources/LispKit/Resources/Libraries/lispkit/draw/turtle.sld

+47-33
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@
3636

3737
(export turtle?
3838
make-turtle
39+
current-turtle
3940
turtle-drawing
4041
pen-up
4142
pen-down
@@ -69,52 +70,65 @@
6970
(enable-transformation (scale sc sc (translate x y)) drawing)
7071
(new-turtle drawing 0.0 0.0 0.0 #t)))
7172

72-
(define (pen-up plane)
73-
(set-turtle-pen-down! plane #f))
73+
(define current-turtle (make-parameter #f))
7474

75-
(define (pen-down plane)
76-
(set-turtle-pen-down! plane #t))
75+
(define (pen-up . args)
76+
(let-optionals args ((turtle (current-turtle)))
77+
(set-turtle-pen-down! turtle #f)))
7778

78-
(define (pen-color color plane)
79-
(set-color color (turtle-drawing plane)))
79+
(define (pen-down . args)
80+
(let-optionals args ((turtle (current-turtle)))
81+
(set-turtle-pen-down! turtle #t)))
8082

81-
(define (pen-size size plane)
82-
(set-line-width size (turtle-drawing plane)))
83+
(define (pen-color color . args)
84+
(let-optionals args ((turtle (current-turtle)))
85+
(set-color color (turtle-drawing turtle))))
8386

84-
(define (home plane)
85-
(move 0.0 0.0 plane))
87+
(define (pen-size size . args)
88+
(let-optionals args ((turtle (current-turtle)))
89+
(set-line-width size (turtle-drawing turtle))))
8690

87-
(define (move x y plane)
88-
(set-turtle-x! plane x)
89-
(set-turtle-y! plane y))
91+
(define (home . args)
92+
(let-optionals args ((turtle (current-turtle)))
93+
(move 0.0 0.0 turtle)))
9094

91-
(define (heading angle plane)
92-
(set-turtle-angle! plane (radian angle)))
95+
(define (move x y . args)
96+
(let-optionals args ((turtle (current-turtle)))
97+
(set-turtle-x! turtle x)
98+
(set-turtle-y! turtle y)))
9399

94-
(define (turn angle plane)
95-
(set-turtle-angle! plane (+ (radian angle) (turtle-angle plane))))
100+
(define (heading angle . args)
101+
(let-optionals args ((turtle (current-turtle)))
102+
(set-turtle-angle! turtle (radian angle))))
96103

97-
(define (left angle plane)
98-
(turn (- angle) plane))
104+
(define (turn angle . args)
105+
(let-optionals args ((turtle (current-turtle)))
106+
(set-turtle-angle! turtle (+ (radian angle) (turtle-angle turtle)))))
99107

100-
(define (right angle plane)
101-
(turn angle plane))
108+
(define (left angle . args)
109+
(let-optionals args ((turtle (current-turtle)))
110+
(turn (- angle) turtle)))
102111

103-
(define (forward len plane)
104-
(let* ((angle (turtle-angle plane))
105-
(ox (turtle-x plane))
106-
(oy (turtle-y plane))
107-
(x (+ ox (* (cos angle) len)))
108-
(y (+ oy (* (sin angle) len))))
109-
(if (turtle-pen-down? plane)
110-
(draw-line (point ox oy) (point x y) (turtle-drawing plane)))
111-
(move x y plane)))
112+
(define (right angle . args)
113+
(let-optionals args ((turtle (current-turtle)))
114+
(turn angle turtle)))
112115

113-
(define (backward len plane)
114-
(forward (- len) plane))
116+
(define (forward len . args)
117+
(let-optionals args ((turtle (current-turtle)))
118+
(let* ((angle (turtle-angle turtle))
119+
(ox (turtle-x turtle))
120+
(oy (turtle-y turtle))
121+
(x (+ ox (* (cos angle) len)))
122+
(y (+ oy (* (sin angle) len))))
123+
(if (turtle-pen-down? turtle)
124+
(draw-line (point ox oy) (point x y) (turtle-drawing turtle)))
125+
(move x y turtle))))
126+
127+
(define (backward len . args)
128+
(let-optionals args ((turtle (current-turtle)))
129+
(forward (- len) turtle)))
115130

116131
(define (radian angle)
117132
(inexact (/ (* angle pi) 180.0)))
118133
)
119134
)
120-

0 commit comments

Comments
 (0)