home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / p / popups / !PopUpTest / !RunImage (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  1993-05-24  |  16KB  |  447 lines
  1.  >!PopUpTest.!RunImage
  2.  Test/Demonstration application for PopUps
  3.  Find a Wimp_OpenTemplate/LoadTemplate/CreateWindow/OpenWindow
  4.  call in this program if you can!
  5.  By Jason Williams 1993
  6.  This code is (truly) Public Domain
  7.  (You may use useful portions of this code in your own programs)
  8. 26,4,7:
  9. "PopUpTest quitting due to error: ";
  10. $;" /";
  11.  --- Global constants -----------------------------------------------------
  12. OPopUpAsWindow        = 0       :
  13.  Application flags - standalone MENU PopUp
  14. LPopUpAsSubmenu       = 1       :
  15.                    - SubMenu MENU PopUp
  16. FPopUpIsStatic        = 2       :
  17.                    - STATIC PopUp
  18. :Message_Quit         = 0       :
  19.  Wimp message numbers
  20. Message_DataSave     = 1
  21. Message_DataSaveAck  = 2
  22. Message_DataLoad     = 3
  23. !Message_MenuWarn     = &400C0
  24. !Message_PopUpRequest = &46D40
  25. !Message_PopUpState   = &46D41
  26. OSaveAs_OKClick       = %00000001          :
  27.  Save-As returned flagword bits
  28. $SaveAs_ShiftDown     = %00000010
  29. Report_CancelOnly    = 1
  30. Report_OKOnly        = 2
  31. Report_OKAndCancel   = 3
  32.  --- PopUp data -----------------------------------------------------------
  33.  popup% 256           :
  34.  Block for PopUp data
  35.  F%=0 
  36.  250 
  37.  4   :
  38.  Which we clear out (I'm a tidy chap ;-)
  39.   popup%!F% = 0
  40. *.popuphandle%    = 0      :
  41.  No valid popup
  42. ,:MagMul% = 1:MagDiv% = 1  :
  43.  Default Magnifier settings
  44. .JDefaultSaveName$ = "PopUpFile"  :
  45.  Name to put in SaveAs writable icon
  46. 0QNewWimpColour%  = 7      :
  47.  WimpColour initially defaults to colour 7 (black)
  48. 2AColourFormat%   = 0      :
  49.  TrueColour initially defaults to:
  50. 3FNewTrueColour%  = 0      :
  51.  Colour = black, specified as RGB value
  52. 4/NewTransparent% = 0      :
  53.  NO transparency
  54.  --- Wimp initialisation --------------------------------------------------
  55.  b% 256, m% 256
  56. $b%="TASK"
  57.  "Wimp_Initialise", 200, !b%, "PopUp Tester" 
  58.  ,taskhandle%
  59.  --- Ensure PopUp Manager/Server running ----------------------------------
  60. ?C*RMEnsure PopUpManager 0.86 WimpTask Run <PopUpServer$Dir>.!Run
  61.  --- Create IconBar icon --------------------------------------------------
  62. CHb%!0 = -1: b%!4 = 0: b%!8 = 0: b%!12 = 68: b%!16 = 68: b%!20 = &3002
  63. D@$(b%+24) = "!PopUpTest": 
  64.  "Wimp_CreateIcon",,b% 
  65.  baricon%
  66.  --- Wimp_Poll loop -------------------------------------------------------
  67. quit%=
  68.  "Wimp_Poll", 1, b% 
  69.  reasoncode%
  70.  reasoncode% 
  71. MK    
  72.  6:                        
  73.  click -------------------------------
  74. N6      
  75.  b%!12 < 0 
  76.  b%!16 = baricon% 
  77. createmenu
  78. PK    
  79.  9:                        
  80.  menu choice -------------------------
  81.       
  82.  !b% 
  83. R,        
  84.  7:                    
  85.  "Quit"
  86.           quit%=
  87. U<        
  88. :                 
  89.  "Info" and the demo PopUps.
  90. VM          
  91.  User clicked on the menu item instead of following the arrow.
  92. WO          
  93.  We thus open the PopUp conveniently under the pointer position.
  94. Y.          
  95.  "Wimp_GetPointerInfo",,b% + 4
  96. Z?          
  97. popup(b%!0, b%!4 - 64, b%!8 + 64, PopUpAsWindow)
  98.       
  99. ]K    
  100.  17, 18:                   
  101.  Incoming message --------------------
  102.       
  103.  b%!16 
  104.         
  105.  Message_Quit:
  106.           quit% = 
  107. b"        
  108.  Message_DataSaveAck:
  109. cN          
  110.  Our SaveAs procedure has sent a DataSave message to the filer,
  111. dF          
  112.  and this is the reply telling us to go ahead and save.
  113. e3          
  114.  The full file pathname is at b%+44.
  115. g+          
  116. savedata(
  117. zerostring(b%+44))
  118.         
  119.  Message_MenuWarn:
  120. j;          
  121.  Menu Warning (A submenu needs to be opened)
  122. kG          
  123.    b%!20 = the sublink number we gave in Wimp_CreateMenu
  124. l@          
  125.    b%!24, b%!28 = x,y position to open submenu at
  126. mK          
  127.    b%!32... list of menu selection values terminated by a -1
  128. o9          
  129. popup(b%!32, b%!24, b%!28, PopUpAsSubmenu)
  130. q#        
  131.  Message_PopUpRequest:
  132. rJ          
  133.  Request from the PopUp Manager for us to attach its window
  134. sL          
  135.  to our menu tree. Simply call CreateSubMenu with the data it
  136. t+          
  137.  has sent us in the message.
  138. v:          
  139.  "Wimp_CreateSubMenu",,b%!20, b%!24, b%!28
  140. x!        
  141.  Message_PopUpState:
  142. y=          
  143.  A PopUp is trying to return new values to us.
  144. zH          
  145.  The following is the handle we were given - this is only
  146. {B          
  147.  important, however, if the PopUp is a STATIC PopUp
  148. |"          PopUpHandle% = b%!20
  149. ~%          
  150. zerostring(b%+24) 
  151.             
  152.  "Magnify":
  153. !              MagMul% = b%!36
  154. !              MagDiv% = b%!40
  155.               
  156.  26, 4, 7
  157. N              
  158. "PopUpTest: New Magnification is ";MagMul%;":";MagDiv%;"  "
  159.             
  160.  "Print":
  161. +              NumCopiesToPrint% = b%!36
  162.               
  163.  26, 4, 7
  164. M              
  165. "PopUpTest: Time to print ";NumCopiesToPrint%;" copies!  "
  166. C            
  167.  "Report" handled separately in PROCreport() below
  168.             
  169.  "SaveAs":
  170.               
  171. savefile
  172.             
  173.  "WimpColour":
  174. )              NewWimpColour%  = b%?36
  175.               
  176.  26, 4, 7
  177. C              
  178.  "PopUpTest: New colour is ";NewWimpColour%;"  "
  179.             
  180.  "TrueColour":
  181. )              ColourFormat%   = b%!36
  182. )              NewTrueColour%  = b%!40
  183. )              NewTransparent% = b%!44
  184.           
  185.       
  186.  quit%
  187.  "Wimp_CloseDown"
  188.  --------------------------------------------------------------------------
  189. createmenu                    :
  190.  Show our iconbar menu
  191.   $(m%) = "PopUp Test"
  192.   m%!12 = &70207
  193.   m%!16 = 16 * 12
  194.   m%!20 = 44
  195.   m%!24 = 0
  196.  Menu flags used below:  8 = Warn on submenu opening, }  8 + 2 = &0A
  197.                          2 = followed by dotted line  }
  198.                         80 = last item in the menu
  199.          Menu flags  Sublink    Icon flags       Text
  200.          ~~~~~~~~~~  ~~~~~~~~~  ~~~~~~~~~~~~~~~  ~~~~~~~~~~~~~~~~~~~~~~
  201. M  p%=m%+28:   p%!0 = &0A: p%!4 =  1: p%!8 = &7000021: $(p% + 12) = "Info"
  202. P  p%+=24:     p%!0 = &08: p%!4 =  2: p%!8 = &7000021: $(p% + 12) = "Magnify"
  203. N  p%+=24:     p%!0 = &08: p%!4 =  3: p%!8 = &7000021: $(p% + 12) = "Print"
  204. Q  p%+=24:     p%!0 = &08: p%!4 =  4: p%!8 = &7000021: $(p% + 12) = "ProgInfo"
  205. R  p%+=24:     p%!0 = &00: p%!4 = -1: p%!8 = &7000021: $(p% + 12) = "Report..."
  206. O  p%+=24:     p%!0 = &08: p%!4 =  6: p%!8 = &7000021: $(p% + 12) = "SaveAs"
  207. S  p%+=24:     p%!0 = &0A: p%!4 =  7: p%!8 = &7000021: $(p% + 12) = "WimpColour"
  208. M  p%+=24:     p%!0 = &80: p%!4 = -1: p%!8 = &7000021: $(p% + 12) = "Quit"
  209. &  numitems% = (p% - (m% + 4)) / 24
  210.  "Wimp_CreateMenu",,m%, b%!0 - 64, 96 + (2 * 24) + (44 * numitems%)
  211.  --------------------------------------------------------------------------
  212. popup(mainitem%, x%, y%, flags%)
  213. fillpopupblock(x%, y%, flags%)
  214.  mainitem% 
  215.  0:                             :
  216.  "Info" menu item
  217. 7    $popup%         = "ProgInfo"      :
  218.  PopUp Name
  219. (    $(popup% + &18) = "PopUp tester"
  220. .    $(popup% + &38) = "Test PopUp modules"
  221. 7    $(popup% + &58) = "
  222.  Copyright 1993 J.Williams"
  223. ,    $(popup% + &78) = "2.00 (21 May 93)"
  224.  1:                             :
  225.  "Magnify" menu item
  226. 7    $(popup%)       = "Magnify"       :
  227.  Popup Name
  228. J    popup%!24       = MagMul%         :
  229.  Default multiplier icon value
  230. G    popup%!28       = MagDiv%         :
  231.  Default divisor icon value
  232. H    popup%!32       = 1               :
  233.  } Multiplier must be in the
  234. G    popup%!36       = 100             :
  235.  } range 1 to 100 inclusive
  236. E    popup%!40       = 1               :
  237.  } Divisor must be in the
  238. E    popup%!44       = 4               :
  239.  } range 1 to 4 inclusive
  240. F    $(popup% + 48)  = "Ratio"         :
  241.  Text for window title bar
  242.  2:                             :
  243.  "Print" menu item
  244. 7    $popup%         = "Print"         :
  245.  PopUp Name
  246. F    popup%!24       = 1               :
  247.  Number of copies to print
  248.  3:                             :
  249.  "ProgInfo" menu item
  250. 7    $popup%         = "ProgInfo"      :
  251.  PopUp Name
  252. 1    $(popup% + &18) = "ProgInfo PopUp Sample"
  253. 7    $(popup% + &38) = "(A display-only MENU PopUp)"
  254. 7    $(popup% + &58) = "
  255.  Copyright 1993 J.Williams"
  256. ,    $(popup% + &78) = "1.00 (01 Jan 01)"
  257.  4:                             :
  258.  "Report ..." menu item
  259. x    message$ = "Please do not choose that menu item again. Click 'Continue' to continue, or 'Abort' to continue ;-)"
  260. F    
  261. report(Report_OKAndCancel, "Continue", "Abort", message$) 
  262. H      
  263. 26,4,7:
  264. "PopUpTest: You opted to CONTINUE. Am I right? ;-)  "
  265.         
  266. L      
  267. 26,4,7:
  268. "PopUpTest: I will ignore that and continue anyway ;-)  "
  269.