home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 551-575 / apd562 / fontute.amos / fontute.amosSourceCode < prev    next >
AMOS Source Code  |  1990-10-20  |  31KB  |  1,410 lines
  1. '----------------------------------------------------------------------------
  2. ' FONT DEMONSTRATOR by Gary O'Connor 
  3. ' AMOS Basic (c) Mandarin / Jawx 1990
  4. '----------------------------------------------------------------------------
  5. 'This programme requires the CLI to be left open on startup. 
  6. '
  7. Dim AB$(24),DD(24),CLD(24),AA$(24),MENYU$(59),ADVICE$(9),ABC$(25)
  8. Dim INF$(24),USE$(24),DR$(24),DRN$(24),DSKNAME$(24)
  9. Global FC,FS,MENYU$(),ADVICE$(),D$,LIM,DR$(),DRN$(),DSKNAME$(),DFAIL
  10. Global AA$(),ABC$(),CD$,MC2,SELF$,SELD$,CURD$,DFS,DCH,FTD,FTR,RTD,DNEED
  11. DFS=0 : DCH=0 : FTD=0 : FTR=0 : RTD=0
  12. For X=0 To 58
  13.    MENYU$(X)=""
  14. Next X
  15. For X=0 To 7
  16.    Read ADVICE$(X)
  17. Next X
  18. For X=0 To 19
  19.    INF$(X)=""
  20.    USE$(X)=""
  21.    DR$(X)=""
  22.    DRN$(X)=""
  23.    DSKNAME$(X)=""
  24. Next X
  25. Unpack 6 To 0
  26. 'Load Iff "df0:FontScreen.IFF",0 
  27. 'Spack 0 To 6
  28. Flash Off : Curs Off 
  29. SCR1OP
  30. Screen 0
  31. Limit Mouse 128,42 To 447,297
  32. GZONES
  33. 'Erase 7 
  34. Bank To Menu 7
  35. For X=0 To 15
  36.    CLD(X)=Colour(X)
  37. Next X
  38. CM=1 : Rem Colour Mode  
  39. IC=5 : Rem Ink Colour 
  40. PC=1 : Rem paper colour 
  41. SF=0 : Rem LowRes Screen
  42. BUILDMENU2
  43. 'BUILDMENUS
  44. 'Menu To Bank 7
  45. '----------------- 
  46. ' TEST loop
  47. '----------------- 
  48. STBG
  49. Pen 2 : Paper 0
  50. SPECCURCOLS
  51. Wait 100
  52. ALERT[" Select a Drive with menu!"]
  53. FLAG=1
  54. On Error Proc ERRFIX
  55. Resume Label MAIN
  56. MAIN:
  57. Do 
  58.    If FLAG=0
  59.       ALERT[" Choose Font or Drive with menu!"]
  60.    End If 
  61.    Repeat 
  62.       Curs Off 
  63.       YM=Y Mouse
  64.       If YM<62 and SF=1 Then Screen Hide 1 : SF=0
  65.       M=Mouse Click
  66.       If M=1
  67.          CHKMOUS
  68.       End If 
  69.       If M=2
  70.          If SF=1
  71.             Screen Hide 1
  72.             SF=0
  73.          End If 
  74.       End If 
  75.    Until Choice
  76.    On Choice(1) Proc HELP,GRABFONTS,MAKEFONT,MAKEFONT,MAKEFONT,CHMEN6
  77. Loop 
  78. '
  79. Data "                                                                   "
  80. Data "For all sizes of this font click `ALL' or click `ONE' then `OK'"
  81. Data "No disc font has been selected!"
  82. Data "Insert destination disc in df0: then click `OK'"
  83. Data "Creating `ram:fonts' directory!"
  84. Data "Insufficient Disc space to create `fonts' directory!"
  85. Data "Insufficient Disc space to continue!"
  86. Data "All done! - Click on `EXIT' to finish!"
  87. '
  88. Procedure ERRFIX
  89.    EN=Errn
  90.    If EN=20
  91.       REDALERT["Division by zero!"]
  92.       Wait 100
  93.       FLAG=0
  94.    End If 
  95.    If EN=88
  96.       MYALERT["Disc FULL!!!  Aborting operation!"]
  97.       Wait 100
  98.       Dir$=SD$
  99.       BUILDMENU2
  100.       AD$=ADVICE$(7)
  101.       MYALERT[AD$]
  102.       CMZ=0
  103.       While CMZ<>1
  104.          If Mouse Click=1
  105.             COPMOUS
  106.          End If 
  107.       Wend 
  108.       Screen Close 1
  109.       SCR1OP
  110.       Screen 0
  111.       MAKEFONT
  112.    End If 
  113.    Resume Label 
  114. End Proc
  115. '
  116. Procedure SCR1OP
  117.    Screen Open 1,640,110,16,Hires
  118.    Get Palette 0
  119.    Curs Off : Flash Off : Screen 1
  120.    Screen Display 1,132,68,640,105
  121.    Screen Hide 1
  122. End Proc
  123. '
  124. Procedure COPREQ
  125.    Shared CMZ,S$,KK$,SD$,F$,FS$,CD$,DD$,DIOK,DSKFR,R,CH,COPEASY,MENYU$(),ADVICE$(),NU,AD$,SELFT$,DR$(),DRN$(),LIM,DSKNAME$(),CMZ
  126.    Reserve Zone 4
  127.    Set Zone 1,36,50 To 90,60 : Set Zone 2,536,46 To 566,56
  128.    Set Zone 3,536,58 To 566,68 : Set Zone 4,572,46 To 600,68
  129.    'Load "FontDisc:CopyReq.abk" 
  130.    Paste Bob 1,8,1
  131.    Ink 11
  132.    Paint 538,48,1
  133.    Screen Show 1
  134.    Pen 8 : Paper 0
  135.    COPEASY=0
  136.    SD$=SELD$
  137.    F$="Topaz" : FS$="8"
  138.    If MENYU$(CH)>""
  139.       Q=Instr(Font$(CH)," ",2)
  140.       F$=Left$(Font$(CH),(Q-1))
  141.       FS$=Mid$(Font$(CH),30,3)
  142.    End If 
  143.    K=Val(FS$)
  144.    FS$=Str$(K)
  145.    LK=Len(FS$)
  146.    FS$=Right$(FS$,(LK-1))
  147.    Locate 17,4 : Print SD$
  148.    Locate 19,6 : Print F$
  149.    Locate 59,6 : Print FS$
  150.    Locate 64,4 : Print Dfree
  151.    LF=Len(F$)
  152.    FT$=Left$(Font$(CH),(LF-5))
  153.    Locate ,9
  154.    Volume 30
  155.    AD$=ADVICE$(1)
  156.    GC:
  157.    MYALERT[AD$]
  158.    CMZ=0 : NU=0
  159.    DCOPMOUS
  160.    If CMZ=2 Then NU=1
  161.    If CMZ=3 Then NU=2
  162.    If CMZ=1 Then Pop Proc
  163.    If NU=0 Then Goto GC
  164.    WUNMORE:
  165.    CHCOPY
  166.    If COPEASY=1
  167.       CMZ=0
  168.       DCOPMOUS
  169.       If CMZ=1
  170.          Pop Proc
  171.       End If 
  172.       Goto GDR
  173.    End If 
  174.    CHM=Chip Free : FAM=Fast Free
  175.    If CHM>50000 or FAM>50000
  176.       AD$=ADVICE$(4)
  177.       MYALERT[AD$]
  178.       CD$="ram:c/makedir ram:fonts"+Chr$(0)
  179.       DDOS
  180.       CD$="ram:c/makedir ram:fonts/"+FT$+Chr$(0)
  181.       AD$="Creating `ram:fonts/"+FT$+"' directory!"
  182.       MYALERT[AD$]
  183.       DDOS
  184.       If NU=1
  185.          CD$="ram:c/copy "+SD$+"fonts/"+FT$+"/"+FS$+" to ram:fonts/"+FT$+Chr$(0)
  186.          AD$="Copying "+SD$+"fonts/"+FT$+"/"+FS$+" to ram:fonts/"+FT$
  187.          MYALERT[AD$]
  188.          DDOS
  189.       End If 
  190.       If NU=2
  191.          CD$="ram:c/copy "+SD$+"fonts/"+FT$+" to ram:fonts/"+FT$+Chr$(0)
  192.          AD$="Copying "+SD$+"fonts/"+FT$+" to ram:fonts/"+FT$
  193.          MYALERT[AD$]
  194.          DDOS
  195.       End If 
  196.       CD$="ram:c/copy "+SD$+"fonts/"+F$+" to ram:fonts"+Chr$(0)
  197.       AD$="Copying "+SD$+"fonts/"+F$+" to ram:fonts"
  198.       MYALERT[AD$]
  199.       DDOS
  200.       CHCOPY
  201.       CMZ=0
  202.       DCOPMOUS
  203.       If CMZ=1
  204.          Pop Proc
  205.       End If 
  206.    End If 
  207.    GDR:
  208.    AD$="Checking memory requirements for transfer!"
  209.    MYALERT[AD$]
  210.    SIZES
  211.    MENINF
  212.    For X=1 To LIM
  213.       If Upper$(KK$)=Upper$(DR$(X))
  214.          Dir$=DRN$(X)
  215.          DD$=DRN$(X)
  216.       End If 
  217.    Next X
  218.    Wait 20
  219.    If DD$=SD$
  220.       Wait 50
  221.       Goto GDR
  222.    End If 
  223.    Pen 8 : Paper 0
  224.    Locate 17,11 : Print DD$
  225.    Locate 64,11 : Print Dfree
  226.    XX=Dfree
  227.    XXX=XX-DNEED
  228.    If XXX<0
  229.       AD$="Insufficient space for transfer. "+Str$(DNEED)+" bytes needed. Click `OK'"
  230.       MYALERT[AD$]
  231.       AGIN=1
  232.    Else 
  233.       AD$=Str$(DNEED)+" bytes required for transfer. Click `OK'"
  234.       MYALERT[AD$]
  235.       AGIN=0
  236.    End If 
  237.    CMZ=0
  238.    DCOPMOUS
  239.    If CMZ=1
  240.       Pop Proc
  241.    End If 
  242.    If AGIN=1
  243.       Locate 17,11 : Print Space$(20)
  244.       Locate 64,11 : Print Space$(6)
  245.       Goto WUNMORE
  246.    End If 
  247.    AD$="Do you wish to proceed? Click `EXIT' or `OK'"
  248.    MYALERT[AD$]
  249.    CMZ=0
  250.    DCOPMOUS
  251.    If CMZ=1
  252.       Pop Proc
  253.    End If 
  254.    E=Exist(DD$+"fonts")
  255.    If E<>-1
  256.       AD$="Creating `fonts' directory on your disc!"
  257.       MYALERT[AD$]
  258.       CD$="ram:c/makedir "+DD$+"fonts"+Chr$(0)
  259.       DDOS
  260.       Wait 50
  261.    End If 
  262.    Locate 17,11 : Print DD$
  263.    Locate 64,11 : Print Dfree
  264.    E=Exist(DD$+"fonts/"+FT$)
  265.    If E<>-1
  266.       If COPEASY=1
  267.          AD$="Creating fonts/"+FT$+" on your disc!"
  268.          MYALERT[AD$]
  269.          CD$="ram:c/makedir "+DD$+"fonts/"+FT$+Chr$(0)
  270.          DDOS
  271.          Wait 50
  272.       End If 
  273.    End If 
  274.    Locate 17,11 : Print DD$
  275.    Locate 64,11 : Print Dfree
  276.    AD$="Saving chosen font/s to your disc!"
  277.    MYALERT[AD$]
  278.    If COPEASY=1
  279.       If NU=1
  280.          CD$="ram:c/copy "+SD$+"fonts/"+FT$+"/"+FS$+" to "+DD$+"fonts/"+FT$+Chr$(0)
  281.          Locate 17,11 : Print DD$
  282.          Locate 64,11 : Print Dfree
  283.       End If 
  284.       If NU=2
  285.          CD$="ram:c/copy "+SD$+"fonts/"+FT$+" to "+DD$+"fonts/"+FT$+" all"+Chr$(0)
  286.          Locate 17,11 : Print DD$
  287.          Locate 64,11 : Print Dfree
  288.       End If 
  289.       AD$=CD$
  290.       MYALERT[AD$]
  291.       DDOS
  292.       Wait 50
  293.       CD$="ram:c/copy "+SD$+"fonts/"+F$+" to "+DD$+"fonts"+Chr$(0)
  294.       Locate 17,11 : Print DD$
  295.       Locate 64,11 : Print Dfree
  296.       AD$=CD$
  297.       MYALERT[AD$]
  298.       DDOS
  299.       Wait 50
  300.    End If 
  301.    If COPEASY=0
  302.       CD$="ram:c/copy ram:fonts to "+DD$+"fonts all"+Chr$(0)
  303.       AD$=CD$
  304.       MYALERT[AD$]
  305.       DDOS
  306.       Wait 50
  307.    End If 
  308.    Pen 8 : Paper 0
  309.    Locate 64,11 : Print Space$(6)
  310.    Locate 64,11 : Print Dfree
  311.    Dir$=SD$
  312.    BUILDMENU2
  313.    AD$=ADVICE$(7)
  314.    MYALERT[AD$]
  315.    CMZ=0
  316.    DCOPMOUS
  317.    If CMZ=1
  318.       Pop Proc
  319.    End If 
  320.    While CMZ<>1
  321.       If Mouse Click=1 Then COPMOUS
  322.    Wend 
  323. End Proc
  324. '
  325. Procedure FTRREQ
  326.    Shared CMZ,S$,KK$,F$,FS$,CD$,R,CH,COPEASY,MENYU$(),ADVICE$(),NU,AD$,SELFT$,DR$(),DRN$(),LIM,DSKNAME$()
  327.    Reserve Zone 4
  328.    Set Zone 1,36,50 To 90,60 : Set Zone 2,536,46 To 566,56
  329.    Set Zone 3,536,58 To 566,68 : Set Zone 4,572,46 To 600,68
  330.    'Load "FontDisc:CopyReq.abk" 
  331.    Paste Bob 1,8,1
  332.    Ink 11
  333.    Paint 538,48,1
  334.    Screen Show 1
  335.    Pen 8 : Paper 0
  336.    COPEASY=0
  337.    SD$=SELD$
  338.    F$="Topaz" : FS$="8"
  339.    If MENYU$(CH)>""
  340.       Q=Instr(Font$(CH)," ",2)
  341.       F$=Left$(Font$(CH),(Q-1))
  342.       FS$=Mid$(Font$(CH),30,3)
  343.    End If 
  344.    K=Val(FS$)
  345.    FS$=Str$(K)
  346.    LK=Len(FS$)
  347.    FS$=Right$(FS$,(LK-1))
  348.    Locate 17,4 : Print SD$
  349.    Locate 19,6 : Print F$
  350.    Locate 59,6 : Print FS$
  351.    Locate 64,4 : Print Dfree
  352.    LF=Len(F$)
  353.    FT$=Left$(Font$(CH),(LF-5))
  354.    Locate ,9
  355.    Volume 30
  356.    AD$=ADVICE$(1)
  357.    AGC:
  358.    MYALERT[AD$]
  359.    CMZ=0 : NU=0
  360.    DCOPMOUS
  361.    If CMZ=2 Then NU=1
  362.    If CMZ=3 Then NU=2
  363.    If CMZ=1 Then Pop Proc
  364.    If NU=0 Then Goto AGC
  365.    CHM=Chip Free : FAM=Fast Free
  366.    RAVAIL=CHM+FAM
  367.    AD$="Checking memory requirements for transfer!"
  368.    MYALERT[AD$]
  369.    SIZES
  370.    XX=RAVAIL
  371.    Pen 8 : Paper 0
  372.    Locate 17,11 : Print "RAM Disk:"
  373.    Locate 64,11 : Print RAVAIL
  374.    XXX=XX-DNEED
  375.    If XXX<0
  376.       AD$="Insufficient space for transfer. "+Str$(DNEED)+" bytes needed. Click `OK'"
  377.       MYALERT[AD$]
  378.       AGIN=1
  379.    Else 
  380.       AD$=Str$(DNEED)+" bytes required for transfer. Click `OK'"
  381.       MYALERT[AD$]
  382.       AGIN=0
  383.    End If 
  384.    CMZ=0
  385.    DCOPMOUS
  386.    If CMZ=1
  387.       Pop Proc
  388.    End If 
  389.    If AGIN=1
  390.       Locate 17,11 : Print Space$(20)
  391.       Locate 64,11 : Print Space$(6)
  392.       Pop Proc
  393.    End If 
  394.    E=Exist("Ram:fonts")
  395.    If E<>-1
  396.       AD$=ADVICE$(4)
  397.       MYALERT[AD$]
  398.       CD$="ram:c/makedir ram:fonts"+Chr$(0)
  399.       DDOS
  400.       Wait 50
  401.    End If 
  402.    E=Exist("Ram:fonts/"+FT$)
  403.    If E<>-1
  404.       AD$="Creating fonts/"+FT$+" in Ram:!"
  405.       MYALERT[AD$]
  406.       CD$="ram:c/makedir Ram:fonts/"+FT$+Chr$(0)
  407.       DDOS
  408.       Wait 50
  409.    End If 
  410.    AD$="Saving chosen font/s to Ram:!"
  411.    MYALERT[AD$]
  412.    If NU=1
  413.       CD$="ram:c/copy "+SD$+"fonts/"+FT$+"/"+FS$+" to Ram:fonts/"+FT$+Chr$(0)
  414.    End If 
  415.    If NU=2
  416.       CD$="ram:c/copy "+SD$+"fonts/"+FT$+" to ram:fonts/"+FT$+" all"+Chr$(0)
  417.    End If 
  418.    AD$=CD$
  419.    MYALERT[AD$]
  420.    DDOS
  421.    Wait 50
  422.    CD$="ram:c/copy "+SD$+"fonts/"+F$+" to ram:fonts"+Chr$(0)
  423.    AD$=CD$
  424.    MYALERT[AD$]
  425.    DDOS
  426.    Wait 50
  427.    Pen 8 : Paper 0
  428.    Dir$=SD$
  429.    CHM=Chip Free : FAM=Fast Free
  430.    RAVAIL=CHM+FAM
  431.    Locate 64,11 : Print Space$(7)
  432.    Locate 64,11 : Print RAVAIL
  433.    BUILDMENU2
  434.    AD$=ADVICE$(7)
  435.    MYALERT[AD$]
  436.    COPEASY=1
  437.    CMZ=0
  438.    DCOPMOUS
  439.    If CMZ=1
  440.       Pop Proc
  441.    End If 
  442.    While CMZ<>1
  443.       If Mouse Click=1 Then COPMOUS
  444.    Wend 
  445. End Proc
  446. '
  447. Procedure RTDREQ
  448.    Shared CMZ,S$,KK$,F$,FS$,CD$,RTDSK,R,CH,COPEASY,MENYU$(),ADVICE$(),NU,AD$,SELFT$,DR$(),DRN$(),LIM,DSKNAME$()
  449.    Reserve Zone 4
  450.    Set Zone 1,36,50 To 90,60 : Set Zone 2,536,46 To 566,56
  451.    Set Zone 3,536,58 To 566,68 : Set Zone 4,572,46 To 600,68
  452.    'Load "FontDisc:CopyReq.abk" 
  453.    Paste Bob 1,8,1
  454.    Ink 11
  455.    Paint 538,48,1
  456.    Screen Show 1
  457.    Pen 8 : Paper 0
  458.    COPEASY=0
  459.    SD$="Ram:"
  460.    F$="Fonts"
  461.    FS$=""
  462.    K=Val(FS$)
  463.    FS$=Str$(K)
  464.    LK=Len(FS$)
  465.    FS$=Right$(FS$,(LK-1))
  466.    Locate 17,4 : Print SD$
  467.    Locate 19,6 : Print F$
  468.    Locate 59,6 : Print FS$
  469.    Locate 64,4 : Print Dfree
  470.    Locate ,9
  471.    Volume 30
  472.    WUNMORETIME:
  473.    CHCOPY
  474.    CMZ=0
  475.    DCOPMOUS
  476.    If CMZ=1
  477.       Pop Proc
  478.    End If 
  479.    AGDR:
  480.    RTDSK=1
  481.    Wait 50
  482.    AD$="Checking memory requirements for transfer!"
  483.    MYALERT[AD$]
  484.    SIZES
  485.    RTDSK=0
  486.    MENINF
  487.    For X=1 To LIM
  488.       If Upper$(KK$)=Upper$(DR$(X))
  489.          Dir$=DRN$(X)
  490.          DD$=DRN$(X)
  491.       End If 
  492.    Next X
  493.    Wait 20
  494.    If DD$=SD$
  495.       Wait 50
  496.       Goto AGDR
  497.    End If 
  498.    Pen 8 : Paper 0
  499.    Locate 17,11 : Print DD$
  500.    Locate 64,11 : Print Dfree
  501.    XX=Dfree
  502.    XXX=XX-DNEED
  503.    If XXX<0
  504.       AD$="Insufficient space for transfer. "+Str$(DNEED)+" bytes needed. Click `OK'"
  505.       MYALERT[AD$]
  506.       AGIN=1
  507.    Else 
  508.       AD$=Str$(DNEED)+" bytes required for transfer. Click `OK'"
  509.       MYALERT[AD$]
  510.       AGIN=0
  511.    End If 
  512.    CMZ=0
  513.    DCOPMOUS
  514.    If CMZ=1
  515.       Pop Proc
  516.    End If 
  517.    If AGIN=1
  518.       Locate 17,11 : Print Space$(20)
  519.       Locate 64,11 : Print Space$(6)
  520.       Goto WUNMORETIME
  521.    End If 
  522.    AD$="Do you wish to proceed? Click `EXIT' or `OK'"
  523.    MYALERT[AD$]
  524.    CMZ=0
  525.    DCOPMOUS
  526.    If CMZ=1
  527.       Pop Proc
  528.    End If 
  529.    E=Exist(DD$+"fonts")
  530.    If E<>-1
  531.       AD$="Creating `fonts' directory on your disc!"
  532.       MYALERT[AD$]
  533.       CD$="ram:c/makedir "+DD$+"fonts"+Chr$(0)
  534.       DDOS
  535.       Wait 50
  536.    End If 
  537.    CD$="ram:c/copy ram:fonts to "+DD$+"fonts all quiet"+Chr$(0)
  538.    AD$=CD$
  539.    MYALERT[AD$]
  540.    DDOS
  541.    Wait 50
  542.    Pen 8 : Paper 0
  543.    Locate 64,11 : Print Space$(6)
  544.    Locate 64,11 : Print Dfree
  545.    Dir$=SD$
  546.    BUILDMENU2
  547.    E=Exist(SELD$)
  548.    If E<>-1
  549.       CDK:
  550.       AD$="Please replace "+SELD$+" in any drive and click OK"
  551.       MYALERT[AD$]
  552.       While Not Mouse Click=1
  553.       Wend 
  554.       COPMOUS
  555.       E=Exist(SELD$)
  556.       If E<>-1
  557.          Goto CDK
  558.       End If 
  559.    End If 
  560.    CD$="ram:c/assign fonts: "+SELD$+"fonts"+Chr$(0)
  561.    DDOS
  562.    MAKEFONTMENU
  563.    BUILDMENU2
  564.    Dir$=SELD$
  565.    CURD$=SELD$
  566.    MAKEMEN3
  567.    AD$=ADVICE$(7)
  568.    MYALERT[AD$]
  569.    CMZ=0
  570.    DCOPMOUS
  571.    If CMZ=1
  572.       Pop Proc
  573.    End If 
  574.    While CMZ<>1
  575.       If Mouse Click=1 Then COPMOUS
  576.    Wend 
  577. End Proc
  578. '
  579. Procedure SIZES
  580.    Shared SD$,F$,FS$,NU,R,CD$,RTDSK
  581.    Dim RS$(20)
  582.    'SD$=Source Disc 
  583.    'F$=Font with font apppended 
  584.    'FH$=Font
  585.    'FS$=Font size 
  586.    'NU if it equals 1, means one size only
  587.    '   if it equals 2 then copy all sizes.
  588.    'K=size of `.font' file
  589.    'K=combined sizes of all files 
  590.    'If RTDSK=1 thentransfer is the entire fonts directory in ram: 
  591.    If RTDSK=1 Then Goto DEWRAM
  592.    L=Len(F$)
  593.    FH$=Left$(F$,L-5)
  594.    CD$="ram:c/list >ram:KeyFile "+SD$+"fonts/"+F$+" nodates"+Chr$(0)
  595.    DDOS
  596.    EF=0 : L=O
  597.    Open In 1,"ram:KeyFile"
  598.    Set Input 10,-1
  599.    While EF=0
  600.       EF=Eof(1)
  601.       Exit If EF=-1
  602.       Input #1,DSIZ$
  603.       L=Instr(DSIZ$,F$)
  604.       If L>0
  605.          J$=Right$(DSIZ$,15)
  606.          K$=Left$(J$,6)
  607.          K=Val(K$)
  608.       End If 
  609.    Wend 
  610.    Close 1
  611.    '
  612.    If NU=1
  613.       CD$="ram:c/list >ram:KeyFile "+SD$+"fonts/"+FH$+"/"+FS$+" nodates"+Chr$(0)
  614.    End If 
  615.    If NU=2
  616.       CD$="ram:c/list >ram:KeyFile "+SD$+"fonts/"+FH$+" nodates"+Chr$(0)
  617.    End If 
  618.    DDOS
  619.    EF=0 : L=O
  620.    Open In 1,"ram:KeyFile"
  621.    Set Input 10,-1
  622.    KK=0
  623.    While EF=0
  624.       EF=Eof(1)
  625.       Exit If EF=-1
  626.       Input #1,DSIZ$
  627.       If NU=1
  628.          L=Instr(DSIZ$,FS$)
  629.       End If 
  630.       If NU=2
  631.          L=Len(DSIZ$)
  632.          If L<27
  633.             L=0
  634.             DSIZ$=""
  635.          End If 
  636.       End If 
  637.       If L>0
  638.          J$=Right$(DSIZ$,15)
  639.          K$=Left$(J$,6)
  640.          KK=KK+Val(K$)
  641.       End If 
  642.    Wend 
  643.    Close 1
  644.    DNEED=K+KK
  645.    Pop Proc
  646.    '
  647.    DEWRAM:
  648.    K=0 : KK=0
  649.    RINSTR$=".font"
  650.    CD$="ram:c/list >ram:KeyFile ram:fonts nodates"+Chr$(0)
  651.    DDOS
  652.    EF=0 : L=O : ZZ=1
  653.    Open In 1,"ram:KeyFile"
  654.    Set Input 10,-1
  655.    KK=0
  656.    While EF=0
  657.       EF=Eof(1)
  658.       Exit If EF=-1
  659.       Input #1,DSIZ$
  660.       L=Instr(DSIZ$,RINSTR$)
  661.       If L>0
  662.          J$=Right$(DSIZ$,15)
  663.          K$=Left$(J$,6)
  664.          KK=KK+Val(K$)
  665.          Z=Instr(DSIZ$,".")
  666.          If Z>1
  667.             RS$(ZZ)=Left$(DSIZ$,Z-1)
  668.             Inc ZZ
  669.          End If 
  670.       End If 
  671.    Wend 
  672.    Close 1
  673.    '
  674.    For X=1 To ZZ-1
  675.       CD$="ram:c/list >ram:KeyFile ram:fonts/"+RS$(X)+" nodates "+Chr$(0)
  676.       DDOS
  677.       EF=0 : L=O : ZZ=1
  678.       Open In 1,"ram:KeyFile"
  679.       Set Input 10,-1
  680.       KK=0
  681.       While EF=0
  682.          EF=Eof(1)
  683.          Exit If EF=-1
  684.          Input #1,DSIZ$
  685.          L=Len(DSIZ$)
  686.          If L<27
  687.             L=0
  688.             DSIZ$=""
  689.          End If 
  690.          If L>0
  691.             J$=Right$(DSIZ$,15)
  692.             K$=Left$(J$,6)
  693.             K=K+Val(K$)
  694.          End If 
  695.       Wend 
  696.       Close 1
  697.    Next X
  698.    DNEED=K+KK
  699. End Proc
  700. '
  701. Procedure ALE
  702. End Proc
  703. '
  704. Procedure CHCOPY
  705.    Shared KK$,AD$,CMZ,SELFT$,COPEASY,DR$(),DRN$(),LIM
  706.    COPEASY=0
  707.    E=Exist("Df1:")
  708.    F=Exist("Df2:")
  709.    If E=-1
  710.       AD$="Put Destination disc in df1: and click `OK'"
  711.       KK$="Df1:"
  712.       If Upper$(SELFT$)=Upper$(KK$)
  713.          AD$=ADVICE$(3)
  714.          KK$="Df0:"
  715.       End If 
  716.       COPEASY=1
  717.       Goto ALDUN
  718.    End If 
  719.    If(F=-1)
  720.       AD$="Put Destination disc in df2: and click `OK'"
  721.       KK$="Df2:"
  722.       If Upper$(SELFT$)=Upper$(KK$)
  723.          AD$=ADVICE$(3)
  724.          KK$="Df0:"
  725.       End If 
  726.       COPEASY=1
  727.    End If 
  728.    ALDUN:
  729.    If(E<>-1) and(F<>-1)
  730.       AD$=ADVICE$(3)
  731.       KK$="Df0:"
  732.    End If 
  733.    MYALERT[AD$]
  734. End Proc
  735. '
  736. Procedure DCOPMOUS
  737.    Shared CMZ,CH,MENYU$(),NU,CD$,AD$,COPEASY
  738.    While CMZ<>4
  739.       If Mouse Click=1 Then COPMOUS
  740.       If CMZ=1
  741.          If COPEASY=0
  742.             CD$="ram:c/delete ram:fonts all"+Chr$(0)
  743.             AD$="Deleting `ram:fonts'!"
  744.             MYALERT[AD$]
  745.             DDOS
  746.          End If 
  747.          Pop Proc
  748.       End If 
  749.       If CMZ=2 Then NU=1
  750.       If CMZ=3 Then NU=2
  751.    Wend 
  752. End Proc
  753. '
  754. Procedure COPMOUS
  755.    Shared CMZ,CH,MENYU$(),NU
  756.    CMZ=Mouse Zone
  757.    If CMZ=1
  758.       Ink 3
  759.       Paint 38,52,1
  760.       Ink 11
  761.       Paint 38,52,1
  762.       Pop Proc
  763.    End If 
  764.    If CMZ=2
  765.       Ink 11
  766.       Paint 538,60,1
  767.       Ink 3
  768.       Paint 538,48,1
  769.       NU=1
  770.       Pop Proc
  771.    End If 
  772.    If CMZ=3
  773.       Ink 11
  774.       Paint 538,48,1
  775.       Ink 3
  776.       Paint 538,60,1
  777.       NU=2
  778.       Pop Proc
  779.    End If 
  780.    If CMZ=4
  781.       Ink 3
  782.       Paint 574,48,1
  783.       Ink 11
  784.       Paint 574,48,1
  785.       Pop Proc
  786.    End If 
  787. End Proc
  788. '
  789. Procedure GZONES
  790.    Reserve Zone 16
  791.    Set Zone 1,26,205 To 71,215 : Set Zone 2,245,205 To 291,215
  792.    For X=1 To 14
  793.       Set Zone(X+2),(X*20),219 To((X*20)+18),245
  794.    Next X
  795. End Proc
  796. '
  797. Procedure HELP
  798.    Shared FLAG
  799.    FLAG=1
  800. End Proc
  801. '
  802. Procedure CHKMOUS
  803.    Shared SF,CM,IC,PC
  804.    MZ=Mouse Zone
  805.    If MZ>0 Then Goto DCOLOURS
  806.    If SF=1
  807.       Screen Hide 1
  808.       SF=0
  809.       Goto ENM
  810.    End If 
  811.    If SF=0
  812.       Screen Show 1
  813.       SF=1
  814.       Goto ENM
  815.    End If 
  816.    DCOLOURS:
  817.    Curs Off 
  818.    If MZ=1
  819.       CM=1
  820.       Ink 14
  821.       Paint 247,207,1
  822.       Ink 16
  823.       Paint 28,207,1
  824.       FCOLS
  825.    End If 
  826.    If MZ=2
  827.       CM=2
  828.       Ink 14
  829.       Paint 28,207,1
  830.       Ink 16
  831.       Paint 247,207,1
  832.       FCOLS
  833.    End If 
  834.    If MZ>2
  835.       If CM=1
  836.          Ink 14
  837.          Paint((IC*20)+2),221,1
  838.          IC=MZ-2
  839.          Ink 16
  840.          Paint((IC*20)+2),221,1
  841.       End If 
  842.       If CM=2
  843.          Ink 14
  844.          Paint((PC*20)+2),221,1
  845.          PC=MZ-2
  846.          Ink 16
  847.          Paint((PC*20)+2),221,1
  848.       End If 
  849.       SPECCURCOLS
  850.    End If 
  851.    ENM:
  852. End Proc
  853. '
  854. Procedure FCOLS
  855.    Shared IC,PC,CM
  856.    If CM=1
  857.       Ink 14
  858.       Paint((PC*20)+2),221,1
  859.       Ink 16
  860.       Paint((IC*20)+2),221,1
  861.    End If 
  862.    If CM=2
  863.       Ink 14
  864.       Paint((IC*20)+2),221,1
  865.       Ink 16
  866.       Paint((PC*20)+2),221,1
  867.    End If 
  868. End Proc
  869. '
  870. Procedure CHKASSIGN
  871.    Shared ABC,DSKNAME$(),MC2
  872.    CASS$=""
  873.    CD$="ram:c/assign >ram:AssFile"+Chr$(0)
  874.    DDOS
  875.    ST=1 : EF=0
  876.    Open In 1,"ram:AssFile"
  877.    Set Input 10,-1
  878.    While EF=0
  879.       EF=Eof(1)
  880.       Exit If EF=-1
  881.       Input #1,CASS$ : Rem ABC$(ST) 
  882.       Exit If Upper$(Left$(CASS$,5))="FONTS"
  883.       Inc ST
  884.    Wend 
  885.    Close 1
  886.    ABC=0
  887.    L=Instr(Upper$(CASS$),Upper$(DSKNAME$(MC2)))
  888.    If L=0 Then Pop Proc
  889.    ABC=5
  890. End Proc
  891. '
  892. Procedure MENINF
  893.    Shared DR$(),DRN$(),INF$(),USE$(),CD$,LIM,AB$(),R
  894.    For X=0 To 19
  895.       INF$(X)=""
  896.       USE$(X)=""
  897.       DR$(X)=""
  898.       DRN$(X)=""
  899.    Next X
  900.    CD$="ram:c/info >ram:InfoFile"+Chr$(0)
  901.    DDOS
  902.    '
  903.    ST=1 : EF=0 : Z=1
  904.    Open In 1,"ram:InfoFile"
  905.    Set Input 10,-1
  906.    While EF=0
  907.       EF=Eof(1)
  908.       Exit If EF=-1
  909.       Input #1,INF$(ST)
  910.       Inc ST
  911.    Wend 
  912.    Close 1
  913.    ST=ST-1 : Rem ********** Remove count added at end of file.    
  914.    Rem           ********** We dont need the set up in the first three strings.     
  915.    Rem           ********** The first string was a null string, and then there  
  916.    Rem           ********** is another null string before the volume names. We  
  917.    Rem           ********** only want the strings between these two, so   
  918.    For X=4 To ST : Rem **** Ignore the first three strings.       
  919.       Rem ******************** Go past the first null string and then    
  920.       If INF$(X)="" : Rem **** find the next one.    
  921.          LIM=X-1 : Rem ****** So we have `LIM' number of useful strings.    
  922.          Goto DUN
  923.       End If 
  924.       USE$(X-3)=INF$(X) : Rem  Make the `USE'ful strings.    
  925.    Next X
  926.    DUN:
  927.    LIM=LIM-3 : Rem ******** Remove the count for the first three strings    
  928.    For X=1 To LIM
  929.       L=Len(USE$(X))
  930.       If L>52
  931.          DRN$(X)=Right$(USE$(X),L-52)+":"
  932.       Else 
  933.          DRN$(X)=""
  934.       End If 
  935.       DR$(X)=Left$(USE$(X),4)
  936.    Next X
  937. End Proc
  938. '
  939. Procedure DSKIN
  940.    Shared CDRN$,AA$(),MC2
  941.    CD$="ram:c/info >ram:InfoFile"+Chr$(0)
  942.    DDOS
  943.    '
  944.    ST=1 : EF=0
  945.    Open In 1,"ram:InfoFile"
  946.    Set Input 10,-1
  947.    While EF=0
  948.       EF=Eof(1)
  949.       Exit If EF=-1
  950.       Input #1,CHD$
  951.       L=Instr(CHD$,AA$(MC2))
  952.       Exit If L>0
  953.       Inc ST
  954.    Wend 
  955.    Close 1
  956.    If L>0 Then Goto ISTHERE
  957.    Pop Proc
  958.    ISTHERE:
  959.    L=Len(CHD$)
  960.    If L<53
  961.       CDRN$=""
  962.       Pop Proc
  963.    End If 
  964.    CDRN$=Right$(CHD$,L-52)+":"
  965. End Proc
  966. '
  967. Procedure BUILDMENU2
  968.    Shared AB$(),DD(),AA$(),LIM,DR$(),DRN$(),DSKNAME$()
  969.    Screen 0
  970.    For X=0 To 23
  971.       AB$(X)=""
  972.    Next X
  973.    MENINF
  974.    Pen 2 : Paper 0
  975.    Menu Off : Y=1
  976.    For X=1 To 23
  977.       Read AB$(X)
  978.    Next X
  979.    Menu$(2)="(IN 1,5:IN 2,8)Dir "
  980.    For X=1 To 23
  981.       For Z=1 To LIM
  982.          If Upper$(DR$(Z))=Upper$(AB$(X))
  983.             Menu$(2,Y)=DR$(Z)+"  "+DRN$(Z)
  984.             AA$(Y)=DR$(Z)
  985.             DSKNAME$(Y)=DRN$(Z)
  986.             Inc Y
  987.          End If 
  988.       Next Z
  989.    Next X
  990.    Menu On 
  991.    '
  992.    Data "df0:","df1:","df2:","df3:","dh0:","dh1:","dh2:","dh3:","dh4:","dh5:","dh6:","dh7:","dh8:","dh9:"
  993.    Data "fh0:","fh1:","fh2:","fh3:","ram:","rad:","di0:","di1:","di2:"
  994. End Proc
  995. '
  996. Procedure BUILDMENUS
  997.    Screen 0
  998.    Pen 2 : Paper 0
  999.    Menu$(1)="(IN 1,5:IN 2,8)H "
  1000.    MAKEMEN3
  1001.    Menu$(4)="(IN 1,5:IN 2,8)Fnts1 "
  1002.    Menu$(5)="(IN 1,5:IN 2,8)Fnts2 "
  1003.    Menu$(6)="(IN 1,5:IN 2,8)Control "
  1004.    Menu$(7)="(IN 1,5:IN 2,8)          "
  1005.    Menu$(6,1)="(IN 1,3)Quit"
  1006.    Menu$(6,2)="(IN 1,5)Copy font to Disc"
  1007.    Menu$(6,3)="(IN 1,5)Copy font to Ram"
  1008.    Menu$(6,4)="(IN 1,5)Copy Ram to Disc"
  1009.    Menu$(1,1)=" 1.   This programme gets the fonts "
  1010.    Menu$(1,2)="     from the currently ASSIGNed fonts"
  1011.    Menu$(1,3)="     directory. We use DOSCALL to call"
  1012.    Menu$(1,4)="     the CLI's ASSIGN command for the"
  1013.    Menu$(1,5)="     fonts dir on the disc you select "
  1014.    Menu$(1,6)="     from Menu 2. For some reason it "
  1015.    Menu$(1,7)="     will not work on all discs, even "
  1016.    Menu$(1,8)="     if they have a fonts directory, so"
  1017.    Menu$(1,9)="     there will be some fonts you "
  1018.    Menu$(1,10)="     cannot see with this programme!"
  1019.    Menu$(1,11)="     -----------------------------"
  1020.    Menu$(1,12)=" 2.  Click the left MOUSE button to"
  1021.    Menu$(1,13)="     alternate between LO and HI "
  1022.    Menu$(1,14)="     Resolution. "
  1023.    Menu$(1,15)="     -----------------------------"
  1024.    Menu$(1,16)=" 3.  Select Paper and Pen colours "
  1025.    Menu$(1,17)="     with the buttons."
  1026.    Menu$(1,18)="     -----------------------------"
  1027.    Menu$(1,19)=" 4.  When you open the FONT menu, the"
  1028.    Menu$(1,20)="     number on the left is the FONT"
  1029.    Menu$(1,21)="     number, the number on the right is"
  1030.    Menu$(1,22)="     the height of the FONT in pixels."
  1031.    Menu$(1,23)="     -----------------------------"
  1032.    Menu$(1,24)=" 5.  To view fonts, they must be in the"
  1033.    Menu$(1,25)="     `fonts' directory on a disc."
  1034.    Menu$(1,26)="     -----------------------------"
  1035.    Menu$(1,27)=" 6.  This programme allows you to view"
  1036.    Menu$(1,28)="     a directory with up to 58 fonts."
  1037.    Menu$(1,29)="---------------------------------------"
  1038.    Menu$(1,30)="  Written by Gary O'Connor using Amos!"
  1039.    Menu On 
  1040. End Proc
  1041. '
  1042. Procedure MAKEMEN3
  1043.    Menu$(3)="(IN 1,5:IN 2,8)Sel "
  1044.    Menu$(3,1)="(IN 1,5:IN 2,4:IN 3,9)   -:Current Selections:-   "
  1045.    Menu$(3,2)="(IN 1,3:IN 2,4)----------------------------"
  1046.    Menu$(3,3)="(IN 1,5:IN 2,8)   Font = "+SELF$
  1047.    Menu$(3,4)="(IN 1,5:IN 2,8) Source = "+SELD$
  1048.    Menu$(3,5)="(IN 1,3:IN 2,4)----------------------------"
  1049.    Menu$(3,6)="(IN 1,3:IN 2,7)Cur/Dir = "+CURD$
  1050. End Proc
  1051. '
  1052. Procedure MAKEFONTMENU
  1053.    Shared FC,FS
  1054.    Shared MENYU$()
  1055.    Screen 0
  1056.    Pen 2 : Paper 0
  1057.    GF=1 : FT=0
  1058.    If FS>0 Then Set Font 2
  1059.    Get Fonts 
  1060.    FC=2
  1061.    Menu Off 
  1062.    Set Font 2
  1063.    Menu Del(4) : Menu Del(5)
  1064.    Menu$(4)="(IN 1,5:IN 2,8)Fnts1 "
  1065.    Menu$(5)="(IN 1,5:IN 2,8)Fnts2 "
  1066.    For X=1 To 58
  1067.       If X<30
  1068.          Menu$(4,X)=""
  1069.       End If 
  1070.       If X>29
  1071.          Menu$(5,X-29)=""
  1072.       End If 
  1073.       MENYU$(X)=""
  1074.    Next X
  1075.    Do 
  1076.       Exit If Font$(GF)=""
  1077.       If Font$(GF)<>""
  1078.          FT=FT+1
  1079.          FT$=Str$(FT)
  1080.          LFT=Len(FT$)
  1081.          If LFT>2
  1082.             FT$=Right$(FT$,(LFT-1))
  1083.          End If 
  1084.          FT$=FT$+" "
  1085.          MENYU$(GF)=FT$+Left$(Font$(GF),15)+Mid$(Font$(GF),30,3)
  1086.          GF=GF+1
  1087.       End If 
  1088.    Loop 
  1089.    For X=1 To 58
  1090.       If X=3
  1091.          If DFS=1 : Rem     *** if a disc font has been selected   
  1092.             If DCH=2 : Rem   *** and we've since changed directories  
  1093.                Goto DX : Rem *** then we dont want this entry!  
  1094.             End If 
  1095.          End If 
  1096.       End If 
  1097.       If X<30
  1098.          Menu$(4,X)=MENYU$(X)
  1099.       End If 
  1100.       If X>29
  1101.          Menu$(5,X-29)=MENYU$(X)
  1102.       End If 
  1103.       DX:
  1104.    Next 
  1105.    Menu On 
  1106.    FS=1
  1107. End Proc
  1108. '
  1109. Procedure CLEERFONTMENU
  1110.    Shared FC,FS
  1111.    Shared MENYU$()
  1112.    Screen 0
  1113.    Pen 2 : Paper 0
  1114.    If FS>0 Then Set Font 2
  1115.    Menu Off 
  1116.    Set Font 2
  1117.    Menu Del(4) : Menu Del(5)
  1118.    Menu$(4)="(IN 1,5:IN 2,8)Fnts1 "
  1119.    Menu$(5)="(IN 1,5:IN 3,8)Fnts2 "
  1120.    For X=1 To 58
  1121.       If X<30
  1122.          Menu$(4,X)=""
  1123.       End If 
  1124.       If X>29
  1125.          Menu$(5,X-29)=""
  1126.       End If 
  1127.       MENYU$(X)=""
  1128.    Next X
  1129.    Menu On 
  1130. End Proc
  1131. '
  1132. Procedure GRABFONTS
  1133.    Shared AA$(),CDRN$,FLAG,FC,CD$,R,SELFT$,DR$(),DRN$(),LIM,DSKNAME$(),MC2,ABC
  1134.    BUILDMENU2
  1135.    MC2=Choice(2)
  1136.    If FC=2 Then Set Font 0
  1137.    DSKIN
  1138.    If CDRN$=""
  1139.       ALERT["No disc present in "+AA$(MC2)]
  1140.       Wait 100
  1141.       FLAG=0
  1142.       Pop Proc
  1143.    End If 
  1144.    ALERT["Checking "+AA$(MC2)+" for `fonts' dir"]
  1145.    D=Exist(AA$(MC2)+"Fonts/")
  1146.    Wait 50
  1147.    If D=0
  1148.       ALERT[" Drive "+AA$(MC2)+" has no fonts dir"]
  1149.       Wait 100
  1150.       FLAG=0
  1151.       Pop Proc
  1152.    End If 
  1153.    ALERT["Attempting to ASSIGN `fonts' dir"]
  1154.    Dir$=DSKNAME$(MC2)
  1155.    SELFT$=AA$(MC2)
  1156.    '
  1157.    Rem ****** Use the CLI to `assign' the `fonts' directory ******
  1158.    CD$="ram:c/assign fonts: "+AA$(MC2)+"fonts"+Chr$(0)
  1159.    DDOS
  1160.    '
  1161.    If R=-1
  1162.       CHKASSIGN
  1163.       If ABC=0
  1164.          ALERT["Fonts present but not available"]
  1165.          Wait 100
  1166.          REDALERT["Assign failed!!!"]
  1167.          Wait 100
  1168.          ALERT["Try another disc!"]
  1169.          Wait 100
  1170.          FLAG=0
  1171.          If FS>0
  1172.             CLEERFONTMENU
  1173.          End If 
  1174.          Pop Proc
  1175.       End If 
  1176.       ALERT[" Getting "+AA$(MC2)+"Fonts"]
  1177.       If FS=1
  1178.          FS=2
  1179.       End If 
  1180.       CURD$=DSKNAME$(MC2)
  1181.       If DCH=0
  1182.          DCH=1
  1183.       Else 
  1184.          DCH=2
  1185.       End If 
  1186.       Menu Off 
  1187.       Menu Del(3)
  1188.       MAKEMEN3
  1189.       Menu On 
  1190.    Else 
  1191.       ALERT[" Drive df0: has no fonts dir"]
  1192.       BUILDMENU2
  1193.       Pop Proc
  1194.    End If 
  1195.    MAKEFONTMENU
  1196.    FLAG=0
  1197. End Proc
  1198. '
  1199. Procedure DDOS
  1200.    Shared CD$,R
  1201.    Rem **** Accessing CLI commands from AmosBasic ******* 
  1202.    DFAIL=0
  1203.    Dreg(0)=0
  1204.    Dreg(1)=Varptr(CD$) : Rem ** Put the address of the command string in D1 **
  1205.    Dreg(2)=0
  1206.    Dreg(3)=0
  1207.    R=Doscall(-222) : Rem *** -222 is the offset for the DOS execute function ***
  1208.    Rem ****** If it worked `R' will equal -1 ****** 
  1209.    If R<>-1
  1210.       DFAILED
  1211.    End If 
  1212. End Proc
  1213. '
  1214. Procedure DFAILED
  1215.    Shared AD$
  1216.    AD$="DOS command failed! Aborting!!"
  1217.    MYALERT[AD$]
  1218.    Wait 100
  1219.    DFAIL=1
  1220. End Proc
  1221. '
  1222. Procedure ALERT[A$]
  1223.    Volume 30 : Bell 60
  1224.    Screen 0
  1225.    Pen 2 : Paper 0
  1226.    Centre At(,19)+Space$(32)
  1227.    Centre At(,19)+A$
  1228.    FLAG=1
  1229. End Proc
  1230. '
  1231. Procedure REDALERT[A$]
  1232.    Volume 30 : Bell 60
  1233.    Screen 0
  1234.    Pen 3 : Paper 0
  1235.    Centre At(,19)+Space$(32)
  1236.    Centre At(,19)+A$
  1237.    FLAG=1
  1238. End Proc
  1239. '
  1240. Procedure MYALERT[A$]
  1241.    Shared AD$,ADVICE$()
  1242.    Volume 30 : Bell 60
  1243.    Screen 1
  1244.    Pen 8 : Paper 0
  1245.    Centre At(,9)+ADVICE$(0)
  1246.    Centre At(,9)+AD$
  1247. End Proc
  1248. '
  1249. Procedure STBG
  1250.    Screen 0
  1251.    Ink 0
  1252.    Bar 0,26 To 320,130
  1253.    Ink 1
  1254.    Bar 0,26 To 319,130
  1255.    Screen 1
  1256.    Ink 1
  1257.    Bar 10,10 To 629,105
  1258.    Screen 0
  1259. End Proc
  1260. '
  1261. Procedure MAKEFONT
  1262.    Shared FLAG,IC,CH,PC,DN,OP,MENYU$(),DFS,MC2,DSKNAME$()
  1263.    If Choice(2)<1 Then Pop Proc
  1264.    If(Choice(1)=3) Then Pop Proc
  1265.    If Choice(1)=4 Then CH=Choice(2)
  1266.    If Choice(1)=5 Then CH=Choice(2)+29
  1267.    If FS=2 and CH>2 Then CH=CH+1
  1268.    If CH<3 Then SELD$="ROM"
  1269.    If CH>2 Then DFS=1
  1270.    SELF$=Left$(Font$(CH),15)
  1271.    SELF$=SELF$+Mid$(Font$(CH),30,3)
  1272.    If CH>2 Then SELD$=DSKNAME$(MC2)
  1273.    Menu Off 
  1274.    Menu Del(3)
  1275.    MAKEMEN3
  1276.    Menu On 
  1277.    If Choice(2)=0
  1278.       ALERT[" No font selected!"]
  1279.       Wait 70
  1280.       Pop Proc
  1281.    End If 
  1282.    DFNT:
  1283.    FF$=Left$(Font$(CH),15)
  1284.    FF$="Loading "+FF$+Mid$(Font$(CH),30,3)
  1285.    ALERT[FF$]
  1286.    FLAG=False : OP=1
  1287.    Screen 0
  1288.    Curs Off 
  1289.    Ink 1
  1290.    Bar 0,26 To 319,130
  1291.    Screen 1
  1292.    Curs Off 
  1293.    Ink 1
  1294.    Bar 10,10 To 629,105
  1295.    Screen 0
  1296.    Ink 15,1
  1297.    Set Font(CH)
  1298.    P$="Amos Basic"
  1299.    Q$="Does it in LoRes!!"
  1300.    W=Text Length(P$)
  1301.    WW=(320-W)/2
  1302.    V=Text Length(Q$)
  1303.    VV=(320-V)/2
  1304.    Text WW,70,P$
  1305.    Text VV,121,Q$
  1306.    Screen 1
  1307.    Q$="Does it in HiRes!!"
  1308.    Ink 15,1
  1309.    Set Font(CH)
  1310.    WW=(640-W)/2
  1311.    VV=(640-V)/2
  1312.    Text WW,44,P$
  1313.    Text VV,95,Q$
  1314.    Screen 0
  1315.    Set Font 2
  1316.    If CH<>3 Then FS=1
  1317.    ALERT[" Choose Font or Drive with menu!"]
  1318.    FLAG=1
  1319. End Proc
  1320. '
  1321. Procedure CHMEN6
  1322.    Shared IC,CH,PC,DN,OP,FLAG,DFS,A$,FLAG
  1323.    If Choice(2)=1
  1324.       Screen Close 1
  1325.       Screen Close 0
  1326.       End 
  1327.    End If 
  1328.    If Choice(2)=2
  1329.       If DFS=0
  1330.          A$="No disc font selected!"
  1331.          ALERT[A$]
  1332.          Wait 75
  1333.          FLAG=0
  1334.          Pop Proc
  1335.       End If 
  1336.       Screen Close 1
  1337.       SCR1OP
  1338.       FTD=1 : FTR=0 : RTD=0
  1339.       COPREQ
  1340.       Screen Close 1
  1341.       SCR1OP
  1342.       Screen 0
  1343.       MAKEFONT
  1344.    End If 
  1345.    If Choice(2)=3
  1346.       If DFS=0
  1347.          A$="No disc font selected!"
  1348.          ALERT[A$]
  1349.          Wait 75
  1350.          FLAG=0
  1351.          Pop Proc
  1352.       End If 
  1353.       Screen Close 1
  1354.       SCR1OP
  1355.       FTR=1 : FTD=0 : RTD=0
  1356.       FTRREQ
  1357.       Screen Close 1
  1358.       SCR1OP
  1359.       Screen 0
  1360.       MAKEFONT
  1361.    End If 
  1362.    If Choice(2)=4
  1363.       If DFS=0
  1364.          A$="No disc font selected!"
  1365.          ALERT[A$]
  1366.          Wait 75
  1367.          FLAG=0
  1368.          Pop Proc
  1369.       End If 
  1370.       Screen Close 1
  1371.       SCR1OP
  1372.       RTD=1 : FTD=0 : FTR=0
  1373.       RTDREQ
  1374.       Screen Close 1
  1375.       SCR1OP
  1376.       Screen 0
  1377.       MAKEFONT
  1378.    End If 
  1379.    DN=0
  1380.    FLAG=1
  1381. End Proc
  1382. '
  1383. Procedure SPECCURCOLS
  1384.    Shared IC,PC
  1385.    NEWCOLOURS
  1386.    Screen 0
  1387.    BL$=Space$(29)
  1388.    Pen 0 : Paper 0
  1389.    Centre At(,23)+Border$(BL$,1)
  1390.    Pen IC : Paper PC
  1391.    CI$=" Current Pen : "+Str$(IC)
  1392.    CP$="  Paper :"+Str$(PC)
  1393.    CC$=CI$+CP$
  1394.    Centre At(,23)+Border$(CC$,1)
  1395.    Curs Off 
  1396. End Proc
  1397. '
  1398. Procedure NEWCOLOURS
  1399.    Shared IC,PC,CLD()
  1400.    BG=CLD(PC)
  1401.    FG=CLD(IC)
  1402.    Screen 0
  1403.    Curs Off 
  1404.    Colour 1,BG
  1405.    Colour 15,FG
  1406.    Screen 1
  1407.    Colour 1,BG
  1408.    Colour 15,FG
  1409. End Proc
  1410. '