home *** CD-ROM | disk | FTP | other *** search
RISC OS BBC BASIC V Source | 1995-03-21 | 12.1 KB | 517 lines |
- This application is FreeWare. (c) 1995 Dick Alstein
- error
- quit%=
- +pollmask%=(1<<0)+(1<<7)+(1<<11)+(1<<12)
- "Wimp_Poll",pollmask%,blk%
- reason%
- reason%
- -
- "Wimp_GetPointerInfo",,scrapblk%
- #
- scrapblk%!12=menuwin%
- ypos%=scrapblk%!4
- scrapblk%!0=menuwin%
- /
- "Wimp_GetWindowState",,scrapblk%
- C linenr%=(scrapblk%!16-scrapblk%!24-ypos%)
- iconheight%
- $
- linenr%<0
- linenr%=-1
- %
- linenr%<>currentline%
- 0
- menuwin_forceredraw(currentline%)
- " currentline%=linenr%
- 0
- menuwin_forceredraw(currentline%)
-
-
- 1 :
- redraw(blk%!0)
- (
- 2 :
- "Wimp_OpenWindow",,blk%
- )
- 3 :
- "Wimp_CloseWindow",,blk%
-
- blk%!0=menuwin%
- # pollmask%=pollmask%
- .
- menuwin_forceredraw(currentline%)
- currentline%=-1
- .
- menuwin_forceredraw(currentline%)
-
-
- blk%!0=menuwin%
- $' pollmask%=pollmask%
- currentline%=-1
-
- '?
- 6 :
- mouseclick(blk%!0,blk%!4,blk%!8,blk%!12,blk%!16)
- (*
- 8 :
- "Wimp_ProcessKey",blk%!24
- 9 :
- menuselect(blk%)
- *1
- 17,18 :
- receive(blk%!4,blk%!8,blk%!16)
- quit%
- next%
- Appl$="ModeHistory"
- 3#ApplVersion$="1.00 (21-Mar-95)"
- 4$ModVersion$="1.00 (19 Feb 1995)"
- errblk% &100
- 6Dmsgcode%=(&DA3C0 << 6) :
- message action code selected randomly
- msglist% 24
- msglist%!0=&400C1
- msglist%!4=&400C2
- msglist%!8=&400C3
- msglist%!12=msgcode%
- msglist%!16=10
- msglist%!20=0
- "Wimp_Initialise",310,&4B534154,Appl$,msglist%
- osversion%,thistask%
- error
- scrapblk% &100
- blk% &200
- indsize%=&200
- indir% indsize%
- indirend%=indir%+indsize%
- E(ApplDir$=
- readvarval("ModeHist$Dir")
- codesize%=&1000
- armcode% codesize%
- H-thetaskname$=
- readvarval("ModeHist$Host")
- check for presence of another copy of myself and of Display Manager
- next%=0
- thetaskhandle%=0
- "TaskManager_EnumerateTasks",next%,scrapblk%,16
- next%
- next%>=0
- str(scrapblk%!4)
- Q5
- thetaskname$ : thetaskhandle%=scrapblk%!0
- R<
- Appl$ :
- 0,Appl$+" is already running"
- next%<0
- thetaskhandle%<>0
- assemble
- YK dummy%=
- errbox("Warning: "+Appl$+" needs "+thetaskname$+" to work",1)
- "Wimp_OpenTemplate",,ApplDir$+".Templates"
- \"infowin%=
- loadtemplate("Info")
- ]%$(blk%!(92+7*32+20))=ApplVersion$
- ^"menuwin%=
- loadtemplate("Menu")
- "Wimp_CloseTemplate"
- "MenuUtil_Initialise",010,0
- "MenuUtil_New",,Appl$
- mainmenu%
- "MenuUtil_Add",mainmenu%,"Info"
- item_info%
- "MenuUtil_SubMenu",item_info%,infowin%
- "MenuUtil_Add",mainmenu%,"Save status"
- item_savestatus%
- "MenuUtil_Add",mainmenu%,"Quit"
- item_quit%
- f0historysize%=
- readvarval("ModeHist$Size"))
- historysize%<3
- historysize%=3
- modedef$(historysize%) :
- full mode descriptor to change mode
- iAdesclength%=20 :
- #chars in lines of the 'menu'
- modedescr% desclength%*historysize% :
- mode descriptors for the menu
- modedesc%(historysize%) :
- -> string describing mode
- i%=0
- historysize%-1
- m- modedesc%(i%)=modedescr%+i%*desclength%
- iconwidth%=16*14+16
- iconheight%=44
- pal% 1024
- nrofmodes%=0
- status_load
- mode_add
- redraw(handle%)
- more%,top%,linenr%,lastline%,hline%
- blk%!0=handle%
- "Wimp_RedrawWindow",,blk%
- more%
- top%=blk%!16-blk%!24
- more%
- }* linenr%=(top%-blk%!40)
- iconheight%
- ~, lastline%=(top%-blk%!32)
- iconheight%
- linenr%<=lastline%
- # hline%=nrofmodes%-linenr%-1
- ,
- (hline%<nrofmodes%)
- (hline%>0)
- $
- print data for this line
- "
- linenr%=currentline%
- !
- "Wimp_SetColour",1
- %
- "Wimp_SetColour",128+7
-
- !
- "Wimp_SetColour",7
- %
- "Wimp_SetColour",128+1
-
- 1
- blk%!4,top%-(iconheight%*(linenr%+1))
- '
- 96+3,iconwidth%,iconheight%
- 1
- blk%!4+8,top%-(iconheight%*linenr%)-8
-
- $(modedesc%(hline%))
-
- linenr%+=1
- "Wimp_GetRectangle",,blk%
- more%
- menuwin_close
- scrapblk%!0=menuwin%
- "Wimp_CloseWindow",,scrapblk%
- menuwin_open
- x%,y%,z%
- scrapblk%!0=menuwin%
- "Wimp_GetWindowState",,scrapblk%
- x%,y%,z%
- scrapblk%!4=x%-3*16
- scrapblk%!8=96
- 'scrapblk%!12=scrapblk%!4+iconwidth%
- $scrapblk%!16=scrapblk%!8+extent%
- scrapblk%!28=-1
- "Wimp_OpenWindow",,scrapblk%
- currentline%=-1
- menuwin_setextent
- scrapblk%!0=0
- scrapblk%!8=iconwidth%
- &extent%=(nrofmodes%-1)*iconheight%
- nrofmodes%<3
- extent%=3*iconheight%
- scrapblk%!4=-extent%
- scrapblk%!12=0
- "Wimp_SetExtent",menuwin%,scrapblk%
- menuwin_forceredraw(l%)
- ymin%=-(l%+1)*iconheight%
- ymax%=-l%*iconheight%+4
- "Wimp_ForceRedraw",menuwin%,0,ymin%,iconwidth%,ymax%
- status_load
- (ApplDir$+".Status")
- F%<>0
- $
- #F%,modedef$(nrofmodes%),d$
- # $(modedesc%(nrofmodes%))=d$
- nrofmodes%+=1
- #F%)
- (nrofmodes%=historysize%)
- menuwin_setextent
- status_save
- (ApplDir$+".Status")
- F%<>0
- i%=0
- nrofmodes%-1
- *
- #F%,modedef$(i%),$(modedesc%(i%))
- errbox(err$,boxes%)
- errblk%!0=0
- $(errblk%+4)=err$+
- "Wimp_ReportError",errblk%,boxes%,Appl$
- ,click%
- =(click%=1)
- error
- exit :
- errbox(
- $+" (line "+
- )+")",3)
- "Wimp_CloseDown"
- "XOS_Module",4,modname$
- "Wimp_CloseDown"
- loadtemplate(name$)
- handle%
- "Wimp_CloseTemplate" :
- error
- "Wimp_LoadTemplate",,blk%+4,indir%,indirend%,-1,name$,0
- ,,indir%
- "Wimp_CreateWindow",,blk%+4
- handle%
- =handle%
- mode_add
- m%,m$,M$,x%,y%,c%,grey%,c$,xeig%,yeig%
- i%,end%
- create mode definition string
- x%=1+
- mode_readvar(11)
- y%=1+
- mode_readvar(12)
- mode_readvar(9)
- xeig%=
- mode_readvar(4)
- yeig%=
- mode_readvar(5)
- c%>3
- grey%=
- check current palette to see if it's grey
- grey%=
- "ColourTrans_ReadPalette",-1,-1,pal%,1024,0
- ,,end%
- i%=pal%
- grey%
- (i%<end%)
- K grey%=((i%?1)=(i%?2))
- ((i%?1)=(i%?3)) :
- are R,G,B values equal?
- i%+=4
- 4 : c$+="32k"
- 5 : c$+="16M"
- : c$+=
- (1<<(1<<c%))
- M$="X"+
- (x%)+" Y"+
- (y%)+" "
- 11," ")
- m$,1)=
- (x%)+"x"+
- grey%
- M$+="G"
- m$,11)="g"
- M$+="C"
- (M$+=c$+" EX"+
- (xeig%)+" EY"+
- (yeig%)
- m$+=c$
- m%<256
- check if already present in history
- (modedef$(i%)<>M$)
- (i%<nrofmodes%)
- i%+=1
- i%>=nrofmodes%
- i%<historysize%
- i%=nrofmodes%
- nrofmodes%+=1
- menuwin_setextent
- i%-=1
- move history data
- i%>0
- %! modedef$(i%)=modedef$(i%-1)
- &) $(modedesc%(i%))=$(modedesc%(i%-1))
- i%-=1
- add current mode at top
- modedef$(0)=M$
- $(modedesc%(0))=m$
- mode_change(hline%)
- osversion%<350
- "Wimp_SetMode",
- (modedef$(hline%))
- modedef$(hline%)
- mode_readvar(nr%)
- "OS_ReadModeVariable",-1,nr%
- ,,v%
- menuselect(selection%)
- selinfo%,itemnr%,item%,item$,parentitem%
- "MenuUtil_Decode",mainmenu%,selection%
- ,,selinfo%
- itemnr%=selinfo%!0
- item%=selinfo%!8
- item$=
- str(selinfo%!12)
- parentitem%=selinfo%!24
- item%
- item_savestatus%
- status_save
- item_quit%
- quit%=
- mouseclick(xpos%,ypos%,button%,wndw%,icon%)
- wndw%
- menuwin%
- button%
-
- N scrapblk%!0=menuwin%
- O/
- "Wimp_GetWindowState",,scrapblk%
- PC linenr%=(scrapblk%!16-scrapblk%!24-ypos%)
- iconheight%
- Q' hline%=nrofmodes%-linenr%-1
- R0
- (hline%<nrofmodes%)
- (hline%>0)
-
- menuwin_close
- T"
- mode_change(hline%)
-
-
- blk%!4=blk%!4+66
-
- showmenu(blk%)
- Y
- readvarval(var$)
- len%
- "OS_ReadVarVal",var$,scrapblk%,256,0
- ,,len%
- scrapblk%?len%=13
- =$(scrapblk%)
- receive(sender%,ref%,code%)
- icon%,window%,name$,type%
- i%,cmd$
- sender% <> thistask%
- code%
- quit%=
-
- desktop save
- l" cmd$="Run "+ApplDir$+
- m-
- "OS_GBPB",2,blk%!20,cmd$,
- (cmd$)
- n'
- &400C1 :
- Message_ModeChange
-
- mode_add
- p+
- &400C2 :
- Message_TaskInitialise
- q?
- str(blk%+28)=thetaskname$)
- (thetaskhandle%=0)
- r" thetaskhandle%=sender%
-
- assemble
-
- u*
- &400C3 :
- Message_TaskCloseDown
- v$
- sender%=thetaskhandle%
- w&
- "XOS_Module",4,modname$
- thetaskhandle%=0
-
- msgcode%
-
- -1)
-
- nrofmodes%>1
-
- menuwin_close
-
- mode_change(1)
-
-
-
- menuwin_open
-
- showmenu(blkptr%)
- "MenuUtil_Show",mainmenu%,blkptr%
- str(s%)
- i%,n$
- (s%?i%>=32)
- (i%<255)
- n$+=
- (s%?i%)
- i%+=1
- assemble
- LR = 14
- PC = 15
- modname$=Appl$
- pass%=8
- P% = armcode%
- L% = P% + codesize%
- [ OPT pass%
- ? EQUD 0 ; offset to start code
- H EQUD initCode-top ; offset to initialization code
- F EQUD exitCode-top ; offset to finalization code
- I EQUD 0 ; offset to service call handler
- A EQUD titleStr-top ; offset to title string
- @ EQUD helpStr-top ; offset to help string
- G EQUD 0 ; offset to help&command table
- .titleStr
- EQUS modname$+
- ALIGN
- .helpStr
- ) EQUS modname$+
- 9+ModVersion$+
- ALIGN
- .thetaskhandle
- EQUD thetaskhandle%
- .msgcode
- EQUD msgcode%
- .thistaskhandle
- EQUD thistask%
- .filtermask
- ! EQUD &FFFFFFFF
- (1<<6)
- .filtername
- EQUS Appl$+
- ALIGN
- .initCode
- STMFD R13!,{R0-R4,LR}
- ADR R0,filtername
- ADR R1,filterit
- MOV R2,#0
- LDR R3,thetaskhandle
- LDR R4,filtermask
- + SWI "XFilter_RegisterPostFilter"
- 2 LDMFD R13!,{R0-R4,PC} ; return
- .exitCode
- STMFD R13!,{R0-R4,LR}
- ADR R0,filtername
- ADR R1,filterit
- MOV R2,#0
- LDR R3,thetaskhandle
- LDR R4,filtermask
- - SWI "XFilter_DeRegisterPostFilter"
- LDMFD R13!,{R0-R4,PC}^
- .filterit
- STMFD R13!,{R1-R3,LR}
- LDR R3,[R1,#8]
- C TST R3,#1 ; test if Adjust pressed
- BEQ filterit_end
- F LDR R3,[R1,#12] ; test for click on iconbar
- CMN R3,#2
- BNE filterit_end
- / ; transfer the event to the ModeHist task
- 4 LDR R3,[R1,#0] ; X coord
- + STR R3,[R1,#20]
- 4 LDR R3,[R1,#4] ; Y coord
- STR R3,[R1,#24]
- : LDR R3,[R1,#8] ; mouse buttons
- STR R3,[R1,#28]
- : LDR R3,[R1,#12] ; window handle
- STR R3,[R1,#32]
- 8 LDR R3,[R1,#16] ; icon handle
- STR R3,[R1,#36]
- MOV R0,#17
- 9 MOV R3,#40 ; message size
- STR R3,[R1,#0]
- MOV R3,#0
- 5 STR R3,[R1,#12] ; your_ref
- LDR R3,msgcode
- STR R3,[R1,#16]
- LDR R2,thistaskhandle
- " SWI "XWimp_SendMessage"
- < MVN R0,#0 ; claim the event
- .filterit_end
- LDMFD R13!,{R1-R3,PC}
- .bottom
- pass%
- "OS_Module",11,top,(bottom-top)
-