to DRAW
INIT D2 erall fs
end
to INIT
wrap ts ct setscrunch 0.468
make "Q 0
make "H 30
make "U 1
make "X 10
HELP
pr []
type word char 27 "p
(type char 32 [PRESS ANY KEY TO START])
type word char 27 "q
if rc = "\* []
setsplit 1
cs st CT
end
to D2
make "A ascii rc
if :A = 240 [seth 0 fd :X]
if :A = 242 [seth 180 fd :X]
if :A = 254 [seth 270 fd :X]
if :A = 250 [seth 90 fd :X]
if :A = 111 [rt :H fd :X]
if :A = 79 [lt :H fd :X]
if :A = 102 [pu fd 3 pd fill BL]
if :A = 234 [BIG CT]
if :A = 28 [SMALL CT]
if :A = 253 [EXIT CT]
if :A = 104 [copyon HELP pr char 12 copyoff]
if :Q = 1 [stop]
D2
end
to LD
NAME if :nm = " [CT stop] if not emptyp dirpic :nm [CT loadpic :nm BL stop] DIR
end
to SV
NAME if :nm = " [CT stop] if emptyp dirpic :nm [CT savepic :nm BL stop]
type [Name already in use.] WT DIR
end
to ER
NAME if :nm = " [CT stop] if not emptyp dirpic :nm [erasepic :nm BL stop] DIR
end
to NAME
ct (type [Name?] char 32) make "nm rq
end
to DIR
(type [PICTURE DIRECTORY:] char 32) type dirpic "A: WT
end
to EXIT
ct type [OPTIONS : s = Save (23 K!) , e = Erase, l = Load, c = clear screen, q = Quit]
make "i rc
if :i = "s [SV]
if :i = "e [ER]
if :i = "l [LD]
if :i = "c [cs]
if :i = "q [ct type [Are you sure? (y / n)] if rc = "y [setscrunch 0.468 make "Q 1]] CT
end
to BL
setsplit 1 ct pr char 7
end
to WT
repeat 400 []
end
to CT
ct fs
end
to HELP
pr [DRAW is a small drawing program.]
pr []
pr [COMMANDS AVAILABLE:]
pr []
pr [CURSOR - keys: lines in 4 directions]
pr [o key: circle to the right]
pr [O key: circle to the left]
pr [+ key: to make hook / unit / length / pen or turtle BIGGER]
pr [- key: to make hook / unit / length / pen or turtle SMALLER]
pr [f key: to fill closed fields]
pr [h key: HELP instructions on paper]
pr [EXIT - key: to load / save / erase pictures on screen or disc / quit the program]
end
to SMALL
ct type [SMALLER? u = unit, h = hook, l = length, p = pen up, t = turtle hidden]
make "I lc rc
if :I = "u [make "U :U * 0.6666666 setscrunch 0.468 * :U]
if :I = "h [make "H :H - 15]
if :I = "l [make "X :X / 2]
if :I = "p [pu]
if :I = "t [ht]
end
to BIG
ct type [BIGGER? u = unit h = hook, l = length, p = pen down, t = turtle shown]
make "I lc rc
if :I = "u [make "U :U * 1.5 setscrunch 0.468 * :U]
if :I = "h [make "H :H + 15]
if :I = "l [make "X :X * 2]
if :I = "p [pd]
if :I = "t [st]
end
 fs
end