home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / programs / fonts / a_q / fontwindow / !Demo / EditorSrc (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  1993-03-02  |  14KB  |  500 lines
  1.   >EditorSrc
  2.      Demonstration of use of FontWindow module
  3.      Multi-document application, windows with anti-aliased title bars
  4.      Windows are demand-created
  5.      Look for REM### to see where I've put the FontModule code
  6.      Look for REM#++ to see menu code
  7.      documents are kept in a simple linked list
  8.  v1.20 now has some menu items *not* indirected
  9.   MACHINE:  Archimedes
  10.   LANGUAGE: BBC BASIC V (v1.05)
  11.   AUTHOR:   Cy Booker,
  12.             86 Church View, Main Road, Crockenhill, Swanley, Kent.
  13.             BR8 8JW
  14.      apologies for the crappy coding, but it is done in a hurry
  15. main(
  16. , "12")
  17. main(0, 0, "x")
  18. main(FontWindow, FontMenu, Title$)
  19.  = &8000+64*1024
  20.   Debug% = 
  21.  q% 256
  22.   $q%="TASK"
  23.  "Wimp_Initialise",200,!q%, Title$ 
  24.  , TaskHandle%
  25.  need local error handlers before poll loop...
  26.  FontMenu 
  27. $Q      flags     = 1 << 16               :
  28.   menus as fonts in all resolutions
  29.       
  30.  menufont 48
  31. &>      menufont!0 = 15*16                :
  32.   X size of font
  33. '>      menufont!4 = 14*16                :
  34.   Y size of font
  35. (\      $(menufont+8) = "Trinity.Medium"  :
  36.   Font name (40 chars including CR terminator)
  37. )I      version   = 120                   :
  38.   latest version know about
  39. *_      flags    += 1 << 18               :
  40.   calculate menu width automatically if fontified
  41. +^      flags    += 1 << 19               :
  42.   automatically indirect menu items if fontified
  43. ,        
  44.       version   = 100
  45.       flags     = 0
  46. /6      menufont  = 0                     :
  47.   unused
  48. 0        
  49. 1K    malloc_routine      = 0             :
  50.   default allocate RMA memory
  51. 2G    free_routine        = 0             :
  52.   default free RMA memory
  53. 3d    gethandle_routine   = 1             :
  54.   default one for abstract == pointer to window handle
  55. 4d    recreate_routine    = 1             :
  56.   default one for abstract == pointer to window handle
  57. 56    routine_r12         = 0             :
  58.   unused
  59. 6C    fonttable           = 0             :
  60.   please allocate one
  61.  "FontWindow_Initialise", TaskHandle%, malloc_routine,free_routine, gethandle_routine,recreate_routine, routine_r12, fonttable, version 
  62.  flags, menufont 
  63.  FontTable%
  64. 9=    
  65.  FontTable% 256:
  66.  i%= 0 
  67.  255:FontTable%?i% = 0:
  68.  Documents 4               :
  69.   pointer to pointer to linked list of'em
  70. =$  !Documents = 0                
  71. >L  DocNumber = 1                 :
  72.   so can tell documents apart visually
  73.  Each document is stored in the following structure:
  74. BE  Doc_Next      = 0 << 2        :
  75.  pointer to next in linked list
  76. C9  Doc_Window    = 1 << 2        :
  77.  wimp window handle
  78. DR  Doc_Title     = 2 << 2        :
  79.  pointer to indirected title bar icon buffer
  80.   sizeof_Doc    = 3 << 2
  81. loadtemplates
  82. makemenus
  83. makeiconbaricon
  84. reporterror
  85. O"    
  86.  "Wimp_Poll",&31,q% 
  87. Q%    
  88.  "Wimp_OpenWindow",, q%
  89. closewindow
  90. mouseclick
  91. menuselect
  92.  17,18:
  93. message
  94. V        
  95.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  96. closewindow
  97. docwindow_p(doc, !q%) 
  98. quitdocument(doc)
  99. a"    
  100.  "Wimp_CloseWindow",, q%
  101.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  102. createdocument
  103.  doc, dx, dy, len
  104.  doc sizeof_Doc            :
  105.   claim memory [kludge]
  106.  we now redirect the indirected data
  107.  this is a kludge (a bad one) because only redirect the title bar
  108.  should be re-directing all the indirected icons as well...
  109.   len = Document_WDef%!80
  110.  doc!Doc_Title len
  111. o'  Document_WDef%!72 = doc!Doc_Title
  112. putz(doc!Doc_Title, 
  113. "Document number "+ 
  114. (DocNumber), len-1))
  115.   DocNumber += 1
  116. ### -- note the TO parameter in the next line
  117.  FontWindow 
  118. tb    
  119.  "FontWindow_CreateWindow", TaskHandle%, Document_WDef%, doc+Doc_Window 
  120.  doc!Doc_Window
  121. v@    
  122.  "Wimp_CreateWindow",, Document_WDef% 
  123.  doc!Doc_Window
  124.   !q% = doc!Doc_Window
  125.  "Wimp_GetWindowState",, q%
  126. zD  dx = (
  127. (64) - &1F) * 16         :
  128.  so not on top of eachother!
  129.   dy = (
  130. (64) - &1F) * 16
  131.   q%!4 += dx
  132.   q%!8 += dy
  133.   q%!12 += dx
  134.   q%!16 += dy
  135.   q%!28 = -1
  136.  "Wimp_OpenWindow",, q%    :
  137.   no need to fontwindow_openwindow, although could
  138.   doc!Doc_Next = !Documents
  139. G  !Documents = doc                      :
  140.   new head of linked list
  141.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  142. quitdocument(doc)
  143.  parent
  144.   parent = Documents
  145.  !parent <> doc
  146. %    parent = (!parent) + Doc_Next
  147.  FontWindow 
  148. A    
  149.  "FontWindow_DeleteWindow", TaskHandle%, doc+Doc_Window
  150. /    
  151.  "Wimp_DeleteWindow",, doc+Doc_Window
  152.   !parent = doc!Doc_Next
  153.   <release memory used by document>
  154.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  155.      returns TRUE if window belongs to a document, setting doc
  156.      if true
  157. docwindow_p(
  158.  doc, w%)
  159.   rc% = 
  160.   doc = !Documents
  161.  doc 
  162. #    rc% = (doc!Doc_Window = w%)
  163. $    
  164.  rc% 
  165.  doc = doc!Doc_Next
  166.     = rc%
  167.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  168. closedown
  169.  !Documents
  170. !    
  171. quitdocument(!Documents)
  172.  FontWindow 
  173. 4    
  174.  "FontWindow_CloseDown", TaskHandle%, 
  175.  i%=0 
  176.       
  177.  FontTable%?i%
  178. #        
  179.  "XFont_LoseFont", i%
  180.         FontTable%?i% -= 1
  181.       
  182.  "Wimp_CloseDown"
  183.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  184.   doesn't actually load window, but saves definition in memory
  185.   if make multiple clones of a windows then need to redirect
  186.   all of the indirected data... 
  187. loadtemplate(name$, 
  188.  wh%)
  189.  siz, i, pos
  190.   $q% = name$+ 
  191.  "Wimp_LoadTemplate",, buf%, indrove%, ind%+bufsiz%, FontTable%, q%, 0 
  192.  ,, indrove%,,,, pos
  193.  pos=0 
  194.  1, "Can't find template "+ name$
  195.   siz = 88+((buf%!84)*32)
  196.  wh% siz
  197.  i = 0 
  198.  siz-1 
  199.     wh%!i = buf%!i
  200.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  201. message_modechange
  202.  FontWindow 
  203. /    
  204.  "FontWindow_ModeChange", TaskHandle%
  205.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  206. message_menuwarning
  207.   x% = q%!24
  208.   y% = q%!28
  209.   item% = q%!32
  210.  item% 
  211.  ProgInfo_WDef% 
  212.       
  213.  ProgInfo_WPtr% 4
  214.       
  215.  FontWindow 
  216. g        
  217.  "FontWindow_CreateWindow", TaskHandle%, ProgInfo_WDef%, ProgInfo_WPtr% 
  218.  !ProgInfo_WPtr%
  219.       
  220. E        
  221.  "Wimp_CreateWindow",, ProgInfo_WDef% 
  222.  !ProgInfo_WPtr%
  223.       
  224. 5      ProgInfo_WDef% = 0        :
  225.  release memory
  226.         
  227.       
  228.  FontWindow 
  229. E        
  230.  "FontWindow_UpdateWindow", TaskHandle%, ProgInfo_WPtr%
  231.       
  232.         
  233. 9    
  234.  "Wimp_CreateSubMenu",, !ProgInfo_WPtr%, x%, y%
  235.  SaveAs_WDef% 
  236.       
  237.  SaveAs_WPtr% 4
  238.       
  239.  FontWindow 
  240. a        
  241.  "FontWindow_CreateWindow", TaskHandle%, SaveAs_WDef%, SaveAs_WPtr% 
  242.  !SaveAs_WPtr%
  243.       
  244. A        
  245.  "Wimp_CreateWindow",, SaveAs_WDef% 
  246.  !SaveAs_WPtr%
  247.       
  248. 3      SaveAs_WDef% = 0        :
  249.  release memory
  250.         
  251.       
  252.  FontWindow 
  253. C        
  254.  "FontWindow_UpdateWindow", TaskHandle%, SaveAs_WPtr%
  255.       
  256.         
  257. 7    
  258.  "Wimp_CreateSubMenu",, !SaveAs_WPtr%, x%, y%
  259.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  260. mouseclick
  261.  (q%!12 = -2) 
  262.  (q%!16 = IconBarIcon%) 
  263.  (q%!8 
  264. (      
  265. menutick(Menu%, 2, FontMenus)
  266.     L      
  267.  "Wimp_CreateMenu",, Menu%, q%!0 - ((Menu%!16)>>1), 96+44*5+24*0
  268.         
  269.       
  270. createdocument
  271.         
  272. menuselect
  273.  !q% 
  274.  FontMenus 
  275. ?      
  276.  "FontWindow_DeRegisterMenu", TaskHandle%, Menu%, 
  277. F      
  278.  "FontWindow_DeRegisterMenu", TaskHandle%, MenuColours%, 
  279.         
  280. :      
  281.  "FontWindow_RegisterMenu", TaskHandle%, Menu%
  282. A      
  283.  "FontWindow_RegisterMenu", TaskHandle%, MenuColours%
  284.         
  285.     FontMenus = 
  286.  FontMenus
  287. &    
  288. menutick(Menu%, 2, FontMenus)
  289.  q%!4 >= 0 
  290. $      
  291.  q%!4 <> CurrentColour% 
  292.  6        
  293. menutick(MenuColours%, CurrentColour%, 
  294. !!        CurrentColour% = q%!4
  295.       
  296. #4      
  297. menutick(MenuColours%, CurrentColour%, 
  298. $        
  299. closedown
  300.  "Wimp_GetPointerInfo",, q%
  301.  q%!8 
  302. )$    
  303.  "Wimp_CreateMenu",, Menu%
  304.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  305. reporterror
  306.   !q% = 
  307.  Debug% 
  308. 2'    
  309. putz(q%+4, 
  310. $+ " code "+ 
  311. putz(q%+4, 
  312.  "Wimp_ReportError", q%, 3, Title$ 
  313.  , choice%
  314.  choice% = 2 
  315. closedown
  316.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  317. loadtemplates
  318.   bufsiz% = 10*1024
  319.  buf% bufsiz%  :
  320.  kludge
  321.  ind% bufsiz%  :
  322.  kludge
  323.   indrove% = ind%
  324.  "Wimp_OpenTemplate",, "<DemoFontWindow$Dir>.Templates"
  325.  local error handler...
  326. loadtemplate("ProgInfo", ProgInfo_WDef%)
  327. loadtemplate("SaveAs", SaveAs_WDef%)
  328. loadtemplate("Document", Document_WDef%)
  329. ID  :
  330.   the following window will not be cached, as it contains no
  331.   anti-aliased fonts.
  332. loadtemplate("Query", Query_WDef%)
  333.  "Wimp_CreateWindow",, Query_WDef% 
  334.  Query_W%
  335.  "Wimp_CloseTemplate"
  336.   free buf% memory
  337.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  338. makemenus
  339.  col$, i
  340.   FontMenus = FontMenu
  341.   CurrentColour% = 0
  342.   col$ = "0123456789ABCDEF"
  343.   menusiz% = 10*1024
  344.  Menu% menusiz%
  345. _%  MenuColours% = 
  346. maddr(Menu%, 5)
  347.   menu% = Menu%
  348.   menu% += 28
  349. menuitem("Info", 1 << 3, &8004)
  350. menuitem("Save as", 1 << 3, &8004)
  351. menuitem("Use FONTS", 0, 0)
  352.  FontWindow = 
  353.  menu%!-16 += 1 << 22
  354. menuitem("Colours", 0, MenuColours%)
  355. menuitem("Quit", 1 << 7, -1)
  356. menutitle(Menu%, Title$)
  357.   menu% += 28
  358.  i= 0 
  359.     menu%!0 = 0
  360.     menu%!4 = 0
  361.  fore
  362. o1    menu%!8 = (i << 28) 
  363.  (fore << 24) 
  364.  &129
  365. p     menu%!12 = 
  366. strdup(
  367. s1    
  368.  give menu item an "F" validation string
  369. t8    
  370.  which will be used IF the item is anti-aliased
  371. u?    
  372.  this validation string will be used by the FontWindow
  373. v)    
  374.  when we DeRegister the sub/menu
  375. w        :
  376. xB    menu%!16 = 
  377. strdup("F"+ 
  378. col$, i+1, 1)+ 
  379. col$, fore+1, 1))
  380.     menu%!20 = 
  381. (i))+1
  382.     menu%+=24
  383.   menu%!-24 += 1 << 7
  384. menutitle(MenuColours%, "Colours")
  385.  7,7,7,0, 0,0,0,0, 0,7,7,0, 7,0,7,7
  386.  FontWindow 
  387.  FontMenu 
  388. :      
  389.  "FontWindow_RegisterMenu", TaskHandle%, Menu%
  390. A      
  391.  "FontWindow_RegisterMenu", TaskHandle%, MenuColours%
  392.         
  393. strdup(s$)
  394. (s$) + 1
  395.   $s = s$
  396. maddr(base, item)
  397.  item >= 0 
  398.      base += 28 + (item * 24)
  399. = base
  400. menutick(base, item, boolean)
  401.  boolean 
  402.  boolean = 1 << 0
  403.   base = 
  404. maddr(base, item)
  405. '  base!0 = (base!0 
  406.  boolean
  407. menutitle(menu%, title$)
  408.  maxw%, w%, item$, item%
  409. (title$)>12 
  410.  menu%!0 
  411. (title$)+1
  412.     $(menu%!0) = title$
  413.     menu%!4 = -1
  414.     menu%!8 = 
  415. (title$)+1
  416.     menu%!28 += 1 << 8
  417. <    $menu% = title$                       :
  418.  do this now
  419.   menu%?12 = 7
  420.   menu%?13 = 2
  421.   menu%?14 = 7
  422.   menu%?15 = 0
  423.   menu%!20 = 44
  424.   menu%!24 = 0
  425.   maxw% = 
  426. (title$) * 16
  427.   item% = menu% + 28 - 24
  428.     item% += 24
  429.  item%!8 
  430.  (1 << 8) 
  431.       item$ = $(item%!12)
  432.         
  433.       w% = 13
  434.       
  435.  item%?24, w%
  436.       item$ = $(item%+12)
  437.       
  438.  item%?24, w%
  439.         
  440.     w% = 
  441. (item$) * 16 + 8
  442. !    
  443.  maxw% < w% 
  444.  maxw% = w%
  445.  (item%!0) 
  446.  (1 << 7)
  447.   menu%!16 = maxw%
  448. menuitem(item$, flags%, data%)
  449.   menu%!0 = flags% 
  450.   menu%!4 = data%
  451.   menu%!8 = &07000021
  452. (item$)<=12 
  453. .    $(menu%+12) = 
  454. item$+ 
  455. (13)), 12)
  456.     menu%!8 += 1 << 8
  457.  menu%!12 
  458. (item$)+1
  459.     $(menu%!12) = item$
  460.     menu%!16 = -1
  461.     menu%!20 = 
  462. (item$)+1
  463.   menu%+=24
  464.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  465. makeiconbaricon
  466.  name% 13
  467.   $name% = "!demo"
  468.   q%!0 = -1
  469.   q%!4 = 0
  470.   q%!8 = 0
  471.   q%!12 = 68
  472.   q%!16 = 68
  473.   q%!20 = &07006102
  474.   q%!24 = name%
  475.   q%!28 = +1
  476.   q%!32 = 
  477. ($name%) + 1
  478.  "Wimp_CreateIcon",, q% 
  479.  IconBarIcon%
  480.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  481. message
  482.  q%!16 
  483. closedown
  484.  &400C0:
  485. message_menuwarning
  486.  &400C1:
  487. message_modechange
  488.  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  489.  Debug% 
  490. !    
  491. $+ ", ["+ 
  492. )+ "]"
  493. getz(q%)
  494. ?q%:V$+=
  495. (?q%):q%+=1:
  496. putz(z%, z$)
  497.   $z% = z$
  498.   z%?
  499. z$ = 0
  500.