home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 451-475 / apd472 / fontshower / fontshower.amos / fontshower.amosSourceCode < prev    next >
AMOS Source Code  |  1993-03-13  |  4KB  |  200 lines
  1. Rem Font Displayer 
  2. '
  3. Rem c. February 1993 
  4. '
  5. Set Buffer 20
  6. '
  7. Dim _TEMP$(200),_FONT$(200),_SIZE$(200)
  8. '
  9. Global _TEMP$(),_FONT$(),_SIZE$(),TF,NF,PO,T,CH,ST,SV,PF
  10. '
  11. Proc _INIT
  12. '
  13. Do 
  14.    '
  15.    If Key State(69) Then _QUIT
  16.    '
  17.    CH=Dialog(1)
  18.    '
  19.    If CH=1
  20.       CH=Rdialog(1,1)
  21.       _SHOW
  22.    Else If CH=3
  23.       CH=NF
  24.       _SHOW
  25.    Else If CH=4 and PF>NF
  26.       CH=PF-1
  27.       _SHOW
  28.    Else If CH=5 and PF<200
  29.       CH=PF+1
  30.       _SHOW
  31.    Else If CH=6
  32.       CH=200
  33.       _SHOW
  34.    Else If CH=7
  35.       _HRES
  36.    Else If CH=8
  37.       _LRES
  38.    Else If CH=9
  39.       _LRLA
  40.    Else If CH=10
  41.       _HRLA
  42.    Else If CH=11
  43.       _QUIT
  44.    End If 
  45.    '
  46. Loop 
  47. '
  48. Procedure _INIT
  49.    '
  50.    Get Fonts 
  51.    '
  52.    Resource Screen Open 0,640,512,0
  53.    '
  54.    Resource Bank 16
  55.    '
  56.    Palette $0,$666,$888,$FFF
  57.    '
  58.    Flash Off : Curs Off : Cls 2
  59.    '
  60.    Paste Bob 0,3,1
  61.    '
  62.    Repeat 
  63.       Inc TF
  64.       _TEMP$(TF)=Font$(TF)
  65.    Until Font$(TF)=""
  66.    '
  67.    Repeat 
  68.       Inc NF
  69.       _FONT$(NF)="  "+(Left$(_TEMP$(NF),25)-".font"-Chr$(32))
  70.       _SIZE$(NF)=Mid$(_TEMP$(NF),31,2)-Chr$(32)
  71.       If Len(_SIZE$(NF))=1 Then _SIZE$(NF)=" "+_SIZE$(NF)
  72.       _FONT$(NF)=_FONT$(NF)+Space$(64-Len(_FONT$(NF)))+_SIZE$(NF)
  73.    Until NF=200
  74.    '
  75.    Sort _FONT$(0)
  76.    '
  77.    NF=202-TF
  78.    '
  79.    PO=1
  80.    '
  81.    Proc _SLID
  82.    '
  83.    Proc _LRES
  84.    '
  85.    CH=NF
  86.    '
  87.    _SHOW
  88.    '
  89. End Proc
  90. Procedure _SLID
  91.    '
  92.    A$=A$+"AL  1,60, 48, 67,14,0 VA,2 VA,0, 1,3;[]"
  93.    A$=A$+"HS  2,45,162,549,10,0   ,1,1 VA,1;[ZC 1,ZP 2 VA+;]"
  94.    A$=A$+"BU  3, 64,173, 64,11,0,0,1;[UN 0,0,18 BP-;][BR 0;]"
  95.    A$=A$+"BU  4,128,173, 64,11,0,0,1;[UN 0,0,16 BP-;][BR 0;]"
  96.    A$=A$+"BU  5,448,173, 64,11,0,0,1;[UN 0,0,10 BP-;][BR 0;]"
  97.    A$=A$+"BU  6,512,173, 64,11,0,0,1;[UN 0,0, 8 BP-;][BR 0;]"
  98.    A$=A$+"BU  7,320,173,128,11,0,0,1;[UN 0,0,12 BP-;][BR 1; BC 8,0; BC  9,0; BC 10,0;]"
  99.    A$=A$+"BU  8,192,173,128,11,1,0,1;[UN 0,0,14 BP-;][BR 1; BC 7,0; BC  9,0; BC 10,0;]"
  100.    A$=A$+"BU  9,192,184,128,11,0,0,1;[UN 0,0, 6 BP-;][BR 1; BC 7,0; BC  8,0; BC 10,0;]"
  101.    A$=A$+"BU 10,320,184,128,11,0,0,1;[UN 0,0, 4 BP-;][BR 1; BC 7,0; BC  8,0; BC  9,0;]"
  102.    A$=A$+"BU 11,  8,  8, 56,17,0,0,1;[UN 0,0, 2 BP-;][BR 0;]"
  103.    A$=A$+"EX;"
  104.    '
  105.    Dialog Open 1,A$
  106.    '
  107.    Vdialog(1,0)=Array(_FONT$(0))
  108.    Vdialog(1,1)=TF-16
  109.    Vdialog(1,2)=202-TF
  110.    '
  111.    D=Dialog Run(1)
  112.    '
  113.    Ink 0 : Polyline 46,160 To 46,47 To 591,47 : Draw 45,160 To 45,47
  114.    Ink 3 : Polyline 47,160 To 592,160 To 592,47 : Draw 593,160 To 593,47
  115.    '
  116. End Proc
  117. Procedure _SHOW
  118.    '
  119.    BB=0
  120.    '
  121.    Repeat 
  122.       Inc BB
  123.    Until(Left$(Font$(BB),25)-".font"-Chr$(32))=(Left$(_FONT$(CH),25)-Chr$(32)) and((Mid$(Font$(BB),31,2)-Chr$(32))=(Right$(_FONT$(CH),2)-" "))
  124.    '
  125.    Set Font(BB)
  126.    '
  127.    PF=CH
  128.    '
  129.    Cls 2,50,180 To 590,250
  130.    '
  131.    T$=Left$(_FONT$(CH),25)-Chr$(32)+Chr$(32)+Right$(_FONT$(CH),2)
  132.    '
  133.    V=(ST-Text Length(T$))
  134.    V=V/2
  135.    '  
  136.    Ink 0,1 : Cls 1 : Text V,SV,T$
  137.    '
  138. End Proc
  139. Procedure _LRES
  140.    '
  141.    Screen Open 1,320,63,2,Lowres : Palette $0,$FFF : Curs Off : Cls 1
  142.    '
  143.    Screen Display 1,,239,,
  144.    '
  145.    ST=320 : SV=50
  146.    '
  147.    If PF>0
  148.       CH=PF
  149.       _SHOW
  150.    End If 
  151.    '
  152. End Proc
  153. Procedure _HRES
  154.    '
  155.    Screen Open 1,640,63,2,Hires : Palette $0,$FFF : Curs Off : Cls 1
  156.    '
  157.    Screen Display 1,,239,,
  158.    '
  159.    ST=640 : SV=50
  160.    '
  161.    If PF>0
  162.       CH=PF
  163.       _SHOW
  164.    End If 
  165.    '
  166. End Proc
  167. Procedure _LRLA
  168.    '
  169.    Screen Open 1,320,126,2,Lowres+Laced : Palette $0,$FFF : Curs Off : Cls 1
  170.    '
  171.    Screen Display 1,,239,,
  172.    '
  173.    ST=320 : SV=100
  174.    '
  175.    If PF>0
  176.       CH=PF
  177.       _SHOW
  178.    End If 
  179.    '
  180. End Proc
  181. Procedure _HRLA
  182.    '
  183.    Screen Open 1,640,126,2,Hires+Laced : Palette $0,$FFF : Curs Off : Cls 1
  184.    '
  185.    Screen Display 1,,239,,
  186.    '
  187.    ST=640 : SV=100
  188.    '
  189.    If PF>0
  190.       CH=PF
  191.       _SHOW
  192.    End If 
  193.    '
  194. End Proc
  195. Procedure _QUIT
  196.    Trap Reserve As Data 100,1000000000
  197.    Wait 15
  198.    Default 
  199.    Edit 
  200. End Proc