home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / programs / fonts / a_q / fontwindow / !Demo / NormalSrc (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  1993-03-02  |  9KB  |  331 lines
  1.   >NormalSrc
  2.      Demonstration of use of FontWindow module
  3.      Simple dboxes + complicated menus
  4.      Windows are created at time of load.
  5.      Look for REM### to see where I've put FontModule code
  6.      Look for REM#++ to see menu code
  7.   MACHINE:  Archimedes
  8.   LANGUAGE: BBC BASIC V (v1.05)
  9.   AUTHOR:   Cy Booker,
  10.             86 Church View, Main Road, Crockenhill, Swanley, Kent.
  11.             BR8 8JW
  12.      apologies for the crappy coding, but it is done in a hurry
  13. main(
  14. , "Test Simple")
  15. main(FontWindow, FontMenu, Title$)
  16.  = &8000+64*1024
  17.   Debug% = 
  18.  q% 256
  19.   $q%="TASK"
  20.  "Wimp_Initialise",200,!q%, Title$ 
  21.  , TaskHandle%
  22.  need local error handlers before poll loop...
  23.  FontWindow 
  24.  FontMenu 
  25. !I      version   = 110                   :
  26.   latest version know about
  27. "?      flags     = 1 << 16               :
  28.   all resolutions
  29. #H      flags     = 1 << 17               :
  30.   high-rez (>= 90dpi) only
  31. $F      menufont  = 0                     :
  32.   default font for menus
  33. %        
  34.       version   = 100
  35.       flags     = 0
  36. (6      menufont  = 0                     :
  37.   unused
  38. )        
  39. *K    malloc_routine      = 0             :
  40.   default allocate RMA memory
  41. +G    free_routine        = 0             :
  42.   default free RMA memory
  43. ,Y    gethandle_routine   = 0             :
  44.   default one for abstract == window handle
  45. -Y    recreate_routine    = 0             :
  46.   default one for abstract == window handle
  47. .6    routine_r12         = 0             :
  48.   unused
  49. /C    fonttable           = 0             :
  50.   please allocate one
  51.  "FontWindow_Initialise", TaskHandle%, malloc_routine,free_routine, gethandle_routine,recreate_routine, routine_r12, fonttable, version 
  52.  flags, menufont 
  53.  FontTable%
  54. 2=    
  55.  FontTable% 256:
  56.  i%= 0 
  57.  255:FontTable%?i% = 0:
  58. loadtemplates
  59. makemenus
  60. makeiconbaricon
  61. reporterror
  62. ="    
  63.  "Wimp_Poll",&31,q% 
  64. ?%    
  65.  "Wimp_OpenWindow",, q%
  66. @&    
  67.  "Wimp_CloseWindow",, q%
  68. mouseclick
  69. menuselect
  70.  17,18:
  71. message
  72. D        
  73.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  74. closedown
  75.  FontWindow 
  76. M4    
  77.  "FontWindow_CloseDown", TaskHandle%, 
  78.  i%=0 
  79.       
  80.  FontTable%?i%
  81. Q#        
  82.  "XFont_LoseFont", i%
  83.         FontTable%?i% -= 1
  84.       
  85.  "Wimp_CloseDown"
  86.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  87. loadtemplate(name$, 
  88.  wh%)
  89.   $q% = name$+ 
  90.  "Wimp_LoadTemplate",, buf%, indrove%, ind%+bufsiz%, FontTable%, q%, 0 
  91.  ,, indrove%,,,, pos%
  92.  pos%=0 
  93.  1, "Can't find template "+ name$
  94.  FontWindow 
  95. bE    
  96.  "FontWindow_CreateWindow", TaskHandle%, buf%, 0 
  97.  wh%, qq%
  98. d+    
  99.  "Wimp_CreateWindow",, buf% 
  100.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  101. message_modechange
  102.  FontWindow 
  103. m/    
  104.  "FontWindow_ModeChange", TaskHandle%
  105.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  106. message_menuwarning
  107.   x% = q%!24
  108.   y% = q%!28
  109.   item% = q%!32
  110.  item% 
  111.  FontWindow 
  112. {@      
  113.  "FontWindow_UpdateWindow", TaskHandle%, ProgInfo_W%
  114. |        
  115. }5    
  116.  "Wimp_CreateSubMenu",, ProgInfo_W%, x%, y%
  117.  FontWindow 
  118. >      
  119.  "FontWindow_UpdateWindow", TaskHandle%, SaveAs_W%
  120.         
  121. 3    
  122.  "Wimp_CreateSubMenu",, SaveAs_W%, x%, y%
  123.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  124. mouseclick
  125.  (q%!12 = -2) 
  126.  (q%!16 = IconBarIcon%) 
  127.  (q%!8 
  128. (      
  129. menutick(Menu%, 2, FontMenus)
  130. 5      
  131. menutick(MenuColours%, CurrentColour%, 
  132. L      
  133.  "Wimp_CreateMenu",, Menu%, q%!0 - ((Menu%!16)>>1), 96+44*5+24*0
  134.         
  135.       !q% = Document_W%
  136. '      
  137.  "Wimp_GetWindowState",, q%
  138.       q%!28 = -1
  139.       
  140.  FontWindow 
  141. D        
  142.  "FontWindow_OpenWindow", TaskHandle%, q%, Document_W%
  143.       
  144. %        
  145.  "Wimp_OpenWindow",, q%
  146.       
  147.         
  148. menuselect
  149.  !q% 
  150.  FontMenus 
  151. ?      
  152.  "FontWindow_DeRegisterMenu", TaskHandle%, Menu%, 
  153. F      
  154.  "FontWindow_DeRegisterMenu", TaskHandle%, MenuColours%, 
  155.         
  156. :      
  157.  "FontWindow_RegisterMenu", TaskHandle%, Menu%
  158. A      
  159.  "FontWindow_RegisterMenu", TaskHandle%, MenuColours%
  160.         
  161.     FontMenus = 
  162.  FontMenus
  163. &    
  164. menutick(Menu%, 2, FontMenus)
  165.  q%!4 >= 0 
  166. $      
  167.  q%!4 <> CurrentColour% 
  168. 6        
  169. menutick(MenuColours%, CurrentColour%, 
  170. !        CurrentColour% = q%!4
  171.       
  172. 4      
  173. menutick(MenuColours%, CurrentColour%, 
  174.         
  175. closedown
  176.  "Wimp_GetPointerInfo",, q%
  177.  q%!8 
  178. $    
  179.  "Wimp_CreateMenu",, Menu%
  180.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  181. reporterror
  182.   !q% = 
  183.  Debug% 
  184. '    
  185. putz(q%+4, 
  186. $+ " code "+ 
  187. putz(q%+4, 
  188.  "Wimp_ReportError", q%, 3, Title$ 
  189.  , choice%
  190.  choice% = 2 
  191. closedown
  192.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  193. loadtemplates
  194.   bufsiz% = 10*1024
  195.  buf% bufsiz%  :
  196.   kludge
  197.  ind% bufsiz%  :
  198.  kludge
  199.   indrove% = ind%
  200.  "Wimp_OpenTemplate",, "<DemoFontWindow$Dir>.Templates"
  201.  local error handler...
  202. loadtemplate("ProgInfo", ProgInfo_W%)
  203. loadtemplate("SaveAs", SaveAs_W%)
  204. loadtemplate("Test", Document_W%)
  205.   the following window will not be cached, as it contains no
  206.   anti-aliased fonts.
  207. loadtemplate("Query", Query_W%)
  208.  "Wimp_CloseTemplate"
  209.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  210. makemenus
  211.  col$, i
  212.   FontMenus = FontMenu
  213.   CurrentColour% = 0
  214.   col$ = "0123456789ABCDEF"
  215.   menusiz% = 10*1024
  216.  Menu% menusiz%
  217. %  MenuColours% = 
  218. maddr(Menu%, 5)
  219.   menu% = Menu%
  220. menutitle(Title$)
  221. menuitem("Info", 1 << 3, &8004)
  222. menuitem("Save as", 1 << 3, &8004)
  223. menuitem("Menu FONTS", 0, 0)
  224.  FontWindow = 
  225.  menu%!-16 += 1 << 22
  226. menuitem("Colours", 0, MenuColours%)
  227. menuitem("Quit", 1 << 7, -1)
  228. menutitle("Colours")
  229.  i= 0 
  230.     menu%!0 = 0
  231.     menu%!4 = 0
  232.  fore
  233. 1    menu%!8 = (i << 28) 
  234.  (fore << 24) 
  235.  &129
  236.      menu%!12 = 
  237. strdup(
  238. 1    
  239.  give menu item an "F" validation string
  240. 8    
  241.  which will be used IF the item is anti-aliased
  242. ?    
  243.  this validation string will be used by the FontWindow
  244. )    
  245.  when we DeRegister the sub/menu
  246.         :
  247. B    menu%!16 = 
  248. strdup("F"+ 
  249. col$, i+1, 1)+ 
  250. col$, fore+1, 1))
  251.     menu%!20 = 
  252. (i))+1
  253.     menu%+=24
  254.   menu%!-24 += 1 << 7
  255.  7,7,7,0, 0,0,0,0, 0,7,7,0, 7,0,7,7
  256.  FontWindow 
  257.  FontMenu 
  258. :      
  259.  "FontWindow_RegisterMenu", TaskHandle%, Menu%
  260. A      
  261.  "FontWindow_RegisterMenu", TaskHandle%, MenuColours%
  262.         
  263. strdup(s$)
  264. (s$) + 1
  265.   $s = s$
  266. maddr(base, item)
  267.  item >= 0 
  268.      base += 28 + (item * 24)
  269. = base
  270. menutick(base, item, boolean)
  271.  boolean 
  272.  boolean = 1 << 0
  273.   base = 
  274. maddr(base, item)
  275.  '  base!0 = (base!0 
  276.  boolean
  277. menutitle(title$)
  278.   $menu% = title$
  279.   menu%?12 = 7
  280.   menu%?13 = 2
  281.   menu%?14 = 7
  282.   menu%?15 = 0
  283. ),  menu%!16 = 11*16              :
  284.  width
  285.   menu%!20 = 44
  286.   menu%!24 = 0
  287.   menu% += 28
  288. menuitem(item$, flags%, data%)
  289.   menu%!0 = flags% 
  290.   menu%!4 = data%
  291.   menu%!8 = &07000021
  292. 3&  $(menu%+12) = item$+ 
  293. (13))
  294.   menu%+=24
  295.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  296. makeiconbaricon
  297.  name% 13
  298.   $name% = "!demo"
  299.   q%!0 = -1
  300.   q%!4 = 0
  301.   q%!8 = 0
  302.   q%!12 = 68
  303.   q%!16 = 68
  304.   q%!20 = &07006102
  305.   q%!24 = name%
  306.   q%!28 = +1
  307.   q%!32 = 
  308. ($name%) + 1
  309.  "Wimp_CreateIcon",, q% 
  310.  IconBarIcon%
  311.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  312. message
  313.  q%!16 
  314. closedown
  315.  &400C0:
  316. message_menuwarning
  317.  &400C1:
  318. message_modechange
  319.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  320.  Debug% 
  321. V!    
  322. $+ ", ["+ 
  323. )+ "]"
  324. getz(q%)
  325. ?q%:V$+=
  326. (?q%):q%+=1:
  327. putz(z%, z$)
  328.   $z% = z$
  329.   z%?
  330. z$ = 0
  331.