home *** CD-ROM | disk | FTP | other *** search
Wrap
RISC OS BBC BASIC V Source | 1993-05-09 | 8.2 KB | 351 lines
>!RunImage ExtDemo - WimpExtension Demo Application (c) Jon Ribbens of DoggySoft, 1993 @xdragasprite_stop%=&62401 : Spot the anagram of a musical? "OS_ReadModeVariable",-1,5 ,,yeig% yeig%<2 sprite$="Sprites22" sprite$="Sprites" "OS_File",17,"<ExtDemo$Dir>."+sprite$ type%,,,,length% type%<>1 length%>12288 0,"Incorrect or missing Sprites file" sprite% length%+4 !sprite%=length%+4 "OS_SpriteOp",266,sprite%,"<ExtDemo$Dir>."+sprite$ "OS_File",17,"<ExtDemo$Dir>.DrawFile" type%,,,,drawlen% type%<>1 drawlen%>4096 0,"Incorrect or missing DrawFile file" draw% drawlen%,drawsc% 24 "OS_File",255,"<ExtDemo$Dir>.DrawFile",draw%,0 but_ok% 32,but_okquit% 32 $but_ok%="OK"+ ($but_okquit%="OK"+ 0+"Quit"+ q% 3072,indir% 2048,font% 256 i%=0 255:font%?i%=0: "Wimp_Initialise",200,&4B534154,"ExtDemo" ,task% "WimpExt_Initialise",16,task%,%10100001111,sprite% !q%=0:q%!4=0:q%!8=0 "WimpExt_LoadTemplates",q%,q%+12,indir%,indir%+2048,font%,"<ExtDemo$Dir>.Templates",sprite% &infow%=!q%:mainw%=q%!4:linkw%=q%!8 "WimpExt_LinkWindows",,,mainw%,linkw%,%1111 makemenu "WimpExt_SetIconString",,,infow%,0,"0.11 (09-May-1993)" "WimpExt_IconBarSprite",,,-1,"!extdemo",,3 save% 256 !:$save%="This is an example file saved by ExtDemo."+ "5$save%+="WimpExtension makes it very easy to"+ #8$save%+="implement save boxes, and they can use"+ $6$save%+="<Wimp$Scrap> and RAM transfer - drag"+ %8$save%+="the icon to a text editor to try it out..." &!esave%=save%+ $save%:error%=0 'Aptrc%= :ptrl%= :colour%=8:menu%=0:cmenu%=-1:fmenu%=-1:quit%= iconbox% 40,windbox% 16 )C!iconbox%=linkw%:iconbox%!4=32: "Wimp_GetIconState",,iconbox% iconbox%+=8:heap%=0 SYS "WimpExt_Heap",0,0 "WimpExt_Heap",0, error quit% "XWimpExt_SlabIcon",,,0,0,0 "WimpExt_PrePoll" "Wimp_Poll",1,q% reason% "WimpExt_Action",task%,q%,reason% reason% reason% 5* "Wimp_RedrawWindow",,q% flag% flag% 7! "WimpExt_Redraw",,q% !q%=linkw% 9. xorg%=q%!4-q%!20:yorg%=q%!16-q%!24 :% !windbox%=!iconbox%+xorg% ;' windbox%!4=iconbox%!4+yorg% <' windbox%!8=iconbox%!8+xorg% =) windbox%!12=iconbox%!12+yorg% >9 "WimpExt_Intersect",1,,windbox%,q%+28 @E !drawsc%=65536:drawsc%!4=0:drawsc%!8=0:drawsc%!12=65536 AD drawsc%!16=!iconbox%+xorg%:drawsc%!20=iconbox%!4+yorg% BI "WimpExt_DrawOp",0,drawsc%,draw%+40,draw%+drawlen%,q%+28 E, "Wimp_GetRectangle",,q% flag% F 2 : "WimpExt_OpenLinked",,q% 3 : "WimpExt_CloseLinked",,q% J" q%!12=infow% q%!8<>2 K6 q%!24=infow%: "Wimp_GetWindowState",,q%+24 L< q%!8=4 q%!52=-1: "WimpExt_OpenLinked",,q%+24 M7 q%!20=infow%:q%!24=1: "Wimp_DragBox",,q%+20 N q%!12=-2 q%!8=4 P+ "WimpExt_OpenWindowTop",mainw% Q. "WimpExt_PutCaretIcon",,,linkw%,9 R q%!12=-2 q%!8=2 T4 "WimpExt_CreateMenu",,imenu%,!q%-64,184 menu%=imenu% V q%!12=linkw% q%!16=2 q%!16=3 Y< "WimpExt_GetFontMenu",0,"Font menu" ,fmenu% Z: "WimpExt_CreateMenu",,fmenu%,!q%-64,16+q%!4 menu%=fmenu% q%!16=5 ^7 "WimpExt_ColoursMenu",colour%,0 cmenu% _: "WimpExt_CreateMenu",,cmenu%,!q%-64,16+q%!4 menu%=cmenu% q%!16=8 q%!8<>2 cH "WimpExt_DragIcon",%100000101,sprite%,linkw%,8,"file_fff" e q%!16=10 q%!8<>2 f6 "WimpExt_GetIcon",,,linkw%,9 ,,,file$ gP file$,".")=0 1,"To save, drag the icon to a directory viewer" h4 "OS_File",10,file$,&FFF,,save%,esave% j q%!16=13 q%!8<>2 "WimpExt_OpenRequester",,,"Message from ExtDemo","This is an ordinary, multitasking requester. The message, title and buttons can be anything you like.",but_ok%,0 resptr(1) n q%!16=14 q%!8<>2 "WimpExt_ControlImmediate",,2,"Message from ExtDemo","This is an immediate, non-multitasking requester. The message, title and buttons can be anything you like.",but_ok%,0 resptr(1) r q%!16=17 q%!8<>2 ptrl% t) "WimpExt_ReleasePointer" uD "WimpExt_SetIconString",,,linkw%,17,"Limit pointer" ptrl%= x. "WimpExt_LimitPointer",linkw% yF "WimpExt_SetIconString",,,linkw%,17,"Release pointer" ptrl%= } q%!16=18 q%!8<>2 ptrc% ' "WimpExt_SetPointer",0 E "WimpExt_SetIconString",,,linkw%,18,"Change pointer" ptrc%= 9 "WimpExt_SetPointer","ptr_extdemo",,16,6 D "WimpExt_SetIconString",,,linkw%,18,"Reset pointer" ptrc%= xdragasprite_stop% 2 "WimpExt_GetIcon",,,linkw%,9 ,,,file$ = "WimpExt_DataSave",esave%-save%,file$,&FFF,save%,1 " "Wimp_ProcessKey",q%!24 menu%=imenu% !q% 9 0 : "WimpExt_OpenDialogue",,,infow%,398,44 1 : quit%= menu%=fmenu% / "WimpExt_DecodeFontMenu",q%+256,q% 6 "WimpExt_SetIconString",,,linkw%,2,q%+256 ! menu%=cmenu% !q%>=0 colour%=!q% : "WimpExt_SetIconColour",,,linkw%,5,-1,colour% , "WimpExt_ColoursMenu",colour%,0 17,18 : q%!16 0 : quit%= 1 1,3 : "WimpExt_DataLoad",0,q%,0,0 &400C1 : resptr(3) &45782 : 1 q%!20=0 "OS_GenerateError",q%+24 A q%!20=2 "WimpExt_SetIconString",,,linkw%,9,q%+24 &45784 : 1 q%!20=0 "OS_GenerateError",q%+28 q%!20=1 q%!20=2 heap%=q%!24 bk%=!heap% / "WimpExt_FindLeaf",q%+40 file$ "WimpExt_ControlImmediate",,2,"Message from ExtDemo","File '"+file$+"' loaded and will be saved as RAM:$.ExtDemoT.",but_ok%,0 B "OS_File",10,"RAM:$.ExtDemoT",&FFF,,bk%,bk%+(q%!28) 1 A%=heap%:heap%=0: "WimpExt_Heap",3,A% &45790 : q%!20=18 7 q%!12=q%!8: "Wimp_SendMessage",19,q%,q%!4 / "WimpExt_SlabIcon",,,linkw%,13,1 "WimpExt_OpenRequester",,,"Message from ExtDemo","This is an ordinary, multitasking requester. The message, title and buttons can be anything you like.",but_ok%,0 resptr(1) xdragasprite_stop% "XWimpExt_SetPointer",0 "XWimpExt_ReleasePointer" losefonts "XWimpExt_CloseDown",task% "XWimp_CloseDown" makemenu imenu% 72 $imenu%="ExtDemo" imenu%!12=&70207 imenu%!16=7*16+16 imenu%!20=44 imenu%!24=0 imenu%!28=0 imenu%!32=infow% imenu%!36=&7000021 $(imenu%+40)="Info" imenu%!52=128 imenu%!56=0 imenu%!60=&7000021 $(imenu%+64)="Quit" resptr(F%) > "WimpExt_SetIconString",,,linkw%,17,"Limit pointer" ptrl%= ? "WimpExt_SetIconString",,,linkw%,18,"Change pointer" ptrc%= error error%=2 heap% A%=heap%:heap%=0: "XWimpExt_Heap",3,A% error%=1 error%=2: error2:error%=0: error%=1 resptr(3) "WimpExt_ControlImmediate",,2,"Error from ExtDemo", $,but_okquit%,0 button% error%=0 button%<>3 error2 " A$= A$,1)="." ; !q%= :$(q%+4)=A$+". Click CANCEL to quit program."+ "Wimp_ReportError",q%,%10011,"Serious error from ExtDemo" ,button% button%<>2 losefonts i%=1 : font%?i%>0:font%?i%-=1: "XFont_LoseFont",i%: