home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 1 / RISC_DISC_1.iso / pd_share / code / desklib / PopUps / !PopUpTest / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1993-05-24  |  15.3 KB  |  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.         
  270. F    
  271.                            :
  272.  Exit from this PROC immediately
  273.  5:                             :
  274.  "Save As" menu item
  275. 7    $popup%         = "SaveAs"        :
  276.  PopUp Name
  277. B    $(popup% + 24)  = "file_fff"      :
  278.  File icon sprite name
  279. N    $(popup% + 36)  = DefaultSaveName$:
  280.  Default text for save-as writable
  281.  6:                             :
  282.  "WimpColour" menu item
  283.     7    $popup%         = "WimpColour"    :
  284.  PopUp Name
  285. C    popup%?24       = NewWimpColour%  :
  286.  Default to this colour
  287.  "PopUp_Open", popup% 
  288.  popuphandle%
  289. fillpopupblock(x%, y%, flags%)
  290.  Set up the generic part of the application parameter block...
  291.  (Used by 2 places in the program, so I've made it a procedure)
  292. 7popup%!12 = x%                        :
  293.  PopUp XPos
  294. 7popup%!16 = y%                        :
  295.  PopUp YPos
  296. Opopup%?20 = flags%                    :
  297.  Flags: Leaf or 'submenu' dialogue?
  298. I                                      :
  299.         Menu or Static PopUp?
  300. *                                      
  301. Bpopup%?21 = 0                         :
  302.  Plus 3 reserved bytes
  303. ?popup%?22 = 0                         :
  304.  Which must be zero
  305. popup%?23 = 0
  306.  --------------------------------------------------------------------------
  307. zerostring(address%)            :
  308.  Read a zero-terminated string
  309. A%=address%
  310.  ?A% > 31: A%+=1: 
  311. ?A%=&0d
  312. =$address%
  313.  --------------------------------------------------------------------------
  314. savefile
  315.  flags%, window, icon, xpos, ypos
  316.  ON Entry, the pollblock (b%) contains the Message_PopUpState from the
  317.  SaveAs PopUp.
  318. flags% = b%!36
  319.  flags% 
  320.  SaveAs_OKClick 
  321.  The SaveAs 'OK' button was clicked (or RETURN pressed), and the filename
  322.  appears valid, so we can just try saving to the given name.
  323. savedata(
  324. zerostring(b%+44))
  325.  The SaveAs file icon was dragged and dropped onto another window.
  326.  We thus build a DataSave message and send it to the window under the
  327.  pointer, to initiate a save.
  328.  "Wimp_GetPointerInfo",,b%
  329. ><  window = b%!12                 :
  330.  window under pointer
  331. ?:  icon   = b%!16                 :
  332.  icon under pointer
  333. @1  xpos   = b%!0                  :
  334.  pointer x
  335. A1  ypos   = b%!4                  :
  336.  pointer y
  337. C=  b%!0   = 256                   :
  338.  Message header : size
  339. D?  b%!4   = 0                     :
  340.                   sender
  341. E?  b%!8   = 0                     :
  342.                   my-ref
  343. FA  b%!12  = 0                     :
  344.                   your-ref
  345. G?  b%!16  = Message_DataSave      :
  346.                   action
  347. IF  b%!20  = window                :
  348.  DataSave msg:    window handle
  349. JD  b%!24  = icon                  :
  350.                   icon handle
  351. KK  b%!28  = xpos                  :
  352.                   pointer position x
  353. LK  b%!32  = ypos                  :
  354.                   pointer position y
  355. ML  b%!36  = 80                    :
  356.                   Estimated file size
  357. NO  b%!40  = &FFF                  :
  358.                   File type (FFF = Text)
  359.  b%+44 onwards already contains the proposed leafname, as returned
  360.  by the SaveAs popup in the Message_PopUpState.
  361.  "Wimp_SendMessage", 17, b%, window, icon
  362. savedata(filepathname$)
  363. (filepathname$)
  364.  (F% = 0) 
  365.               :
  366.  ERROR - can't open output file
  367.  #F%, "Output for testing/demonstrating SaveAs PopUp operation"
  368. ("SetType "+filepathname$+"  Text")
  369. bMDefaultSaveName$ = filepathname$ :
  370. emeber this as new SaveAs icon default
  371.  --------------------------------------------------------------------------
  372. report(reportflags%, oktext$, canceltext$, message$)
  373.  done%, result%
  374. 26,4,7:
  375. "PopUpTest Fatal Error: ";
  376.  If we want to report an error/problem/message, then we call this function.
  377.  It is sortof equivalent to SYS "Wimp_ReportError", but allows other
  378.  tasks to CONTINUE MULTITASKING while we are reporting the problem.
  379.  Parameters:
  380.    IN
  381.      reportflags% = Report_OKOnly, ReportCancelOnly, or Report_OKAndCancel
  382.      the strings are text for OK/Cancel buttons and Message to report
  383.    OUT
  384.      Returns TRUE if 'OK' was clicked, or FALSE if 'Cancel' was clicked
  385.    EXPLANATION
  386.      It first creates a PopUp "Report", and then waits for it to return a
  387.      result to us before allowing the user to do anything else. This is
  388.      achieved by using a new Wimp_Poll loop that ignores all events except
  389.        a) those events that we MUST process (redraws, open window requests)
  390.        b) those events that we want to process (quit, Report state return)
  391.      Note that this can be called at any time, and will not return until
  392.      the user has ackknowledged the report dialogue box - perfect in
  393.      cases when you want to ask about something before continuing.
  394.      Note also that I am repeating a bit of code here - this is to provide
  395.      a function that you can copy & paste into your own programs which will
  396.      (with slight modifications) allow you to show a problem/message report
  397.      by just calling this function. Simple!
  398.      (BTW, remember to also copy fillpopupblock, and use popup%!)
  399.  "Wimp_GetPointerInfo",,b%
  400. fillpopupblock(b%!0 - 64, b%!4 + 64, PopUpAsWindow)
  401. 3$popup%         = "Report"        :
  402.  PopUp Name
  403. "popup%!24       = reportflags%
  404. #$(popup% + 28)  = 
  405. oktext$, 11)
  406. '$(popup% + 40)  = 
  407. canceltext$, 11)
  408. P$(popup% + 52)  = "PopUp Test"    :
  409.  **** Put 12-char application name here!
  410. %$(popup% + 64)  = 
  411. message$, 187)
  412.  "Wimp_CreateMenu",,-1         :
  413.  Ensure menu is killed
  414.  "PopUp_Open", popup% 
  415.  popuphandle%
  416.  popuphandle% = 0 
  417.  Failed! Argh!
  418. done%   = 
  419. result% = 
  420.  "Wimp_Poll", 1, b% 
  421.  reasoncode%
  422.  reasoncode% 
  423. P    
  424. emeber that you MUST handle REDRAW, OPEN requests for your own windows!
  425.  17, 18:  
  426.       
  427.  b%!16 
  428.         
  429.  Message_Quit:
  430.           quit% = 
  431.           done% = 
  432. #        
  433.  Message_PopUpRequest:
  434. :          
  435.  "Wimp_CreateSubMenu",,b%!20, b%!24, b%!28
  436. !        
  437.  Message_PopUpState:
  438. &          
  439.  b%!20 = popuphandle% 
  440. 6            result% = (b%!36 
  441.  Report_OKOnly) <> 0
  442.             done% = 
  443.           
  444.       
  445.  done%
  446. = result%
  447.