Black Box 4/BlackBox.cdr/proglang/ladybug1.arj/DEMO4.BUG

Text File | 1991-01-13 | 2KB | 152 lines

; demo4.bug
to "inspi  :S :A :C
IF :C > 180 [STOP]
POLYS :S :A
MAKE "C :C + 1
INSPI :S :A + 10 :C
end

to "starfish
DRAW PD
SETBG 3
SETPC 3
INSPI 10 1 1
PRINT [INSPI - RATION]
WAIT 10
THIRD
end

to "third
CT CURSOR 1 5
PR [Logo has often been described]
JL PR [as a language for children.]
PR [Maybe that's because it brings]
PR [out the child in all of us.]
JL PR [This does not preclude Logo]
PR [from being a language for]
CURSOR 5 13 PR [Poets,]
CURSOR 10 15
PR [Scientists,]
CURSOR 15 17
PR [and philosophers.]
CURSOR 1 21
WAIT 40
CLEARWS
LOAD "DEMO5
START
end

to "polys  :S :A
FD :S
RT :A
end

to "polyx  :A :R
CS HM SETBG 1 + INTEGER RANDOM 6
SETPC 1 + INTEGER RANDOM 3
SETPAL INTEGER RANDOM 2
REPEAT :R [FD 100 RT :A] CR
end

to "squirl  :A
CS HT HM SETBG 0 PD SI :A 5 CR
end

to "si  :B :N
SETPC 1 + INTEGER RANDOM 3
IF :N > 225 [STOP]
FD :N RT :B
SI :B :N + 4
end

to "cr
PU SETXY -220 -80
end

to "spiro  :A :L
DRAW SETBG 0 PD IR :A :L CR
end

to "ir  :B :L
SO :B :L 8
IF HEADING = 0 [STOP]
end

to "so  :A :L :S
MAKE "PEN REMAINDER :L 5
IF :D > 2 MAKE "D 0
FD :S RT :A SETPC 1 + :D
IF :L = 0 [STOP]
SO :A :L - 1 :S + 8
end

to "start
JE JL JL PR [Polygons lead to the fun of]
JP PR [exploring polyspirals...]
JL JL PR [?TO POLYSPIRAL :LIMIT :SIZE :ANGLE]
PR [> IF :SIZE > :LIMIT [STOP]]
PR [> FORWARD :SIZE]
PR [> RIGHT :ANGLE]
PR [> POLYSPIRAL :LIMIT :SIZE + 5 :ANGLE]
PR [> END]
JL JL JP PR [Now watch...]
WAIT 3 JL JL JP PR [First some polygons...]
WAIT 3 DRAW JB
end

to "jb
POLYGON 120 3 POLYGON 90 4 POLYGON 72 5
POLYGON 144 5 POLYGON 60 6
PR [Now polyspirals...] WAIT 10 HM
SQUIRL 120 SQUIRL 123
PR [And some others...] WAIT 10 HM
SPIRO 144 11 SPIRO 140 7 STARFISH
end

to "je
CT CURSOR 1 1
end

to "JC
BG 0 CS CT
end

to "JL
PR "
end

to "JP
REPEAT 3 [JI]
end

to "JI
TYPE CHAR 32
end

to "WAIT  :T
IF :T = 0 [STOP]
MAKE "T :T - 0.1
WAIT :T
end

to "pr  :LIST
PRINT :LIST
end

to "polygon  :A :R
CS HM SETBG 1 + INTEGER RANDOM 6
SETPC 3
REPEAT :R [FD 100 RT :A] CR
WAIT 5
end

to "hm
PU HOME PD
end

to "remainder  :A :B
MAKE "C :A / :B
MAKE "D ( :C - INTEGER :C ) * :B
OUTPUT :D
end