home *** CD-ROM | disk | FTP | other *** search
RISC OS BBC BASIC V Source | 1994-08-23 | 17.2 KB | 831 lines |
- ><Abode$Dir>.Source
- This application is FreeWare. (c) 1992,1993,1994 Dick Alstein
- Appl$="Abode"
- Version$="1.20 (23-Aug-94)"
- error
- quit%=
- .mask%=(1<<4)+(1<<5)+(1<<7)+(1<<11)+(1<<12)
- "OS_ReadMonotonicTime"
- blinktime%
- F blinktime%=(blinktime%+blinkperiod%)-(blinktime%
- blinkperiod%)
- "Wimp_PollIdle",mask%,blk%,blinktime%
- reason%
- reason%
-
- blinkcaret
- +
- "OS_ReadMonotonicTime"
- time%
-
- time%>rmamintime%
- B
- minimizerma%
- "XOS_ChangeDynamicArea",1,-(1<<24)
- ! rmamintime%=time%+100
-
- )
- 2 :
- "XWimp_OpenWindow",,blk%
- )
- 3 :
- "Wimp_CloseWindow",,blk%
- ?
- 6 :
- mouseclick(blk%!0,blk%!4,blk%!8,blk%!12,blk%!16)
- )
- 8 :
- key(blk%!0,blk%!4,blk%!24)
- 9 :
- menuselect(blk%)
- 1
- 17,18 :
- receive(blk%!4,blk%!8,blk%!16)
- quit%
- msg_exit
- "Wimp_CloseDown"
- access(name$,type%)
- ofs%,read%,item$,itemtype%,i%,N$
- "OS_File",5,name$
- ,,,,,attr%
- type%=2
- &+ attr%=(attr%
- &F7)
- (access%
- &08)
- (# attr%=(attr%
- &C4)
- access%
- dontlocksetup%
- *$ N$=
- upcase(
- leafname(name$))
- +
- msg_lookup0(N$)<>""
- attr%=attr%
- -
- "XOS_File",4,name$,,,,attr%
- ;flg%
- (flg%
- complain(
- msg_lookup1("NoAccess",name$))
- type%=2
- ofs%=0
- 6
- 7B
- "OS_GBPB",10,name$,blk%,1,ofs%,40,"*"
- ,,,read%,ofs%
-
- read%
- itemtype%=blk%!16
- :) item$=name$+"."+
- str(blk%+20)
- ;$
- access(item$,itemtype%)
-
- =
- (read%=0)
- (flg%
- basicload(file$)
- dodir%
- "Wimp_StartTask","Dir "+
- dirname(file$)
- "XOS_Module",18,"ARMBasicEditor"
- ;flg%
- ((flg%
- 1)=0)
- -1)
- insertcmd("EDIT")
- insertcmd("MODE MODE")
- "Wimp_StartTask","Basic -load "+file$
- blinkcaret
- blink%
- "Wimp_GetCaretPosition",,ct%
- (ct%!0<>-1)
- (ct%!16<>-1)
- ct%!16=(ct%!16)
- (1<<25)
- TI
- "Wimp_SetCaretPosition",ct%!0,ct%!4,ct%!8,ct%!12,ct%!16,ct%!20
- complain(text$)
- dummy%
- dummy%=
- errbox(text$,17)
- defaultstatus
- mode%=1
- access%=&03
- dodir%=
- confirm%=
- blink%=
- newtype$="Text"
- cmd$=""
- dontlocksetup%=
- pullfront%=
- pullfrontkey%=&1EA
- blinkperiod%=25
- minimizerma%=
- taskwindow%=
- dirname(F$)
- p%,q%
- F$,".",p%)
- q% > 0
- p%=q%+1
- q%=0
- F$,p%-2)
- errbox(err$,boxes%)
- errblk%!0=0
- $(errblk%+4)=err$+
- "Wimp_ReportError",errblk%,boxes%,Appl$
- ,click%
- =(click%=1)
- error
- "Wimp_CloseDown" :
- errbox(
- $+" (line "+
- )+")",3)
- "Wimp_CloseDown"
- flg%
- errblk% &100
- "Wimp_Initialise",200,&4B534154,Appl$
- osversion%,thistask%
- error
- blk% &400
- indsize%=&400
- indir% indsize%
- indirend%=indir%+indsize%
- ptrinfo% 20
- varbuf% 256
- newtype$="Text"
- emptystr% 4
- $emptystr%=""
- ct% 24
- accessbit%(4)
- accessbit%(0)=&08
- accessbit%(1)=&01
- accessbit%(2)=&02
- accessbit%(3)=&10
- accessbit%(4)=&20
- msg_init
- "OS_ReadMonotonicTime"
- rmamintime%
- readscreenvars
- loadstatus
- %spfilename$="<Abode$Dir>.Sprites"
- "OS_ReadModeVariable",27,0
- ;flg% :
- test if hires modes available
- (flg%
- 2)=0
- spfilename$+="22"
- "OS_File",17,spfilename$
- ,,,,spsize%
- spsize%+=16
- sparea% spsize%
- sparea%!0=spsize%
- sparea%!8=16
- "OS_SpriteOp",256+9,sparea%
- "OS_SpriteOp",256+10,sparea%,spfilename$
- spname% 14
- $spname%="abode_"+
- (mode%)
- mode%=4
- (access%
- accessbit%(0))
- $spname%+="b"
- $spname%+="a"
- blk%!0=-1
- blk%!4=0 : blk%!8=0
- blk%!12=68 : blk%!16=68
- blk%!20=&7000311A
- blk%!24=spname%
- blk%!28=sparea%
- blk%!32=12
- "Wimp_CreateIcon",,blk%
- baricon%
- "Wimp_OpenTemplate",,"<Abode$Dir>.Templates"
- *infowin%=
- loadtemplate("Info",sparea%)
- !$(blk%!(92+32*3+20))=Version$
- .accesswin%=
- loadtemplate("Access",sparea%)
- ,optwin%=
- loadtemplate("Options",sparea%)
- 'pullfrontkeystr%=blk%!(92+32*11+20)
- 1grabkeywin%=
- loadtemplate("GrabKeys",sparea%)
- "Wimp_CloseTemplate"
- I%=0
- selecticon(accesswin%,I%,(access%
- accessbit%(I%)))
- selecticon(optwin%,1,dodir%)
- selecticon(optwin%,2,dontlocksetup%)
- selecticon(optwin%,3,confirm%)
- selecticon(optwin%,4,blink%)
- selecticon(optwin%,5,pullfront%)
- selecticon(optwin%,6,minimizerma%)
- shadeicon(optwin%,8,
- blink%)
- shadeicon(optwin%,9,
- blink%)
- selecticon(optwin%,14,taskwindow%)
- :blk%!0=grabkeywin% :
- open grabkeys window off-screen
- "Wimp_GetWindowState",,blk%
- blk%!4=(blk%!4)-10000
- blk%!8=(blk%!8)-10000
- blk%!12=(blk%!12)-10000
- blk%!16=(blk%!16)-10000
- blk%!28=-1
- "Wimp_OpenWindow",,blk%
- preparemenus
- insertcmd(s$)
- i%=1
- "OS_Byte",138,0,
- s$,i%,1))
- "OS_Byte",138,0,13
- key(window%,icon%,key%)
- val%,ok%
- (window%=optwin%)
- (icon%=11)
- val%=0
- validhotkey(key%)
- - $(pullfrontkeystr%)=
- hotkeyname(key%)
- !
- selecticon(optwin%,11,0)
- I
- "Wimp_SetCaretPosition",optwin%,11,,,-1,
- ($(pullfrontkeystr%))
- pullfrontkey%=key%
- (key%=27)
- (key%=13)
- 6 $(pullfrontkeystr%)=
- hotkeyname(pullfrontkey%)
- !
- selecticon(optwin%,11,0)
- I
- "Wimp_SetCaretPosition",optwin%,11,,,-1,
- ($(pullfrontkeystr%))
- pullfront%
- (key%=pullfrontkey%)
- *
- "Wimp_GetPointerInfo",,ptrinfo%
- (ptrinfo%!12)>=0
- blk%!0=ptrinfo%!12
- (
- "Wimp_GetWindowState",,blk%
- !
- ((blk%!32)
- (1<<17))
- blk%!28=-2
-
- blk%!28=-1
-
- -
- "Wimp_SendMessage",2,blk%,blk%!0
-
- !
- "Wimp_ProcessKey",key%
- validhotkey(val%)
- ok%=
- (val%
- &F)
- 1,2,3,4,5,6,7,8,9
- ok%=(val%>=&181)
- 10,11,12
- ok%=(val%>=&1CA)
- hotkeyname(val%)
- name$
- name$=""
- (val%
- &10)
- name$+=
- (139)
- (val%
- &20)
- name$+="^"
- name$+="F"+
- (val%
- =name$
- leafname(f$)
- p%,q%
- p%=q%+1
- q%=
- f$,".",p%)
- q%=0
- f$,p%)
- loadstatus
- type$
- ("<Abode$Dir>.Status")
- F%=0
- complain(
- msg_lookup0("NoStLoad"))
- defaultstatus
- #F%,mode%,access%,dodir%,confirm%,blink%,type$,cmd$
- #F%,dontlocksetup%,pullfront%,pullfrontkey%
- #F%,blinkperiod%,minimizerma%,taskwindow%
- mode% < 1
- mode% > 5
- mode%=1
- (type$)>0)
- (type$)<12)
- newtype$=type$
- newtype$="Text"
- loadtemplate(name$,spptr%)
- handle%,i%
- "Wimp_CloseTemplate" :
- error
- "Wimp_LoadTemplate",,blk%+4,indir%,indirend%,-1,name$,0
- ,,indir%
- blk%!68=spptr%
- blk%!88>0
- i%=0
- blk%!88
- f%=blk%!(92+i%*32+16)
- (f%
- &103)=&102
- B# blk%!(92+i%*32+24)=spptr%
- C
- "Wimp_CreateWindow",,blk%+4
- handle%
- =handle%
- msg_init
- fname$,flags%,size%,buf%
- K!fname$="<Abode$Dir>.Messages"
- "MessageTrans_FileInfo",,fname$
- flags%,,size%
- flags%
- buf%=0
- buf% size%
- MsgDesc% 17+
- (fname$)
- $(MsgDesc%+16)=fname$
- "MessageTrans_OpenFile",MsgDesc%,MsgDesc%+16,buf%
- msg_exit
- "MessageTrans_CloseFile",MsgDesc%
- MsgDesc%=0
- msg_lookup0(token$)
- result%,flg%
- "XMessageTrans_Lookup",MsgDesc%,token$,0
- ,,result%;flg%
- (flg%
- ` =""
- str(result%)
- msg_lookup1(token$,param$)
- result%
- "MessageTrans_Lookup",MsgDesc%,token$,blk%,&100,param$
- ,,result%
- str(result%)
- mouseclick(xpos%,ypos%,button%,wndw%,icon%)
- wndw%
- button%
-
-
- mode%=5
-
- setmode(1)
-
-
- setmode(mode%+1)
-
-
-
- mainmenu(1)
-
-
- mode%
-
- x'
- insertcmd("MODE MODE")
- y+
- "Wimp_StartTask","Basic"
-
- {1 access%=(access%
- accessbit%(0))
- |C
- selecticon(accesswin%,0,(access%
- accessbit%(0)))
-
- setmode(4)
-
-
- runcmd(cmd$)
-
-
- accesswin%
- +
- iconselected(accesswin%,icon%)
- / access%=access%
- (accessbit%(icon%))
-
- 1 access%=access%
- accessbit%(icon%))
-
- !
- (icon%=0)
- (mode%=4)
-
- setmode(mode%)
-
- optwin%
- icon%
-
- 1 : dodir%=
- dodir%
- /
- 2 : dontlocksetup%=
- dontlocksetup%
- #
- 3 : confirm%=
- confirm%
-
- blink%=
- blink%
- +
- "Wimp_GetCaretPosition",,ct%
- <
- blink%)
- (ct%!16<>-1)
- ((ct%!16)
- (1<<25)>0)
- * ct%!16=(ct%!16)
- (1<<25))
- O
- "Wimp_SetCaretPosition",ct%!0,ct%!4,ct%!8,ct%!12,ct%!16,ct%!20
-
- *
- shadeicon(optwin%,8,
- blink%)
- *
- shadeicon(optwin%,9,
- blink%)
-
- A
- ((button%=4)
- (icon%=9))
- ((button%=1)
- (icon%=8))
- !
- blinkperiod%>16
- #
- blinkperiod%>40
- ! blinkperiod%-=2
-
- ! blinkperiod%-=1
-
-
-
- A
- ((button%=4)
- (icon%=8))
- ((button%=1)
- (icon%=9))
- "
- blinkperiod%<100
- #
- blinkperiod%<40
- ! blinkperiod%+=1
-
- ! blinkperiod%+=2
-
-
-
- '
- 5 : pullfront%=
- pullfront%
- +
- 6 : minimizerma%=
- minimizerma%
-
-
- savestatus
- blk%!0=optwin%
- '
- "Wimp_CloseWindow",,blk%
-
- blk%!0=optwin%
- '
- "Wimp_CloseWindow",,blk%
- *
- 14 : taskwindow%=
- taskwindow%
-
- menuselect(selection%)
- adjust%,selinfo%,itemnr%,item%,item$,parentitem%,p%,dx%,dy%
- "MenuUtil_Decode",mainmenu%,selection%
- ,adjust%,selinfo%
- itemnr%=selinfo%!0
- item%=selinfo%!8
- item$=
- str(selinfo%!12)
- parentitem%=selinfo%!24
- parentitem%=0
- item%
- E
- item_mode1%,item_mode2%,item_mode3%,item_mode4%,item_mode5%
-
- setmode(itemnr%)
- item_options%
- blk%!0=optwin%
- (
- "Wimp_GetWindowState",,blk%
- #
- (blk%!32
- (1<<16))=0
- 9
- center window to screen if not already open
- 4 dx%=(screensize_x%-(blk%!12+blk%!4))
- 4 dy%=(screensize_y%-(blk%!16+blk%!8))
-
- blk%!4=blk%!4+dx%
- blk%!8=blk%!8+dy%
- blk%!12=blk%!12+dx%
- blk%!16=blk%!16+dy%
- blk%!28=-1
- $
- "Wimp_OpenWindow",,blk%
- K
- "Wimp_SetCaretPosition",optwin%,11,,,-1,
- ($(pullfrontkeystr%))
- item_quit%
- quit%=
- parentitem%
- &
- item_mode2%,item_othertypes%
- !
- item%=item_rebuild%
-
- typemenu
-
- newtype$=item$
- (
- "MenuUtil_TickOnly",item%
- ,
- parentitem%=item_othertypes%
- 0
- "MenuUtil_TickOnly",parentitem%
-
- /
- "MenuUtil_Tick",typesubmenu%,0
-
-
- item_mode3%
-
- confirm%
- 5
- errbox("Kill module "+item$+"?",&13)
- 1
- "Wimp_StartTask","RMKill "+item$
- *
- "MenuUtil_Delete",item%,
-
-
- /
- "Wimp_StartTask","RMKill "+item$
- (
- "MenuUtil_Delete",item%,
-
- item_mode5%
- cmd$=item$
- adjust%
- mainmenu(0)
- readscreenvars
- xeig%,yeig%,xpixels%,ypixels%
- "OS_ReadModeVariable",-1,4
- ,,xeig%
- "OS_ReadModeVariable",-1,5
- ,,yeig%
- "OS_ReadModeVariable",-1,11
- ,,xpixels%
- "OS_ReadModeVariable",-1,12
- ,,ypixels%
- Escreensize_x%=(xpixels%+1)*(1<<xeig%) :
- screen size in OS units
- )screensize_y%=(ypixels%+1)*(1<<yeig%)
- receive(sender%,ref%,code%)
- ack%
- ack%=0
- sender% <> thistask%
- code%
- 0 : quit%=
- obj$=
- str(blk%+44)
- objtype%=blk%!40
-
- mode%
-
-
- objtype%=&FFB
-
- basicload(obj$)
- ack%=4
-
-
- 6
- (objtype% >= 0)
- (objtype% <= &FFF)
- @
- "Wimp_StartTask","SetType "+obj$+" "+newtype$
- ack%=4
-
-
- 5
- (objtype%=&1000)
- (objtype%=&2000)
-
- access(obj$,2)
-
-
- access(obj$,1)
-
- ack%=4
-
- $
- runcmd(cmd$+" "+obj$)
- ack%=4
-
- &400C1
-
- readscreenvars
- ack%<>0
- blk%!0=20
- blk%!12=ref%
- blk%!16=ack%
- (-
- "Wimp_SendMessage",17,blk%,sender%
- runcmd(command$)
- taskwindow%
- "Wimp_StartTask","TaskWindow -quit "+
- 34+command$+
- "Wimp_StartTask",command$
- savestatus
- ("<Abode$Dir>.Status")
- F%=0
- complain(
- msg_lookup0("NoStSave"))
- #F%,mode%,access%,dodir%,confirm%,blink%,newtype$,cmd$
- #F%,dontlocksetup%,pullfront%,pullfrontkey%
- #F%,blinkperiod%,minimizerma%,taskwindow%
- setmode(newmode%)
- mode%=newmode%
- C $(spname%)="abode_"+
- (mode%)
- mode%=4
- (access%
- accessbit%(0))
- $(spname%)+="b"
- $(spname%)+="a"
- selecticon(-2,baricon%,0)
- str(s%)
- i%,n$
- s%?i% >= 32 : n$+=
- (s%?i%) : i%+=1 :
- upcase(s$)
- i%=1
- a%=
- s$,i%,1))
- (a%>=97)
- (a%<=122)
- s$,i%,1)=
- (a%-32)
- menu_add(text$,submenu%)
- handle%
- "MenuUtil_Add",,text$
- handle%
- submenu%<>-1
- "MenuUtil_SubMenu",handle%,submenu%
- =handle%
- menu_addwritable(maxlen%,validstr%)
- handle%
- "MenuUtil_Add",,""
- handle%
- "MenuUtil_Writable",,1,maxlen%,validstr%
- =handle%
- preparemenus
- i%,p%,t$
- "MenuUtil_Initialise",010,0
- typesubmenu%=0
- "MenuUtil_New",,"Set type"
- typemenu%
- "MessageTrans_EnumerateTokens",MsgDesc%,"TYPE*",blk%,256,i%
- ,,p%,,i%
- p%<>0
- s! t$=
- msg_lookup0(
- str(p%))
- dummy%=
- menu_add(t$,-1)
- u-
- t$=newtype$
- "MenuUtil_Tick",,1
- p%=0
- x*item_othertypes%=
- menu_add("Other",-1)
- "MenuUtil_Dots",,1
- z.item_rebuild%=
- menu_add("Rebuild menu",-1)
- {7modmenu%=0 :
- modules submenu is built when opened
- "MenuUtil_New",,"CLI command"
- cmdmenu%
- }2item_command%=
- menu_addwritable(256,emptystr%)
- "MenuUtil_Text",item_command%,cmd$
- "MenuUtil_New",,Appl$
- mainmenu%
- )item_info%=
- menu_add("Info",infowin%)
- "MenuUtil_Dots",,1
- *item_mode1%=
- menu_add("Basic edit",-1)
- /item_mode2%=
- menu_add("Set type",typemenu%)
- +item_mode3%=
- menu_add("Kill module",-1)
- .item_mode4%=
- menu_add("Access",accesswin%)
- -item_mode5%=
- menu_add("Command",cmdmenu%)
- "MenuUtil_Dots",,1
- ,item_options%=
- menu_add("Options...",-1)
- #item_quit%=
- menu_add("Quit",-1)
- typemenu
- mainmenu(newmenu%)
- 2$(pullfrontkeystr%)=
- hotkeyname(pullfrontkey%)
- "MenuUtil_TickOnly",mainmenu%,mode%
- "MenuUtil_Text",,newtype$
- newmenu%
- modmenu
- newmenu%
- "Wimp_GetPointerInfo",,ptrinfo%
- "MenuUtil_Show",mainmenu%,ptrinfo%
- "MenuUtil_Show",mainmenu%,0
- modmenu
- item%
- modmenu%<>0
- "MenuUtil_Delete",modmenu%,
- "MenuUtil_New",,"RMKill"
- modmenu%
- modnr%=0
- inst%=0
- nrmods%=0
- "XOS_Module",12,modnr%,inst%
- ,modnr%,inst%,base%;flg%
- (flg%
- 1)=0
- ! modname%=base%+(base%!16)
- modname% < &3000000
- , item%=
- menu_add(
- str(modname%),-1)
- nrmods%+=1
-
- ((flg%
- 1)=1)
- nrmods%=0
- "MenuUtil_SubMenu",item_mode3%,0
- "MenuUtil_SubMenu",item_mode3%,modmenu%
- typemenu
- item%
- typesubmenu%<>0
- "MenuUtil_Delete",typesubmenu%,
- "MenuUtil_New",,"Other types"
- typesubmenu%
- nameptr%=0
- "XOS_ReadVarVal","File$Type_###",varbuf%,24,nameptr%
- ,,len%,nameptr%
- len%>0
- varbuf%?len%=13
- & item%=
- menu_add($(varbuf%),-1)
- 5
- $(varbuf%)=newtype$
- "MenuUtil_Tick",,1
- len%=0
- )item_newtype%=
- menu_addwritable(24,0)
- "MenuUtil_SubMenu",item_othertypes%,typesubmenu%
- selecticon(window%,icon%,f%)
- blk%!0=window%
- blk%!4=icon%
- blk%!8=1<<21
- blk%!8=0
- blk%!12=1<<21
- "Wimp_SetIconState",,blk%
- iconselected(window%,icon%)
- blk%!0=window%
- blk%!4=icon%
- "Wimp_GetIconState",,blk%
- =((blk%!24)
- (1<<21)) > 0
- shadeicon(window%,icon%,f%)
- blk%!0=window%
- blk%!4=icon%
- blk%!8=1<<22
- blk%!8=0
- blk%!12=1<<22
- "Wimp_SetIconState",,blk%
-