to sketch
;SKETCH by David Wess
;V 001 15/10/84
;Copyright (c) Tatung (UK) Ltd. 1984
setscrunch 1.312 setbg 0 ht cs st ct
draw
end
to absine :a :i1 :n
pu
home clean
setx 0 sety 70 clean rt 90
make "c 2
make "i 0 pd
label "col make "c 2
label "loop make "x1 (sin :i) * :a
fd :x1 bk :x1 bk :x1 fd :x1 rt 90 fd 2 lt 90
make "i :i + :i1
if :i > 540 [stop]
if :i > (360 * :n) [stop]
setpc :c
make "c :c + 1
if :c > 15 [go "col]
go "loop
end
to pattern :sides :quant
repeat 5 [fd :quant box :sides]
end
to bar :number
fd :number
bk :number
rt 90 fd 90 lt 90
end
to chart :values
if emptyp :values [stop]
fd first :values rt 90 fd 10 rt 90 fd first :values rt 180
chart bf :values
end
to histogram :values
cs ht
pu
seth 0
lt 90 fd 120 lt 90 fd 60 rt 180
pd
chart :values
end
to beepmess :mess
tones [70 2]
if emptyp :mess [stop]
make "mbuff se :mbuff first :mess
if :shaketurtle = [yes] [rt 45]
setcursor [0 20] pr :mbuff
beepmess bf :mess
end
to tpat :tsize :tcol
ht
if :tsize > 400 [stop]
pu setpc :tcol
make "t1 :tsize * (12 / 20)
bk :t1 / 4.5
pd
rt 120
fd :t1
lt 150
fd :tsize
lt 120
fd :tsize
lt 150
fd :t1
lt 150
fd :tsize / 22
rt 90
pu fd :t1 / 4.5 zap
tpat :tsize + 45 :tcol + 1
end
to zap
tones [500 1]
tones [502 1]
tones [504 1]
tones [550 1]
tones [576 1]
tones [600 1]
tones [626 1]
tones [650 1]
tones [676 1]
end
to messprep
make "mbuff " setcursor [0 24] pr "
setcursor [0 20]
end
to facesmile
cs st setpc 11 pu
fd 20 lt 90 fd 60 rt 125
pd eye 0 pu
seth 90 fd 40
pd eye 0 pu
seth 270
fd 73 lt 90 fd 30 lt 45
pd mouth pu
seth 270 fd 22 rt 90 fd 20
end
to eye :move
if :move = 12 [stop]
fd 3 rt 5
eye :move + 1
end
to mouth
setpc 9
repeat 10 [lt 8 fd 5]
end
to pie
setpc 11 repeat 60 [fd 2 rt 6]
rt 90 fd 19 lt 40 fd 19 bk 19 rt 60 fd 19
end
to engine
cs
setbg 12 setpc 1
messprep beepmess [.....You can doodle with Dr. Logo.....]
pu rt 90 fd 20 lt 90 pd ;start point
fd 20 lt 90 fd 5 rt 90 fd 5 rt 90 fd 50 rt 90 fd 50
rt 90 fd 15 lt 90 ;cabin
repeat 9 [fd 5 rt 20] fd 5 ;wheel
lt 90 fd 40 lt 90
repeat 9 [fd 5 rt 20] fd 5 ;wheel
lt 90 fd 30 rt 120 fd 20 lt 30 fd 8 rt 90 fd 8 ;front
lt 90 fd 15 lt 45 fd 18 rt 135 fd 40 rt 135 fd 18 lt 45 fd 15 ;funnel
lt 90 fd 30 lt 90 repeat 9 [fd 1 rt 20] fd 1 lt 90 fd 28 ;top
pu fd 10 pd repeat 2 [fd 20 lt 90 fd 10 lt 90]
pu bk 90 lt 90 fd 30 pd setpc 15 arc 6 lt 90 arc 4 lt 90 arc 7 rt 30 arc 4 lt 60 arc 3
end
to cir :n :c
;where n is the number of cycles and c
;is the color
setscrunch 0.8
ht home clean
make "a 0.5
setpc :c
ht
rt 270
label "loop repeat 10 [fd :a rt 36]
rt 15
make "a :a + 0.5
make "b (2 * :a) - 1
if :n < :b [go "loopo]
go "loop
label "loopo zap wait 2
setscrunch 1.312 ;?
end
to sine :a :i1 :n :c
;a is the amplitude, i1 is the incrmnt.
;n is the nuber of cycles required
;c is the color (0 to 15)
pu
home
setx -130
sety 10
make "x -120
clean
pd
make "n2 :n * 360
make "i 2
label "again make "deg 0
setpc :c
label "loop make "x1 (sin :deg) * :a
fd :x1 bk :x1 rt 90 pu fd :i lt 90 pd
make "deg :deg + :i1
if :deg > :n2 [stop]
go "loop
end
to draw
messprep
make "intmess [......Meet the Dr. Logo TURTLE ! .....]
setpc 9
make "shaketurtle [yes] messprep
beepmess :intmess rt 45
tpat 12 5
make "shaketurtle [no] messprep
beepmess [........Dr. Logo can talk to you......] tones [2 200]
messprep
beepmess [....What is your name ?] setcursor [25 20] make "name rl
facesmile
messprep pr [.........Hello] tones [676 15] zap setcursor [15 20] pr se :name [!] zap
cs messprep beepmess [........Dr. Logo for statistics .....]
setbg 6 setpc 1 histogram [10 30 40 60 70 120 125 30 34 55 60 62 63 80 10 10 4] pu seth 90 fd 10 lt 90 fd 100 seth 0
pd pie
wait 12
engine
wait 12
cs setbg 0 messprep beepmess [...Dr. Logo can draw spiral patterns..] zap
cir 56 9 zap wait 2
pu home cs pd
messprep beepmess [........Dr. Logo can draw graphs......] zap
;sinewave :amplitude, sample interval,  number of cycles and colour of pen
sine 50 10 3 2 zap wait 2
pu home pd clean
;absine :amplitude, sample interval and number of cycles.
absine 95 10 1.5 wait 5 cs ct
pr (se [\ \ \ \ \ \ \ \ \ \ \ \ \ Bye] :name) tones [300 5] zap wait 15 cs ct st
end
to arc :ang
repeat :ang [fd 5 rt 20]
end
pprop "dog "bread "alsation
pprop "house "colour "green
s [........Dr. Logo can talk to you......] tones [2 200]
messprep
beepmess [....Wh