Post by tsh73 on Jan 7, 2021 15:51:58 GMT
Details in comments
Visually, added digits to allow printing numbers
It really seems to me that setting to NORTH on each stroke is redundant.
But then, it would need new coding system (and all-letters recode).
Visually, added digits to allow printing numbers
It really seems to me that setting to NORTH on each stroke is redundant.
But then, it would need new coding system (and all-letters recode).
'mazinger JUST BASIC ROTATE FONT (from 2007)
'modified my tsh73 Jan 2021
' recoded letters in strings ("UEEE") instead of expressions (U$+E$+E$+E$)
' added digits, e and . - for numbers
' added ,?! just for kicks
'here is a function that generate the string command for rotate text to graphics windows:
'Rotext$(Angle,Size,text)
' starts lower left of letter
' letter is in the box 2x4 sizes, 1 size between letters
' except comma that goes 1 size down
' chr$(209) is over-bar N - from initial program
' missing letters produces kind of missing-glyph-box
nomainwin
WindowWidth = 1000
WindowHeight = 800
open "drawn rotatable font for JB" for Graphics as #main
#main "trapclose [quit]"
#main "cls; down"
#main "home; posxy cx cy"
'goto [page2]
'page1. From original program
#main "place 10 80; "+Rotext$(0,8,"ABCDEFGHYJKLMN"+chr$(209)+"OPQRSTUVWXYZ")
#main "place 80 80; "+Rotext$(30,8,"JUST ")+Rotext$(30,14,"BASIC")+Rotext$(30,8," ROTATE FONT")
#main "place 10 100;"+Rotext$(90,6,"HELLO")
#main "place 80 550;"+Rotext$(-45,10,"HAPPY NEW YEAR")
#main "place 650 400;"+Rotext$(-80,6,"FELIZ A"+chr$(209)+"O NUEVO")
#main "place 80 400;"+Rotext$(-80,20,"BLAH")
#main "place 160 390;"+Rotext$(-80,16,"BLAH")
#main "place 220 350;"+Rotext$(-80,10,"BLAH")
#main "place 600 250;"+Rotext$(-90,22,"YES")
#main "place 450 200;"+Rotext$(-80,16,"YES")
#main "place 500 400;"+Rotext$(185,16,"SETUP")
'it was not part of original demo, but you can use color and line width
#main "size 10"
#main "color red"
#main "place 100 700;"+Rotext$(-10,16,"BOLD COLOR!")
#main "flush"
notice "Press Ok for more"
[page2]
#main "size 1; color black"
#main "cls"
sz = 3
y0 = 20
'I see really weird jigger at size = 7 (and 12). Just be warned.
do
#main "place 10 ";y0;";"; Rotext$(0,sz,"ABCDEFGHYJKLMN"+chr$(209)+"OPQRSTUVWXYZ")
#main "place 10 ";y0+sz*6;";"; Rotext$(0,sz,sz;" A.B,C!D?E789 "); Rotext$(0,sz,str$(exp(20)))
y0=y0+2*6*sz+sz
sz=sz+1
loop while y0 < 2*cy
#main "flush"
notice "Press Ok for more"
[page3]
#main "cls"
pi = acs(-1)
'last # is for showing missing glyph
t0$="ABCDEFGHYJKLMN"+chr$(209)+"OPQRSTUVWXYZ"+".,!?"+"0123456789"+"e"+"#"
t$=using("##",sz);" ";t0$
sz = 3
R=(3*sz)*len(t$)/2/pi
While R+4*sz < cy
t$=using("##",sz);" ";t0$
'L=2*pi*R
'-> R=L/2/pi
'letter 2 sz, gap 1 sz (normal text)
'notice R
for i = 1 to len(t$)
da = 360/len(t$)
a=(i-2)*da 'so sz is exactly at right
x=cx+R*cos(a/180*pi)
y=cy+R*sin(a/180*pi)
#main "place ";x;" ";y
#main Rotext$(a+90,sz,mid$(t$,i,1))
next
R=R+6*sz
sz=sz+1
wend
#main "flush"
wait
'--------------------------------
function Rotext$(ang,size,txt$)
ang = int(ang)
diagonal=int(sqr(2*(size^2)))
size = int(size)
text$=""
'NnEeSsWwUDC, small letter +45 degrees
dim stroke$(11)
stroke$(1)="north;turn "; ang;";go ";size; ";" 'North
stroke$(2)="north;turn "; 45+ang;";go ";diagonal;";" 'North East
stroke$(3)="north;turn "; 90+ang;";go ";size; ";" 'East
stroke$(4)="north;turn ";135+ang;";go ";diagonal;";" 'South East
stroke$(5)="north;turn ";180+ang;";go ";size; ";" 'South
stroke$(6)="north;turn ";225+ang;";go ";diagonal;";" 'South West
stroke$(7)="north;turn ";-90+ang;";go ";size; ";" 'West
stroke$(8)="north;turn ";-45+ang;";go ";diagonal;";" 'North West
stroke$(9)="up;"
stroke$(10)="down;"
minSz=int(size/4): if minSz<1 then minSz=1
stroke$(11)="circle ";minSz;";"
for i=1 to len(txt$)
letter$=mid$(txt$,i,1)
select case letter$
case " ":t$= "UEEE"
case "A":t$= "DNNNneSWWEESSUE"
case "B":t$= "DEENNWWEnNWWSSSSUEEE"
case "C":t$= "EDEWwNNnEUSSSSE"
case "D":t$= "DEnNNwWSSSSUEEE"
case "E":t$= "DEEWWNNEEWWNNEEUSSSe"
case "F":t$= "DNNEEWWNNEEUSSSe"
case "G":t$= "DNNNnEUsSDESsWUEEE"
case "H":t$= "DNNNNSSEENNSSSSUE"
case "I":t$= "DENNNNWEEWSSSSEUE"
case "J":t$= "NDenNNNWUSSSSEUE"
case "K":t$= "EEDNNWWEnNUWWDSSSSUEEE"
case "L":t$= "NNNNDSSSSEEUE"
case "M":t$= "DNNNNeSNnSSSSUE"
case "N":t$= "DNNNNeeNNSSSSUE"
case chr$(209):t$= "DNNNeeNNUnWDWWEEUSDSSSUE"
case "O":t$= "DNNNnESSSsWUEEE"
case "P":t$= "DNNNNEESSWWSSUEEE"
case "Q":t$= "DNNNnESSSsWUnDeUE"
case "R":t$= "EEDNNWWEnNWWSSSSUEEE"
case "S":t$= "DEnNWWNnEUSSSe"
case "T":t$= "NNNNDEEWSSSSUEE"
case "U":t$= "NDNNNSSSSEENNNNUSSSSE"
case "V":t$= "NDNNNSSSenNNNUSSSSE"
case "W":t$= "NNNNDSSSSneNNNNSSSUe"
case "X":t$= "DNnnNUWWDSeeSUE"
case "Y":t$= "EDNNwNUEEDSsUee"
case "Z":t$= "NNNNDEESssSEEUE"
case "0":t$= "UEDnNNwsSSeUEE"
case "1":t$= "NNNDnSSSSUEE"
case "2":t$= "UNNNDnESSssEEUE"
case "3":t$= "UNNNDnESsesWUEEE"
case "4":t$= "UnnDWWnnSSSSUE"
case "5":t$= "DEnNWWNNEEUeSSS"
case "6":t$= "UNNNnEDWsSSSEENNWWUeeE"
case "7":t$= "DNnnNWWUeeSSE"
case "8":t$= "DNnwneseSWWUEEE"
case "9":t$= "DEnNNNWsSEEUeS"
case "e":t$= "UEEDWwNneSWWUeEE"
case ".":t$= "UEDCUEE"
case ",":t$= "UEDCsUnEE"
case "!":t$= "UEDCUNDNNNUeeSS"
case "?":t$= "UEDCUNDNnNWsUeee"
case else: t$= "UnDNNESSWUeE"
end select
'process t$
r$=""
for j = 1 to len(t$)
r$=r$+stroke$(instr("NnEeSsWwUDC", mid$(t$,j,1)))
next
text$ = text$+r$
next
Rotext$=text$
end function
[quit]
close #main
end