home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / amos1.34_progs / scalable_a.amos / scalable_a.amosSourceCode
Encoding:
AMOS Source Code  |  1993-01-17  |  5.4 KB  |  174 lines
  1. 'The size of the font can be altered by changing the parameters  
  2. '
  3. FS=8 : FSX=5 : FSY=100 : I=5 : KERN=12 : A$="abcdefghijklmnopqrstuvwxyz"
  4. '
  5. A$=Upper$(A$)
  6. Global FS,X,Y,I,A$
  7. '
  8. Cls 0
  9. Proc PRT_STR[A$,FSX,FSY,I,KERN]
  10. '
  11. Procedure A[FSX,FSY,FS]
  12.    Gr Locate FSX,FSY
  13.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY
  14.    Gr Locate FSX,FSY-FS
  15.    Draw To FSX+FS,FSY-FS
  16. End Proc
  17. Procedure B[FSX,FSY,FS]
  18.    Gr Locate FSX,FSY
  19.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY-FS
  20.    Gr Locate FSX,FSY-FS : Draw To FSX+FS,FSY-FS : Draw To FSX+FS,FSY : Draw To FSX,FSY
  21. End Proc
  22. Procedure C[FSX,FSY,FS]
  23.    Gr Locate FSX+FS,FSY
  24.    Draw To FSX,FSY : Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS)
  25. End Proc
  26. Procedure D[FSX,FSY,FS]
  27.    Gr Locate FSX,FSY
  28.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY : Draw To FSX,FSY
  29. End Proc
  30. Procedure E[FSX,FSY,FS]
  31.    Gr Locate FSX+FS,FSY
  32.    Draw To FSX,FSY : Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS)
  33.    Gr Locate FSX,FSY-FS : Draw To FSX+(0.75*FS),FSY-FS
  34. End Proc
  35. Procedure F[FSX,FSY,FS]
  36.    Gr Locate FSX,FSY
  37.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS)
  38.    Gr Locate FSX,FSY-FS
  39.    Draw To FSX+(0.75*FS),FSY-FS
  40. End Proc
  41. Procedure G[FSX,FSY,FS]
  42.    Gr Locate FSX+FS,FSY-FS
  43.    Draw To FSX+FS,FSY-FS : Draw To FSX+FS,FSY : Draw To FSX,FSY : Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS)
  44. End Proc
  45. Procedure H[FSX,FSY,FS]
  46.    Gr Locate FSX,FSY
  47.    Draw To FSX,FSY-(2*FS)
  48.    Gr Locate FSX+FS,FSY
  49.    Draw To FSX+FS,FSY-(2*FS)
  50.    Gr Locate FSX,FSY-FS
  51.    Draw To FSX+FS,FSY-FS
  52. End Proc
  53. Procedure I[FSX,FSY,FS]
  54.    Gr Locate FSX+(0.5*FS),FSY
  55.    Draw To FSX+(0.5*FS),FSY-(2*FS)
  56.    Gr Locate FSX,FSY
  57.    Draw To FSX+FS,FSY
  58.    Gr Locate FSX,FSY-(2*FS)
  59.    Draw To FSX+FS,FSY-(2*FS)
  60. End Proc
  61. Procedure J[FSX,FSY,FS]
  62.    Gr Locate FSX,FSY-(0.5*FS)
  63.    Draw To FSX,FSY : Draw To FSX+FS,FSY : Draw To FSX+FS,FSY-(2*FS)
  64. End Proc
  65. Procedure K[FSX,FSY,FS]
  66.    Gr Locate FSX,FSY
  67.    Draw To FSX,FSY-(2*FS)
  68.    Gr Locate FSX+FS,FSY
  69.    Draw To FSX,FSY-FS : Draw To FSX+FS,FSY-(2*FS)
  70. End Proc
  71. Procedure L[FSX,FSY,FS]
  72.    Gr Locate FSX+FS,FSY
  73.    Draw To FSX,FSY : Draw To FSX,FSY-(2*FS)
  74. End Proc
  75. Procedure M[FSX,FSY,FS]
  76.    Gr Locate FSX,FSY
  77.    Draw To FSX,FSY-(2*FS) : Draw To FSX+(0.5*FS),FSY-FS : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY
  78. End Proc
  79. Procedure N[FSX,FSY,FS]
  80.    Gr Locate FSX,FSY
  81.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY : Draw To FSX+FS,FSY-(2*FS)
  82. End Proc
  83. Procedure O[FSX,FSY,FS]
  84.    Gr Locate FSX,FSY
  85.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY : Draw To FSX,FSY
  86. End Proc
  87. Procedure P[FSX,FSY,FS]
  88.    Gr Locate FSX,FSY
  89.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY-FS : Draw To FSX,FSY-FS
  90. End Proc
  91. Procedure Q[FSX,FSY,FS]
  92.    Gr Locate FSX,FSY
  93.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY : Draw To FSX,FSY
  94.    Gr Locate FSX,FSY-(0.5*FS)
  95.    Draw To FSX+FS,FSY+(0.5*FS)
  96. End Proc
  97. Procedure R[FSX,FSY,FS]
  98.    Gr Locate FSX,FSY
  99.    Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS) : Draw To FSX+FS,FSY-FS : Draw To FSX,FSY-FS : Draw To FSX+FS,FSY
  100. End Proc
  101. Procedure S[FSX,FSY,FS]
  102.    Gr Locate FSX,FSY
  103.    Draw To FSX+FS,FSY : Draw To FSX+FS,FSY-FS : Draw To FSX,FSY-FS : Draw To FSX,FSY-(2*FS) : Draw To FSX+FS,FSY-(2*FS)
  104. End Proc
  105. Procedure T[FSX,FSY,FS]
  106.    Gr Locate FSX,FSY-(2*FS)
  107.    Draw To FSX+FS,FSY-(2*FS)
  108.    Gr Locate FSX+(0.5*FS),FSY-(2*FS)
  109.    Draw To FSX+(0.5*FS),FSY
  110. End Proc
  111. Procedure U[FSX,FSY,FS]
  112.    Gr Locate FSX,FSY-(2*FS)
  113.    Draw To FSX,FSY : Draw To FSX+FS,FSY : Draw To FSX+FS,FSY-(2*FS)
  114. End Proc
  115. Procedure V[FSX,FSY,FS]
  116.    Gr Locate FSX,FSY-(2*FS)
  117.    Draw To FSX+(0.5*FS),FSY : Draw To FSX+FS,FSY-(2*FS)
  118. End Proc
  119. Procedure W[FSX,FSY,FS]
  120.    Gr Locate FSX,FSY-(2*FS)
  121.    Draw To FSX,FSY : Draw To FSX+(0.5*FS),FSY-FS : Draw To FSX+FS,FSY : Draw To FSX+FS,FSY-(2*FS)
  122. End Proc
  123. Procedure X[FSX,FSY,FS]
  124.    Gr Locate FSX,FSY
  125.    Draw To FSX+FS,FSY-(2*FS)
  126.    Gr Locate FSX,FSY-(2*FS)
  127.    Draw To FSX+FS,FSY
  128. End Proc
  129. Procedure Y[FSX,FSY,FS]
  130.    Gr Locate FSX,FSY-(2*FS)
  131.    Draw To FSX+(0.5*FS),FSY-FS : Draw To FSX+FS,FSY-(2*FS)
  132.    Gr Locate FSX+(0.5*FS),FSY-FS
  133.    Draw To FSX+(0.5*FS),FSY
  134. End Proc
  135. Procedure Z[FSX,FSY,FS]
  136.    Gr Locate FSX,FSY-(2*FS)
  137.    Draw To FSX+FS,FSY-(2*FS) : Draw To FSX,FSY : Draw To FSX+FS,FSY
  138. End Proc
  139. '
  140. Wait Key 
  141. '
  142. Procedure PRT_STR[A$,FSX,FSY,I,KERN]
  143.    Ink I
  144.    For N=1 To Len(A$)
  145.       U$=Mid$(A$,N,1)
  146.       If U$="A" Then Proc A[FSX,FSY,FS]
  147.       If U$="B" Then Proc B[FSX,FSY,FS]
  148.       If U$="C" Then Proc C[FSX,FSY,FS]
  149.       If U$="D" Then Proc D[FSX,FSY,FS]
  150.       If U$="E" Then Proc E[FSX,FSY,FS]
  151.       If U$="F" Then Proc F[FSX,FSY,FS]
  152.       If U$="G" Then Proc G[FSX,FSY,FS]
  153.       If U$="H" Then Proc H[FSX,FSY,FS]
  154.       If U$="I" Then Proc I[FSX,FSY,FS]
  155.       If U$="J" Then Proc J[FSX,FSY,FS]
  156.       If U$="K" Then Proc K[FSX,FSY,FS]
  157.       If U$="L" Then Proc L[FSX,FSY,FS]
  158.       If U$="M" Then Proc M[FSX,FSY,FS]
  159.       If U$="N" Then Proc N[FSX,FSY,FS]
  160.       If U$="O" Then Proc O[FSX,FSY,FS]
  161.       If U$="P" Then Proc P[FSX,FSY,FS]
  162.       If U$="Q" Then Proc Q[FSX,FSY,FS]
  163.       If U$="R" Then Proc R[FSX,FSY,FS]
  164.       If U$="S" Then Proc S[FSX,FSY,FS]
  165.       If U$="T" Then Proc T[FSX,FSY,FS]
  166.       If U$="U" Then Proc U[FSX,FSY,FS]
  167.       If U$="V" Then Proc V[FSX,FSY,FS]
  168.       If U$="W" Then Proc W[FSX,FSY,FS]
  169.       If U$="X" Then Proc X[FSX,FSY,FS]
  170.       If U$="Y" Then Proc Y[FSX,FSY,FS]
  171.       If U$="Z" Then Proc Z[FSX,FSY,FS]
  172.       Add FSX,KERN
  173.    Next N
  174. End Proc