home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / ACE / Prgs / FontReq / FontReq.b < prev    next >
Text File  |  1995-02-13  |  3KB  |  137 lines
  1. {*
  2. ** ASL Font Requester.
  3. **
  4. ** Author: David J Benn
  5. **   Date: 22nd January, 10th,13th February 1995
  6. *}
  7.  
  8. {*
  9. ** General constants.
  10. *}
  11. CONST true = -1&, false = 0&
  12. CONST null = 0&
  13.  
  14. {*
  15. ** ASL contants/values.
  16. *}
  17. CONST ASL_FontRequest    = 1
  18.  
  19. CONST FONF_FRONTCOLOR     = 1
  20. CONST FONF_BACKCOLOR    = 2
  21. CONST FONF_STYLES    = 4
  22.  
  23. CONST TAG_DONE         = 0&
  24.  
  25. {*
  26. ** Structure definitions.
  27. *}
  28. STRUCT TagItem
  29.   LONGINT ti_Tag
  30.   LONGINT ti_Data
  31. END STRUCT
  32.  
  33. STRUCT TextAttr
  34.   ADDRESS  ta_Name
  35.   SHORTINT ta_YSize
  36.   BYTE       ta_Style
  37.   BYTE        ta_Flags
  38. END STRUCT
  39.  
  40. STRUCT FontRequester
  41.   ADDRESS  fo_Reserved1
  42.   ADDRESS  fo_Reserved2
  43.   TextAttr fo_Attr
  44.   BYTE       fo_FrontPen
  45.   BYTE       fo_BackPen
  46.   BYTE       fo_DrawMode
  47.   ADDRESS  fo_UserData
  48.   SHORTINT fo_LeftEdge
  49.   SHORTINT fo_TopEdge
  50.   SHORTINT fo_Width
  51.   SHORTINT fo_Height
  52. END STRUCT
  53.  
  54. STRUCT FontInfo
  55.   ADDRESS  fontName
  56.   SHORTINT fontHeight
  57.   SHORTINT textStyle
  58.   SHORTINT frontColor
  59.   SHORTINT backColor
  60. END STRUCT
  61.  
  62. {*
  63. ** External references.
  64. *}
  65. EXTERNAL _EXIT_PROG    '..Kludge! This is a label in every main program module. 
  66.             '..Fix for next release of compiler.
  67.  
  68. {*
  69. ** Shared library function declarations.
  70. *}
  71. DECLARE FUNCTION ADDRESS AllocAslRequest(LONGINT type, ADDRESS ptags) LIBRARY asl
  72. DECLARE FUNCTION FreeAslRequest(ADDRESS request) LIBRARY asl
  73. DECLARE FUNCTION SHORTINT AslRequest(ADDRESS request, ADDRESS ptags) LIBRARY asl
  74.  
  75. DECLARE FUNCTION ADDRESS AllocateTagItems(LONGINT tags) LIBRARY utility
  76. DECLARE FUNCTION FreeTagItems(ADDRESS ptags) LIBRARY utility
  77.  
  78. {*
  79. ** Subprogram definitions.
  80. *}
  81. SUB LONGINT FontInfoRequest(ADDRESS theInfo) EXTERNAL
  82. DECLARE STRUCT TagItem *fontReqTags, *tag
  83. DECLARE STRUCT FontRequester *request
  84. DECLARE STRUCT TextAttr *theAttr
  85. DECLARE STRUCT FontInfo *info
  86. LONGINT ASL_FuncFlags, retVal
  87.  
  88.   LIBRARY "utility.library"
  89.   LIBRARY "asl.library"
  90.  
  91.   info = theInfo
  92.  
  93.   '..Allocate requester structure.
  94.   fontReqTags = AllocateTagItems(2)
  95.   IF fontReqTags = null THEN
  96.     retVal = false
  97.   ELSE
  98.     ASL_FuncFlags = SHL(1,31) + &H80000 + 20  {* see C header libraries/asl.h *}
  99.     tag = fontReqTags
  100.     tag->ti_Tag = ASL_FuncFlags
  101.     tag->ti_Data = FONF_FRONTCOLOR OR FONF_BACKCOLOR OR FONF_STYLES
  102.     tag = tag + SIZEOF(TagItem)
  103.     tag->ti_Tag = TAG_DONE
  104.  
  105.     request = AllocAslRequest(ASL_FontRequest, fontReqTags)
  106.  
  107.     IF request = null THEN 
  108.       retVal = false
  109.     ELSE
  110.       '..Render the requester.
  111.       IF AslRequest(request, null) THEN
  112.         '..Okay -> get font information.
  113.         theAttr = @request->fo_Attr
  114.         info->fontName = theAttr->ta_Name
  115.         info->fontHeight = theAttr->ta_YSize
  116.         info->textStyle = theAttr->ta_Style
  117.         info->frontColor = request->fo_FrontPen
  118.         info->backColor = request->fo_BackPen
  119.         retVal = true
  120.       ELSE
  121.         '..Requester cancelled.
  122.         retVal = false
  123.       END IF
  124.     END IF
  125.  
  126.     '..Clean up.
  127.     FreeAslRequest(request)
  128.     FreeTagItems(fontReqTags)
  129.  
  130.     LIBRARY CLOSE "asl.library"
  131.     LIBRARY CLOSE "utility.library"
  132.   END IF
  133.  
  134.   '..successful?
  135.   FontInfoRequest = retVal
  136. END SUB
  137.