home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 501-525 / apd511 / fontreq.amos / fontreq.amosSourceCode
AMOS Source Code  |  1991-01-18  |  8KB  |  267 lines
  1. '--------------------------------------------------------------------
  2. ' FontReq  
  3. '
  4. ' A Font Requester.
  5. '
  6. ' * Has a show area (like DPaint III), and a drag bar (Top area) 
  7. ' * Specify number of fonts displayed. 
  8. ' * XY addressable, easy auto-centering. 
  9. ' * Works with a four colour screen, or greater. (it aint pretty)
  10. ' * Works in Hires or Lowres.  
  11. ' * Saves background & callers palette (has its own fixed palette) 
  12. '
  13. ' Look inside SELECTFONT for parameter details.
  14. '
  15. ' Robert Farnsworth
  16. ' 1 Vidovic Ave, Mildura, 3500 
  17. ' Jan. 91. 
  18. '------------------------------------------------------------------- 
  19. '
  20. Screen Open 0,640,256,16,Hires
  21. Curs Off : Flash Off 
  22. Reserve Zone 6
  23. '
  24. Global SELECTEDFONT
  25. ' --- Default font - Topaz 8 
  26. SELECTEDFONT=2
  27. '
  28. INITFONTS
  29. Do 
  30.    Draw 0,0 To 640,256 : Draw 0,256 To 640,0
  31.    SELECTFONT[0,0,0,SELECTEDFONT,8]
  32.    Set Font SELECTEDFONT
  33.    '
  34.    Print At(0,0);Font$(SELECTEDFONT)
  35.    Ink 2,1
  36.    Text 0,Screen Height/2,Font$(SELECTEDFONT)
  37. Loop 
  38. End 
  39. '
  40. '---------------- Font Requester routines -------------  
  41. '  
  42. Procedure INITFONTS
  43.    ' --- Read the fonts.
  44.    Shared LASTNAME
  45.    ' --- Load the fonts 
  46.    Get Fonts 
  47.    ' how many fonts?
  48.    F=1
  49.    While Font$(F)<>""
  50.       Inc F
  51.    Wend 
  52.    LASTNAME=F-1
  53. End Proc
  54. '
  55. Procedure SELECTFONT[X,Y,SCR,OLDFONT,LINES]
  56.    '
  57.    ' Font requester.
  58.    '  
  59.    ' Requires at least a 4 colour screen. 
  60.    ' INITFONTS must be called first.
  61.    '  
  62.    ' X,Y       Coords of top left corner. If zero, requester is centered. 
  63.    ' SCR       Screen number for the requester, pops this screen to front.
  64.    ' OLDFONT   The number of the font that is being used prior to calling 
  65.    '           this routine.
  66.    ' LINES     The number of text lines for displaying font names, mimimum  
  67.    '           of four. 
  68.    ' RETURNS:  SELECTEDFONT (Global) with the number of the font that is
  69.    '           chosen. See comments near the end of this routine
  70.    '           for alternative approach.
  71.    '
  72.    Shared LASTNAME,SELECTEDFONT
  73.    '
  74.    Screen SCR
  75.    Screen To Front SCR
  76.    Set Font 2 : Rem Topaz 8
  77.    Set Text 0
  78.    ' --- Setup our own palette  
  79.    Dim P(4)
  80.    For C=0 To 3 : P(C)=Colour(C) : Next 
  81.    Palette ,,$DDD,$0
  82.    ' --- You may need to change this ---
  83.    Reset Zone 
  84.    Reserve Zone 6
  85.    '  
  86.    LINES=Max(4,LINES)
  87.    WIDTH=240 : HEIGHT=62+LINES*8
  88.    ' --- Centre requester if X or Y are zero
  89.    If X=0 Then X=Screen Width/2-WIDTH/2
  90.    If Y=0 Then Y=Screen Height/2-HEIGHT/2
  91.    X1=X : X2=X1+WIDTH : Y1=Y : Y2=Y1+HEIGHT
  92.    ' --- save background ---
  93.    Get Block 1,X1,Y1,WIDTH/16*16+16,HEIGHT+1
  94.    '------------ Draw the body ---------
  95.    Ink 2
  96.    Bar X1,Y1 To X2,Y2
  97.    Ink 3
  98.    Box X1+2,Y1+1 To X2-2,Y2-1
  99.    '--- font name area
  100.    WX1=X1+7 : WY1=Y1+12 : WX2=X2-7 : WY2=WY1+LINES*8
  101.    Box WX1,WY1 To WX2,WY2+2
  102.    Set Zone 5,WX1,WY1+1 To WX2,WY2+1
  103.    '--- show area 
  104.    SY1=WY2+4 : SY2=SY1+30
  105.    Box WX1,SY1 To WX2,SY2
  106.    Ink 3,2
  107.    Text X1+75,Y1+10,"Select a Font"
  108.    Set Zone 6,X1,Y1 To X2,WY1
  109.    ' --- Draw buttons 
  110.    Z=1 : F=2 : B=3
  111.    S#=(WX2-WX1)/3.9
  112.    BUTTON[WX1+4,SY2+10," OK ",Z,F,B] : Inc Z
  113.    BUTTON[WX1+S#*1,SY2+10,"BACK",Z,F,B] : Inc Z
  114.    BUTTON[WX1+S#*2,SY2+10,"NEXT",Z,F,B] : Inc Z
  115.    BUTTON[WX1+S#*3,SY2+10,"CANCEL",Z,F,B] : Inc Z
  116.    ' -----------------------------------
  117.    P=1
  118.    PAGE[P,LASTNAME,LINES,WX1,WY1,WX2,WY2]
  119.    SELECTEDFONT=0
  120.    Ink 3,2 : HILITE=-1
  121.    ' --- Main loop
  122.    Repeat 
  123.       If Mouse Click=1 Then BUTTON=Mouse Zone
  124.       ' in font name area ?  
  125.       While Mouse Zone=5
  126.          ' --- calc which font name 
  127.          Y=(Y Screen(Y Mouse)-WY1-2)/8
  128.          ' --- font selected ?
  129.          If Mouse Click=1
  130.             ' --- Undo last hilite 
  131.             If HILITE>-1
  132.                PRTFONT[WX1+1,WY1,P,HILITE]
  133.                HILITE=-1
  134.             End If 
  135.             ' --- Hilite & Show selected font
  136.             If P+Y<=LASTNAME
  137.                ' --- Hilite font name 
  138.                Gr Writing 4+1
  139.                PRTFONT[WX1+1,WY1,P,Y]
  140.                Gr Writing 1
  141.                HILITE=Y : Rem --- set flag   
  142.                ' --- Set & display font 
  143.                SELECTEDFONT=P+Y
  144.                Set Font SELECTEDFONT
  145.                Ink 2
  146.                Bar WX1+1,SY1+1 To WX2-1,SY2-1
  147.                Clip WX1=1,SY1+1 To WX2-1,SY2
  148.                Ink 3,2
  149.                Text WX1+1,SY2-2,"AaBbCcDdy"
  150.                Clip 0,0 To Screen Width,Screen Height
  151.                Set Font 2
  152.                BUTTON=0
  153.             End If 
  154.          End If 
  155.       Wend 
  156.       Set Font 2
  157.       ' --- BACK --- 
  158.       If BUTTON=2
  159.          If P-LINES>0
  160.             P=P-LINES
  161.          Else 
  162.             P=1
  163.          End If 
  164.          PAGE[P,LASTNAME,LINES,WX1,WY1,WX2,WY2]
  165.          BUTTON=0
  166.       End If 
  167.       ' --- NEXT --- 
  168.       If BUTTON=3
  169.          If P+LINES<=LASTNAME
  170.             P=P+LINES
  171.             PAGE[P,LASTNAME,LINES,WX1,WY1,WX2,WY2]
  172.             BUTTON=0
  173.          End If 
  174.       End If 
  175.       ' --- Move requester --- 
  176.       If BUTTON=6
  177.          ' --- Get req image
  178.          Get Block 2,X1,Y1,WIDTH,HEIGHT+1
  179.          MX=X Screen(X Mouse) : MY=Y Screen(Y Mouse)
  180.          MXO=MX-X1 : MYO=MY-Y1
  181.          Limit Mouse X Hard(MXO),Y Hard(MYO) To X Hard(Screen Width-(WIDTH-MXO)),Y Hard(Screen Height-(HEIGHT-MYO)-1)
  182.          Gr Writing 2 : Rem XOR
  183.          While Mouse Key=1
  184.             Box MX-MXO,MY-MYO To MX-MXO+WIDTH,MY-MYO+HEIGHT
  185.             OLDX=MX : OLDY=MY
  186.             While OLDX=X Screen(X Mouse) and OLDY=Y Screen(Y Mouse) : Wend 
  187.             MX=X Screen(X Mouse) : MY=Y Screen(Y Mouse)
  188.             Box OLDX-MXO,OLDY-MYO To OLDX-MXO+WIDTH,OLDY-MYO+HEIGHT
  189.          Wend 
  190.          Gr Writing 1
  191.          Limit Mouse X Hard(0),Y Hard(0) To X Hard(Screen Width),Y Hard(Screen Height)
  192.          ' --- Restore bg at present location 
  193.          Put Block 1
  194.          ' --- Save bg at new location
  195.          Get Block 1,MX-MXO,MY-MYO,WIDTH,HEIGHT+1
  196.          ' --- Put Req at new location
  197.          Put Block 2,MX-MXO,MY-MYO
  198.          Del Block 2
  199.          ' --- Re-calc var's & zones ---
  200.          X=MX-MXO : Y=MY-MYO
  201.          X1=X : X2=X1+WIDTH : Y1=Y : Y2=Y1+HEIGHT
  202.          WX1=X1+7 : WY1=Y1+12 : WX2=X2-7 : WY2=WY1+LINES*8
  203.          SY1=WY2+4 : SY2=SY1+30
  204.          Set Zone 5,WX1,WY1+1 To WX2,WY2+1
  205.          Set Zone 6,X1,Y1 To X2,WY1
  206.          S#=(WX2-WX1)/3.9 : Z=1
  207.          BUTTON[WX1+4,SY2+10," OK ",Z,F,B] : Inc Z
  208.          BUTTON[WX1+S#*1,SY2+10,"BACK",Z,F,B] : Inc Z
  209.          BUTTON[WX1+S#*2,SY2+10,"NEXT",Z,F,B] : Inc Z
  210.          BUTTON[WX1+S#*3,SY2+10,"CANCEL",Z,F,B] : Inc Z
  211.          Ink 3,2
  212.          BUTTON=0
  213.       End If 
  214.    Until BUTTON=1 or BUTTON=4
  215.    ' --- Finaly, set the selected font. --- 
  216.    '
  217.    ' (Remove the Rem's from the two lines below if
  218.    ' you want to Set the font in this routine, otherwise
  219.    ' use the global variable SELECTEDFONT - this contains 
  220.    ' the font number that has just been chosen.)
  221.    '
  222.    If BUTTON=1 and SELECTEDFONT>0
  223.       ' --- OK. Set selected font here if you want.  
  224.       ' Set Font SELECTEDFONT  
  225.    Else 
  226.       ' --- CANCEL. Restore the font that was being used.  
  227.       ' Set Font oldfont 
  228.       SELECTEDFONT=OLDFONT
  229.    End If 
  230.    ' --- Restore background 
  231.    Put Block 1
  232.    Del Block 1
  233.    ' --- restore palette  
  234.    For C=0 To 3 : Colour C,P(C) : Next 
  235. End Proc
  236. '
  237. Procedure PAGE[P,LAST,LINES,X1,Y1,X2,Y2]
  238.    '--- Print a page of font names
  239.    Ink 2
  240.    Bar X1+1,Y1+1 To X2-1,Y2+1
  241.    Ink 3,2
  242.    For I=0 To LINES-1
  243.       If P+I<=LAST
  244.          PRTFONT[X1+1,Y1,P,I]
  245.       End If 
  246.    Next 
  247. End Proc
  248. '
  249. Procedure PRTFONT[X,Y,PG,I]
  250.    '--- Print one font name 
  251.    F$=Left$(Font$(PG+I),Instr(Font$(PG+I),".font")-1)
  252.    F$=F$+String$(" ",22-Len(F$))+Mid$(Font$(PG+I),30,6)
  253.    Text X,Y+(I*8)+8,F$
  254. End Proc
  255. '
  256. Procedure BUTTON[X,Y,A$,Z,FG,BG]
  257.    X1=X-2 : Y1=Y-8 : X2=X1+Len(A$)*8+2 : Y2=Y+2
  258.    Ink BG
  259.    Bar X1+1,Y1+2 To X2+3,Y2+1
  260.    Ink BG,BG,FG
  261.    Set Paint 1
  262.    Bar X1-1,Y1 To X2+1,Y2
  263.    Set Paint 0
  264.    Ink FG,BG
  265.    Text X,Y,A$
  266.    Set Zone Z,X1,Y1 To X2,Y2
  267. End Proc