home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 576-600 / apd591 / proc / text / openfont.amos / openfont.amosSourceCode < prev   
AMOS Source Code  |  1994-02-02  |  1KB  |  52 lines
  1. Procedure OPENFONT[NAME$,SIZE,_REM]
  2.   ER=0
  3.   If Upper$(Right$(NAME$,5))<>'.FONT' : NAME$=NAME$+'.font' : End If 
  4.   NAME$=NAME$+Chr$(0)
  5.   Dreg(0)=8 : Dreg(1)=0 : S=Execall(-198)
  6.   If S=0 : ER=24 : End If 
  7.   Loke S,Varptr(NAME$)
  8.   Doke S+4,SIZE
  9.   Doke S+6,0
  10.   Areg(0)=S
  11.   FONT=Gfxcall(-72)
  12.   If FONT=0
  13.     Dreg(0)=10 : Dreg(1)=0 : T=Execall(-198)
  14.     If T=0
  15.       ER=24
  16.     Else 
  17.       A$='diskfont.library'+Chr$(0) : Areg(1)=Varptr(A$) : Dreg(0)=0
  18.       DISKFONT_LIB=Execall(-552)
  19.       If DISKFONT_LIB=0
  20.         ER=81
  21.       Else 
  22.         Doke T,$4DF9
  23.         Loke T+2,DISKFONT_LIB
  24.         Loke T+6,$4EEEFFE2
  25.         Areg(0)=S : Areg(1)=S
  26.         Call T
  27.         FONT=Dreg(0)
  28.         If FONT=0 : ER=44 : End If 
  29.       End If 
  30.     End If 
  31.   End If 
  32.   If DISKFONT_LIB : Areg(1)=DISKFONT_LIB : X=Execall(-414) : End If 
  33.   If T : Areg(1)=T : Dreg(0)=10 : X=Execall(-210) : End If 
  34.   If S : Areg(1)=S : Dreg(0)=8 : X=Execall(-210) : End If 
  35.   If ER : Error ER : End If 
  36.   If _REM
  37.     Areg(1)=FONT : X=Gfxcall(-78) : Areg(1)=FONT : X=Gfxcall(-78)
  38.   Else 
  39.     Get Rom Fonts 
  40.     FONT=0
  41.     N$=Upper$(Left$(NAME$,Len(NAME$)-6))
  42.     Repeat 
  43.       Inc FONT
  44.       A$=Upper$(Font$(FONT))
  45.       A$=Left$(A$,Instr(A$,'.FONT')-1)
  46.       A=Val(Mid$(Font$(FONT),31,5))
  47.     Until(A$=N$ and A=SIZE) or(A$='')
  48.     If A$=''
  49.       Error 44
  50.     End If 
  51.   End If 
  52. End Proc[FONT]