aUCBLogo Demos and Tests / drawchartest
setCaseIgnored false
be drawchartest
setsc 0
setUpdateGraph false
scale=1
::textScale=2
textLength=0
initChars
ht
hue=0
forever
[ setsc hsb hue 1 .5
hue=hue+60
pu setxy -390 0 pd
drawText [ABCDEFGHIJKLMNOPQRSTUVWXYZ] "draw
pu setxy -390 -100 pd
drawText [abcdefghijklmnopqrstuvwxyz] "draw
pu setxy -390 -200 pd
drawText [0123456789:-?!.,'"_] "draw
updateGraph
if Key? [stop]
]
be drawText :txt :action
tPos=pos
textLength=0
seth 0
ifelse list? :txt
[ make "numWords count :txt
repeat :numWords
[ make "chars item repcount :txt
make "numChars count :chars
repeat :numChars
[ drawChar item repcount :chars :action
]
if not repcount == :numWords
[ rt 90 tfd 6 lt 90
textLength=textLength+6
]
]
][
make "numChars count :txt
repeat :numChars
[ drawChar (item repcount :txt) :action
]
]
make "textLength round (:textLength*:textScale )
if :action == "getLength [pu setpos :tPos seth 0]
end
be drawChar :c :action
make "validChar true
setPenSize list round(1*:scale) round(1*:scale)
seth 0
make "cPos pos
setPC rgb 1 1 0
pd
if action != "getLength
[ charvar=word "char_ BackslashEncode c
; if name? charvar [run thing charvar]
if procedure? charvar [run charvar]
]
make "charWidth 0
if c >= "A and2 c <= "Z [make "charWidth 12]
if c >= "a and2 c <= "z [make "charWidth 10]
if c >= "0 and2 c <= "9 [make "charWidth 12]
case c
[ ["I make "charWidth 7]
["f make "charWidth 8]
["j make "charWidth 6]
["i make "charWidth 2]
["l make "charWidth 1]
["m make "charWidth 17]
["r make "charWidth 9]
["t make "charWidth 9]
["1 make "charWidth 11]
[": make "charWidth 1]
["- make "charWidth 10]
["? make "charWidth 11]
["! make "charWidth 1]
[". make "charWidth 3]
[", make "charWidth 5]
["' make "charWidth 5]
["" make "charWidth 6]
["_ make "charWidth 11]
[32 make "charWidth 7]
]
pu
setpos :cPos
seth 0
ifelse charWidth==0
[ make "validChar false
][
if action != "getLength
[
;the 3 in "tfd 3" is assumed to be 3 by inputText.keyHit and most button procedures
rt 90 tfd :charWidth tfd 3 lt 90
]
make "textLength :textLength+:charWidth+3
]
end
end
be tfd :dist
fd :dist*::textScale
end
be tbk :dist
bk :dist*::textScale
end
be ltCnr
arc2 -90 -::textScale*3*sqrt 2
; lt 45 tfd 1.4 lt 45
end
be rtCnr
arc2 90 ::textScale*3*sqrt 2
; rt 45 tfd 1.4 rt 45
end
be ltCnr2
arc2 -90 -::textScale*10.5
; lt 45 tfd 1.4 lt 45
end
be rtCnr2
arc2 90 ::textScale*10.5
; rt 45 tfd 1.4 rt 45
end
be initChars
charlist=
[ [A tfd 11 make "pos1 pos pu tfd 10 rt 90 tfd 5.5 make "pos2 pos tfd 5.5 rt 90 tfd 10 pd rt 90 tfd 11 tbk 11 lt 90 tfd 11 tbk 11 setpos :pos2 setpos :pos1]
[B tfd 21 rt 90 tfd 7 rtCnr tfd 2 rtCnr tfd 7 lt 90 tfd 11 lt 90 tfd 8 ltCnr tfd 2 ltCnr]
[C pu rt 90 tfd 11 rt 180 pd tfd 1 rtCnr2 tfd 0 rtCnr2 tfd 1]
[D tfd 21 rt 90 tfd 1 rtCnr2 tfd 0 rtCnr2 tfd 1]
[E rt 90 tfd 11 tbk 11 lt 90 tfd 11 rt 90 tfd 10 tbk 10 lt 90 tfd 10 rt 90 tfd 12]
[F tfd 11 rt 90 tfd 10 tbk 10 lt 90 tfd 10 rt 90 tfd 12]
[G pu rt 90 tfd 11 lt 90 pd tfd 11 lt 90 tfd 5 tbk 5 rt 90 tbk 11 lt 90 tfd 3 rtCnr2 tfd 0 rtCnr2 tfd 3]
[H tfd 11 rt 90 tfd 11 tbk 11 lt 90 tfd 11 pu rt 90 tfd 11 rt 90 tfd 1 pd tfd 21]
[I pu rt 90 pd tfd 6 tbk 3 lt 90 tfd 21 lt 90 tfd 3 tbk 7]
[J pu tfd 6 rt 180 pd tfd 2 ltCnr tfd 1 ltCnr tfd 17 lt 90 tfd 3 tbk 6]
[K tfd 21 tbk 10 rt 45 tfd 14 tbk 14 rt 90 tfd 15]
[L rt 90 tfd 11 tbk 11 lt 90 tfd 21]
[M pu rt 90 tfd 11 lt 90 pd tfd 21 make "pos1 pos tbk 21 lt 90 pu tfd 6 rt 90 tfd 11 make "pos2 pos tbk 11 lt 90 tfd 5 rt 90 pd tfd 21 setpos :pos2 setpos :pos1]
[N pu rt 90 tfd 11 pd make "pos1 pos lt 90 tfd 21 tbk 21 pu lt 90 tfd 11 rt 90 pd tfd 21 setpos :pos1]
[O pu tfd 4 pd repeat 2 [tfd 13 rtCnr tfd 3 rtCnr]]
[P tfd 21 rt 90 tfd 6 rtCnr tfd 2 rtCnr tfd 6]
[Q pu tfd 4 pd repeat 2 [tfd 13 rtCnr tfd 3 rtCnr] pu rt 90 tfd 6 rt 45 pd tfd 8]
[R tfd 21 rt 90 tfd 6 rtCnr tfd 2 rtCnr tfd 6 rt 45 tbk 15]
[S pu rt 90 fd 3 lt 180 rtCnr rt 180 ltCnr tfd 3 ltCnr tfd 2 ltCnr tfd 1 rtCnr tfd 2 rtCnr tfd 1 rtCnr]
[T pu rt 90 tfd 6 pd lt 90 tfd 21 lt 90 tfd 6 tbk 12]
[U pu tfd 4 pd tfd 17 rt 180 tfd 17 ltCnr tfd 2 ltCnr tfd 17]
[V pu rt 90 tfd 6 lt 75 pd tfd 22 tbk 22 lt 30 tfd 22]
[W pu rt 90 tfd 11 lt 90 tfd 21 rt 180 rt 90 tfd 11 lt 90 pd tfd 21 make "pos1 pos tbk 21 lt 90 pu tfd 6 rt 90 tfd 11 make "pos2 pos tbk 11 lt 90 tfd 5 rt 90 pd tfd 21 setpos :pos2 setpos :pos1]
[X pu rt 90 tfd 11 lt 90 tfd 21 rt 180 pu make "pos1 pos tfd 21 lt 45 tfd 1.4 make "pos2 pos tbk 1.4 rt 45 rt 90 tfd 11 lt 45 tfd 1.4 make "pos3 pos tbk 1.4 rt 45 rt 90 tfd 21 pd setpos :pos2 pu setpos :pos1 pd setpos :pos3]
[Y pu rt 90 tfd 6 lt 90 pd tfd 11 rt 30 tfd 12 tbk 12 lt 60 tfd 12]
[Z make "pos1 pos rt 90 tfd 12 pu tbk 1 lt 90 tfd 21 pd lt 90 tfd 11 tbk 11 setpos :pos1]
[a pu rt 90 tfd 4 pd tfd 5 tbk 1 lt 90 tfd 12 tbk 1 lt 90 tfd 4 ltCnr tfd 2.5 ltCnr]
[b tfd 21 tbk 10 rt 90 tfd 3 rtCnr tfd 2 rtCnr tfd 3]
[c pu rt 90 tfd 3 tfd 4 rt 180 pd tfd 4 rtCnr tfd 2.5 rtCnr tfd 4]
[d pu rt 90 tfd 2 pd tfd 5 tbk 1 lt 90 tfd 21 tbk 10 lt 90 tfd 4 ltCnr tfd 2.5 ltCnr]
[e pu rt 90 tfd 3 tfd 4 rt 180 pd tfd 4 rtCnr tfd 2.5 rtCnr rtCnr tfd 1 rt 90 tfd 8]
[f pu rt 90 tfd 2 pd lt 90 tfd 11 lt 90 tfd 3 tbk 6 tfd 3 rt 90 tfd 8 rtCnr tfd 1]
[g pu rt 90 tfd 3 pd tfd 4 rt 90 tfd 2 rtCnr rtCnr rt 180 ltCnr ltCnr tfd 14 tbk 1 lt 90 tfd 4 ltCnr tfd 2.5 ltCnr]
[h tfd 21 tbk 10 rt 90 tfd 4 rtCnr tfd 7]
[i rt 90 tfd 3 tbk 1.5 lt 90 tfd 12 pu tfd 3 pd tfd 2]
[j pu rt 90 tfd 4 lt 90 tfd 17 rt 180 pd tfd 2 pu tfd 3 pd tfd 13 rtCnr]
[k tfd 7 make "pos1 pos tfd 14 tbk 21 rt 90 pu tfd 10 rt 90 tfd 1 make "pos2 pos tbk 1 lt 90 tbk 1 lt 90 tfd 11 pd setpos :pos1 setpos :pos2]
[l tfd 22]
[m tfd 11 tbk 4 rtCnr rtCnr tfd 7 rt 180 tfd 7 rtCnr rtCnr tfd 7]
[n tfd 11 tbk 4 rtCnr tfd 2 rtCnr tfd 7]
[o pu tfd 4 pd repeat 2 [tfd 3 rtCnr tfd 1 rtCnr]]
[p tbk 6 tfd 17 tbk 4 rtCnr tfd 1 rtCnr tfd 3 rtCnr tfd 1 rtCnr]
[q pu rt 90 tfd 5 ltCnr rt 180 pd rtCnr tfd 1 rtCnr tfd 3 rtCnr tfd 1 rtCnr tfd 13 tbk 17]
[r tfd 11 tbk 4 rtCnr tfd 1 rtCnr]
[s rt 180 ltCnr ltCnr ltCnr rtCnr rtCnr rtCnr]
[t pu rt 90 tfd 4 pd lt 90 tfd 11 lt 90 tfd 4 tbk 8 tfd 4 rt 90 tfd 8]
[u pu tfd 11 rt 180 pd tfd 6 ltCnr tfd 1 ltCnr tfd 6]
[v pu tfd 12 make "pos1 pos tbk 12 rt 90 tfd 5 make "pos2 pos tfd 4 lt 90 tfd 11 pd setpos :pos2 setpos :pos1]
[w pu tfd 6 pd tfd 5 tbk 5 pu make "pos1 pos tbk 6 rt 90 tfd 2 make "pos2 pos tfd 2 lt 90 tfd 5 make "pos3 pos tbk 5 rt 90 tfd 2 make "pos4 pos tfd 2 lt 90 tfd 6 pd tfd 5 tbk 5 setpos :pos4 setpos :pos3 setpos :pos2 setpos :pos1]
[x pu rt 90 tfd 9 lt 90 tfd 11 rt 180 pu make "pos1 pos tfd 11 lt 45 tfd 1.4 make "pos2 pos tbk 1.4 rt 45 rt 90 tfd 9 lt 45 tfd 1.4 make "pos3 pos tbk 1.4 rt 45 rt 90 tfd 11 pd setpos :pos2 pu setpos :pos1 pd setpos :pos3]
[y pu tfd 11 make "pos1 pos tbk 19 make "pos2 pos tfd 8 rt 90 tfd 4 make "pos3 pos tfd 5 lt 90 tfd 11 pd setpos :pos3 setpos :pos1 setpos :pos3 setpos :pos2]
[z make "pos1 pos rt 90 tfd 10 pu tbk 1 lt 90 tfd 11 pd lt 90 tfd 9 tbk 9 setpos :pos1]
[0 pu tfd 4 pd repeat 2 [tfd 13 rtCnr tfd 2 rtCnr] pu tfd 6 rt 90 tfd 5.3 lt 70 pd tfd 4 tbk 8]
[1 pu rt 90 tfd 3 pd tfd 8 tbk 4 lt 90 tfd 21 lt 135 tfd 8]
[2 pu rt 90 tfd 11 lt 180 pd tfd 11 rt 90 tfd 6 rtCnr tfd 2 ltCnr tfd 3 ltCnr tfd 1 ltCnr]
[3 pu rt 90 tfd 5 lt 180 rtCnr lt 180 pd ltCnr tfd 2 ltCnr tfd 3 ltCnr tfd 2 rt 180 tfd 2 ltCnr tfd 2 ltCnr tfd 1 ltCnr]
[4 pu rt 90 tfd 8 lt 90 pd tfd 21 lt 135 tfd 13 lt 135 tfd 11]
[5 pu rt 90 tfd 3 lt 180 rtCnr rt 180 ltCnr tfd 2 ltCnr tfd 3 ltCnr tfd 5 rt 90 tfd 10 rt 90 tfd 10]
[6 pu tfd 4 pd repeat 2 [tfd 3 rtCnr tfd 2 rtCnr] tfd 13 rtCnr tfd 2 rtCnr]
[7 pu tfd 21 rt 90 pd tfd 11 rt 115 tfd 23]
[8 pu tfd 4 pd repeat 2 [tfd 3 rtCnr tfd 2 rtCnr] tfd 3 rtCnr tfd 1.5 rt 180 repeat 2 [tfd 1 rtCnr tfd 2 rtCnr]]
[9 pu rt 90 tfd 3 lt 180 rtCnr rt 180 ltCnr tfd 1 ltCnr tfd 14 ltCnr tfd 1 ltCnr tfd 2 ltCnr tfd 1 ltCnr]
[: tfd 2 pu tfd 8.5 pd tfd 2]
[- pu tfd 11 rt 90 pd tfd 10]
[? pu rt 90 tfd 2 lt 90 pd tfd 2 pu tfd 3 pd tfd 3 rtCnr tfd 0 ltCnr tfd 2 ltCnr tfd 3 ltCnr tfd 1]
[! tfd 2 pu tfd 3 pd tfd 17]
[. tfd 2]
[, pu tbk 4 rt 30 pd tfd 3 lt 30 tfd 2 lt 90 tfd 3]
[' pu tfd 17 rt 30 pd tfd 3 lt 30 tfd 2 lt 90 tfd 3]
[" pu tfd 17 pd tfd 4 pu rt 90 tfd 4 rt 90 pd tfd 4]
[_ pu tbk 2 rt 90 pd tfd 11]
]
foreach charlist
[
; make (word "char_ first ?) bf ?
define (word ": ":char_ first ?) (list [] bf ?)
]
end