Home » Personal collection » Acorn ADFS disks » Archimedes » ALPS.ADF » !ALPS/!RunImage
!ALPS/!RunImage
This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.
Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.
Tape/disk: | Home » Personal collection » Acorn ADFS disks » Archimedes » ALPS.ADF |
Filename: | !ALPS/!RunImage |
Read OK: | ✔ |
File size: | 1D244 bytes |
Load address: | FFFFFB42 |
Exec address: | C7ABC11 |
Duplicates
There is 1 duplicate copy of this file in the archive:
- Personal collection » Acorn ADFS disks » Archimedes » ALPS.ADF » !ALPS/!RunImage
- Personal collection » Acorn hard disk » apps » Alps » !ALPS/!RunImage
File contents
10REM >$.!ALPS.!RunImage 20REM Copyright Alpine Software/Philip Hawthorne 1989 30REM With modifications by Keith McAlpine 40version$="5.08C, 22-Nov-1989" 50 60DIM block &200,mistake 300,quitblk 100 70 80ON ERROR MODE 0:PRINT REPORT$:PRINT ":";ERL:SYS"Wimp_CloseDown":END 90 100@%=&10:ctr%=0 110mode%=MODE 120testing=FALSE 130resources_ok=FNOS_Var("Alps$Resources") AND FNOS_Var("Alps$Data") 140 150SYS "OS_GetEnv" TO Env$ 160I%=INSTR(Env$,CHR$34,INSTR(Env$,CHR$34)+1) 170ef$=MID$(Env$,I%+1) 180WHILE LEFT$(ef$,1)=" " 190ef$=MID$(ef$,2) 200ENDWHILE 210 220theLastMenu = 0 : tick$="" 230 240type$="CF8" 250 260DIM tempBlk 4 270$tempBlk = "TASK" 280SYS "Wimp_Initialise",200,!tempBlk,"ALPS" TO ,task% 290 300IF NOT resources_ok THEN ERROR 1,"The ALPS resources are not available. Open up the directory viewer with !ALPS in it.":SYS "Wimp_CloseDown",task%,!tempBlk:END 310PROCinstall_texted 320PROCinit2 330ON ERROR dialog=FNerrorbox(REPORT$,ERR,1,-99):GOTO 500 340PROCnew 350PROCassemble(armcode%) 360PROCfill(text_block%,text_blocksize%,dummy_spc) 370PROCfill(verb_type,2*(maxvbn+1),0) 380PROCfill(nref+4,nref_size-4,0) 390PROCfill(aref+4,aref_size-4,0) 400PROCclear 410claimpoll$="":claimmenu$="":quit%=FALSE 420 430path$=ef$ 440IF ef$<>"" THEN 450$filename%=FNleafname(ef$) 460PROCload_all(ef$) 470PROCopen(ALPSmain,400,800,600,600) 480ENDIF 490 500REPEAT 510SYS Poll,,block TO reason 520CASE reason OF 530 WHEN 1: PROCredraw(!block) 540 WHEN 2: SYS OpenW,,block 550 WHEN 3: PROCclose(!block) 560 WHEN 6: PROCcheckmouse(!block,block!4,block!8,block!12,block!16,block!20) 570 WHEN 7: PROCsave:REM User has dragged 'Alps' file icon to another window 580 WHEN 8: PROCuserkeypressed(!block,block!4,block!24) 590 WHEN 9: PROCmenuselect(!block,block!4) 600 WHEN 17,18: PROCreceive(block) 610 ENDCASE 620UNTIL quit% 630SYS "Wimp_CloseDown",task%,!tempBlk:IF testing THEN OSCLI("FX4"):REPORT:PRINT" at line ";ERL:END 640END 650 660DEF PROCinit2 670PROCgetmodeinfo:oldsize=scrnsize 680data_saved=TRUE:loaded$="" 690DIM a_list$(10) 700small_areasize%=30 710DIM small_area% small_areasize% 720 730DIM D%(3),shade%(15),scale 15,pixtr 15 740REM --------------------------------- 750REM Manifest constants for the system 760 770maxrms=1000:maxobs=255:maxsw%=10:maxtokens=128 780 790listoption=2:REM Default LISTO 800 810DIM pos$(3) 820FOR I%=0 TO 3:READ pos$(I%):NEXT 830DATA T,B,L,R 840 850DIM oldpars 73 860FOR I%=0 TO 72 870READ B%:oldpars?I%=B% AND &F 880NEXT 890 900DATA 0,0,0,0,0,1,161,193 910DATA 161,193,2,1,0,128,128,0 920DATA 128,0,0,128,0,1,1,1 930DATA 1,65,1,0,0,0,65,0 940DATA 130,194,130,194,193,193,129,129 950DATA 193,193,131,195,1,130,128,128 960DATA 2,2,66,0,1,66,3,67 970DATA 0,1,1,65,65,65,3,0 980DATA 1,1,130,130,130,2,130,2 990DATA 2 1000 1010maxlen=10:REM Maximum word length in vocabulary 1020 1030REM Room and object data block lengths (in bytes) 1040r_len=74:o_len=16 1050 1060num_vars=60:REM Number of ALPS variables 1070var_size=num_vars*2:REM 2 bytes per variable 1080 1090maxmsg=65535:maxobn=255:maxvbn=255:maxconst=65535 1100maxadj=255:maxprep=50:maxconj=10:maxspec=30:maxnoise=50:maxpix=50 1110 1120noun_size=3000 1130verb_size=3000 1140adjc_size=2000 1150prep_size=400:REM Size of prepositions list 1160conj_size=50:REM size of conjunctions list 1170spec_size=100:REM size of 'specials' list (IT, THEM, ALL) 1180noise_size=200:REM size of 'noise' list (THE,A,AN) 1190aref_size=2000:REM size of adjective object reference table 1200nref_size=2000:REM size of nouns object reference table 1210pix_size=1000:REM size of pix filename list 1220 1230DIM nouns noun_size,verbs verb_size,adjects adjc_size,preps prep_size,conjs conj_size,specs spec_size,noise noise_size,pixs pix_size 1240 1250DIM aref aref_size,nref nref_size,verb_type 2*(maxvbn+1) 1260 1270noun_end=nouns+noun_size:verb_end=verbs+verb_size 1280adjc_end=adjects+adjc_size:prep_end=preps+prep_size:conj_end=conjs+conj_size:spec_end=specs+spec_size:noise_end=noise+noise_size 1290aref_end=aref+aref_size:nref_end=nref+nref_size:pix_end=pixs+pix_size 1300 1310REM Printer codes etc 1320condensed=15:reset=64 1330pline$=STRING$(132,"-") 1340pline2$=STRING$(79,"-") 1350 1360REM ------- Set up data areas for rooms and objects and clear them ------ 1370DIM rdata% (maxrms+1)*r_len,odata% (maxobs+1)*o_len,controom% 12 1380 1390REM Set up the save buffers 1400initareasize=7*(maxobs+1)+22*(maxrms+1) 1410DIM initsave initareasize,ramsave initareasize+var_size+128 1420$controom%="0":cont_room=0:container=FALSE 1430 1440rptr=1:optr=1:last_room=1:last_object=1 1450 1460REM areas to store flag descriptions 1470maxd%=13 1480DIM o_flags% maxd%*8,r_flags% maxd%*8 1490 1500REM Set the flag descriptions 1510FOR I%=7 TO 0 STEP-1 1520READ flag$ 1530$(o_flags%+I%*maxd%)=LEFT$(flag$,maxd%-1) 1540NEXT 1550 1560FOR I%=7 TO 0 STEP-1 1570READ flag$ 1580$(r_flags%+I%*maxd%)=LEFT$(flag$,maxd%-1) 1590NEXT 1600 1610REM Object Flag descriptions 1620DATA "","",Being worn,Wearable,Scenery,Invisible,Takeable,Light source 1630 1640REM Room flag descriptions 1650DATA "","","","","","",Visited,Light 1660 1670REM Room Exit flag descriptions 1680DATA Invisible,Closed door,Open door,Locked door,Unl'ked door,Blocked,Reserved,Reserved 1690 1700DIM exit_flag$(7) 1710FOR flag=7 TO 0 STEP-1:READ exit_flag$(flag):NEXT 1720 1730DIM proc% 12,exit% 12,def% 12 1740$proc%="":$def%="":$exit%="" 1750 1760REM prg_sel% = Section of program selected for editing 1770REM 2=Main, 3=Proc, 4=Define, 5=Exit 1780REM progval$ = STR$ value of proc or exit number or name of selected verb 1790 1800prg_sel%=2:progval$="" 1810 1820REM voc_sect% = Section of vocabulary selected for editing 1830REM 1=Nouns, 2=Verbs 1840voc_sect%=1 1850 1860pbsize=(scrnsize DIV 2)+400:REM size of picture buffer 1870 1880DIM picbuf pbsize 1890 1900prgbsize=&1000 1910DIM prgbuf% prgbsize 1920 1930REM ------- Some constants for the character designer ------- 1940 1950cur_chr%=ASC"A":max_chr%=125 1960DIM charnum 12 1970$charnum="" 1980 1990REM ------- Dimension the other arrays needed ------- 2000ucsize=500 2010SYS "OS_File",5,"<ALPS$Resources>.ASIobjcode" TO ftype,,,,codesize 2020pbyte_size=148 2030DIM armcode% 1000,pbytes pbyte_size,work% &1100,asicode% codesize+10 2040DIM usercode% ucsize 2050run=asicode%:printmsg=asicode%+4:search=asicode%+12:findcode=asicode%+16 2060setup=asicode%+20 2070OSCLI("LOAD <ALPS$Resources>.ASIobjcode "+STR$~asicode%) 2080DIM pal%(2) 2090DIM q% &2000,erroraddr%(4) 2100DIM indexdata% 32*24+20 2110maxbuf%=&3000 2120DIM buffer% maxbuf%:curbuff%=buffer% 2130nh%=32:ni%=11 2140DIM handle%(nh%+1),wident$(nh%),wptr%(nh%) 2150FOR I%=0TOnh%:handle%(I%)=I%-1:wident$(I%)="":NEXT:handleSP%=nh% 2160DIM icon%(ni%+1),iconbar$(ni%) 2170FOR I%=0 TO ni%:icon%(I%)=-1:READ iconbar$(I%):NEXT 2180icon%(ni%+1)=-1 2190oldicon%=0:oldrmicon%=0 2200 2210REM ------ Names of icons (sprites) on icon bar ------ 2220DATA disk35,arclogo,door,key,quill,info,listing,chardes,vocab,swap,eye,face 2230 2240diskicon=0:texticon=4:progicon=6:staricon=99 2250vocabicon=8:faceicon=99:arcicon=1:swapicon=9 2260alpsicon=5:helpicon=13:eyeicon=10 2270THEkeyicon=3:THEdooricon=2:texticon=4:THEcharicon=7 2280 2290DIM menufree% &1800:menuend%=menufree%+&1800 2300DIM menulist% &100 2310DIM qBlk% 256 2320dx%=2:lsY%=40:ypixel%=4:chX%=16:chY%=32 2330currentwindow%=-1:currenticon%=-1 2340spritef$="" 2350DIM mb_wident% 12,filename% 64,filename2% 64,import% 64 2360IF testing $filename%="demo" ELSE $filename%="starter" 2370$filename2%="charset":$import%="" 2380DIM start(20),sys_b2% &300,os_block 50 2390 2400PROCKeyWordRead 2410PROCErrorMsgRead 2420 2430REM ----- Define the "Wimp" and "OS" SYS numbers ------ 2440Wimp=&400C0 2450CreateW=Wimp+1 2460CreateI=Wimp+2 2470DeleteW=Wimp+3 2480DeleteI=Wimp+4 2490OpenW=Wimp+5 2500CloseW=Wimp+6 2510Poll=Wimp+7 2520RedrawW=Wimp+8 2530UpdateW=Wimp+9 2540GetW=Wimp+11 2550GetWI=Wimp+&C 2560SetCaret=Wimp+&12 2570GetCaret=Wimp+&13 2580GetR=Wimp+&A 2590SetI=Wimp+&D 2600GetI=Wimp+&E 2610GetP=Wimp+&F 2620Drag=Wimp+&10 2630ForceR=Wimp+&11 2640CreateM=Wimp+&14 2650SetP=Wimp+&18 2660ReadPal=&2F 2670 2680REM ------ Set up our own sprite area and read the sprites in ------ 2690SYS "OS_File",5,"<ALPS$Resources>.AlpsSprite" TO ,,,,spritesize 2700spritesize+=4 2710DIM spritearea% spritesize 2720!spritearea%=spritesize 2730SYS "OS_SpriteOp",266,spritearea%,"<Alps$Resources>.AlpsSprite" 2740DIM fontcounts% 255,mb_wident% 24 2750 2760REM ------ Set up the wimps and their handles ------ 2770 2780DIMrgb(19,3) 2790PROCloadtemplates("<Alps$Resources>.ALPS") 2800 2810REM ------ Name the window handles ------ 2820objhandle=handle%(FNmatchident("objected")) 2830roomhandle=handle%(FNmatchident("roomedit")) 2840texthandle=handle%(FNmatchident("texted")) 2850design=handle%(FNmatchident("chrdesign")) 2860infohandle=handle%(FNmatchident("info")) 2870savehandle=handle%(FNmatchident("saveas")) 2880ALPSmain=handle%(FNmatchident("iconbar")):dialogue%=0 2890setuph=handle%(FNmatchident("Setup")) 2900desticon=47:exitprogicon=48 2910 2920iconbar% = -2 2930windowindex%=nh%+1 2940 2950PROCchangeicon(infohandle,7,version$,dummy) 2960 2970firstIconBarIcon% = FNiconbar(spritearea%, "face",31,19) 2980THEmiscicon=firstIconBarIcon% 2990 3000 3010REM ------ Define the colours ------ 3020barfgcol=11:barbgcol=3 3030`wbcol=0:`tbcol=2:`sco=&3:`mbcol=&B 3040`wfcol=7:`tfcol=7:`sci=&D:`tbcol2=&C 3050 3060cur_pal%=7:phys_col%=16 3070 3080first_token=&30:REM Lowest keyword token value 3090PROCfind_token(keyword$(),"INC",var_token,dummy):REM Tokens from here up allow variables 3100PROCfind_token(keyword$(),"DEFINE",def_token,dummy) 3110PROCfind_token(keyword$(),"STOP",stop_token,dummy) 3120PROCfind_token(keyword$(),"END",end_token,dummy) 3130PROCfind_token(keyword$(),"EXIT",exit_token,dummy) 3140PROCfind_token(keyword$(),"DEFPROC",proc_token,dummy) 3150PROCfind_token(keyword$(),"PREP",prep_token,dummy) 3160PROCfind_token(keyword$(),"NOTPREP",notprep_token,dummy) 3170 3180REM ------ Set up the dictionary ------ 3190dict_size=1000 3200DIM dict% dict_size,tok$(maxtokens) 3210!dict%=3:dict%?2=&80 3220 3230REM ------ Find the available memory ------ 3240memfree=(HIMEM-END)-50000 3250IF memfree<0 THEN null=FNerrorbox("Not enough memory available in 'Next' slot",0,1,-99):SYS "Wimp_CloseDown":END 3260maxtext%=0.83*memfree 3270code_size%=0.17*memfree 3280 3290REM ------ Areas for storing messages, switch info etc; ------ 3300DIM text% maxtext%,swdata% 12*maxsw%,switch_vals(maxsw%),m_msg% 12 3310DIM switch_buf% 2*maxsw%+1 3320$swdata%=STRING$(12*maxsw%,CHR$13):$m_msg%="" 3330 3340REM ------ Initialise the text area ------ 3350!text%=1:text%!2=&B:text%!6=0:text%!10=0 3360DIM st_msg% 12,end_msg% 12 3370$st_msg%="1":$end_msg%="1" 3380mptr=1:REM The current message number 3390text_owner$="":REM The current owner of any text in the text editor 3400 3410datavalid=TRUE 3420 3430REM ------ Set up the program area ------ 3440DIM program% code_size% 3450!program%=0 3460program%!4=0 3470errflag=FALSE 3480 3490REM ------ Set up the menu structure ------ 3500m_controom%=FNcrmenu 3510DATA "#Number,$controom%(5)" 3520m_contain=FNcrmenu 3530DATA "Container,Use room>m_controom%" 3540m_chardes%=FNcrmenu 3550DATA "#CHANGE TO?,$charnum(2)" 3560char_fname%=FNcrmenu 3570DATA "#Filename:,$filename2%(11)" 3580menu_fname%=FNcrmenu 3590DATA "#Filename:,$filename%(11)" 3600m_gotomsg%=FNcrmenu 3610DATA "$m_msg%(12)" 3620m_proc%=FNcrmenu 3630DATA "#Number:,$proc%(4)" 3640m_def%=FNcrmenu 3650DATA "#Verb:,$def%(12)" 3660m_exit%=FNcrmenu 3670DATA "#Number:,$exit%(4)" 3680m_listopts=FNcrmenu 3690DATA "#Display:,Vocabulary as numbers,Vocabulary as strings" 3700m_import%=FNcrmenu 3710DATA "#Filename:,$import%(11)" 3720sw1=FNcrmenu:nxtsw=swdata%+12 3730DATA "#Value:,$swdata%(12)" 3740sw2=FNcrmenu:nxtsw=nxtsw+12 3750DATA "#Value:,$nxtsw" 3760sw3=FNcrmenu:nxtsw=nxtsw+12 3770DATA "#Value:,$nxtsw" 3780sw4=FNcrmenu:nxtsw=nxtsw+12 3790DATA "#Value:,$nxtsw" 3800sw5=FNcrmenu:nxtsw=nxtsw+12 3810DATA "#Value:,$nxtsw" 3820sw6=FNcrmenu:nxtsw=nxtsw+12 3830DATA "#Value:,$nxtsw" 3840sw7=FNcrmenu:nxtsw=nxtsw+12 3850DATA "#Value:,$nxtsw" 3860sw8=FNcrmenu:nxtsw=nxtsw+12 3870DATA "#Value:,$nxtsw" 3880sw9=FNcrmenu:nxtsw=nxtsw+12 3890DATA "#Value:,$nxtsw" 3900sw10=FNcrmenu:nxtsw=nxtsw+12 3910DATA "#Value:,$nxtsw" 3920m_switch%=FNcrmenu 3930DATA "#Switch,No switches,1>sw1,2>sw2,3>sw3,4>sw4,5>sw5,6>sw6,7>sw7,8>sw8,9>sw9,10>sw10" 3940m_text%=FNcrmenu 3950DATA "#MSG: nnnnn,Insert,Overtype#,Cut,Copy,Paste#,Next,Previous,First,Last,Goto msg#>m_gotomsg%,Edit switch#>m_switch%,Print this" 3960m_prog%=FNcrmenu 3970DATA "#Program Editor,Insert,Overtype#,Cut,Copy,Paste#,Main,Procedure>m_proc%,Define>m_def%,Exit routine#>m_exit%,Print this,List options>m_listopts" 3980m_vocab%=FNcrmenu 3990DATA "#Vocabulary,Insert,Overtype#,Cut,Copy,Paste#,Nouns,Verbs,Adjectives,Prepositions,Conjunctions,Specials,Noise#,Print this" 4000pixmenu=FNcrmenu 4010DATA "#Pictures,Print" 4020progmenu=FNcrmenu 4030DATA "#Program,Print,Import#>m_import%,Run" 4040charmenu=FNcrmenu 4050DATA "#CharSet,Save>char_fname%,Load>char_fname%" 4060vocabmenu=FNcrmenu 4070DATA "#Vocabulary,Print" 4080diskmenu=FNcrmenu 4090DATA "#Files,Save all>savehandle,Setup disk" 4100facemenu=FNcrmenu 4110DATA "#Actors,Print" 4120miscmenu=FNcrmenu 4130DATA "#ALPS,Info>infohandle,Quit" 4140msg2%=FNcrmenu 4150DATA "$st_msg%(6)" 4160msg3%=FNcrmenu 4170DATA "$end_msg%(6)" 4180msg1%=FNcrmenu 4190DATA "#From/To?,Start msg>msg2%,End msg>msg3%" 4200textmenu=FNcrmenu 4210DATA "#Text,Print>msg1%,Import>m_import%" 4220objmenu=FNcrmenu 4230DATA "#Objects,Print,Import>m_import%" 4240mo_user5=FNcrmenu:ofl%=o_flags%+maxd%*3 4250DATA "#Description:,$o_flags%(13)" 4260mo_user4=FNcrmenu:ofl%=ofl%+maxd% 4270DATA "#Description:,$ofl%(13)" 4280mo_user3=FNcrmenu:ofl%=ofl%+maxd% 4290DATA "#Description:,$ofl%(13)" 4300mo_user2=FNcrmenu:ofl%=ofl%+maxd% 4310DATA "#Description:,$ofl%(13)" 4320mo_user1=FNcrmenu:ofl%=ofl%+maxd% 4330DATA "#Description:,$ofl%(13)" 4340mo_user0=FNcrmenu:ofl%=ofl%+maxd% 4350DATA "#Description:,$ofl%(13)" 4360m_objflag=FNcrmenu 4370DATA "#Flags,7 Light source,6 Takeable,5 Invisible,4 Scenery,3 Wearable,2 Being worn,1 User flag>mo_user1,0 User flag>mo_user0" 4380roommenu=FNcrmenu 4390DATA "#Rooms,Print,Import>m_import%" 4400mr_user6=FNcrmenu:rfl%=r_flags%+maxd%*2 4410DATA "#Description:,$r_flags%(13)" 4420mr_user5=FNcrmenu:rfl%=rfl%+maxd% 4430DATA "#Description:,$rfl%(13)" 4440mr_user4=FNcrmenu:rfl%=rfl%+maxd% 4450DATA "#Description:,$rfl%(13)" 4460mr_user3=FNcrmenu:rfl%=rfl%+maxd% 4470DATA "#Description:,$rfl%(13)" 4480mr_user2=FNcrmenu:rfl%=rfl%+maxd% 4490DATA "#Description:,$rfl%(13)" 4500mr_user1=FNcrmenu:rfl%=rfl%+maxd% 4510DATA "#Description:,$rfl%(13)" 4520mr_user0=FNcrmenu:rfl%=rfl%+maxd% 4530DATA "#Description:,$rfl%(13)" 4540m_rmflag=FNcrmenu 4550DATA "#Flags,7 Light,6 Visited,5 User (Trans)>mr_user5,4 User (Open)>mr_user4,3 User flag>mr_user3,2 User flag>mr_user2,1 User flag>mr_user1,0 User flag>mr_user0" 4560m_exitf=FNcrmenu 4570DATA "#Flags,7 Invisible exit,6 Closed door,5 Open door,4 Locked door,3 Unlocked door,2 Blocked exit,1 Reserved,0 Reserved" 4580 4590ENDPROC 4600 4610REM ------ Now we have the Procedures and Functions!! ------ 4620 4630DEF PROCgetmodeinfo 4640LOCAL x,y,xeig,yeig,cols 4650mode=MODE 4660 4670SYS "OS_ReadModeVariable",mode,1 TO ,,textcols% 4680SYS "OS_ReadModeVariable",mode,2 TO ,,textrows% 4690text_maxllen%=textcols%-2 4700SYS "OS_ReadModeVariable",mode,3 TO ,,cols 4710SYS "OS_ReadModeVariable",mode,4 TO ,,xeig 4720SYS "OS_ReadModeVariable",mode,5 TO ,,yeig 4730SYS "OS_ReadModeVariable",mode,7 TO ,,scrnsize 4740SYS "OS_ReadModeVariable",mode,11 TO ,,x 4750SYS "OS_ReadModeVariable",mode,12 TO ,,y 4760scrw=((x+1)<<xeig)-1:scrh=((y+1)<<yeig)-1 4770ENDPROC 4780 4790DEF PROCclear 4800PROCfill(odata%,(maxobs+1)*o_len,0) 4810PROCfill(rdata%,(maxrms+1)*r_len,0) 4820PROCfill(program%+4,code_size%-20,0) 4830REM PROCfill(initsave,initareasize,0) 4840ENDPROC 4850 4860 4870DEF PROCreturn(x%,y%) 4880PROCcol(128+12):PROCcol(7) 4890PROCcentre(" Hit any key/button to return to the editor ",y%) 4900REPEAT 4910MOUSE X%,Y%,B% 4920UNTIL B%=0 4930 4940REPEAT 4950any=INKEY(0) 4960MOUSE X%,Y%,B% 4970UNTIL any>0 OR B%>0 4980ENDPROC 4990 5000DEF PROCcentre(t$,r) 5010PRINTTAB((textcols%-LEN t$+1) DIV 2,r);t$; 5020ENDPROC 5030 5040REM ------ General window handling routines ------ 5050 5060DEF PROCdeletewindow(I%) 5070!q%=handle%(I%) 5080handle%(I%)=handleSP%:handleSP%=I% 5090SYS DeleteW,,q% 5100wident$(I%)="" 5110ENDPROC 5120 5130DEF PROCloadtemplates(tfile$) 5140tmp%=0 5150SYS "Wimp_OpenTemplate",,tfile$ 5160tf_index%=0:REPEAT 5170$mb_wident%="*" 5180SYS "Wimp_LoadTemplate",,q%+4,curbuff%,buffer%+maxbuf%,fontcounts%,mb_wident%,tf_index% TO ,,curbuff%,,,,tf_index% 5190IF tf_index%<>0 THEN PROCloadtemp($mb_wident%) 5200UNTIL tf_index%=0 5210SYS "Wimp_CloseTemplate" 5220ENDPROC 5230 5240DEF PROCloadtemp(wident$) 5250I%=FNmatchident(wident$):IF I%<>-1 THEN PROCdeletewindow(I%) 5260q%!68=spritearea% : REM user sprite area 5270PROCcrwindow(q%+4,wident$) 5280ENDPROC 5290 5300DEF PROChighlight(I%) 5310ENDPROC 5320SYS SetCaret,handle%(I%),-1,0,0,&2000000,0 5330ENDPROC 5340 5350DEF PROCretitle(handle%,newtitle$,RETURN handle%) 5360index%=windowindex% 5370REPEAT 5380 index%-=1: IFindex%<0 ERROR 255,"Invalid window" 5390UNTIL handle%(index%)=handle% 5400!q%=handle% 5410SYS GetWI,,q% 5420SYS DeleteW,,q% 5430$(q%+76)=LEFT$(newtitle$,11) 5440SYS CreateW,,q%+4 TO handle% 5450handle%(index%)=handle% 5460ENDPROC 5470 5480DEF PROCcrwindow(q%,wident$) 5490SYS CreateW,,q% TO handle% 5500m%=handleSP%:handleSP%=handle%(handleSP%):handle%(m%)=handle% 5510!q%=handle% 5520SYS GetW,,q% 5530currentwindow%=m%:wident$(m%)=wident$ 5540currenticon%=-1 5550PROChighlight(m%) 5560ENDPROC 5570 5580DEF PROCclose(wind) 5590i%=ni%+1 5600CASE wind OF 5610 WHEN objhandle:i%=THEkeyicon:IF icon%(i%)<>-1 PROCstore_obj(optr) 5620 WHEN roomhandle: i%=THEdooricon:IF icon%(i%)<>-1 PROCstore_room(rptr) 5630 WHEN texthandle 5640 i%=texticon 5650 PROCremove_markers 5660 CASE text_owner$ OF 5670 WHEN "texted" : PROCstore_msg 5680 WHEN "program" : IF NOT text_ok THEN PROCstore_prog 5690 WHEN "vocab" : IF NOT text_ok THEN PROCstore_vocab 5700 WHEN "pix" : PROCstore_pix 5710 ENDCASE 5720 IF NOT errflag THEN 5730 text_owner$="":REM release Text Editor window 5740 PROCfill(text_block%,text_blocksize%,dummy_spc) 5750 ENDIF 5760 WHEN design: i%=THEcharicon 5770ENDCASE 5780IF (text_owner$="program" AND errflag AND wind=texthandle) OR (text_owner$="vocab" AND errflag AND wind=texthandle) OR (text_owner$="pix" AND errflag AND wind=texthandle) OR (text_owner$="texted" AND errflag AND wind=texthandle) THEN 5790ELSE 5800 icon%(i%)=-1 5810 !block=wind 5820 SYS CloseW,,block 5830ENDIF 5840ENDPROC 5850 5860DEF PROCopen(handle,x,y,w,d) 5870!block=handle 5880block!4=x:block!8=y-d 5890block!12=x+w:block!16=y 5900block!20=0:block!24=0 5910block!28=-1 5920SYS OpenW,,block 5930ENDPROC 5940 5950DEF PROCredraw(handle) 5960block!0=handle 5970SYS RedrawW,0,block TO more% 5980PROCinfo(block+4) 5990IF handle=texthandle THEN dummy=FNredraw_text(TRUE) 6000ENDPROC 6010 6020DEF PROCforceR(handle) 6030REM Force the given window ONLY to be redrawn 6040PROCgetw(handle) 6050SYS ForceR,handle,scx%,scy%-(y1%-y0%),scx%+(x1%-x0%),scy% 6060ENDPROC 6070 6080DEF FNmatchident(A$) 6090IF A$="" THEN =-1 6100LOCAL I% 6110I%=nh%+1:REPEATI%=I%-1:UNTILA$=wident$(I%)ORI%=0 6120IFA$=wident$(I%)THEN=I%ELSE=-1 6130 6140DEF PROCgetw(handle%) 6150IF handle%=iconbar% ENDPROC 6160!block=handle%:SYSGetW,0,block 6170PROCinfo(block+4):bhandle%=block!28:flags%=block!32 6180ontop=flags% AND &20000 6190ENDPROC 6200 6210DEF PROCinfo(b) 6220x0%=!b:y0%=b!4:x1%=b!8:y1%=b!12:scx%=b!16:scy%=b!20 6230bx%=x0%-scx%:by%=y1%-scy% 6240gwxl%=b!24:gwyb%=b!28:gwxr%=b!32:gwyt%=b!36 6250ENDPROC 6260 6270DEF PROCgetpointer 6280SYSGetP,0,block 6290mousex%=!block:mousey%=block!4:b%=block!8:handle%=block!12:icon%=block!16:ob%=block!20 6300ENDPROC 6310 6320DEF PROCsys_claiminputfocus(window%,icon%,xofst%,yofst%,height%,index%) 6330SYSSetCaret, window%,icon%,xofst%,yofst%,height%,index% 6340ENDPROC 6350 6360DEF PROCsys_getcaretposition(RETURN window%,RETURN icon%,RETURN xofst%,RETURN yofst%,RETURN height%,RETURN indx%) 6370SYSGetCaret,0,b 6380window%=!block: icon%=block!4: xofst%=block!8: yofst%=block!12: height%=block!16: indx%=block!20 6390ENDPROC 6400 6410DEF PROCcursor(x%,y%) 6420PROCsys_claiminputfocus(texthandle,-1,(x%-1)*chX%,-y%*lsY%-9*ypixel%,&1000000 OR10*ypixel%,-1) 6430ENDPROC 6440 6450DEF PROCtext_menubox 6460CASE text_owner$ OF 6470WHEN "texted" 6480 tick$="message" 6490 null = FNtick_message 6500 SYS CreateM,0,m_text%,mousex%-64,mousey%:claimmenu$="message" 6510 theLastMenu = m_text% 6520 6530WHEN "program" 6540 tick$="program" 6550 null = FNtick_program 6560 SYS CreateM,0,m_prog%,mousex%-64,mousey%:claimmenu$="program" 6570 theLastMenu = m_prog% 6580 6590WHEN "vocab" 6600 tick$="vocab" 6610 null = FNtick_vocab 6620 SYS CreateM,0,m_vocab%,mousex%-64,mousey%:claimmenu$="vocab" 6630 theLastMenu = m_vocab% 6640 6650ENDCASE 6660 6670ENDPROC 6680 6690DEF PROCcheckmouse(mousex%,mousey%,button%,handle%,icon%,ob%) 6700IFhandle%=-1 THEN ENDPROC 6710PROCgetw(handle%) 6720IFhandle%=ALPSmain THEN 6730 IFicon%<>-1 THEN 6740REM icon% -= firstIconBarIcon% 6750 CASETRUE OF 6760 WHEN(button%AND1)=1 : REM adjust does nothing 6770 WHEN(button%AND2)=2 : void=EVAL("FNmenu_"+iconbar$(icon%)) 6780 WHEN(button%AND4)=4 : PROCopenup(icon%) 6790 ENDCASE 6800 ENDIF 6810ELSE 6820 IF handle%=iconbar% THEN 6830 REM The RISC OS icon bar 6840 CASE TRUE OF 6850 WHEN (button%AND2)=2 : void=FNmenu_misc 6860 WHEN (button%AND4)=4 6870 IF icon%=firstIconBarIcon% THEN PROCopen(ALPSmain,400,800,600,600) 6880 ENDCASE 6890 ELSE 6900 index%=windowindex% 6910 REPEAT 6920 index%-=1: IFindex%<0 ERROR 255,"Invalid window" 6930 UNTIL handle%(index%)=handle% 6940 void=EVAL("FNbutton_"+wident$(index%)) 6950 ENDIF 6960ENDIF 6970ENDPROC 6980 6990DEF PROCuserkeypressed(handle%,icon%,key%) 7000PROCgetw(handle%) 7010LOCALindex% 7020index%=windowindex% 7030REPEAT 7040index%-=1: IFindex%<0 THEN ENDPROC 7050UNTILhandle%(index%)=handle% 7060void=EVAL("FNkeypress_"+wident$(index%)) 7070ENDPROC 7080 7090DEF PROCmenuselect(item0%,item1%) 7100SYS "Wimp_GetPointerInfo",,block 7110buTTon = block!8 7120void=EVAL("FNmenuselect_"+claimmenu$) 7130IF buTTon=1 THEN 7140 REM *** ADJUST pressed so keep the menu structure *** 7150 null = EVAL("FNtick_"+tick$) 7160 SYS CreateM,0,theLastMenu,0,0 7170ELSE 7180 claimmenu$="" 7190ENDIF 7200ENDPROC 7210 7220DEF PROCupdate(handle%,ux0%,uy0%,ux1%,uy1%) 7230!block=handle%:block!4=ux0%:block!8=uy0%:block!12=ux1%:block!16=uy1% 7240SYS UpdateW,0,block TO more%:PROCinfo(block+4) 7250ENDPROC 7260 7270DEF PROCopenup(icon%) 7280IF icon%(icon%)=-1 THEN 7290 IF icon%<>diskicon AND icon%<>texticon AND icon%<>arcicon AND icon%<>swapicon AND icon%<>progicon AND icon%<>vocabicon AND icon%<>eyeicon THEN icon%(icon%)=icon% 7300 CASE icon% OF 7310 WHEN diskicon: 7320 SYS CreateM,0,diskmenu,mousex%-64,mousey% 7330 IF loaded$<>"" THEN f$=path$ ELSE f$="AlpsFile" 7340 PROCchangeicon(savehandle,2,f$,void) 7350 claimmenu$="disk35":theLastMenu=diskmenu:tick$="" 7360 REM WHEN THEmiscicon: 7370 REM *********** do nothing for this icon ******* 7380 WHEN texticon: 7390 IF text_owner$="" THEN 7400 PROCretitle(texthandle,"MESSAGES",texthandle) 7410 PROCopen(texthandle,0,1000,scrw,400) 7420 text_owner$="texted":text_ok=TRUE 7430 PROCshow_msg(mptr) 7440 ELSE 7450 VDU 7 7460 ENDIF 7470 WHEN THEdooricon: 7480 PROCopen(handle%(FNmatchident("roomedit")),0,720,1280,1040) 7490 PROCrestore_room(rptr) 7500 WHEN THEkeyicon: 7510 PROCopen(handle%(FNmatchident("objected")),850,560,800,680) 7520 PROCrestore_obj(optr) 7530 WHEN progicon: 7540 IF text_owner$="" THEN 7550 PROCretitle(texthandle,"PROGRAM",texthandle) 7560 PROCopen(texthandle,0,1000,scrw,400) 7570 text_owner$="program":text_ok=TRUE 7580 PROClist(prg_sel%,progval$) 7590 ELSE 7600 VDU 7 7610 ENDIF 7620 WHEN THEcharicon: 7630 PROCopen(handle%(FNmatchident("chrdesign")),0,560,1280,860) 7640 PROCdisplay_chr(cur_chr%) 7650 PROCchangeicon(design,64,CHR$(cur_chr%),dummy) 7660 WHEN vocabicon: 7670 IF text_owner$="" THEN 7680 PROCretitle(texthandle,"VOCABULARY",texthandle) 7690 PROCopen(texthandle,0,1000,scrw,400) 7700 text_owner$="vocab":text_ok=TRUE 7710 PROClist_vocab(voc_sect%) 7720 ELSE 7730 VDU 7 7740 ENDIF 7750 WHEN helpicon: 7760 PROCopen(handle%(FNmatchident("HELP")),0,500,960,400) 7770 WHEN eyeicon: 7780 IF text_owner$="" THEN 7790 PROCretitle(texthandle,"PICTURES",texthandle) 7800 PROCopen(texthandle,0,1000,scrw,400) 7810 text_owner$="pix":text_ok=TRUE 7820 PROClist_pix 7830 ELSE 7840 VDU 7 7850 ENDIF 7860 WHEN arcicon:dummy=FNkeypress_status 7870 WHEN swapicon 7880 datavalid=NOT datavalid:VDU 7:PROCswap_data 7890 IF datavalid THEN 7900 PROCchangeicon(ALPSmain,swapicon,"swap",swapicon) 7910 ELSE 7920 PROCchangeicon(ALPSmain,swapicon,"swap_x",swapicon) 7930 ENDIF 7940 PROCforceR(ALPSmain) 7950 ENDCASE 7960ENDIF 7970ENDPROC 7980 7990 8000REM ------ `button` routines to deal with clicks in given window ------ 8010 8020DEF FNbutton_texted 8030LOCALmx%,my% 8040IF button%<>2 THEN 8050PROCgetpointer 8060mx%=(mousex%-bx%+chX%DIV4) AND(NOT(chX%-1)) 8070my%=(mousey%-by%) - ((mousey%-by%) MODlsY%) 8080text_col%=1+mx% DIVchX% 8090text_row%=-((mousey%-by%) DIVlsY%) 8100IF text_row%>last_row% text_row%=last_row% 8110IF text_col%>text_rowlen%(text_row%) text_col%=text_rowlen%(text_row%)+1 8120IF text_col%<1 text_col%=1 8130ENDIF 8140 8150CASE button% OF 8160WHEN 2 8170PROCtext_menubox 8180WHEN 4 8190PROClocate_ptr 8200PROCcursor(text_col%,text_row%) 8210WHEN 1 8220IF text_owner$<>"pix" THEN 8230PROClocate_ptr 8240IF mrk<2 THEN 8250mark(mrk)=text_ptr% 8260col(mrk)=text_col%:row(mrk)=text_row% 8270asc(mrk)=?text_ptr% 8280IF asc(mrk)=13 THEN VDU23,dummy_cr ELSE VDU23,chr(mrk) 8290?os_block=asc(mrk) 8300SYS "OS_Word",&A,os_block 8310FOR R%=1 TO 8 8320row_value=R%?os_block 8330VDU row_value EOR &FF 8340NEXT 8350IF asc(mrk)=13 THEN ?text_ptr%=dummy_cr ELSE ?text_ptr%=chr(mrk) 8360PROCupdate(texthandle,chX%*(text_col%-1),-(text_row%+1)*lsY%,chX%*(text_col%-1)+chX%,-(text_row%)*lsY%) 8370dummy=FNredraw_text(TRUE) 8380mrk+=1 8390PROCcursor(text_col%,text_row%) 8400ENDIF 8410ENDIF 8420ENDCASE 8430=0 8440 8450DEF PROClocate_ptr 8460text_ptr%=text_block% 8470IF text_row%>0 THEN 8480 FOR R%=0 TO text_row%-1 8490 text_ptr%+=text_rowlen%(R%) 8500 IF text_rowlen%(R%)<text_maxllen% THEN text_ptr%+=1 8510 NEXT 8520ENDIF 8530text_ptr%+=text_col%-1 8540IF text_ptr%>text_end% THEN text_ptr%=text_end% 8550ENDPROC 8560 8570DEF FNbutton_objected 8580CASE icon% OF 8590WHEN 0: 8600 8610REM First set the 'tick' bits for each menu item 8620null = FNtick_objected 8630SYS CreateM,0,m_objflag,mousex%-64,mousey%:claimmenu$="objected" 8640tick$="objected" 8650theLastMenu = m_objflag 8660 8670WHEN 5:PROCfirst_obj 8680WHEN 6:PROClast_obj 8690WHEN 27:PROCnext_obj 8700WHEN 16:PROCprev_obj 8710WHEN 20:PROCfwd_obj(10) 8720WHEN 21:PROCrewind_obj(10) 8730WHEN 17 8740PROCstore_obj(optr) 8750optr=VAL(FNgeticondata(objhandle,7)) 8760IF optr<1 THEN optr=1 8770IF optr>maxobs THEN optr=maxobs 8780PROCrestore_obj(optr) 8790WHEN 22:last_object=optr 8800WHEN 26: 8810SYS CreateM,0,m_contain,mousex%-64,mousey%:claimmenu$="container" 8820tick$="" 8830theLastMenu = m_contain 8840OTHERWISE 8850ENDCASE 8860IF optr>last_object last_object=optr:data_saved=FALSE 8870=0 8880 8890DEF FNbutton_roomedit 8900CASE icon% OF 8910WHEN 1: 8920tick$="roomedit" 8930null = FNtick_roomedit 8940SYS CreateM,0,m_rmflag,mousex%-64,mousey%:claimmenu$="roomedit" 8950theLastMenu = m_rmflag 8960 8970WHEN 5:PROCfirst_room 8980WHEN 6:PROClast_room 8990WHEN 7:PROCnext_room 9000WHEN 8:PROCprev_room 9010WHEN 9:PROCfwd_room(10) 9020WHEN 10:PROCrewind_room(10) 9030WHEN 11 9040PROCstore_room(rptr) 9050rptr=VAL(FNgeticondata(roomhandle,33)) 9060IF rptr<1 THEN rptr=1 9070IF rptr>maxrms THEN rptr=maxrms 9080PROCrestore_room(rptr) 9090 9100WHEN 12:last_room=rptr 9110ENDCASE 9120IF rptr>last_room last_room=rptr:data_saved=FALSE 9130 9140REM Now check for clicking menu on selected EXITR icon 9150 9160CASE TRUE OF 9170 9180WHEN icon%>53 AND icon%<70 9190 9200oldrmicon%=icon% 9210null = FNtick_exitedit 9220tick$="exitedit" 9230SYS CreateM,0,m_exitf,mousex%-64,mousey%:claimmenu$="exitedit" 9240theLastMenu = m_exitf 9250OTHERWISE 9260ENDCASE 9270=0 9280 9290DEF FNbutton_chrdesign 9300CASE TRUE OF 9310WHEN icon%>=0 AND icon%<64 9320 PROCset_icon(design,icon%,&50000000,0) 9330 PROCwrite_chr(cur_chr%) 9340 PROCset_icon(design,64,0,0) 9350WHEN icon%=66 9360 cur_chr%+=1 9370 IF cur_chr%>max_chr% cur_chr%=max_chr% 9380 PROCchangeicon(design,64,CHR$(cur_chr%),icon%) 9390 PROCdisplay_chr(cur_chr%) 9400WHEN icon%=67 9410 cur_chr%-=1 9420 IF cur_chr%<32 cur_chr%=32 9430 PROCchangeicon(design,64,CHR$(cur_chr%),icon%) 9440 PROCdisplay_chr(cur_chr%) 9450WHEN icon%=68 9460 SYS CreateM,0,m_chardes%,mousex%-64,mousey%:claimmenu$="chrdef" 9470 theLastMenu = m_chardes%:tick$="" 9480ENDCASE 9490=0 9500 9510 9520DEF FNbutton_info 9530IF icon%=5 THEN 9540PROCclose(infohandle) 9550ENDIF 9560=0 9570 9580DEF FNbutton_saveas 9590CASE icon% OF 9600WHEN 0 : PROCsave_all(FNgeticondata(savehandle,2)) 9610WHEN 1 : PROCgetw(savehandle) 9620 dummy$=FNgeticondata(savehandle,1) 9630 block!4=5:block!8=block!8+bx% 9640 block!12=block!12+by% 9650 block!16=block!16+bx% 9660 block!20=block!20+by% 9670 block!24=0:block!28=0:block!32=scrw+1:block!36=scrh+1 9680 SYS "Wimp_DragBox",,block 9690ENDCASE 9700=0 9710 9720DEF FNbutton_Setup 9730CASE icon% OF 9740WHEN 0 9750WHEN 1:PROCcreate_dirs(FNgeticondata(setuph,2),FNgeticondata(setuph,5)) 9760ENDCASE 9770PROCclose(setuph) 9780MOUSE RECTANGLE 0,0,scrw,scrh 9790=0 9800 9810REM ------ `keypress` routines deal with pressing key `key%` in a window 9820 9830DEF FNkeypress_texted 9840CASE TRUE OF 9850WHEN key%=13:PROCnewline:data_saved=FALSE:text_ok=FALSE 9860WHEN key%=&18F:PROCup 9870WHEN key%=&18E:PROCdown 9880WHEN key%=&18D:PROCright 9890WHEN key%=&18A:FOR I%=1 TO tab_set:PROCright:NEXT 9900WHEN key%=&19A:FOR I%=1 TO tab_set:PROCleft:NEXT 9910WHEN key%=&18C:PROCleft 9920WHEN key%=&1AB:PROCdelete_line:data_saved=FALSE:text_ok=FALSE 9930WHEN key%=&1ED:PROCinsert_line:data_saved=FALSE:text_ok=FALSE 9940WHEN key%=&1AC:PROCleft_end 9950WHEN key%=&1AD:PROCright_end 9960WHEN key%=&18B:PROCright:PROCdelete_char:data_saved=FALSE:text_ok=FALSE 9970WHEN key%=&1CD:overwrite=NOT overwrite 9980WHEN key%=127:PROCdelete_char:data_saved=FALSE:text_ok=FALSE 9990WHEN (key%>31) AND (key%<126) 10000IF overwrite THEN PROCoverwrite_char(key%) ELSE PROCinsert_char(key%) 10010data_saved=FALSE:text_ok=FALSE 10020OTHERWISE SYS "Wimp_ProcessKey",key% 10030ENDCASE 10040 10050PROCcursor(text_col%,text_row%) 10060=0 10070 10080DEF FNkeypress_saveas 10090IF key%=13 THEN PROCsave_all(FNgeticondata(savehandle,2)) ELSE SYS "Wimp_ProcessKey",key% 10110=0 10120 10130DEF FNkeypress_objected 10140IF key%=13 AND icon%=7 THEN 10150 PROCstore_obj(optr) 10160 optr=VAL(FNgeticondata(objhandle,icon%)) 10170 IF optr<1 THEN optr=1 10180 IF optr>maxobs THEN optr=maxobs 10190 PROCrestore_obj(optr) 10200ENDIF 10210 10220CASE key% OF 10230WHEN 13,&18E:REM Return or down arrow 10240IF icon%<15 THEN 10250 icon%+=1 10260ELSE 10270 icon%=7 10280ENDIF 10290WHEN &18F:REM Up arrow 10300IF icon%>7 THEN 10310 icon%-=1 10320ELSE 10330 icon%=15 10340ENDIF 10350OTHERWISE SYS "Wimp_ProcessKey",key% 10360ENDCASE 10370PROCsys_claiminputfocus(objhandle,icon%,0,0,-1,LEN(FNgeticondata(objhandle,icon%))) 10380=0 10390 10400DEF FNkeypress_roomedit 10410CASE key% OF 10420WHEN 13,&18E,&18F 10430 10440IF key%=13 AND icon%=33 THEN 10450 PROCstore_room(rptr) 10460 rptr=VAL(FNgeticondata(roomhandle,icon%)) 10470 IF rptr<1 THEN rptr=1 10480 IF rptr>maxrms THEN rptr=maxrms 10490 PROCrestore_room(rptr) 10500ENDIF 10510 10520IF key%=13 OR key%=&18E THEN 10530CASE TRUE OF 10540WHEN icon%=37:newicon%=71 10550WHEN icon%=71:newicon%=38 10560WHEN icon%=69:newicon%=33 10570WHEN icon%<37:newicon%=icon%+1 10580WHEN (icon%>37 AND icon%<54):newicon%=icon%+16 10590WHEN (icon%>53 AND icon%<69):newicon%=icon%-15 10600ENDCASE 10610ENDIF 10620 10630IF key%=&18F THEN 10640CASE TRUE OF 10650WHEN icon%=71:newicon%=37 10660WHEN icon%=38:newicon%=71 10670WHEN icon%=33:newicon%=69 10680WHEN icon%>33:newicon%=icon%-1 10690WHEN (icon%>37 AND icon%<54):newicon%=icon%-16 10700WHEN (icon%>53 AND icon%<69):newicon%=icon%+15 10710ENDCASE 10720ENDIF 10730 10740OTHERWISE SYS "Wimp_ProcessKey",key% 10741ENDCASE 10750PROCsys_claiminputfocus(roomhandle,newicon%,0,0,-1,LEN(FNgeticondata(roomhandle,newicon%))) 10760=0 10770 10780DEF FNkeypress_status 10790PROCcol(128+2) 10800VDU 26,4,12 10810PROCcol(9):PROCcol(128+7) 10820PROCcentre(STRING$(27," ")+"System Status Information"+STRING$(28," "),0) 10830PROCcol(128+2):PROCcol(7) 10840PROCstatus 10850PROCcol(128+7):PROCcol(9) 10860PROCcentre(STRING$(31," ")+"Integer Variables"+STRING$(32," "),10) 10870PROCcol(128+2):PROCcol(7) 10880PROClvar 10890OFF:PROCreturn(18,31):ON 10900VDU 26,5 10910SYS ForceR,-1,0,0,scrw+1,scrh+1 10920=0 10930 10940DEF FNkeypress_chrdef 10950IF key%=13 AND icon%=64 THEN 10960cur_chr%=ASC(FNgeticondata(design,icon%)) 10970PROCdisplay_chr(cur_chr%) 10980PROCchangeicon(design,64,CHR$(cur_chr%),icon%) 10981ELSE 10982IF key%<>13 THEN SYS "Wimp_ProcessKey",key% 10983ENDIF 10990=0 11000 11010DEF FNkeypress_Setup 11020IF key%=&18E OR key%=13 AND icon%=2 THEN newicon%=5 11030IF key%=13 AND icon%=5 THEN icon%=1:void=FNbutton_Setup:=0 11040IF key%=&18E AND icon%=5 THEN newicon%=2 11050IF key%=&18F AND icon%=5 THEN newicon%=2 11060IF key%=&18F AND icon%=2 THEN newicon%=5 11061IF key%<>13 AND key%<>&18E AND key%<>&18F THEN SYS "Wimp_ProcessKey",key% 11070PROCsys_claiminputfocus(setuph,newicon%,0,0,-1,LEN(FNgeticondata(setuph,newicon%))) 11080=0 11090 11100REM ------ The `menu` routines to open the selected menu ------ 11110 11120DEF FNmenu_ 11130=0 11140 11150DEF FNmenu_swap 11160=0 11170 11180DEF FNmenu_arclogo 11190=0 11200 11210DEF FNmenu_info 11220=0 11230 11240 11250DEF FNmenu_disk35 11260SYS CreateM,0,diskmenu,mousex%-64,mousey% 11270IF loaded$<>"" THEN f$=path$ ELSE f$="AlpsFile" 11280PROCchangeicon(savehandle,2,f$,void) 11290theLastMenu= diskmenu 11300claimmenu$="disk35":tick$="" 11310=0 11320 11330 11340DEF FNmenu_key 11350SYS CreateM,0,objmenu,mousex%-64,mousey% 11360theLastMenu = objmenu 11370claimmenu$="key":tick$="" 11380=0 11390 11400DEF FNmenu_door 11410SYS CreateM,0,roommenu,mousex%-64,mousey% 11420theLastMenu = roommenu 11430claimmenu$="door":tick$="" 11440=0 11450 11460DEF FNmenu_quill 11470$end_msg%=STR$(FNmaxmsg) 11480SYS CreateM,0,textmenu,mousex%-64,mousey% 11490theLastMenu = textmenu 11500claimmenu$="quill":tick$="" 11510=0 11520 11530 11540DEF FNmenu_listing 11550SYS CreateM,0,progmenu,mousex%-64,mousey% 11560theLastMenu = progmenu 11570claimmenu$="listing":tick$="" 11580=0 11590 11600 11610DEF FNmenu_chardes 11620=0 11630SYS CreateM,0,charmenu,mousex%-64,mousey% 11640theLastMenu = charmenu 11650claimmenu$="chardes":tick$="" 11660=0 11670 11680DEF FNmenu_vocab 11690SYS CreateM,0,vocabmenu,mousex%-64,mousey% 11700theLastMenu = vocabmenu 11710claimmenu$="vocabulary":tick$="" 11720=0 11730 11740DEF FNmenu_face 11750SYS CreateM,0,facemenu,mousex%-64,mousey% 11760theLastMenu = facemenu 11770claimmenu$="actors":tick$="" 11780=0 11790 11800DEF FNmenu_misc 11810null = FNtick_misc 11820SYS CreateM,0,miscmenu,mousex%-64,FNmenuHeight(miscmenu,1) 11830theLastMenu = miscmenu 11840claimmenu$="misc":tick$="misc" 11850=0 11860 11870DEF FNmenu_help 11880=0 11890 11900 11910DEF FNmenu_eye 11920SYS CreateM,0,pixmenu,mousex%-64,mousey% 11930theLastMenu = pixmenu 11940claimmenu$="eye":tick$="" 11950=0 11960 11970 11980REM `menuselect` functions - called when a selection is made from a menu 11990REM `item0%` is the number of selection from first menu (0,1,2...) 12000REM `item1%` is the number of selection from second menu (0,1,2...) 12010 12020DEF FNmenuselect_ 12030=0 12040 12050 12060DEF FNmenuselect_message 12070LOCAL changed_msg 12080 12090CASE item0% OF 12100 WHEN -1 12110 WHEN 0,1:overwrite=NOT overwrite 12120 WHEN 2:PROCcut(mark(0),mark(1),picbuf) 12130 WHEN 3:PROCcopy(mark(0),mark(1),picbuf) 12140 WHEN 4:PROCpaste(text_ptr%,picbuf) 12150 WHEN 5:PROCnext_msg 12160 WHEN 6:PROCprev_msg 12170 WHEN 7:PROCfirst_msg 12180 WHEN 8:PROClast_msg 12190 WHEN 9:PROCgoto_msg(VAL($m_msg%)) 12200 WHEN 10 12210 IF item1%>-1 THEN 12220 IF item1%=0 THEN 12230 FOR I%=0 TO maxsw% 12240 switch_vals(I%)=0 12250 NEXT I% 12260 ENDIF 12270 switch_vals(item1%)=VAL($(swdata%+12*(item1%-1))) 12280 IF item1%>switch_vals(0) THEN switch_vals(0)=item1% 12290 REM switch_vals(0) stores the number of switches 12300 ENDIF 12310 WHEN 11 12320 *FX3,10 12330 PROCprint_msg(mptr) 12340 *FX3,0 12350ENDCASE 12360PROCforceR(texthandle) 12370IF changed_msg THEN 12380text_row%=0:text_col%=1 12390PROCcursor(1,0) 12400ENDIF 12410REM claimmenu$="" 12420=0 12430 12440DEF PROCcut(start,end,buf) 12450IF mrk<2 THEN ERROR 1,error$(29) 12460IF end<start THEN SWAP start,end:SWAP col(0),col(1):SWAP row(0),row(1):SWAP asc(0),asc(1) 12470cliplen=end-start+1 12480PROCmove(start,buf,cliplen) 12490REM SYS"Wimp_CloseDown":MODE 12:STOP 12500PROCmove(end+1,start,text_end%-end):REM was +1 until 16.6.89 12510?buf=asc(0):buf?(cliplen-1)=asc(1) 12520text_end%=text_end%-cliplen 12530IF asc(1)=0 THEN text_end%+=1 12540REM Restore end marker if it has been cut 12550IF text_end%<text_block% THEN text_end%=text_block% 12560?text_end%=0 12570last_row%=FNfind_lastrow 12580FOR I%=0 TO last_row% 12590text_rowlen%(I%)=LENFNrow(I%) 12600NEXT 12610mrk=0:mark()=+0 12620IF text_row%>last_row% THEN text_row%=last_row% 12630IF text_col%>text_rowlen%(text_row%) THEN text_col%=text_rowlen%(text_row%)+1 12640PROClocate_ptr:PROCcursor(text_col%,text_row%) 12650data_saved=FALSE:text_ok=FALSE 12660ENDPROC 12670 12680DEF PROCcopy(start,end,buf) 12690IF mrk<2 THEN ERROR 1,error$(29) 12700IF end<start THEN SWAP start,end:SWAP col(0),col(1):SWAP row(0),row(1):SWAP asc(0),asc(1) 12710cliplen=end+1-start 12720PROCmove(start,buf,cliplen) 12730?buf=asc(0):buf?(cliplen-1)=asc(1) 12740?start=asc(0):?end=asc(1):mrk=0:mark()=+0 12750ENDPROC 12760 12770DEF PROCpaste(to,from) 12780IF cliplen=0 THEN ERROR 1,error$(30) 12790PROCmove(to,to+cliplen,text_end%-to+1) 12800PROCmove(from,to,cliplen) 12810text_end%+=cliplen 12820last_row%=FNfind_lastrow 12830FOR I%=0 TO last_row% 12840text_rowlen%(I%)=LENFNrow(I%) 12850NEXT 12860PROClocate_ptr:PROCcursor(text_col%,text_row%) 12870data_saved=FALSE:text_ok=FALSE 12880ENDPROC 12890 12900DEF FNmenuselect_program 12910errflag=FALSE 12920IF item0%>4 AND item0%<9 THEN 12930PROCremove_markers 12940IF NOT text_ok THEN PROCstore_prog 12950prg_sel%=item0%-3 12960text_row%=0:text_col%=1 12970PROCcursor(1,0) 12980ENDIF 12990 13000CASE item0% OF 13010WHEN 0,1:overwrite=NOT overwrite 13020WHEN 2:PROCcut(mark(0),mark(1),picbuf) 13030WHEN 3:PROCcopy(mark(0),mark(1),picbuf) 13040WHEN 4:PROCpaste(text_ptr%,picbuf) 13050WHEN 5:progval$="" 13060WHEN 6:progval$=$proc% 13070WHEN 7:progval$=$def% 13080WHEN 8:progval$=$exit% 13090WHEN 9:PROCprint_prog_seg 13100WHEN 10:PROClisto 13110ENDCASE 13120 13130IF (item0%>4 AND item0%<9) THEN 13140 IF NOT errflag THEN 13150 PROClist(item0%-3,progval$) 13160 PROCforceR(texthandle) 13170 ENDIF 13180ENDIF 13190IF (item0%>1 AND item0%<5) THEN 13200PROCforceR(texthandle) 13210ENDIF 13220IF item0%=10 THEN 13230IF NOT text_ok THEN PROCstore_prog 13240IF NOT errflag THEN 13250text_row%=0:text_col%=1 13260PROCcursor(1,0) 13270PROClist(prg_sel%,progval$) 13280PROCforceR(texthandle) 13290ENDIF 13300ENDIF 13310=0 13320 13330DEF FNmenuselect_vocab 13340REM Make a selection from the vocabulary editor menu 13350CASE item0% OF 13360WHEN 0,1:overwrite=NOT overwrite 13370WHEN 2:PROCcut(mark(0),mark(1),picbuf) 13380WHEN 3:PROCcopy(mark(0),mark(1),picbuf) 13390WHEN 4:PROCpaste(text_ptr%,picbuf) 13400WHEN 5,6,7,8,9,10,11 13410PROCremove_markers:REM Added 23.08.89 13420IF NOT text_ok THEN PROCstore_vocab 13430IF NOT errflag THEN 13440voc_sect%=item0%-4 13450PROClist_vocab(voc_sect%) 13460text_row%=0:text_col%=1 13470PROCcursor(1,0) 13480ENDIF 13490WHEN 12:PROCprint_prog_seg 13500ENDCASE 13510CASE item0% OF 13520WHEN 2,3,4,5,6,7,8,9,10,11 13530PROCforceR(texthandle) 13540ENDCASE 13550REM claimmenu$="" 13560=0 13570 13580DEF FNmenuselect_exitedit 13590xerr%=FALSE 13600IF oldrmicon%<>0 THEN 13610 ptr%=(rdata%+rptr*r_len+oldrmicon%) 13620 flags%=?ptr% 13630 cl_door%=flags% AND &40 13640 op_door%=flags% AND &20 13650 lk_door%=flags% AND &10 13660 unlk_door%=flags% AND &8 13670 IF cl_door% AND item0%=2 THEN xerr%=TRUE 13680 IF op_door% AND item0%=1 THEN xerr%=TRUE 13690 IF op_door% AND item0%=3 THEN xerr%=TRUE 13700 IF unlk_door% AND item0%=3 THEN xerr%=TRUE 13710 IF lk_door% AND item0%=4 THEN xerr%=TRUE 13720 IF lk_door% AND item0%=2 THEN xerr%=TRUE 13730 IF xerr% THEN 13740 VDU 7 13750 ELSE 13760 ?ptr%=?ptr% EOR (&80 >> item0%) 13770 IF NOT lk_door% AND item0%=3 THEN 13780 ?ptr%=?ptr% AND %11011111 OR %01000000 13790 ENDIF 13800 IF lk_door% AND item0%=1 THEN 13810 ?ptr%=?ptr% AND %11101111 13820 ENDIF 13830 ENDIF 13840 data_saved=FALSE 13850ENDIF 13860REM claimmenu$="" 13870=0 13880 13890DEF FNmenuselect_disk35 13900CASE item0% OF 13910 WHEN 0 13920 path$=FNgeticondata(savehandle,2) 13930 SYS "OS_File",5,path$ TO ftype 13940 IF ftype=0 THEN PROCsave_all(path$) ELSE PROCensure(item0%,"This file exists. Do you want to replace it?") 13950 WHEN 1 13960 PROCload_bits(FNgeticondata(setuph,2)) 13970 PROCsetup_disk(item0%) 13980ENDCASE 13990icon%(diskicon)=-1:REM claimmenu$="" 14000=0 14010 14020 14030 14040DEF FNmenuselect_objected 14050old_flags%=VAL(FNgeticondata(objhandle,8)) 14060new_flags%=old_flags% EOR (&80 >> item0%) 14070PROCchangeicon(objhandle,8,STR$(new_flags%),dummy) 14080REM claimmenu$="" 14090=0 14100 14110DEF FNmenuselect_container 14120CASE item0% OF 14130WHEN 0 14140container=NOT container 14150IF container THEN 14160PROCchangeicon(objhandle,26,"SIZE <C>",dummy) 14170ELSE 14180PROCchangeicon(objhandle,26,"SIZE",dummy) 14190ENDIF 14200WHEN 1 14210cont_room=VAL($controom%) 14220ENDCASE 14230REM data_saved=FALSE 14240REM claimmenu$="" 14250=0 14260 14270DEF FNmenuselect_roomedit 14280old_flags%=VAL(FNgeticondata(roomhandle,34)) 14290new_flags%=old_flags% EOR (&80 >> item0%) 14300PROCchangeicon(roomhandle,34,STR$(new_flags%),dummy) 14310REM claimmenu$="" 14320=0 14330 14340DEF FNmenuselect_key 14350CASE item0% OF 14360 WHEN 0:PROCprint_objs 14370 WHEN 1:PROCimport_obj("O."+$import%) 14380ENDCASE 14390REM claimmenu$="" 14400=0 14410 14420DEF FNmenuselect_door 14430CASE item0% OF 14440 WHEN 0:PROCprint_rooms 14450 WHEN 1:PROCimport_rooms("R."+$import%) 14460ENDCASE 14470REM claimmenu$="" 14480=0 14490 14500DEF FNmenuselect_quill 14510CASE item0% OF 14520 WHEN 0:PROCprint_text 14530 WHEN 1:PROCimport_text("T."+$import%) 14540 PROCload_dict("D."+$import%) 14550ENDCASE 14560REM claimmenu$="" 14570=0 14580 14590DEF FNmenuselect_listing 14600CASE item0% OF 14610 WHEN 0:PROCprint_program 14620 WHEN 1:PROCconvert($import%) 14630 WHEN 2:PROCrun 14640ENDCASE 14650REM claimmenu$="" 14660=0 14670 14680DEF FNmenuselect_chardes 14690REM When `menu` is clicked on the `chardes` icon 14700CASE item0% OF 14710WHEN 0:PROCsave_chars("<Users$Resources>."+$filename2%) 14720WHEN 1 14730OSCLI("PRINT <Alps$Resources>."+$filename2%) 14740PROCdisplay_chr(cur_chr%) 14750SYS ForceR,-1,0,0,scrw+1,scrh+1 14760ENDCASE 14770REM claimmenu$="" 14780=0 14790 14800DEF FNmenuselect_chrdef 14810REM When button is clicked on the `SELECT` icon in the char design window 14820chr%=ASC($charnum) 14830IF chr%>31 AND chr%<=max_chr% THEN 14840 cur_chr%=chr% 14850 PROCchangeicon(design,64,CHR$(cur_chr%),icon%) 14860 PROCdisplay_chr(cur_chr%) 14870ENDIF 14880REM claimmenu$="" 14890=0 14900 14910DEF FNmenuselect_vocabulary 14920REM When SELECT pressed in small vocab menu 14930CASE item0% OF 14940WHEN 0:PROCprint_vocab 14950ENDCASE 14960REM claimmenu$="" 14970=0 14980 14990DEF FNmenuselect_actors 15000REM SELECT pressed in small 'face' menu (Actors) 15010CASE item0% OF 15020WHEN 0:PROCprint_actors 15030ENDCASE 15040REM claimmenu$="" 15050=0 15060 15070DEF FNmenuselect_eye 15080REM SELECT pressed in small 'eye' menu (Pictures) 15090CASE item0% OF 15100WHEN 0:PROCprint_pix 15110ENDCASE 15120REM claimmenu$="" 15130=0 15140 15150DEF FNmenuselect_misc 15160CASE item0% OF 15170 WHEN 1: REM quit 15180 PROCquit(4) 15190 ENDCASE 15200icon%(THEmiscicon)=-1 15210=0 15220 15230 15240REM ------ Utility procedures and functions for each editor ------ 15250 15260REM ------ Character designer utilities ------ 15270 15280DEF PROCwrite_chr(C%) 15290VDU 23,C% 15300FOR row%=0 TO 7 15310row_value=0 15320FOR col%=0 TO 7 15330dummy=VAL(FNgeticondata(design,row%*8+col%)) 15340bit=flags% >>> 28 15350IF bit=7 THEN row_value=row_value+2^(7-col%) 15360NEXT col% 15370VDU row_value 15380NEXT row% 15390ENDPROC 15400 15410DEF PROCdisplay_chr(C%) 15420?os_block=C% 15430SYS "OS_Word",&A,os_block 15440FOR R%=1 TO 8 15450row_value=R%?os_block 15460FOR C%=0 TO 7 15470bit=row_value DIV 2^(7-C%) 15480row_value=row_value MOD 2^(7-C%) 15490IF bit>0 PROCset_icon(design,(R%-1)*8+C%,&70000000,&F0000000) ELSE PROCset_icon(design,(R%-1)*8+C%,&20000000,&F0000000) 15500NEXT C% 15510NEXT R% 15520ENDPROC 15530 15540DEF PROCsave_chars(f$) 15550f%=OPENOUT(f$) 15560FOR ch%=32 TO max_chr% 15570BPUT#f%,23:BPUT#f%,ch% 15580?os_block=ch% 15590SYS "OS_Word",&A,os_block 15600FOR I%=1 TO 8 15610BPUT#f%,I%?os_block 15620NEXT I% 15630NEXT ch% 15640CLOSE#f% 15650OSCLI("SETTYPE "+f$+" BBC Font") 15660ENDPROC 15670 15680DEF PROCsave_pal(f$) 15690LOCAL ch%,col1,rgb 15700PROCreadPalette 15710ch%=OPENOUT f$ 15720FOR col=0 TO 19 15730FOR rgb=1 TO 3 15740BPUT#ch%,rgb(col,rgb) 15750NEXT rgb 15760NEXT col 15770CLOSE#ch% 15780OSCLI "SETTYPE "+f$+" FED" 15790ENDPROC 15800 15810 15820 15830REM ------ Text editor utilities ------ 15840 15850DEF PROCleft 15860IF text_col%<>1 THEN 15870 text_ptr%-=1 15880 text_col%-=1 15890ELSE 15900 IF text_row%<>0 THEN 15910 text_row%-=1 15920 text_col%=text_rowlen%(text_row%)+1 15930 IF text_rowlen%(text_row%)<text_maxllen% THEN text_ptr%-=1 15940 ELSE 15950 VDU 7 15960 ENDIF 15970ENDIF 15980ENDPROC 15990 16000DEF PROCleft_end 16010text_ptr%-=(text_col%-1) 16020text_col%=1 16030ENDPROC 16040 16050DEF PROCright 16060IF text_row%=last_row% AND text_col%=text_rowlen%(text_row%)+1 THEN 16070 VDU 7 16080ELSE 16090 REM This '<' was changed to '<=' on 23.08.89 16100 IF text_col%<=text_maxllen% THEN text_ptr%+=1 16110 text_col%+=1 16120 IF text_col%>text_rowlen%(text_row%)+1 AND text_row%<>last_row% THEN 16130 text_col%=1:text_row%+=1 16140 ENDIF 16150ENDIF 16160ENDPROC 16170 16180DEF PROCright_end 16190text_ptr%+=(text_rowlen%(text_row%)-text_col%)+1 16200text_col%=text_rowlen%(text_row%)+1 16210REM IF text_col%>text_maxllen% text_col%=text_maxllen% 16220ENDPROC 16230 16240DEF PROCdown 16250IF text_row%=text_maxrows% OR text_row%=last_row% THEN 16260 VDU 7 16270ELSE 16280 text_row%+=1 16290 old_col%=text_col% 16300 IF text_rowlen%(text_row%)<text_col% THEN 16310 text_col%=text_rowlen%(text_row%)+1 16320 ENDIF 16330 text_ptr%+=(text_rowlen%(text_row%-1)-old_col%+text_col%) 16340 IF text_rowlen%(text_row%-1)<text_maxllen% text_ptr%+=1 16350ENDIF 16360ENDPROC 16370 16380DEF PROCup 16390IF text_row%<>0 THEN 16400 text_row%-=1 16410 old_col%=text_col% 16420 IF text_rowlen%(text_row%)<text_col% THEN 16430 text_col%=text_rowlen%(text_row%)+1 16440 ENDIF 16450 text_ptr%-=(old_col%+(text_rowlen%(text_row%)-text_col%)) 16460 IF text_rowlen%(text_row%)<text_maxllen% text_ptr%-=1 16470ELSE 16480 VDU 7 16490ENDIF 16500ENDPROC 16510 16520DEF PROCnewline 16530old_col%=text_col% 16540PROCinsert_char(13) 16550text_row%+=1 16560text_col%=1 16570PROCupdate(texthandle,scx%,scy%-(y1%-y0%),scx%+(x1%-x0%)+chX%,scy%) 16580dummy=FNredraw_text(TRUE) 16590ENDPROC 16600 16610DEF PROCinsert_char(chr%) 16620IF text_ptr%>text_end% THEN FOR I%=text_end% TO text_ptr%:?I%=32:NEXT:text_end%=text_ptr% 16630IF text_ptr%=text_end% OR text_rowlen%(text_row%)<text_maxllen%-1 THEN 16640 redraw_all%=FALSE 16650ELSE 16660 redraw_all%=TRUE 16670ENDIF 16680 16690PROCmove(text_ptr%,text_ptr%+1,text_end%-text_ptr%) 16700IF text_ptr%<mark(0) THEN mark(0)+=1 16710IF text_ptr%<mark(1) THEN mark(1)+=1 16720?text_ptr%=chr%:text_ptr%+=1:text_end%+=1:?text_end%=0 16730 16740IF text_rowlen%(text_row%)<text_maxllen%-1 AND chr%<>13 THEN 16750REM The '-1' above added 29.08.89 to fix bug 8a. 16760text_rowlen%(text_row%)+=1 16770ELSE 16780last_row%=FNfind_lastrow 16790FOR R%=text_row% TO last_row% 16800 text_rowlen%(R%)=LEN FNrow(R%) 16810NEXT 16820ENDIF 16830 16840IF redraw_all% THEN 16850PROCupdate(texthandle,0,-(last_row%+1)*lsY%,scx%+(x1%-x0%)+chX%,-(text_row%)*lsY%) 16860ELSE 16870IF text_col%>text_maxllen% THEN 16880PROCupdate(texthandle,0,-(text_row%)*lsY%,scx%+(x1%-x0%)+chX%,-(text_row%-1)*lsY%) 16890ELSE 16900PROCupdate(texthandle,chX%*(text_col%-1),-(text_row%+1)*lsY%,scx%+(x1%-x0%)+chX%,-(text_row%)*lsY%) 16910ENDIF 16920ENDIF 16930 16940IF text_col%>text_maxllen% THEN 16950text_col%=2:text_row%+=1 16960IF text_row%>last_row% last_row%=text_row% 16970ELSE 16980text_col%+=1 16990IF text_col%>text_maxllen% THEN 17000 text_col%=1:text_row%+=1 17010 IF text_row%>last_row% last_row%=text_row% 17020ENDIF 17030ENDIF 17040 17050dummy=FNredraw_text(redraw_all%) 17060ENDPROC 17070 17080DEF PROCoverwrite_char(chr%) 17090IF text_col%>text_rowlen%(text_row%) THEN PROCinsert_char(chr%):ENDPROC 17100IF text_ptr%=mark(0) THEN SWAP mark(0),mark(1):SWAP asc(0),asc(1):SWAP chr(0),chr(1):mrk-=1:mark(1)=0 ELSE IF text_ptr%=mark(1) THEN mrk-=1:mark(1)=0 17110?text_ptr%=chr% 17120text_ptr%+=1 17130IF text_ptr%>text_end% text_end%=text_ptr% 17140?text_end%=0 17150PROCupdate(texthandle,chX%*(text_col%-1),-(text_row%+1)*lsY%,scx%+(x1%-x0%)+chX%,-(text_row%)*lsY%) 17160dummy=FNredraw_text(TRUE) 17170text_col%+=1 17180IF text_col%>text_maxllen% THEN text_col%=1:text_row%+=1 17190 17200last_row%=FNfind_lastrow 17210 17220FOR R%=text_row% TO last_row% 17230 text_rowlen%(R%)=LEN FNrow(R%) 17240NEXT 17250ENDPROC 17260 17270DEF PROCdelete_char 17280IF text_col%=1 AND text_row%=0 VDU 7:ENDPROC 17290IF text_ptr%<mark(0) THEN mark(0)-=1 17300IF text_ptr%<mark(1) THEN mark(1)-=1 17310text_ptr%-=1:text_end%-=1 17320IF text_ptr%=mark(0) THEN SWAP mark(0),mark(1):SWAP asc(0),asc(1):SWAP chr(0),chr(1):mrk-=1:mark(1)=0 ELSE IF text_ptr%=mark(1) THEN mrk-=1:mark(1)=0 17330text_col%-=1:this_row%=text_row%:REM text_rowlen%(text_row%)-=1 17340cr%=FALSE 17350IF text_col%<1 THEN 17360 cr%=TRUE 17370 text_col%=text_rowlen%(text_row%-1) 17380 IF ?text_ptr%=13 text_col%+=1 17390 text_row%-=1 17400ENDIF 17410PROCmove(text_ptr%+1,text_ptr%,text_end%-text_ptr%+1) 17420 17430IF text_rowlen%(this_row%)<text_maxllen% AND NOT cr% THEN 17440text_rowlen%(this_row%)-=1 17450ELSE 17460last_row%=FNfind_lastrow 17470FOR R%=text_row% TO last_row% 17480 text_rowlen%(R%)=LEN FNrow(R%) 17490NEXT 17500ENDIF 17510PROCgetw(texthandle) 17520IF (text_ptr%=text_end% OR text_rowlen%(text_row%)<text_maxllen%-1) AND NOT cr% THEN 17530PROCupdate(texthandle,chX%*(text_col%-1),-(text_row%+1)*lsY%,scx%+(x1%-x0%)+chX%,-(text_row%)*lsY%) 17540 C%=text_col% 17550ELSE 17560PROCupdate(texthandle,0,-(last_row%+2)*lsY%,scx%+(x1%-x0%)+chX%,-(text_row%)*lsY%) 17570REM PROCupdate(texthandle,scx%,scy%-(y1%-y0%),scx%+(x1%-x0%)+chX%,scy%) 17580ENDIF 17590 17600dummy=FNredraw_text(TRUE) 17610ENDPROC 17620 17630DEF PROCinsert_line 17640IF last_row%=text_maxrows% THEN VDU7:ENDPROC 17650from%=text_ptr%-text_col%+1 17660IF from%<mark(0) THEN mark(0)+=1 17670IF from%<mark(1) THEN mark(1)+=1 17680PROCmove(from%,from%+1,text_end%-from%+1) 17690?from%=13 17700FOR R%=last_row%+1 TO text_row%+1 STEP -1 17710text_rowlen%(R%)=text_rowlen%(R%-1) 17720NEXT 17730text_rowlen%(text_row%)=0 17740text_end%+=1:last_row%+=1 17750text_ptr%-=text_col%-1 17760text_col%=1 17770PROCupdate(texthandle,scx%,scy%-(y1%-y0%),scx%+(x1%-x0%)+chX%,scy%-(text_row%)*lsY%) 17780dummy=FNredraw_text(TRUE) 17790ENDPROC 17800 17810DEF PROCdelete_line 17820LOCAL cr%,to% 17830PROCremove_markers 17840next_line%=text_ptr%+text_rowlen%(text_row%)-text_col%+1 17850text_ptr%-=(text_col%-1):to%=text_ptr% 17860IF ?(text_ptr%+text_rowlen%(text_row%))=13 next_line%+=1:cr%=TRUE 17870PROCmove(next_line%,to%,text_end%-next_line%) 17880text_end%-=text_rowlen%(text_row%) 17890IF cr% text_end%-=1 17900IF text_end%<text_block% text_end%=text_block% 17910?text_end%=0 17920text_col%=1 17930last_row%=FNfind_lastrow 17940 17950FOR R%=text_row% TO last_row% 17960 text_rowlen%(R%)=LEN FNrow(R%) 17970NEXT 17980 17990REM PROCupdate(texthandle,scx%,scy%-(y1%-y0%),scx%+(x1%-x0%)+chX%,scy%-(text_row%)*lsY%) 18000PROCupdate(texthandle,scx%,scy%-(y1%-y0%),scx%+(x1%-x0%)+chX%,scy%) 18010dummy=FNredraw_text(TRUE) 18020ENDPROC 18030 18040DEF PROCinstall_texted 18050text_maxrows%=500 18060text_blocksize%=20000 18070text_original%=TRUE 18080DIM text_rowlen%(text_maxrows%) 18090DIM default_text_block% text_blocksize%+300 18100text_block%=default_text_block% 18110dummy_spc=27:dummy_cr=253 18120VDU23,dummy_spc,0,0,0,0,0,0,0,0 18130VDU23,dummy_cr,0,0,0,0,0,0,0,0 18140text_row%=0 18150text_col%=1 18160last_row%=0 18170text_cur%=TRUE 18180overwrite=FALSE 18190tab_set=5 18200text_ptr%=text_block% 18210text_end%=text_block% 18220?text_block%=0 18230mrk=0:DIM mark(1),row(1),col(1),chr(1),asc(1):chr(0)=254:chr(1)=255:cliplen=0 18240ENDPROC 18250 18260DEF PROCremove_markers 18270LOCAL I% 18280IF mrk>0 THEN 18290mrk-=1 18300FOR I%=0 TO mrk 18310?mark(I%)=asc(I%):mark(I%)=0 18320NEXT 18330mrk=0 18340ENDIF 18350ENDPROC 18360 18370DEF FNfind_lastrow 18380LOCAL A%,B% 18390A%=text_block%:B%=text_end% 18400CALL lastrow 18410=!rowcount 18420 18430DEF FNrow(row%) 18440LOCAL A%,B% 18450A%=text_block%:B%=row% 18460CALL row 18470=$linebuffer 18480 18490 18500REM ------ Object editor utilities ------ 18510 18520DEF PROCfirst_obj 18530PROCstore_obj(optr) 18540optr=1 18550PROCrestore_obj(1) 18560ENDPROC 18570 18580DEF PROClast_obj 18590PROCstore_obj(optr) 18600optr=last_object 18610PROCrestore_obj(optr) 18620ENDPROC 18630 18640DEF PROCnext_obj 18650PROCstore_obj(optr) 18660optr+=1 18670IF optr>maxobs optr=maxobs 18680PROCrestore_obj(optr) 18690ENDPROC 18700 18710DEF PROCprev_obj 18720PROCstore_obj(optr) 18730optr-=1 18740IF optr<1 optr=1 18750PROCrestore_obj(optr) 18760ENDPROC 18770 18780DEF PROCfwd_obj(times%) 18790PROCstore_obj(optr) 18800optr+=times%:IF optr>maxobs THEN optr=maxobs 18810PROCrestore_obj(optr) 18820ENDPROC 18830 18840DEF PROCrewind_obj(times%) 18850PROCstore_obj(optr) 18860optr-=times%:IF optr<1 THEN optr=1 18870PROCrestore_obj(optr) 18880ENDPROC 18890 18900DEF PROCstore_obj(o%) 18910REM This reads the object data from the writeable icons in the window 18920REM and stores it in the object data area (odata%...) 18930LOCAL olddata 18940ptr=o%*o_len 18950 18960FOR I%=8 TO 15 18970 icondata=VAL(FNgeticondata(objhandle,I%)) 18980 CASE I% OF 18990 WHEN 10,11,12,13 19000 REM The double-byte values 19010 olddata=?(odata%+ptr)+?(odata%+ptr+1)*256 19020 IF icondata<>olddata THEN data_saved=FALSE 19030 ?(odata%+ptr)=icondata MOD 256 19040 ?(odata%+ptr+1)=icondata DIV 256 19050 ptr+=2 19060 WHEN 8,9,14,15 19070 REM The single-byte values 19080 olddata=?(odata%+ptr) 19090 IF olddata<>icondata MOD 256 THEN data_saved=FALSE 19100 ?(odata%+ptr)=icondata MOD 256:ptr+=1 19110 ENDCASE 19120NEXT 19130IF container THEN 19140?(odata%+ptr)=?(odata%+ptr) OR %10000000:ptr+=1:?(odata%+ptr)=cont_room 19150ELSE 19160?(odata%+ptr)=?(odata%+ptr) AND %01111111:ptr+=1:?(odata%+ptr)=0 19170ENDIF 19180ENDPROC 19190 19200DEF PROCrestore_obj(o%) 19210REM This reads the data for object o% from memory and updates the icon 19220REM contents, ensuring the window reflects the new values 19230 19240ptr=o%*o_len 19250PROCchangeicon(objhandle,7,STR$(o%),icon%) 19260FOR I%=8 TO 15 19270 CASE I% OF 19280 WHEN 10,11,12,13:data$=STR$(?(odata%+ptr)+256*?(odata%+ptr+1)):ptr+=2 19290 WHEN 8,9,14,15:data$=STR$(?(odata%+ptr)):ptr+=1 19300 ENDCASE 19310 IF data$="" THEN data$="0" 19320 PROCchangeicon(objhandle,I%,data$,newicon%) 19330NEXT I% 19340 19350store=small_area%:col%=1:row%=0 19360PROCfill(small_area%,small_areasize%,13) 19370print=FALSE 19380PROCpvok(FNfindnoun(o%,void),1,FALSE) 19390PROCchangeicon(objhandle,19,$small_area%,newicon%) 19400IF ((?(odata%+ptr) AND %10000000) DIV 128)>0 THEN container=TRUE ELSE container=FALSE 19410ptr+=1 19420cont_room=?(odata%+ptr):$controom%=STR$(cont_room) 19430IF container PROCchangeicon(objhandle,26,"SIZE <C>",newicon%) ELSE PROCchangeicon(objhandle,26,"SIZE",newicon%) 19440ENDPROC 19450 19460 19470REM ------ Room editor utilities ------ 19480 19490DEF PROCfirst_room 19500PROCstore_room(rptr) 19510rptr=1 19520PROCrestore_room(1) 19530ENDPROC 19540 19550DEF PROClast_room 19560PROCstore_room(rptr) 19570rptr=last_room 19580PROCrestore_room(rptr) 19590ENDPROC 19600 19610DEF PROCnext_room 19620PROCstore_room(rptr) 19630rptr+=1 19640IF rptr>maxrms rptr=maxrms 19650PROCrestore_room(rptr) 19660ENDPROC 19670 19680DEF PROCprev_room 19690PROCstore_room(rptr) 19700rptr-=1 19710IF rptr<1 rptr=1 19720PROCrestore_room(rptr) 19730ENDPROC 19740 19750DEF PROCfwd_room(times%) 19760PROCstore_room(rptr) 19770rptr+=times%:IF rptr>maxrms THEN rptr=maxrms 19780PROCrestore_room(rptr) 19790ENDPROC 19800 19810DEF PROCrewind_room(times%) 19820PROCstore_room(rptr) 19830rptr-=times%:IF rptr<1 THEN rptr=1 19840PROCrestore_room(rptr) 19850ENDPROC 19860 19870DEF PROCstore_room(r%) 19880ptr=r%*r_len 19890FOR I%=34 TO 69 19900 icondata=VAL(FNgeticondata(roomhandle,I%)) 19910 CASE TRUE OF 19920 WHEN I%>35 AND I%<54 19930 olddata=?(rdata%+ptr)+?(rdata%+ptr+1)*256 19940 IF icondata<>olddata THEN data_saved=FALSE 19950 ?(rdata%+ptr)=icondata MOD 256 19960 ?(rdata%+ptr+1)=icondata DIV 256 19970 ptr+=2 19980 WHEN I%<36 OR I%>53 19990 olddata=?(rdata%+ptr) 20000 IF olddata<>icondata MOD 256 THEN data_saved=FALSE 20010 ?(rdata%+ptr)=icondata MOD 256 20020 ptr+=1 20030 ENDCASE 20040NEXT I% 20050icondata=VAL(FNgeticondata(roomhandle,71)) 20060?(rdata%+ptr+16)=icondata MOD 256 20070?(rdata%+ptr+17)=icondata DIV 256 20080ENDPROC 20090 20100DEF PROCrestore_room(r%) 20110ptr=r%*r_len 20120PROCchangeicon(roomhandle,33,STR$(r%),icon%) 20130FOR I%=34 TO 69 20140 CASE TRUE OF 20150 WHEN I%>35 AND I%<54 20160 data$=STR$(?(rdata%+ptr)+256*?(rdata%+ptr+1)):ptr+=2 20170 WHEN I%<36 OR I%>53 20180 data$=STR$(?(rdata%+ptr)):ptr+=1 20190 ENDCASE 20200 IF data$="" THEN data$="0" 20210 PROCchangeicon(roomhandle,I%,data$,newicon%) 20220NEXT I% 20230data$=STR$(?(rdata%+ptr+16)+256*?(rdata%+ptr+17)) 20240IF data$="" THEN data$="0" 20250PROCchangeicon(roomhandle,71,data$,newicon%) 20260ENDPROC 20270 20280 20290REM ------ Message editor utilities ------ 20300 20310DEF PROCstore_msg 20320errflag=FALSE:PROCremove_markers 20330newlen=text_end%-text_block% 20340diff=newlen-oldlen 20350IF diff+text%!2>maxtext% THEN 20360 PROCerror(13,error$(36)) 20370 errflag=TRUE 20380ELSE 20390 to=mstart+newlen-1 20400 from=mend-1 20410 text_end%=text_block%:text_ptr%=text_block% 20420 bytes_to_move=FNtext_end-mend+1 20430 PROCmove(from,to,bytes_to_move) 20440 PROCmove(text_block%,mstart,newlen) 20450 PROCincmsglen(diff) 20460 ns%=switch_vals(0) 20470 IF ns%>0 THEN 20480 ?switch_buf%=ns%:ptr%=1 20490 FOR I%=1 TO ns% 20500 switch_buf%?ptr%=switch_vals(I%) 20510 switch_buf%?(ptr%+1)=switch_vals(I%) DIV 256 20520 ptr%+=2 20530 NEXT 20540 ELSE 20550 PROCfill(switch_buf%,maxsw%*2+1,0) 20560 ENDIF 20570 PROCmove(mstart,swloc+2*ns%+1,FNtext_end-mstart) 20580 PROCmove(switch_buf%,swloc,2*ns%+1) 20590 PROCincmsglen(2*ns%-2*oldsw) 20600ENDIF 20610ENDPROC 20620 20630DEF PROCincmsglen(bytes_to_add) 20640text%!2=text%!2+bytes_to_add 20650ENDPROC 20660 20670DEF FNtext_end 20680=text%+text%!2 20690 20700DEF FNmaxmsg 20710=?text%+256*text%?1 20720 20730DEF PROCincmaxmsg 20740?text%+=1:IF ?text%=0 ?(text%+1)+=1 20750ENDPROC 20760 20770DEF PROCshow_msg(ms%) 20780IF ms%>FNmaxmsg THEN ERROR 4,error$(31) 20790IF ms%<1 ENDPROC 20800PROCfill(text_block%,text_blocksize%,dummy_spc) 20810text_rowlen%()=+0:switch_vals()=+0 20820changed_msg=TRUE 20830A%=ms%:C%=text%+7:ptr%=USR findmsg 20840chr%=?ptr%:ptr%+=1 20850switch_vals(0)=chr%:oldsw=chr%:swloc=ptr%-1 20860IF chr%>0 THEN 20870 FOR I%=1 TO chr% 20880 switch_vals(I%)=?ptr%+256*ptr%?1 20890 ptr%+=2 20900 NEXT 20910ENDIF 20920mstart=ptr% 20930chr%=?ptr% 20940row%=0:text_ptr%=text_block% 20950WHILE chr%>0 20960 col%=1:line$="" 20970 WHILE chr%<>13 AND chr%<>0 AND col%<=text_maxllen% 20980 IF chr%>&7F THEN 20990 tokptr=chr%-&7F 21000 line$+=tok$(tokptr):L%=LEN tok$(tokptr) 21010 FOR I%=1 TO L% 21020 ?(text_ptr%+I%-1)=ASC(MID$(tok$(tokptr),I%,1)) 21030 NEXT 21040 text_ptr%+=(L%-1) 21050 ELSE 21060 ?text_ptr%=chr%:line$+=CHR$ chr% 21070 ENDIF 21080 ptr%+=1:text_ptr%+=1:chr%=?ptr%:col%+=1 21090 ENDWHILE 21100 text_rowlen%(row%)=LEN line$ 21110 IF col%>text_maxllen% OR chr%=13 row%+=1:col%=1 21120 IF chr%=13 ?text_ptr%=13:text_ptr%+=1:ptr%+=1 21130 chr%=?ptr%:REM ptr%+=1 21140ENDWHILE 21150mend=ptr%:?text_ptr%=chr% 21160text_end%=text_ptr% 21170oldlen=mend-mstart 21180IF oldlen<0 oldlen=0 21190text_ptr%=text_block% 21200last_row%=FNfind_lastrow 21210FOR I%=0 TO last_row%:text_rowlen%(I%)=LEN FNrow(I%):NEXT 21220ENDPROC 21230 21240DEF PROCnext_msg 21250mptr+=1 21260PROCstore_msg:REM save this one first 21270IF mptr>FNmaxmsg THEN ptr=FNtext_end:ptr?0=0:ptr?1=0:PROCincmaxmsg:PROCincmsglen(2) 21280PROCshow_msg(mptr):REM Now load the next one into `texted` 21290ENDPROC 21300 21310DEF PROCprev_msg 21320IF mptr>1 THEN 21330mptr-=1 21340PROCstore_msg 21350PROCshow_msg(mptr) 21360ENDIF 21370ENDPROC 21380 21390DEF PROCgoto_msg(ms%) 21400IF ms%>FNmaxmsg ms%=FNmaxmsg:VDU 7 21410IF ms%<1 ms%=1:VDU 7 21420PROCstore_msg 21430PROCshow_msg(ms%) 21440mptr=ms% 21450ENDPROC 21460 21470DEF PROClast_msg 21480PROCstore_msg 21490mptr=FNmaxmsg 21500PROCshow_msg(mptr) 21510ENDPROC 21520 21530DEF PROCfirst_msg 21540PROCstore_msg 21550mptr=1 21560PROCshow_msg(mptr) 21570ENDPROC 21580 21590 21600REM ------ Program Editor utilities ------ 21610 21620DEF PROCstore_prog 21630LOCAL sp_ptr%,line$,chr% 21640REM Use `hourglass` pointer 21650SYS "Hourglass_On" 21660errflag=FALSE:PROCremove_markers 21670sp_ptr%=text_block% 21680chr%=?sp_ptr% 21690prgptr=prgbuf% 21700WHILE sp_ptr%<text_end% AND NOT errflag 21710 line$="" 21720 WHILE (chr%<>13) AND (chr%<>0) AND (chr%<>dummy_spc) 21730 chr%=?sp_ptr% 21740 sp_ptr%+=1 21750 line$+=CHR$(chr%) 21760 ENDWHILE 21770 PROCscan 21780 chr%=?sp_ptr% 21790 WHILE (chr%=13 OR chr%=dummy_spc OR chr%=0) AND (sp_ptr%<text_end%) 21800 sp_ptr%+=1:chr%=?sp_ptr% 21810 ENDWHILE 21820ENDWHILE 21830IF NOT errflag THEN 21840 oldlen%=prgend-pstart:IF oldlen%<>0 oldlen%+=1 21850 bytes_to_move=FNprglen-oldlen% 21860 PROCincprglen(-oldlen%) 21870 newlen%=prgptr-prgbuf% 21880 REM This check for 'No room' was added 2.6.89 21890 IF FNprglen+newlen%>code_size%-4 THEN 21900 PROCincprglen(oldlen%) 21910 PROCerror(13,error$(35)) 21920 ELSE 21930 PROCmove(prgend+1,pstart+newlen%,bytes_to_move) 21940 PROCmove(prgbuf%,pstart,newlen%) 21950 PROCincprglen(newlen%) 21960 ?(program%+4+FNprglen)=0:REM restore end of program marker (9/4/89) 21970 text_ok=TRUE 21980 ENDIF 21990ENDIF 22000SYS "Hourglass_Off" 22010ENDPROC 22020 22030DEF FNprglen 22040=!program% 22050 22060DEF PROCincprglen(bytes) 22070!program%=!program%+bytes 22080ENDPROC 22090 22100 22110REM ------ Window `redraw` functions ------ 22120 22130 22140DEF FNredraw_text(flag%) 22150REM flag%=TRUE -> redraw WHOLE text window 22160REM else only redraw from the cursor line 22170 22180WHILE more% 22190BR%=(by%-block!32-ypixel%) DIV lsY% 22200IF BR%>last_row% BR%=last_row% 22210TR%=(by%-block!40-ypixel%) DIV lsY% 22220IF TR%>last_row% TR%=last_row% 22230ptr_end%=BR%*text_maxllen%+text_block% 22240CLG 22250FOR I%=TR% TO BR% 22260 MOVE bx%,by%-lsY%*I%-ypixel% 22270 PRINT FNrow(I%); 22280NEXT 22290SYSGetR,0,block TO more% 22300ENDWHILE 22310=0 22320 22330 22340REM ------ General icon handling routines ------ 22350 22360DEF PROCht(handle%,icon%,fl$,fc%,bc%) 22370LOCALmask% 22380IFfl$="*"THENfl%=0:mask%=&FF000000 ELSEfl%=EVALfl$:mask%=-1 22390!block=handle%:block!4=icon%:block!8=fl%:block?11=fc%+(bc%<<4):block!12=mask%:SYS SetI,0,block 22400ENDPROC 22410 22420DEF FNgeticondata(handle%,icon%) 22430!block=handle%:block!4=icon% 22440SYS GetI,0,block 22450flags%=block!24 22460IF (flags% AND 256)<>0 THEN data$=$(!(block+28)) ELSE data$=$(block+28) 22470=data$ 22480 22490DEF PROCchangeicon(handle%,icon%,new$,RETURN icon%) 22500LOCAL J% 22510dummy$=FNgeticondata(handle%,icon%) 22520IF (flags% AND 256)<>0 THEN $(!(block+28))=new$ ELSE $(block+28)=new$ 22530SYS DeleteI,0,block 22540FOR J%=4 TO 28 STEP 4 22550 block!J%=block!(J%+4) 22560NEXT J% 22570!block=handle%:SYS CreateI,0,block TO icon% 22580PROCset_icon(handle%,icon%,0,0):REM ensure it appears updated on screen 22590ENDPROC 22600 22610DEF PROCset_icon(handle%,icon%,eor%,mask%) 22620!block=handle%:block!4=icon%:block!8=eor%:block!12=mask% 22630SYS SetI,0,block 22640ENDPROC 22650 22660 22670REM ------ Menu creation procedures ------ 22680 22690REM **** onIconBar = 1 if yes, otherwise 0 ********** 22700DEF FNmenuHeight(theMenu%, onIconBar%) 22710= ((96 * onIconBar%) + (theMenu%?30 * 44) + (theMenu%?31 * 24)) 22720 22730 22740DEF FNcrmenu 22750IF menufree%+28 > menuend% THEN ERROR 1,error$(32) 22760LOCAL m%,menu$:READ menu$ 22770 22780 22790REM ************** the bodge to store the menu height **************** 22800LOCAL menuHiAddr% 22810menuHiAddr% = menufree% + 28 + 2 :REM 2nd last byte in 1st menuitem flags 22820menuItemNum% = 0 22830dashItemNum% = 0 22840 22850 22860IF LEFT$(menu$,1)="=" THEN menu$=EVALMID$(menu$,2) 22870menuptr%=menufree% 22880i%=0:ctr%=0 22890IF LEFT$(menu$,1)="#" THEN i%=1:menutitle$=FNpar(",") ELSE menutitle$="" 22900I%=INSTR(menutitle$,">") 22910IF I%>0 THEN 22920 menuptr%!20=EVAL(MID$(menutitle$,I%+1)) 22930 menutitle$=LEFT$(menutitle$,I%-1) 22940ELSE menuptr%!20=44 22950ENDIF 22960$menuptr%=menutitle$ 22970menuptr%?12=`tfcol:menuptr%?13=`tbcol:menuptr%?14=`wfcol:menuptr%?15=`wbcol 22980menuptr%!16=196-24:menuptr%!24=0 22990menuptr%+=28:maxx%=LENmenutitle$-3 23000WHILE RIGHT$(menu$,1)="~" 23010 menu$=LEFT$(menu$,LENmenu$-1) 23020 REPEAT item$=FNpar(","):PROCmenuitem(item$):UNTIL item$="" 23030 READ menu$ 23040ENDWHILE 23050REPEAT item$=FNpar(","):PROCmenuitem(item$):UNTIL item$="" 23060menuptr%!-24=(menuptr%!-24)OR&80 23070m%=menufree%:m%!16=(maxx%*8+6)*dx% 23080menufree%=menuptr% 23090?menuHiAddr% = menuItemNum% : REM the number of items 23100?(menuHiAddr% +1) = dashItemNum% : REM the number of dashes 23110=m% 23120 23130DEF PROCmenuitem(text$) 23140IF text$="" THEN ENDPROC 23150IF menuptr%+24 > menuend% THEN ERROR 1,error$(32) 23160IF text$="&" THEN 23170 SYS "Font_ListFonts",,q%,ctr% TO ,,ctr% 23180 IF ctr%>=0 THEN text$=$q%+">m_fsize%":i%-=2 ELSE ENDPROC 23190ENDIF 23200LOCALi%,flg% 23210 23220menuItemNum% += 1 23230 23240flg%=&00 23250i%=INSTR(text$,">") 23260IFi%>0THENsubptr%=EVALMID$(text$,i%+1):text$=LEFT$(text$,i%-1)ELSEsubptr%=-1 23270IF RIGHT$(text$,1)="#" THEN text$=LEFT$(text$,LENtext$-1):flg%+=&02:dashItemNum% += 1 23280menuptr%!0=flg% 23290menuptr%!4=subptr% 23300menuptr%!8=&07000021 23310IF LEFT$(text$,1)="?" THEN 23320 menuptr%!8=&0700011A 23330 I%=FNworkspace(LENtext$):$I%=MID$(text$,2) 23340 menuptr%!12=I%:menuptr%!16=systemsprites%:menuptr%!20=LENtext$ 23350ELSE 23360 IF LEFT$(text$,1)="$" THEN 23370 !menuptr%+=&04 23380 menuptr%!8+=&100 23390 i%=INSTR(text$,"(") 23400 IFi%>0THENL%=VALMID$(text$,i%+1):text$=LEFT$(text$,i%-1)ELSEL%=12 23410 menuptr%!12=EVAL(MID$(text$,2)):menuptr%!16=-1:menuptr%!20=L% 23420 text$=STRING$(L%," ") 23430 ELSE 23440 IFLENtext$<=12THEN 23450 $(menuptr%+12)=text$ 23460 ELSE I%=FNworkspace(LENtext$+1):$I%=text$ 23470 menuptr%!12=I%:menuptr%!16=-1:menuptr%!20=LENtext$+1 23480 menuptr%!8=menuptr%!8 OR &100 23490 ENDIF 23500 ENDIF 23510 IFLENtext$>maxx%THENmaxx%=LENtext$ 23520ENDIF 23530menuptr%+=24 23540ENDPROC 23550 23560DEF FNpar(sep$) 23570i1%=i%+1:i%=INSTR(menu$+sep$,sep$,i1%) 23580=MID$(menu$,i1%,i%-i1%) 23590 23600DEF FNworkspace(L%) 23610IF curbuff%+L%>buffer%+maxbuf% THEN ERROR 1,error$(33) 23620curbuff%+=L%:=curbuff%-L% 23630 23640 23650REM ------ Procedures to interface with ARM code ------ 23660 23670DEF PROCmove(from,to,bytes_to_move) 23680IF bytes_to_move=0 THEN ENDPROC 23690A%=from:B%=to:C%=bytes_to_move 23700CALL move 23710ENDPROC 23720 23730DEF PROCfill(start,bytes,filler) 23740A%=start:B%=bytes:C%=filler 23750CALLfill 23760ENDPROC 23770 23780 23790REM ------ ARM source code ------ 23800 23810DEF PROCassemble(addr%) 23820LOCAL pass 23830sp=13:link=14 23840FOR pass=0 TO 2 STEP 2 23850P%=addr% 23860[OPT pass 23870.fill b fill2 23880.move b blockmove 23890 23900.fill2 23910\ r0=start address r1=number of bytes r2=value to fill with 23920\ all registers are preserved 23930stmfd (sp)!,{r0-r3,link} 23940mov r3,r0 23950add r3,r3,r1 23960.fillloop 23970strb r2,[r0],#1 23980cmp r0,r3 23990blt fillloop 24000ldmfd (sp)!,{r0-r3,PC} 24010 24020\ General purpose block move routine (up or down and overlapping) 24030\ r0 = `from` address, r1 = `to` address, r2 = number of bytes to move 24040.blockmove 24050cmp r0,r1 24060blt moveup 24070bal movedown 24080 24090.movedown 24100\ Move memory block down 24110\ r0 = `from` address, r1= `to` address, r2 = number of bytes to move 24120stmfd (sp)!,{r0-r3,link} 24130 24140.movdloop 24150ldrb r3,[r0],#1 24160strb r3,[r1],#1 24170subs r2,r2,#1 24180bne movdloop 24190 24200ldmfd (sp)!,{r0-r3,PC} 24210 24220.moveup 24230\ Move memory block up 24240\ r0 = `from` address, r1= `to` address, r2 = number of bytes to move 24250 24260stmfd (sp)!,{r0-r3,link} 24270sub r2,r2,#1 24280add r0,r0,r2 24290add r1,r1,r2 24300\ Call here if r2 = end address 24310.moveuploop 24320ldrb r3,[r0],#-1 24330strb r3,[r1],#-1 24340subs r2,r2,#1 24350bpl moveuploop 24360ldmfd (sp)!,{r0-r3,PC} 24370 24380.lastrow 24390\ Find last row of text 24400\ Entry - r0 = start address of text (text_block%) 24410\ r1 = end address of text (text_end%) 24420\ Exit - number of last row is in 'rowcount' (rows numbered 0,1,2...) 24430stmfd (sp)!,{r0-r4,link} 24440mov r2,#0 24450mov r3,#0 24460mov r4,#0 24470 24480.while 24490cmp r0,r1 24500beq endwhile 24510ldrb r3,[r0],#1 24520add r4,r4,#1 24530cmp r4,#text_maxllen% 24540addeq r2,r2,#1 24550moveq r4,#0 24560beq while 24570cmp r3,#13 24580addeq r2,r2,#1 24590moveq r4,#0 24600cmp r3,#dummy_cr 24610addeq r2,r2,#1 24620moveq r4,#0 24630bal while 24640 24650.endwhile 24660str r2,rowcount 24670ldmfd (sp)!,{r0-r4,PC} 24680 24690.rowcount EQUD 0 24700 24710.row 24720\ Returns the string of text in the specified row of the text block 24730\ Entry - r0 = start address of text (text_block%) 24740\ r1 = row wanted (0,1,2...) 24750\ Exit - the string is returned in 'linebuffer', terminated by <cr> 24760\ r2 is the current row 24770\ r3 is the current character 24780\ r4 is the length of the current row 24790 24800stmfd (sp)!,{r0-r4,link} 24810mov r2,#0 24820mov r4,#0 24830 24840.while2 24850cmp r2,r1 24860beq endwhile2 24870ldrb r3,[r0],#1 24880add r4,r4,#1 24890cmp r4,#text_maxllen% 24900moveq r4,#0 24910addeq r2,r2,#1 24920beq while2 24930cmp r3,#13 24940moveq r4,#0 24950addeq r2,r2,#1 24960cmp r3,#dummy_cr 24970moveq r4,#0 24980addeq r2,r2,#1 24990bal while2 25000 25010.endwhile2 25020adr r1,linebuffer 25030mov r4,#0 25040 25050.strloop 25060ldrb r3,[r0],#1 25070add r4,r4,#1 25080cmp r3,#0 25090beq lineend 25100cmp r3,#dummy_spc 25110beq lineend 25120cmp r3,#13 25130beq lineend 25140cmp r3,#dummy_cr 25150streqb r3,[r1],#1 25160beq lineend 25170strb r3,[r1],#1 25180cmp r4,#text_maxllen% 25190bne strloop 25200 25210.lineend 25220cmp r3,#0 25230moveq r3,#13 25240cmp r3,#dummy_spc 25250moveq r3,#13 25260cmp r3,#dummy_cr 25270moveq r3,#13 25280cmp r4,#text_maxllen% 25290moveq r3,#13 25300strb r3,[r1],#1 25310ldmfd (sp)!,{r0-r4,PC} 25320 25330.linebuffer EQUS STRING$(text_maxllen%+1,CHR$ dummy_spc) 25340 align 25350 25360.findmsg 25370\Finds start of specified message 25380\Entry - r0 = message number 25390\ - r2 = text start address (MSG#0) 25400\Exit - r0 = start address of message (switches) 25410stmfd (sp)!,{r1-r3,link} 25420cmp r0,#0 25430beq startm 25440 25450.nxtmsg 25460ldrb r1,[r2],#1 25470add r2,r2,r1, lsl #1 \ r2 = r2 + r1*2 25480 25490.readch 25500ldrb r1,[r2],#1 25510cmp r1,#0 25520bne readch 25530subs r0,r0,#1 25540bne nxtmsg 25550 25560.startm 25570mov r0,r2 25580ldmfd (sp)!,{r1-r3,pc} 25590 25600.pvok 25610;Print Verb, Object or Keyword (returns the word string) 25620;Entry - r0 = Number of word to print 25630; r1 = address of required word table 25640;Exit - word is in 'atext' terminated by <cr> 25650stmfd (sp)!,{r0-r5,link} 25660mov r3,r0 \Word number is now in r3 25670mov r4,r2 \r4 is 'all' flag 25680mov r5,#0 \r5 is 'ctr' 25690 25700.LLL1 25710adr r2,atext \r2 points to 'atext' 25720 25730.LLL2 25740ldrb r0,[r1] \Get character from list 25750\orr r0,r0,#32 \Convert to lower case 25760strb r0,[r2] \Put it in 'text' 25770tst r0,#&80 \Is bit 7 set (end of the word) 25780bne endofw \Yes 25790add r2,r2,#1 25800add r1,r1,#1 25810b LLL2 25820 25830.endofw 25840cmp r0,#&FF 25850adreq r2,pvokflag 25860streqb r0,[r2] 25870beq endtbl 25880and r0,r0,#%01111111 ;Clear bit 7 25890strb r0,[r2],#1 25900mov r0,#13 25910strb r0,[r2] 25920add r1,r1,#1 25930ldrb r0,[r1] ;Get the verb/object number from table 25940add r1,r1,#1 ;Skip the number 25950cmp r0,r3 ;Is it the one we want? 25960bne LLL1 ;No - try the next one 25970 25980.endtbl 25990adr r2,address 26000str r1,[r2] 26010ldmfd (sp)!,{r0-r5,pc} 26020 26030.atext EQUS STRING$(80,"*") 26040align 26050.address equd 0 26060.pvokflag equb 0 26070align 26080] 26090NEXT pass 26100ENDPROC 26110 26120 26130REM ------ Some general utility routines ------ 26140 26150DEF PROCErrorMsgRead 26160in%=OPENIN("<Alps$Resources>.Errormsgs") 26170INPUT#in%,errors 26180DIM error$(errors) 26190FOR error=0 TO errors-1 26200 INPUT#in%,error$(error) 26210NEXT error 26220CLOSE#in% 26230ENDPROC 26240 26250DEF PROCKeyWordRead 26260REM Reads file of keywords/info bytes 26270REM Keywords are in alphabetical order 26280LOCAL CHN%,I%,J% 26290first_token=&60 26300maxmsg=65535:maxobn=255:maxvbn=255:maxconst=65535 26310chn%=OPENIN "<Alps$Resources>.keywrdlist" 26320INPUT#chn%,keywords 26330DIM keyword$(keywords),info%(keywords,5) 26340 26350REM Set up keyword tables 26360REM keyword$ | token | type/No. params | Max values param 1,2,3 | 26370REM type/No. params gives number of parameters and bit 7 is set if its 26380REM a function, bit 6 set for object keywords, bit 5 for verb keywords 26390 26400FOR I%=1 TO keywords 26410INPUT#chn%,keyword$(I%) 26420FOR J%=0 TO 5 26430INPUT#chn%,info%(I%,J%) 26440NEXT J% 26450NEXT I% 26460CLOSE#chn% 26470 26480FOR I%=1 TO keywords 26490params=info%(info%(I%,2),1) AND %00011111 26500bytes=0 26510IF params>0 THEN 26520FOR K%=3 TO 5 26530maxval=info%(info%(I%,2),K%) 26540IF maxval<256 AND maxval>0 THEN bytes+=1 26550IF maxval>255 AND maxval<65536 THEN bytes+=2 26560IF maxval>65535 THEN bytes+=3 26570NEXT K% 26580ENDIF 26590parambyte=info%(info%(I%,2),1) AND %10000000 26600pbytes?(I%-1)=bytes OR parambyte 26610NEXT 26620ENDPROC 26630 26640 26650REM ------ Printing procedures ------ 26660 26670DEF PROCprint_prog_seg 26680LOCAL R% 26690LOCAL ERROR 26700ON ERROR LOCAL:OSCLI("FX3,0"):SYS "Hourglass_Off":ENDPROC 26710*FX3,10 26720FOR R%=0 TO last_row% 26730 PRINT FNrow(R%) 26740NEXT R% 26750*FX3,0 26760ENDPROC 26770 26780DEF PROCprint_program 26790LOCAL ERROR 26800ON ERROR LOCAL:OSCLI("FX3,0"):SYS "Hourglass_Off":ENDPROC 26810PROClist(1,"") 26820ENDPROC 26830 26840DEF PROCprint_text 26850LOCAL st%,end%,M% 26860LOCAL ERROR 26870ON ERROR LOCAL:OSCLI("FX3,0"):SYS "Hourglass_Off":ENDPROC 26880PROCclose(texthandle) 26890*FX3,10 26900st%=VAL $st_msg% 26910end%=VAL $end_msg% 26920IF end%>FNmaxmsg end%=FNmaxmsg 26930FOR M%=st% TO end% 26940 PROCshow_msg(M%) 26950 PROCprint_msg(M%) 26960NEXT M% 26970*FX3,0 26980ENDPROC 26990 27000DEF PROCprint_msg(M%) 27010LOCAL S%,R% 27020PRINT"Message: ";M%;" Switches: "; 27030IF switch_vals(0)=0 THEN 27040 PRINT"None"; 27050ELSE 27060 FOR S%=1 TO switch_vals(0) 27070 PRINT"<";switch_vals(S%);">"; 27080 NEXT 27090ENDIF 27100PRINT 27110FOR R%=0 TO last_row% 27120 PRINT FNrow(R%) 27130NEXT R% 27140PRINT STRING$(text_maxllen%,"-") 27150ENDPROC 27160 27170DEF PROCprint_objs 27180LOCAL O%,F%,I%,ptr% 27190*FX3,10 27200VDU condensed 27210PRINTpline$ 27220PROCprint_flags(o_flags%) 27230PRINTpline$ 27240PRINT"Obj Noun Flags 7 6 5 4 3 2 1 0 State Start Describe Short Examine Weight Size Cont. 'Store' Trans. Open" 27250PRINTpline$ 27260FOR O%=1 TO last_object 27270PRINT;O%; 27280store=small_area%:col%=1:row%=0 27290PROCfill(small_area%,small_areasize%,13) 27300print=FALSE 27310PROCpvok(FNfindnoun(O%,void),1,FALSE):PRINTTAB(4)$small_area%;TAB(21); 27320ptr%=odata%+O%*o_len 27330FOR F%=7 TO 0 STEP-1 27340IF ?ptr% AND (2^F%) THEN PRINT"* "; ELSE PRINT". "; 27350NEXT 27360PRINTTAB(39);ptr%?1;TAB(43);ptr%?2+256*ptr%?3;TAB(50)ptr%?4+256*ptr%?5;TAB(58);ptr%?6+256*ptr%?7;TAB(65);ptr%?8+256*ptr%?9;TAB(73);ptr%?10;TAB(80);ptr%?11; 27370IF (ptr%?12 AND &80)<>0 THEN PRINTTAB(85)"<C>";TAB(92);ptr%?13; 27380IF (ptr%?12 AND &80)<>0 THEN 27390store_room=ptr%?13 27400rmflags=?(rdata%+store_room*r_len) 27410tr_flag=(rmflags AND %100000)>0 27420op_flag=(rmflags AND %10000)>0 27430IF tr_flag PRINTTAB(100);"Y"; ELSE PRINTTAB(100);"N"; 27440IF op_flag PRINTTAB(106);"Y" ELSE PRINTTAB(106);"N" 27450ELSE 27460PRINT 27470ENDIF 27480NEXT 27490PRINTpline$ 27500VDU 27,reset 27510*FX3,0 27520ENDPROC 27530 27540DEF PROCprint_rooms 27550LOCAL R%,F%,I%,ptr% 27560*FX3,10 27570VDU condensed 27580PRINTpline$ 27590PROCprint_flags(r_flags%) 27600PRINTpline$:PRINTTAB(70);" * DESTINATIONS *" 27610PRINT"Room Flags 76543210 State Desc. Short Pict. N S E W NE NW SE SW Up Down In Out Back Left Righ Jump" 27620PRINTpline$ 27630FOR R%=1 TO last_room 27640PRINT;R%;TAB(11); 27650ptr%=rdata%+R%*r_len 27660FOR F%=7 TO 0 STEP-1 27670IF ?ptr% AND (2^F%) THEN PRINT"*"; ELSE PRINT"."; 27680NEXT 27690PRINTTAB(20);ptr%?1;TAB(26);ptr%?2+256*ptr%?3;TAB(32);ptr%?4+256*ptr%?5;TAB(38);ptr%?70+256*ptr%?71; 27700FOR I%=6 TO 36 STEP 2 27710PRINTTAB(5*(I% DIV 2-3)+44);ptr%?I%+256*ptr%?(I%+1); 27720NEXT I% 27730PRINT 27740NEXT R% 27750 27760PRINTpline$:PRINTTAB(30);" * EXIT ROUTINES *" 27770PRINT"Room N S E W NE NW SE SW Up Down In Out Back Left Righ Jump" 27780PRINTpline$ 27790FOR R%=1 TO last_room 27800PRINT;R%; 27810ptr%=rdata%+R%*r_len 27820FOR I%=38 TO 53 27830PRINTTAB(5*(I%-38)+6);ptr%?I%; 27840NEXT I% 27850PRINT 27860NEXT R% 27870PRINTpline$ 27880PRINTTAB(59)"* EXIT FLAGS *" 27890PRINTpline$ 27900PRINT"Exit Flag: "; 27910FOR flag=7 TO 0 STEP-1 27920PRINTTAB(11+(7-flag)*15);"|"TAB(20+(7-flag)*15);flag; 27930NEXT 27940PRINTTAB(11+8*15);"|" 27950PRINT"Descript'n"; 27960FOR flag=7 TO 0 STEP-1 27970PRINTTAB(10+(7-flag)*15);" | ";exit_flag$(flag); 27980NEXT 27990PRINTTAB(10+8*15);" |" 28000PRINTpline$ 28010PRINTTAB(4);" North South East West No'east No'west So'east So'west Up Down In Out Back Left Right Jump " 28020FOR R%=1 TO last_room 28030IF R%=1 OR R% MOD 10=0 THEN PRINTTAB(4)STRING$(16,"|-------") 28040PRINT;R%; 28050ptr%=rdata%+R%*r_len 28060PRINTTAB(4); 28070FOR I%=54 TO 69 28080FOR F%=7 TO 0 STEP-1 28090IF ?(ptr%+I%) AND (2^F%) THEN PRINT"*"; ELSE PRINT"."; 28100NEXT F% 28110NEXT I% 28120PRINT 28130NEXT R% 28140PRINTpline$ 28150VDU 27,reset 28160*FX3,0 28170ENDPROC 28180 28190DEF PROCprint_flags(mem%) 28200PRINT"Flag: "; 28210FOR flag=7 TO 0 STEP-1 28220PRINTTAB(11+(7-flag)*15);"|"TAB(20+(7-flag)*15);flag; 28230NEXT 28240PRINTTAB(11+8*15);"|" 28250PRINT"Descript'n"; 28260FOR flag=7 TO 0 STEP-1 28270PRINTTAB(10+(7-flag)*(maxd%-1+3));" | ";$mem%; 28280mem%+=maxd% 28290NEXT 28300PRINTTAB(10+8*(maxd%-1+3));" |" 28310ENDPROC 28320 28330DEF PROCprint_vocab 28340print=TRUE 28350PROCput(pline2$+CHR$13) 28360PROCput(STRING$(37," ")+"Nouns:"+CHR$13):PROClistnouns 28370PROCput(pline2$+CHR$13) 28380PROCput(STRING$(37," ")+"Verbs:"+CHR$13):PROClistverbs 28390PROCput(pline2$+CHR$13) 28400PROCput(STRING$(34," ")+"Adjectives:"+CHR$13):PROClistadjs 28410PROCput(pline2$+CHR$13) 28420PROCput(STRING$(33," ")+"Conjunctions:"+CHR$13):PROClistconjs 28430PROCput(pline2$+CHR$13) 28440PROCput(STRING$(33," ")+"Prepositions:"+CHR$13):PROClistpreps 28450PROCput(pline2$+CHR$13) 28460PROCput(STRING$(35," ")+"Specials:"+CHR$13):PROClistspecs 28470PROCput(pline2$+CHR$13) 28480PROCput(STRING$(37," ")+"Noise:"+CHR$13):PROClistnoise 28490PROCput(pline2$+CHR$13) 28500print=FALSE 28510ENDPROC 28520 28530DEF PROCprint_pix 28540LOCAL mptr 28550print=TRUE:SYS "Hourglass_On" 28560 28570IF pxn>1 THEN 28580mptr=pixs+3 28590FOR I%=1 TO pxn-1 28600 PROCput(STR$(I%)+"= ") 28610 PROCput($mptr) 28620 mptr+=LEN$mptr+1 28630 PROCput(",<"+pos$(?mptr)+">"+CHR$13) 28640 mptr+=5 28650NEXT 28660ENDIF 28670 28680print=FALSE:SYS "Hourglass_Off" 28690ENDPROC 28700 28710DEF PROCscan 28720oldptr=prgptr:numflag=0 28730ptr=1:len=LEN line$:IF len=0 THEN GOTO 29140 28740REPEAT 28750temp$="" 28760WHILE MID$(line$,ptr,1)<"A" AND ptr<len 28770ptr+=1 28780ENDWHILE 28790vptr=ptr 28800WHILE MID$(line$,ptr,1)>"@" AND ptr<len 28810temp$=temp$+MID$(line$,ptr,1):ptr+=1 28820ENDWHILE 28830IF temp$<>"" THEN 28840PROClookup(temp$,token,info_ptr) 28850IF token=0 PROCerror(0,": "+MID$(line$,vptr,30)):prgptr=oldptr:GOTO 29120 28860IF token=def_token THEN PROCdodefn:GOTO29120 28870?prgptr=token:tokptr=prgptr:prgptr+=1 28880p_info=info%(info%(token-first_token+1,2),1):params=p_info AND %1111 28890ptr+=1 28900IF params <>0 THEN 28910FOR I%=1 TO params 28920 WHILE INSTR(", ",MID$(line$,ptr,1))<>0 AND ptr<len 28930 ptr+=1 28940 ENDWHILE 28950 IF token>=var_token AND I%=1 THEN PROCget_var(ptr,ptr,paramvalue,vptr) 28960 IF token>=var_token AND I%>1 THEN PROCget_num_or_var(ptr,ptr,paramvalue,varflag):IF varflag THEN ?tokptr=?tokptr+&10 28970 IF token<var_token THEN 28980 IF MID$(line$,ptr,1)=CHR$34 PROCdecode_string(line$,ptr,ptr,paramvalue,FNfntype(p_info)) ELSE PROCdecode_parameter(line$,ptr,ptr,paramvalue,vptr) 28990 ENDIF 29000 IF errflag THEN 29120 29010 IF paramvalue>info%(info_ptr,I%+2) PROCerror(2,STR$(info%(info_ptr,I%+2))+" ("+temp$+")"):GOTO29120 29020 IF info%(info_ptr,I%+2)<256 THEN bytes=1 29030 IF info%(info_ptr,I%+2)>255 AND info%(info_ptr,I%+2)<65536 THEN bytes=2 29040 IF info%(info_ptr,I%+2)>65535 THEN bytes=3 29050 FOR J%=0 TO bytes-1 29060 J%?prgptr=paramvalue DIV 256^J% 29070 NEXT J% 29080 prgptr+=bytes 29090NEXT I% 29100ENDIF 29110ENDIF 29120UNTIL ptr>=(len-1) OR token=0 OR errflag 29130IF token=0 OR errflag THEN PROCrestore_end:GOTO29150 29140?prgptr=13:prgptr+=1 29150ENDPROC 29160 29170DEF PROCrestore_end 29180prgptr=oldptr:?prgptr=0 29190ENDPROC 29200 29210DEF PROCerror(err_num,err$) 29220errflag=TRUE 29230null =FNerrorbox(error$(err_num)+" "+err$,err_num,1,-99) 29240ENDPROC 29250 29260DEF PROCfind_token(A$(),search$,RETURN token,RETURN mid) 29270LOCAL first,last,stop_search,found,len 29280len=LEN search$ 29290first=1 29300last=DIM(A$(),1) 29310stop_search=FALSE:found=FALSE 29320REPEAT 29330PROCchop 29340UNTIL stop_search 29350IF found THEN token=info%(mid,0) ELSE token=0 29360ENDPROC 29370 29380DEF PROCchop 29390mid=(first+last) DIV 2 29400A$=A$(mid) 29410IF A$=search$ THEN stop_search=TRUE:found=TRUE:ENDPROC 29420IF A$>search$ THEN 29430last=mid-1 29440ELSE 29450first=mid+1 29460ENDIF 29470IF first>last THEN stop_search=TRUE 29480ENDPROC 29490 29500DEF PROClookup(search$,RETURN token,RETURN index) 29510LOCAL I%,found 29520token=0 29530IF search$="" THEN ENDPROC 29540PROCfind_token(keyword$(),search$,token,index) 29550ENDPROC 29560 29570I%=1 29580REPEAT 29590IF INSTR(LEFT$(keyword$(I%),LEN(search$)),search$)<>0 THEN token=info%(I%,0):found=TRUE:index=I% 29600I%+=1 29610UNTIL found OR I%=keywords+1 29620ENDPROC 29630 29640DEF PROCdecode_parameter(line$,place,RETURN place,RETURN value,vptr) 29650LOCAL temp1$ 29660WHILE INSTR(" (,",MID$(line$,place,1))<>0 place+=1 29670ENDWHILE 29680WHILE INSTR("0123456789",MID$(line$,place,1))<>0 AND place<=LEN(line$) temp1$=temp1$+MID$(line$,place,1):place+=1 29690ENDWHILE 29700IF INSTR(") ,"+CHR$13,MID$(line$,place,1))=0 THEN 29710PROCerror(1,": "+MID$(line$,vptr,30)):errflag=TRUE 29720ELSE 29730value=VAL(temp1$) 29740ENDIF 29750ENDPROC 29760 29770DEF PROCdecode_string(line$,place,RETURN place,RETURN value,type) 29780LOCAL temp1$,dummy$,vptr 29790vptr=place-1 29800place+=1 29810temp1$="" 29820WHILE (INSTR(CHR$34,MID$(line$,place,1))=0 AND place<LENline$) 29830temp1$+=MID$(line$,place,1) 29840place+=1 29850ENDWHILE 29860IF INSTR(CHR$34,MID$(line$,place,1))<>0 THEN place+=1:REM added 31.5.89 29870IF temp1$="" THEN 29880value=0 29890ELSE 29900CASE type OF 29910WHEN 1 29920PROCgetobn(temp1$,value,dummy$):REM Find the noun number 29930IF value=0 THEN 29940temp1$=": "+temp1$ 29950ERROR 1,"Badly formed/Non-existent noun: "+MID$(line$,vptr-LENtemp$,20) 29960ELSE 29970PROCwhich_obj(value,val$,refs):REM Find which object/s it references 29980IF refs=1 THEN value=VAL(val$) ELSE PROCerror(27,temp1$+error$(37)) 29990ENDIF 30000WHEN 2:PROCgetvbn(temp1$,value,dummy$) 30010WHEN 3:PROCgetprn(temp1$,value,dummy$) 30020ENDCASE 30030ENDIF 30040ENDPROC 30050 30060DEF PROCget_var(place,RETURN place,RETURN value,vptr) 30070WHILE INSTR(" (,",MID$(line$,place,1))<>0 place+=1 30080ENDWHILE 30090chr$=MID$(line$,place,1) 30100IF chr$<"A" OR chr$>"|" THEN PROCerror(3,": "+MID$(line$,vptr,30)):ENDPROC 30110value=ASC chr$ - ASC"A" 30120place+=1:IF MID$(line$,place,1)<>"%" THEN PROCerror(3,": "+MID$(line$,vptr,30)) ELSE place+=1 30130ENDPROC 30140 30150DEF PROCget_num_or_var(place,RETURN place,RETURN value,RETURN flag) 30160WHILE INSTR(" (,",MID$(line$,place,1))<>0 place+=1 30170ENDWHILE 30180chr$=MID$(line$,place,1) 30190IF INSTR("0123456789",chr$) THEN flag=FALSE:PROCdecode_parameter(line$,place,place,value,vptr):ENDPROC 30200PROCget_var(place,place,value,vptr):flag=TRUE 30210ENDPROC 30220 30230DEF PROCrun 30240LOCAL ERROR 30250SYS "OS_Byte",229,0,0 TO ,oldstate% 30260err_col=11:PROCcol(130):PROCcol(7):SYS "Wimp_SetColour",128+2 30270ON ERROR LOCAL:PROCcol(err_col):IF ERR<>17 PRINT'"Interpreter reports a run-time error: "REPORT$:GOTO 30610 ELSE PRINT'REPORT$:GOTO 30610 30280PROCclose(texthandle):PROCclose(objhandle):PROCclose(roomhandle) 30290!work%=rdata% 30300work%!4=verbs+3 30310work%!8=nouns+3 30320work%!12=program%+4 30330work%!16=text%+7 30340work%!20=dict%+3 30350work%!24=odata% 30360work%!28=adjects+3 30370work%!32=preps+3 30380work%!36=conjs+3 30390work%!40=specs+3 30400work%!44=noise+3 30410work%!48=pixs+3 30420REM work%!52 is reserved 30430work%!56=initsave 30440work%!60=last_room 30450work%!64=last_object+1 30460VDU26,4,12 30470PROCcentre("PLEASE WAIT",0):OFF 30480IF datavalid THEN PROCcopy_from_editor ELSE PROCcopy_to_editor 30490!picbuf=pbsize 30500OSCLI("LOAD <Users$Resources>.Buttons "+STR$~(picbuf+4)) 30510REM Read the scale factors and pixel translation table 30520SYS "Wimp_ReadPixTrans",&200,picbuf,picbuf+16,0,0,0,scale,pixtr 30530REM Now PutSpriteScaled 30540SYS "OS_SpriteOp",&234,picbuf,picbuf+16,0,0,8,scale,pixtr 30550VDU 28,0,textrows%-5,textcols%,0,24,0;148;scrw;scrh; 30560PROCcentre(STRING$(11," "),0):PRINT:ON 30570A%=verb_type:B%=nref:C%=aref:D%=ramsave 30580E%=pbytes:F%=work%:G%=picbuf:H%=pbsize 30590cliplen=0 30600CALL run 30610VDU 26:PROCcentre("PLEASE WAIT",26):OFF:PROCswap_data:datavalid=TRUE:PROCcentre(STRING$(11," "),26):PROCreturn(18,0):ON 30620PROCchangeicon(ALPSmain,swapicon,"swap",swapicon) 30630REM The copy/swap routines as used above ensure the data in the editor is 30640REM ALWAYS valid after running a game, even if it wasn't before running it 30650VDU 5 30660SYS ForceR,-1,0,0,scrw+1,scrh+1 30670RESTORE ERROR 30680SYS "OS_Byte",229,oldstate%,0 30690SYS "OS_Byte",124 30700ENDPROC 30710 30720DEF PROCcol(color) 30730SYS "Wimp_TextColour",color 30740ENDPROC 30750 30760DEF PROCfind_section(code%,value%,RETURN found) 30770REM Searches program for a match with code%,value% 30780REM eg DEFPROC(3) --> &86,&03 30790REM Sets `listptr` to the address of the `code%` byte, if found 30800ptr=listptr 30810LOCAL byte1,byte2 30820found=FALSE 30830E%=pbytes:F%=work%:CALL setup:G%=ptr 30840REPEAT 30850A%=code%:ptr=USR findcode 30860IF ?ptr=value% THEN found=TRUE ELSE G%=ptr+1 30870UNTIL found OR ptr=0 30880IF found THEN listptr=ptr-1 ELSE listptr=program%+4+FNprglen+1 30890ENDPROC 30900 30910DEF PROClist(prg_part%,val$) 30920LOCAL col%,row% 30930PROCfill(text_block%,text_blocksize%,dummy_spc) 30940text_rowlen%()=+0 30950SYS "Hourglass_On" 30960listptr=program%+4:line=1:last=65535:first=1 30970col%=1:row%=0 30980store=text_block% 30990existing_verb=FALSE 31000print=FALSE 31010errflag=FALSE 31020 31030CASE prg_part% OF 31040WHEN 1:found=TRUE:end1%=0:end2%=0:print=TRUE:REM Print whole program 31050WHEN 2:found=TRUE:end1%=stop_token:end2%=def_token 31060WHEN 3,4,5:end1%=end_token:end2%=0 31070ENDCASE 31080 31090CASE prg_part% OF 31100WHEN 3 31110PROCfind_section(proc_token,VAL val$,found) 31120token=proc_token 31130WHEN 4 31140existing_verb=TRUE 31150PROCgetvbn(val$,verb,dummy$) 31160PROCfind_section(def_token,verb,found) 31170token=def_token 31180WHEN 5 31190PROCfind_section(exit_token,VAL val$,found) 31200token=exit_token 31210ENDCASE 31220 31230IF NOT found THEN 31240 PROCerror(10,""+FNtoken_to_keyword(token)+"("+val$+")") 31250 listptr-=1:REM Point to end of program 31260 IF token=def_token THEN existing_verb=FALSE 31270ENDIF 31280 31290pstart=listptr:REM Start address of program section 31300byte1=?listptr:found_end=FALSE 31310WHILE byte1<>0 AND NOT found_end 31320eol%=FALSE 31330 WHILE byte1=13 31340 listptr+=1:PROCput(CHR$13):eol%=TRUE 31350 row%+=1 31360 byte1=?listptr 31370 ENDWHILE 31380 IF byte1=0 THEN PROCput(CHR$(0)):GOTO31770 31390 IF (byte1=end1% AND eol%) OR byte1=end2% THEN found_end=TRUE 31400 IF byte1>&BF THEN byte2=byte1-&10 ELSE byte2=byte1 31410 token=byte2:listptr+=1 31420 word$=FNtoken_to_keyword(token) 31430 PROCput(word$) 31440 IF byte2=def_token THEN PROCprtdef:listptr+=1:GOTO31770 31450 p_info=info%(info%(token-first_token+1,2),1):params=p_info AND %1111 31460 IF params=0 AND ?listptr<>13 PROCput(" ") 31470 IF params<>0 THEN 31480 PROCput("(") 31490 FOR I%=1 TO params 31500 maxvalue=info%(info%(token-first_token+1,2),I%+2) 31510 IF maxvalue<256 THEN bytes=1 31520 IF maxvalue>255 AND maxvalue<65536 THEN bytes=2 31530 IF maxvalue>65535 THEN bytes=3 31540 value=0 31550 FOR J%=0 TO bytes-1 31560 value=value+(J%?listptr)*256^J% 31570 NEXT J% 31580 doneit=FALSE 31590 IF I%=1 AND (listoption AND %10)<>0 AND FNfntype(p_info)=1 THEN 31600 PROCprntobj 31610 ELSE 31620 IF I%=1 AND (listoption AND %10)<>0 AND FNfntype(p_info)=2 THEN 31630 PROCprntvrb 31640 ENDIF 31650 ENDIF 31660 IF I%=1 AND (word$="PREP" OR word$="NOTPREP") AND (listoption AND %10)<>0 THEN PROCprintprep 31670 IF I%=2 AND (word$="PUTIN" OR word$="TAKEOUT") AND (listoption AND %10)<>0 THEN PROCprntobj 31680 IF NOT doneit THEN 31690 IF byte1<var_token OR (I%>1 AND byte1<&C0) PROCput(STR$(value)) ELSE PROCput(CHR$(value+ASC"A")+"%") 31700 ENDIF 31710 listptr+=bytes 31720 IF I%<>params THEN PROCput(",") 31730 NEXT I% 31740 PROCput(")") 31750 IF ?listptr<>13 PROCput(" ") 31760 ENDIF 31770 byte1=?listptr 31780ENDWHILE 31790IF found_end PROCput(CHR$13+CHR$0) 31800text_end%=store-1:text_ptr%=text_block% 31810IF text_end%<text_block% text_end%=text_block% 31820prgend=listptr:REM End address of program section 31830last_row%=FNfind_lastrow 31840 31850FOR R%=0 TO last_row% 31860text_rowlen%(R%)=LEN FNrow(R%) 31870NEXT 31880 31890SYS "Hourglass_Off" 31900ENDPROC 31910 31920DEF PROCput(text$) 31930LOCAL I% 31940IF NOT print THEN 31950IF text$<>"" THEN 31960$store=text$ 31970store+=LEN text$ 31980ENDIF 31990ELSE 32000*FX3,10 32010PRINTtext$; 32020*FX3,0 32030ENDIF 32040ENDPROC 32050 32060DEF PROClist_vocab(voc%) 32070SYS "Hourglass_On" 32080print=FALSE:store=text_block% 32090PROCfill(text_block%,text_blocksize%,dummy_spc) 32100col%=1:row%=0 32110 32120CASE voc% OF 32130WHEN 1: PROClistnouns 32140WHEN 2: PROClistverbs 32150WHEN 3: PROClistadjs 32160WHEN 4: PROClistpreps 32170WHEN 5: PROClistconjs 32180WHEN 6: PROClistspecs 32190WHEN 7: PROClistnoise 32200ENDCASE 32210 32220text_end%=store-1:text_ptr%=text_block% 32230IF text_end%<text_block% text_end%=text_block% 32240last_row%=FNfind_lastrow 32250FOR R%=0 TO last_row% 32260 text_rowlen%(R%)=LEN FNrow(R%) 32270NEXT 32280SYS "Hourglass_Off" 32290ENDPROC 32300 32310DEF PROClist_pix 32320LOCAL mptr 32330SYS "Hourglass_On" 32340print=FALSE:store=text_block% 32350PROCfill(text_block%,text_blocksize%,dummy_spc) 32360col%=1:row%=0 32370 32380IF pxn>1 THEN 32390mptr=pixs+3 32400FOR I%=1 TO pxn-1 32410 PROCput(STR$(I%)+"= ") 32420 PROCput($mptr) 32430 mptr+=LEN$mptr+1 32440 PROCput(",<"+pos$(?mptr)+">"+CHR$13) 32450 mptr+=5 32460NEXT 32470PROCput(CHR$0) 32480ENDIF 32490 32500text_end%=store-1:text_ptr%=text_block% 32510IF text_end%<text_block% text_end%=text_block% 32520last_row%=FNfind_lastrow 32530 32540FOR R%=0 TO last_row% 32550text_rowlen%(R%)=LEN FNrow(R%) 32560NEXT 32570 32580SYS "Hourglass_Off" 32590ENDPROC 32600 32610DEF FNtoken_to_keyword(token) 32620=keyword$(info%(token-first_token+1,2)) 32630 32640DEF PROCnew 32650obn=1:vbn=1:adn=1:prn=1:cjn=1:spn=1:nsn=1:pxn=1 32660nxtobj=nouns:?nxtobj=obn:nxtobj?1=3:nxtobj?2=0:nxtobj+=3:?nxtobj=&FF 32670nxtvrb=verbs:?nxtvrb=vbn:nxtvrb?1=3:nxtvrb?2=0:nxtvrb+=3:?nxtvrb=&FF 32680nxtadj=adjects:?nxtadj=adn:nxtadj?1=3:nxtadj?2=0:nxtadj+=3:?nxtadj=&FF 32690nxtprp=preps:?nxtprp=prn:nxtprp?1=3:nxtprp?2=0:nxtprp+=3:?nxtprp=&FF 32700nxtcjn=conjs:?nxtcjn=cjn:nxtcjn?1=3:nxtcjn?2=0:nxtcjn+=3:?nxtcjn=&FF 32710nxtspn=specs:?nxtspn=spn:nxtspn?1=3:nxtspn?2=0:nxtspn+=3:?nxtspn=&FF 32720nxtnsn=noise:?nxtnsn=nsn:nxtnsn?1=3:nxtnsn?2=0:nxtnsn+=3:?nxtnsn=&FF 32730nxtpxn=pixs:?nxtpxn=pxn:nxtpxn?1=3:nxtpxn?2=0:nxtpxn+=3:?nxtpxn=&FF 32740!aref=4:aref?4=0:!nref=4:nref?4=0 32750prev_file$="" 32760ENDPROC 32770 32780DEF PROClvar 32790vars=work%+&88 32800FOR I%=1 TO 2*num_vars STEP 8 32810PRINTTAB(8)CHR$(I% DIV 2 +ASC"A");"% = ";vars?(I%-1)+vars?I%*256; 32820PRINTTAB(24)CHR$(I% DIV 2 +ASC"B");"% = ";vars?(I%+1)+vars?(I%+2)*256; 32830PRINTTAB(40)CHR$(I% DIV 2 +ASC"C");"% = ";vars?(I%+3)+vars?(I%+4)*256; 32840PRINTTAB(56)CHR$(I% DIV 2 +ASC"D");"% = ";vars?(I%+5)+vars?(I%+6)*256 32850NEXT 32860ENDPROC 32870 32880DEF PROClisto 32890LOCAL bitmask$,op$ 32900CASE item1% OF 32910WHEN 0: bitmask$="%11111101":op$=" AND " 32920WHEN 1: bitmask$="%00000010":op$=" OR " 32930WHEN 2: bitmask$="%11111011":op$=" AND " 32940WHEN 3: bitmask$="%00000100":op$=" OR " 32950ENDCASE 32960listoption=EVAL(STR$listoption+op$+bitmask$) 32970ENDPROC 32980 32990DEF PROCstatus 33000PRINTTAB(1);"User code address = &";~usercode%;" (";usercode%;" decimal)" 33010PRINTTAB(1);"Program bytes: ";TAB(21);FNprglen;TAB(28);code_size%-FNprglen;" bytes free." 33020PRINTTAB(1)"Messages defined: "TAB(21);FNmaxmsg;TAB(28);(FNtext_end-text%);" characters used. ";maxtext%-(FNtext_end-text%);" characters free." 33030PRINTTAB(1)"Verbs defined: "TAB(21);vbn-1;TAB(28);verb_size-(nxtvrb-verbs);" characters free." 33040PRINTTAB(1)"Nouns defined: "TAB(21);obn-1;TAB(28);noun_size-(nxtobj-nouns);" characters free." 33050PRINTTAB(1)"Adjectives defined: "TAB(21);adn-1;TAB(28);adjc_size-(nxtadj-adjects);" characters free." 33060PRINTTAB(1)"Objects defined: "TAB(21);last_object;TAB(28);maxobs-last_object" object(s) remaining." 33070PRINTTAB(1)"Rooms defined: "TAB(21);last_room;TAB(28);maxrms-last_room" room(s) remaining." 33080PRINTTAB(1)"Screen mode: ";mode%;", File: "CHR$34+loaded$+CHR$34", Data: ";:PROCcol(11):IF data_saved PRINT"Saved" ELSE PRINT"NOT Saved" 33090ENDPROC 33100 33110 33120REM ------ Various Disk Operations ------ 33130 33140DEF PROCcreate_dirs(app$,root$) 33150LOCAL t$,l$,r$,I%,rd$,out% 33160SYS "Hourglass_On" 33170IF RIGHT$(root$,1)<>"." THEN root$+="." 33180t$=root$:l$="":I%=0 33190 WHILE INSTR(t$,".")<>0 33200 r$=LEFT$(t$,INSTR(t$,".")-1) 33210 IF I%>0 l$=l$+"."+r$ ELSE l$=r$ 33220 I%+=1 33230 OSCLI("CDIR "+l$) 33240 t$=MID$(t$,INSTR(t$,".")+1) 33250 ENDWHILE 33260 IF LEFT$(app$,1)<>"!" THEN app$="!"+app$ 33270 app$=LEFT$(app$,10) 33280 ra$=root$+app$:REM path to users 'Alps' file 33290 OSCLI("CDIR "+ra$) 33300 OSCLI("CDIR "+ra$+".ALPS") 33310 OSCLI("CDIR "+ra$+".PICTURES") 33320 OSCLI("CDIR "+ra$+".Resources") 33330 rd$=ra$+".Resources.":REM Resources dir path 33340 OSCLI "SAVE "+rd$+"pbytes "+STR$~pbytes+"+"+STR$~pbyte_size 33350 OSCLI("SAVE "+rd$+"ASIobjcode "+STR$~asicode%+"+"+STR$~codesize) 33360 OSCLI "SAVE "+rd$+"buttons "+STR$~picbuf+"+"+STR$~butlen 33370 OSCLI "SETTYPE "+rd$+"buttons Sprite" 33380 OSCLI "SETTYPE "+rd$+"pbytes Data" 33390 OSCLI "SETTYPE "+rd$+"ASIobjcode Absolute" 33400 OSCLI "SAVE "+ra$+".!RunImage "+STR$~(picbuf+butlen)+"+"+STR$~ldlen 33410 OSCLI "SETTYPE "+ra$+".!RunImage BASIC" 33420 SYS "OS_SpriteOp",256+26,sprld,"!alpsgames",app$:REM Rename Sprite 33430 SYS "OS_SpriteOp",256+12,sprld,ra$+".!Sprites":REM Save it 33440 out%=OPENOUT(ra$+".!Run") 33450 out2%=OPENOUT(ra$+".!Boot") 33460 BPUT#out%,"| !Run file for ALPS games" 33470 BPUT#out2%,"| !Boot file for ALPS games" 33480 BPUT#out%,"|" 33490 BPUT#out%,"SET Alps$NoMouseInput 0" 33500 BPUT#out%,"|" 33510 BPUT#out%,"SET Alps$ShowAddress 0" 33520 BPUT#out%,"|" 33530 BPUT#out2%,"|" 33540 BPUT#out%,"IconSprites <Obey$Dir>.!Sprites" 33550 BPUT#out2%,"IconSprites <Obey$Dir>.!Sprites" 33560 BPUT#out%,"SET AlpsGame$Resources "+rd$ 33570 BPUT#out%,"SET AlpsGame$Data "+ra$+".Alps" 33580 BPUT#out%,"SET Alps$Pictures "+ra$+".Pictures." 33590 BPUT#out2%,"SET AlpsGame$Resources "+rd$ 33600 BPUT#out2%,"SET AlpsGame$Data "+ra$+".Alps" 33610 BPUT#out2%,"SET Alps$Pictures "+ra$+".Pictures." 33620 BPUT#out%,"Run <Obey$Dir>.!RunImage" 33630 CLOSE#out%:CLOSE#out2% 33640 OSCLI "*SETTYPE "+ra$+".!Run Obey" 33650 OSCLI "*SETTYPE "+ra$+".!Boot Obey" 33660SYS "Hourglass_Off" 33670ENDPROC 33680 33690DEF PROCload_bits(app$) 33700REM Loads 'buttons' sprite and 'Loader' program into picture buffer 33710REM They will then be saved to the user's data disk by PROCcreate_dirs 33720IF LEFT$(app$,1)<>"!" THEN app$="!"+app$ 33730bit$="<Alps$Resources>.buttons" 33740SYS "OS_File",5,bit$ TO ftype,,,,butlen 33750OSCLI "LOAD "+bit$+" "+STR$~picbuf 33760SYS "OS_File",5,"<Alps$Resources>.!Runimage" TO ftype,,,,ldlen 33770OSCLI "LOAD <Alps$Resources>.!Runimage "+STR$~(picbuf+butlen) 33780SYS "OS_File",5,"<Alps$Resources>.!Sprites" TO ftype,,,,sprlen 33790DIM sprld sprlen+4:!sprld=sprlen+4 33800sprld!4=0:sprld!8=16:sprld!12=16 33810SYS "OS_SpriteOp",266,sprld,"<Alps$Resources>.!Sprites" 33820cliplen=0 33830ENDPROC 33840 33850DEF PROCconvert(import$) 33860LOCAL in%,I%,V%,ptr,T% 33870SYS "Hourglass_On" 33880!program%=0 33890program%!4=0 33900PROCfill(nref+4,nref_size-4,0) 33910in%=OPENIN import$ 33920 33930FOR I%=0 TO &57F 33940 V%=BGET#in% 33950 verbs?I%=V% 33960NEXT I% 33970vbn=?verbs 33980nxtvrb=verbs+(verbs?1+256*(verbs?2)) 33990 34000FOR I%=0 TO &57F 34010 V%=BGET#in% 34020 nouns?I%=V% 34030NEXT I% 34040obn=?nouns 34050nxtobj=nouns+(nouns?1+256*(nouns?2)) 34060 34070V%=BGET#in% 34080V%=BGET#in% 34090ptr=program%+4 34100 34110REPEAT 34120 T%=BGET#in% 34130 ?ptr=T%:ptr+=1 34140 IF T%>=&C0 THEN T%-=&10 34150 IF T%>=&70 THEN 34160 pb=oldpars?(T%-&70) 34170 IF pb>0 THEN 34180 FOR I%=1 TO pb 34190 V%=BGET#in% 34200 ?ptr=V%:ptr+=1 34210 CASE T% OF 34220 WHEN &A4,&A1,&92,&90,&96,&97,&A6,&9A,&AA,&87,&88,&7B 34230 IF I%=1 THEN ?ptr=0:ptr+=1 34240 WHEN &7A,&A5,&B2,&B3,&B4,&B5,&B6,&B7,&B8 34250 IF I%=2 THEN ?ptr=0:ptr+=1 34260 ENDCASE 34270 NEXT I% 34280 ENDIF 34290ENDIF 34300UNTIL EOF#in% 34310CLOSE#in% 34320PROCincprglen(ptr-5-program%) 34330SYS "Hourglass_Off" 34340ENDPROC 34350 34360DEF PROCimport_text(import$) 34370IF import$="" THEN 34380PROCerror(16,"") 34390ELSE 34400OSCLI "LOAD "+import$+" "+STR$~(text%+2) 34410mptr=1 34420?text%=text%?2:text%?1=text%?3 34430text%!2=(text%?4+256*text%?5)+2 34440text%!6=text%?6 34450ENDIF 34460ENDPROC 34470 34480DEF PROCimport_obj(import$) 34490LOCAL in%,O%,M%,J%,flags,state,room,mlo,mhi 34500M%=odata% 34510in%=OPENIN(import$) 34520IF in%=0 PROCerror(10,""):ENDPROC 34530O%=BGET#in% 34540PTR#in%=0 34550FOR I%=0 TO O% 34560flags=BGET#in%:state=BGET#in%:room=BGET#in% 34570mlo=BGET#in%:mhi=BGET#in% 34580M%?0=flags:M%?1=state 34590M%?2=room:M%?3=0 34600M%?4=mlo:M%?5=mhi 34610FOR J%=6 TO o_len-1 34620M%?J%=0 34630NEXT J% 34640M%+=o_len 34650NEXT I% 34660last_object=O% 34670CLOSE#in% 34680ENDPROC 34690 34700DEF PROCimport_rooms(import$) 34710LOCAL in%,R%,M%,J% 34720M%=rdata% 34730in%=OPENIN(import$) 34740IF in%=0 PROCerror(10,""):ENDPROC 34750R%=BGET#in% 34760PTR#in%=0 34770FOR I%=0 TO R% 34780FOR J%=0 TO 3 34790M%?J%=BGET#in% 34800NEXT J% 34810M%?4=0:M%?5=0 34820FOR J%=6 TO 13 STEP2 34830M%?J%=BGET#in%:M%?(J%+1)=0 34840NEXT J% 34850FOR J%=14 TO 37 34860M%?J%=0 34870NEXT J% 34880M%?22=BGET#in% 34890M%?24=BGET#in% 34900FOR J%=38 TO 73 34910IF (J%<42 OR J%=46 OR J%=47) THEN M%?J%=BGET#in% ELSE M%?J%=0 34920NEXT J% 34930M%+=r_len 34940NEXT I% 34950last_room=R% 34960ENDPROC 34970 34980DEF PROCsave_all(f$) 34990REM f$=full path name 35000IF INSTR(f$,".")=0 THEN ERROR 1,"To save, drag the file icon to a directory viewer in which there is an ALPS directory.":ENDPROC 35010SYS "Hourglass_On" 35020PROCclose(texthandle):PROCclose(objhandle):PROCclose(roomhandle) 35030p$=f$:f$=FNleafname(p$) 35040p$=LEFT$(p$,LEN(p$)-LEN(f$)) 35050d$=p$+"Alps." 35060OSCLI("SET Alps$Data "+d$) 35070PROCsave_objs("<Alps$Data>Objects") 35080PROCsave_rooms("<Alps$Data>Rooms") 35090PROCsave_flags("<Alps$Data>Flags") 35100PROCsave_pix("<Alps$Data>Pictures") 35110PROCsave_vocab(f$) 35120PROCsave_program("<Alps$Data>Program") 35130PROCsave_text("<Alps$Data>Text") 35140PROCsave_dict("<Alps$Data>Dict") 35150PROCsave_pal("<Alps$Data>!Palette") 35160PROCsave_chars("<Alps$Data>charset") 35170OSCLI("CREATE "+p$+f$+" 100") 35180OSCLI("SETTYPE "+p$+f$+" "+type$) 35190OSCLI("CREATE <Alps$Data>GameData 100") 35200out%=OPENUP("<Alps$Data>GameData") 35210BPUT#out%,mode% 35220CLOSE#out% 35230data_saved=TRUE:loaded$=f$:$filename%=f$ 35240SYS CreateM,,-1 35250SYS "Hourglass_Off" 35260ENDPROC 35270 35280DEF PROCsave_vocab(fi$) 35290IF fi$="" THEN 35300PROCerror(16,"") 35310ELSE 35320PROCsave_nouns("<Alps$Data>Nouns") 35330PROCsave_verbs("<Alps$Data>Verbs") 35340PROCsave_adjects("<Alps$Data>Adjectives") 35350PROCsave_preps("<Alps$Data>Prepos") 35360PROCsave_conj("<Alps$Data>Conjunc") 35370PROCsave_spec("<Alps$Data>Specials") 35380PROCsave_noise("<Alps$Data>Noise") 35390PROCsave_nrefs("<Alps$Data>Nref") 35400PROCsave_arefs("<Alps$Data>Aref") 35410PROCsave_vtypes("<Alps$Data>VerbType") 35420ENDIF 35430ENDPROC 35440 35450DEF PROCsave_nouns(fi$) 35460IF fi$="" THEN 35470PROCerror(16,"") 35480ELSE 35490OSCLI "SAVE "+fi$+" "+STR$~nouns+" "+STR$~(nxtobj+1) 35500OSCLI "SETTYPE "+fi$+" Data" 35510ENDIF 35520ENDPROC 35530 35540DEF PROCsave_verbs(fi$) 35550IF fi$="" THEN 35560PROCerror(16,"") 35570ELSE 35580OSCLI "SAVE "+fi$+" "+STR$~verbs+" "+STR$~(nxtvrb+1) 35590OSCLI "SETTYPE "+fi$+" Data" 35600ENDIF 35610ENDPROC 35620 35630DEF PROCsave_adjects(fi$) 35640IF fi$="" THEN 35650PROCerror(16,"") 35660ELSE 35670OSCLI "SAVE "+fi$+" "+STR$~adjects+" "+STR$~(nxtadj+1) 35680OSCLI "SETTYPE "+fi$+" Data" 35690ENDIF 35700ENDPROC 35710 35720DEF PROCsave_preps(fi$) 35730IF fi$="" THEN 35740PROCerror(16,"") 35750ELSE 35760OSCLI "SAVE "+fi$+" "+STR$~preps+" "+STR$~(nxtprp+1) 35770OSCLI "SETTYPE "+fi$+" Data" 35780ENDIF 35790ENDPROC 35800 35810DEF PROCsave_conj(fi$) 35820IF fi$="" THEN 35830PROCerror(16,"") 35840ELSE 35850OSCLI "SAVE "+fi$+" "+STR$~conjs+" "+STR$~(nxtcjn+1) 35860OSCLI "SETTYPE "+fi$+" Data" 35870ENDIF 35880ENDPROC 35890 35900DEF PROCsave_spec(fi$) 35910IF fi$="" THEN 35920PROCerror(16,"") 35930ELSE 35940OSCLI "SAVE "+fi$+" "+STR$~specs+" "+STR$~(nxtspn+1) 35950OSCLI "SETTYPE "+fi$+" Data" 35960ENDIF 35970ENDPROC 35980 35990DEF PROCsave_noise(fi$) 36000IF fi$="" THEN 36010PROCerror(16,"") 36020ELSE 36030OSCLI "SAVE "+fi$+" "+STR$~noise+" "+STR$~(nxtnsn+1) 36040OSCLI "SETTYPE "+fi$+" Data" 36050ENDIF 36060ENDPROC 36070 36080DEF PROCsave_vtypes(fi$) 36090IF fi$="" THEN 36100PROCerror(16,"") 36110ELSE 36120OSCLI "SAVE "+fi$+" "+STR$~verb_type+"+"+STR$~(2*(maxvbn+1)) 36130OSCLI "SETTYPE "+fi$+" Data" 36140ENDIF 36150ENDPROC 36160 36170DEF PROCsave_arefs(fi$) 36180IF fi$="" THEN 36190PROCerror(16,"") 36200ELSE 36210OSCLI "SAVE "+fi$+" "+STR$~aref+"+"+STR$~(!aref+1) 36220OSCLI "SETTYPE "+fi$+" Data" 36230ENDIF 36240ENDPROC 36250 36260DEF PROCsave_nrefs(fi$) 36270IF fi$="" THEN 36280PROCerror(16,"") 36290ELSE 36300OSCLI "SAVE "+fi$+" "+STR$~nref+"+"+STR$~(!nref+1) 36310OSCLI "SETTYPE "+fi$+" Data" 36320ENDIF 36330ENDPROC 36340 36350DEF PROCsave_objs(fi$) 36360IF fi$="" THEN 36370PROCerror(16,"") 36380ELSE 36390IF NOT datavalid PROCswap_data:datavalid=TRUE 36400odata%?14=optr:odata%?15=last_object 36410OSCLI "SAVE "+fi$+" "+STR$~odata%+"+"+STR$~(o_len*(last_object+1)) 36420OSCLI "SETTYPE "+fi$+" Data" 36430ENDIF 36440ENDPROC 36450 36460DEF PROCsave_rooms(fi$) 36470IF fi$="" THEN 36480PROCerror(16,"") 36490ELSE 36500IF NOT datavalid PROCswap_data:datavalid=TRUE 36510!rdata%=rptr+(last_room<<16) 36520OSCLI "SAVE "+fi$+" "+STR$~rdata%+"+"+STR$~(r_len*(last_room+1)) 36530OSCLI "SETTYPE "+fi$+" Data" 36540ENDIF 36550ENDPROC 36560 36570DEF PROCsave_flags(fi$) 36580IF fi$="" THEN 36590PROCerror(16,"") 36600ELSE 36610chn%=OPENOUT fi$ 36620FOR f%=0 TO 7 36630flag$=$(o_flags%+f%*maxd%) 36640PRINT#chn%,flag$ 36650NEXT 36660FOR f%=0 TO 7 36670flag$=$(r_flags%+f%*maxd%) 36680PRINT#chn%,flag$ 36690NEXT 36700CLOSE#chn% 36710ENDIF 36720ENDPROC 36730 36740DEF PROCsave_pix(fi$) 36750IF fi$="" THEN 36760PROCerror(16,"") 36770ELSE 36780OSCLI "SAVE "+fi$+" "+STR$~pixs+" "+STR$~(nxtpxn+1) 36790OSCLI "SETTYPE "+fi$+" Data" 36800ENDIF 36810ENDPROC 36820 36830DEF PROCsave_program(fi$) 36840IF fi$="" THEN 36850PROCerror(16,"") 36860ELSE 36870OSCLI "SAVE "+fi$+" "+STR$~program%+"+"+STR$~(FNprglen+4+1) 36880OSCLI "SETTYPE "+fi$+" Data" 36890ENDIF 36900ENDPROC 36910 36920DEF PROCsave_text(fi$) 36930IF fi$="" THEN 36940PROCerror(16,"") 36950ELSE 36960OSCLI "SAVE "+fi$+" "+STR$~text%+" "+STR$~FNtext_end 36970OSCLI "SETTYPE "+fi$+" Data" 36980ENDIF 36990ENDPROC 37000 37010DEF PROCsave_dict(fi$) 37020IF fi$="" THEN 37030PROCerror(16,"") 37040ELSE 37050OSCLI "SAVE "+fi$+" "+STR$~dict%+" "+STR$~(dict%+?dict%+256*dict%?1) 37060OSCLI "SETTYPE "+fi$+" Data" 37070ENDIF 37080ENDPROC 37090 37100DEF PROCload_all(f$) 37110REM f$ is the full pathname 37120SYS "Hourglass_On" 37130PROCclose(texthandle):PROCclose(objhandle):PROCclose(roomhandle) 37140p$=f$:f$=FNleafname(p$) 37150p$=LEFT$(p$,LEN(p$)-LEN(f$)) 37160d$=p$+"Alps." 37170r$=p$+"Resources" 37180OSCLI("SET Users$Resources "+r$) 37190OSCLI("SET Alps$Pictures "+p$+"Pictures.") 37200OSCLI("SET Alps$Data "+d$) 37210PROCload_objs("<Alps$Data>Objects") 37220PROCload_rooms("<Alps$Data>Rooms") 37230PROCload_flags("<Alps$Data>Flags") 37240PROCload_pix("<Alps$Data>Pictures") 37250PROCload_vocab(f$) 37260PROCload_program("<Alps$Data>Program") 37270PROCload_text("<Alps$Data>Text") 37280PROCload_dict("<Alps$Data>Dict") 37290OSCLI("PRINT <Alps$Data>charset") 37300data_saved=TRUE:loaded$=f$:$filename%=f$ 37310SYS "Hourglass_Off" 37320ENDPROC 37330 37340DEF PROCload_vocab(f$) 37350IF f$="" THEN 37360PROCerror(16,"") 37370ELSE 37380PROCload_nouns("<Alps$Data>Nouns") 37390PROCload_verbs("<Alps$Data>Verbs") 37400PROCload_adjects("<Alps$Data>Adjectives") 37410PROCload_preps("<Alps$Data>Prepos") 37420PROCload_conj("<Alps$Data>Conjunc") 37430PROCload_spec("<Alps$Data>Specials") 37440PROCload_noise("<Alps$Data>Noise") 37450PROCload_vtypes("<Alps$Data>VerbType") 37460PROCload_nrefs("<Alps$Data>Nref") 37470PROCload_arefs("<Alps$Data>Aref") 37480ENDIF 37490ENDPROC 37500 37510DEF PROCload_nouns(fi$) 37520IF fi$="" THEN 37530PROCerror(16,"") 37540ELSE 37550OSCLI "LOAD "+fi$+" "+STR$~nouns 37560obn=?nouns 37570nxtobj=nouns+(nouns?1+256*(nouns?2)) 37580ENDIF 37590ENDPROC 37600 37610DEF PROCload_verbs(fi$) 37620IF fi$="" THEN 37630PROCerror(16,"") 37640ELSE 37650OSCLI "LOAD "+fi$+" "+STR$~verbs 37660vbn=?verbs 37670nxtvrb=verbs+(verbs?1+256*(verbs?2)) 37680ENDIF 37690ENDPROC 37700 37710DEF PROCload_adjects(fi$) 37720IF fi$="" THEN 37730PROCerror(16,"") 37740ELSE 37750OSCLI "LOAD "+fi$+" "+STR$~adjects 37760adn=?adjects 37770nxtadj=adjects+(adjects?1+256*(adjects?2)) 37780ENDIF 37790ENDPROC 37800 37810DEF PROCload_preps(fi$) 37820IF fi$="" THEN 37830PROCerror(16,"") 37840ELSE 37850OSCLI "LOAD "+fi$+" "+STR$~preps 37860prn=?preps 37870nxtprp=preps+(preps?1+256*(preps?2)) 37880ENDIF 37890ENDPROC 37900 37910DEF PROCload_conj(fi$) 37920IF fi$="" THEN 37930PROCerror(16,"") 37940ELSE 37950OSCLI "LOAD "+fi$+" "+STR$~conjs 37960cjn=?conjs 37970nxtcjn=conjs+(conjs?1+256*(conjs?2)) 37980ENDIF 37990ENDPROC 38000 38010DEF PROCload_spec(fi$) 38020IF fi$="" THEN 38030PROCerror(16,"") 38040ELSE 38050OSCLI "LOAD "+fi$+" "+STR$~specs 38060spn=?specs 38070nxtspn=specs+(specs?1+256*(specs?2)) 38080ENDIF 38090ENDPROC 38100 38110DEF PROCload_noise(fi$) 38120IF fi$="" THEN 38130PROCerror(16,"") 38140ELSE 38150OSCLI "LOAD "+fi$+" "+STR$~noise 38160nsn=?noise 38170nxtnsn=noise+(noise?1+256*(noise?2)) 38180ENDIF 38190ENDPROC 38200 38210DEF PROCload_vtypes(fi$) 38220IF fi$="" THEN 38230PROCerror(16,"") 38240ELSE 38250OSCLI "LOAD "+fi$+" "+STR$~verb_type 38260ENDIF 38270ENDPROC 38280 38290DEF PROCload_arefs(fi$) 38300IF fi$="" THEN 38310PROCerror(16,"") 38320ELSE 38330OSCLI "LOAD "+fi$+" "+STR$~aref 38340ENDIF 38350ENDPROC 38360 38370DEF PROCload_nrefs(fi$) 38380IF fi$="" THEN 38390PROCerror(16,"") 38400ELSE 38410OSCLI "LOAD "+fi$+" "+STR$~nref 38420ENDIF 38430ENDPROC 38440 38450DEF PROCload_objs(fi$) 38460IF fi$="" THEN 38470PROCerror(16,"") 38480ELSE 38490OSCLI "LOAD "+fi$+" "+STR$~odata% 38500optr=odata%?14 38510last_object=odata%?15 38520ENDIF 38530ENDPROC 38540 38550DEF PROCload_rooms(fi$) 38560IF fi$="" THEN 38570PROCerror(16,"") 38580ELSE 38590OSCLI "LOAD "+fi$+" "+STR$~rdata% 38600rptr=!rdata% AND &FFFF 38610last_room=(!rdata% AND &FFFF0000)>>16 38620ENDIF 38630ENDPROC 38640 38650DEF PROCload_flags(fi$) 38660IF fi$="" THEN 38670PROCerror(16,"") 38680ELSE 38690chn%=OPENIN fi$ 38700FOR f%=0 TO 7 38710INPUT#chn%,flag$ 38720$(o_flags%+f%*maxd%)=flag$ 38730NEXT 38740 38750FOR f%=0 TO 7 38760INPUT#chn%,flag$ 38770$(r_flags%+f%*maxd%)=flag$ 38780NEXT 38790CLOSE#chn% 38800ENDIF 38810ENDPROC 38820 38830DEF PROCload_pix(fi$) 38840IF fi$="" THEN 38850PROCerror(16,"") 38860ELSE 38870OSCLI "LOAD "+fi$+" "+STR$~pixs 38880pxn=?pixs 38890nxtpxn=pixs+(pixs?1+256*(pixs?2)) 38900ENDIF 38910ENDPROC 38920 38930DEF PROCload_program(fi$) 38940IF fi$="" THEN 38950PROCerror(16,"") 38960ELSE 38970OSCLI "LOAD "+fi$+" "+STR$~program% 38980ENDIF 38990ENDPROC 39000 39010DEF PROCload_text(fi$) 39020IF fi$="" THEN 39030PROCerror(16,"") 39040ELSE 39050OSCLI "LOAD "+fi$+" "+STR$~text% 39060mptr=1 39070ENDIF 39080ENDPROC 39090 39100DEF PROCload_dict(fi$) 39110LOCAL I%,L% 39120IF fi$="" THEN 39130PROCerror(16,"") 39140ELSE 39150OSCLI "LOAD "+fi$+" "+STR$~dict% 39160tok%=dict%?2:L%=0 39170IF tok%=0 tok%=128 ELSE tok%-=128 39180FOR I%=1 TO tok% 39190tok$(I%)=$(dict%+3+L%) 39200L%+=LENtok$(I%)+1 39210NEXT 39220ENDIF 39230ENDPROC 39240 39250DEF PROCsetup_disk(S%) 39260PROCgetw(setuph):PROCgetpointer 39270PROCopen(setuph,mousex%-64,mousey%,x1%-x0%,y1%-y0%) 39280PROCsys_claiminputfocus(setuph,2,0,0,-1,LEN(FNgeticondata(setuph,2))) 39290PROCgetw(setuph) 39300MOUSE RECTANGLE x0%,y0%,x1%-x0%,y1%-y0% 39310dialogue%=S% 39320ENDPROC 39330 39340DEF PROCquit(S%) 39350IF NOT data_saved THEN 39360ans = FNerrorbox("There is unsaved data in the memory. Do you really want to quit?",0,3,S%) 39370ELSE 39380quit%=TRUE 39390ENDIF 39400ENDPROC 39410 39420DEF PROCensure(S%,T$) 39430dialogue%=FNerrorbox(T$,0,3,S%) 39440ENDPROC 39450 39460 39470REM ------ Vocabulary routines ------ 39480 39490DEF PROCgetobn(text$,RETURN num,RETURN found$) 39500sptr=nouns+3:PROCsearch(sptr,text$,num,found$) 39510ENDPROC 39520 39530DEF PROCgetvbn(text$,RETURN num,RETURN found$) 39540sptr=verbs+3:PROCsearch(sptr,text$,num,found$) 39550ENDPROC 39560 39570DEF PROCgetadn(text$,RETURN num,RETURN found$) 39580sptr=adjects+3:PROCsearch(sptr,text$,num,found$) 39590ENDPROC 39600 39610DEF PROCgetprn(text$,RETURN num,RETURN found$) 39620sptr=preps+3:PROCsearch(sptr,text$,num,found$) 39630ENDPROC 39640 39650DEF PROCgetcjn(text$,RETURN num,RETURN found$) 39660sptr=conjs+3:PROCsearch(sptr,text$,num,found$) 39670ENDPROC 39680 39690DEF PROCgetspn(text$,RETURN num,RETURN found$) 39700sptr=specs+3:PROCsearch(sptr,text$,num,found$) 39710ENDPROC 39720 39730DEF PROCgetnsn(text$,RETURN num,RETURN found$) 39740sptr=noise+3:PROCsearch(sptr,text$,num,found$) 39750ENDPROC 39760 39770DEF PROCsearch(sptr,search$,RETURN number,RETURN temp$) 39780LOCAL temp$,found 39790number=0 39800F%=work%:B%=sptr:$(work%+&128)=search$:REM put search string in 'text' 39810CALL search 39820number=!(work%+&148) 39830ENDPROC 39840 39850DEF PROCword(type,line$) 39860REM Add words to the vocabulary or picture list 39870REM word types are - nouns = 1, verbs = 2, adjectives = 3 39880REM prepositions = 4, conjunctions = 5, specials = 6 39890REM picture names = 10 39900LOCAL index,ptr,I%,len,len2,temp$ 39910 39920IF line$="" THEN ENDPROC 39930 39940WHILE INSTR("0123456789=",LEFT$(line$,1))<>0 39950line$=MID$(line$,2) 39960ENDWHILE 39970 39980WHILE LEFT$(line$,1)=" " 39990line$=MID$(line$,2) 40000ENDWHILE 40010 40020IF type<4 OR type=10 THEN 40030end=INSTR(line$,"<"):IF end=0 THEN PROCerror(22,""):errflag=TRUE:ENDPROC 40040number$=MID$(line$,end+1):line$=LEFT$(line$,end-1) 40050IF RIGHT$(number$,1)=">" THEN number$=LEFT$(number$,LENnumber$-1) 40060ELSE 40070number$="" 40080ENDIF 40090 40100IF number$="" THEN 40110CASE type OF 40120WHEN 1,3 40130number$=STR$(obn) 40140WHEN 2 40150number$="0":REM Default verb type is zero 40160OTHERWISE 40170number$="" 40180ENDCASE 40190ENDIF 40200 40210index=0 40220ptr=INSTR(line$,",") 40230IF ptr=0 THEN 40240a_list$(index)=LEFT$(line$,maxlen) 40250ELSE 40260WHILE ptr<>0 AND index<11 40270temp$=LEFT$(line$,ptr-1) 40280len=LEN(line$) 40290line$=RIGHT$(line$,len-ptr) 40300a_list$(index)=LEFT$(temp$,maxlen) 40310index+=1 40320ptr=INSTR(line$,",") 40330ENDWHILE 40340a_list$(index)=LEFT$(line$,maxlen) 40350ENDIF 40360 40370CASE type OF 40380 40390WHEN 1 40400IF obn=maxobn THEN 40410PROCerror(17,"at "+a_list$(0)):errflag=TRUE 40420ELSE 40430FOR I%=0 TO index 40440 len2=LEN a_list$(I%) 40450 IF len2>0 THEN 40460 PROCgetobn(a_list$(I%),num,fnd$) 40470 IF num<>0 PROCerror(5,a_list$(I%)):errflag=TRUE 40480 IF nxtobj+len2>noun_end-2 PROCerror(13,error$(38)):errflag=TRUE 40490 IF NOT errflag THEN 40500 $nxtobj=a_list$(I%):?(nxtobj+len2-1)=?(nxtobj+len2-1) OR 128 40510 nxtobj+=len2:?nxtobj=obn:nxtobj+=1:?nxtobj=&FF 40520 ENDIF 40530 ENDIF 40540NEXT I% 40550 IF NOT errflag THEN 40560 obn+=1 40570 ?nouns=obn:nouns?1=(nxtobj-nouns) MOD 256:nouns?2=(nxtobj-nouns) DIV 256 40580 ptr=1:memptr=nref+!nref:svmptr=memptr:refs=0:memptr+=1 40590 REPEAT 40600 PROCdecode_parameter(number$,ptr,ptr,val,0) 40610 IF NOT errflag THEN ?memptr=val:memptr+=1:refs+=1 40620 UNTIL ptr>LENnumber$ OR errflag 40630 ?memptr=0:!nref=!nref+refs+1 40640 ?svmptr=refs 40650 ENDIF 40660ENDIF 40670WHEN 2 40680IF vbn=maxvbn THEN 40690PROCerror(18,"at "+a_list$(0)):errflag=TRUE 40700ELSE 40710FOR I%=0 TO index 40720 len2=LEN a_list$(I%) 40730 IF len2>0 THEN 40740 PROCgetvbn(a_list$(I%),num,fnd$) 40750 IF num<>0 PROCerror(8,a_list$(I%)):errflag=TRUE 40760 IF nxtvrb+len2>verb_end-2 PROCerror(13,error$(39)):errflag=TRUE 40770 IF NOT errflag THEN 40780 $nxtvrb=a_list$(I%):?(nxtvrb+len2-1)=?(nxtvrb+len2-1) OR 128 40790 nxtvrb+=len2:?nxtvrb=vbn:nxtvrb+=1:?nxtvrb=&FF 40800 ENDIF 40810 ENDIF 40820NEXT I% 40830IF NOT errflag THEN 40840ptr=1 40850PROCdecode_parameter(number$,ptr,ptr,val,0) 40860IF NOT errflag THEN 40870verb_type?(2*vbn)=val 40880oloc$=MID$(number$,ptr+1):olocflg=0 40890IF INSTR(oloc$,"C")<>0 THEN olocflg=1 40900IF INSTR(oloc$,"P")<>0 THEN olocflg=olocflg OR 2 40910verb_type?(2*vbn+1)=olocflg 40920vbn+=1 40930?verbs=vbn:verbs?1=(nxtvrb-verbs) MOD 256:verbs?2=(nxtvrb-verbs) DIV 256 40940ENDIF 40950ENDIF 40960ENDIF 40970WHEN 3 40980IF adn=maxadj THEN 40990PROCerror(19,"at "+a_list$(0)):errflag=TRUE 41000ELSE 41010FOR I%=0 TO index 41020 len2=LEN a_list$(I%) 41030 IF len2>0 THEN 41040 PROCgetadn(a_list$(I%),num,fnd$) 41050 IF num<>0 PROCerror(8,a_list$(I%)):errflag=TRUE 41060 IF nxtadj+len2>adjc_end-2 PROCerror(13,error$(40)):errflag=TRUE 41070 IF NOT errflag THEN 41080 $nxtadj=a_list$(I%):?(nxtadj+len2-1)=?(nxtadj+len2-1) OR 128 41090 nxtadj+=len2:?nxtadj=adn:nxtadj+=1:?nxtadj=&FF 41100 ENDIF 41110 ENDIF 41120NEXT I% 41130 IF NOT errflag THEN 41140adn+=1 41150?adjects=adn:adjects?1=(nxtadj-adjects) MOD 256:adjects?2=(nxtadj-adjects) DIV 256 41160 ptr=1:memptr=aref+!aref:svmptr=memptr:refs=0:memptr+=1 41170 REPEAT 41180 PROCdecode_parameter(number$,ptr,ptr,val,0) 41190 IF NOT errflag THEN ?memptr=val:memptr+=1:refs+=1 41200 UNTIL ptr>LENnumber$ OR errflag 41210 ?memptr=0:!aref=!aref+refs+1 41220 ?svmptr=refs 41230 ENDIF 41240ENDIF 41250WHEN 4 41260IF prn=maxprep THEN 41270PROCerror(20,"at "+a_list$(0)):errflag=TRUE 41280ELSE 41290FOR I%=0 TO index 41300 len2=LEN a_list$(I%) 41310 IF len2>0 THEN 41320 PROCgetprn(a_list$(I%),num,fnd$) 41330 IF num<>0 PROCerror(8,a_list$(I%)):errflag=TRUE 41340 IF nxtprp+len2>prep_end-2 PROCerror(13,error$(41)):errflag=TRUE 41350 IF NOT errflag THEN 41360 $nxtprp=a_list$(I%):?(nxtprp+len2-1)=?(nxtprp+len2-1) OR 128 41370 nxtprp+=len2:?nxtprp=prn:nxtprp+=1:?nxtprp=&FF 41380 ENDIF 41390 ENDIF 41400NEXT I% 41410 IF NOT errflag THEN 41420 prn+=1 41430 ?preps=prn:preps?1=(nxtprp-preps) MOD 256:preps?2=(nxtprp-preps) DIV 256 41440 ENDIF 41450ENDIF 41460WHEN 5 41470IF cjn=maxconj THEN 41480PROCerror(21,"at "+a_list$(0)):errflag=TRUE 41490ELSE 41500FOR I%=0 TO index 41510 len2=LEN a_list$(I%) 41520 IF len2>0 THEN 41530 PROCgetcjn(a_list$(I%),num,fnd$) 41540 IF num<>0 PROCerror(8,a_list$(I%)):errflag=TRUE 41550 IF nxtcjn+len2>conj_end-2 PROCerror(13,error$(42)):errflag=TRUE 41560 IF NOT errflag THEN 41570 $nxtcjn=a_list$(I%):?(nxtcjn+len2-1)=?(nxtcjn+len2-1) OR 128 41580 nxtcjn+=len2:?nxtcjn=cjn:nxtcjn+=1:?nxtcjn=&FF 41590 ENDIF 41600 ENDIF 41610NEXT I% 41620 IF NOT errflag THEN 41630 cjn+=1 41640 ?conjs=cjn:conjs?1=(nxtcjn-conjs) MOD 256:conjs?2=(nxtcjn-conjs) DIV 256 41650 ENDIF 41660ENDIF 41670WHEN 6 41680IF spn=maxspec THEN 41690PROCerror(24,"at "+a_list$(0)):errflag=TRUE 41700ELSE 41710FOR I%=0 TO index 41720 len2=LEN a_list$(I%) 41730 IF len2>0 THEN 41740 PROCgetspn(a_list$(I%),num,fnd$) 41750 IF num<>0 PROCerror(8,a_list$(I%)):errflag=TRUE 41760 IF nxtspn+len2>spec_end-2 PROCerror(13,error$(43)):errflag=TRUE 41770 IF NOT errflag THEN 41780 $nxtspn=a_list$(I%):?(nxtspn+len2-1)=?(nxtspn+len2-1) OR 128 41790 nxtspn+=len2:?nxtspn=spn:nxtspn+=1:?nxtspn=&FF 41800 ENDIF 41810 ENDIF 41820NEXT I% 41830 IF NOT errflag THEN 41840 spn+=1 41850 ?specs=spn:specs?1=(nxtspn-specs) MOD 256:specs?2=(nxtspn-specs) DIV 256 41860 ENDIF 41870ENDIF 41880WHEN 7 41890IF nsn=maxnoise THEN 41900PROCerror(25,"at "+a_list$(0)):errflag=TRUE 41910ELSE 41920FOR I%=0 TO index 41930 len2=LEN a_list$(I%) 41940 IF len2>0 THEN 41950 PROCgetnsn(a_list$(I%),num,fnd$) 41960 IF num<>0 PROCerror(8,a_list$(I%)):errflag=TRUE 41970 IF nxtnsn+len2>noise_end-2 PROCerror(13,error$(44)):errflag=TRUE 41980 IF NOT errflag THEN 41990 $nxtnsn=a_list$(I%):?(nxtnsn+len2-1)=?(nxtnsn+len2-1) OR 128 42000 nxtnsn+=len2:?nxtnsn=nsn:nxtnsn+=1:?nxtnsn=&FF 42010 ENDIF 42020 ENDIF 42030NEXT I% 42040 IF NOT errflag THEN 42050 nsn+=1 42060 ?noise=nsn:noise?1=(nxtnsn-noise) MOD 256:noise?2=(nxtnsn-noise) DIV 256 42070 ENDIF 42080ENDIF 42090WHEN 10 42100IF pxn=maxpix THEN 42110PROCerror(26,"at "+a_list$(0)):errflag=TRUE 42120ELSE 42130FOR I%=0 TO index 42140 len2=LEN a_list$(I%) 42150 IF len2>0 THEN 42160 IF nxtpxn+len2>pix_end-2 PROCerror(13,error$(45)):errflag=TRUE 42170 IF NOT errflag THEN 42180 $nxtpxn=a_list$(I%):REM ?(nxtpxn+len2-1)=?(nxtpxn+len2-1) OR 128 42190 nxtpxn+=len2+1 42200 ENDIF 42210 ENDIF 42220NEXT I% 42230 IF NOT errflag THEN 42240 loc$=MID$(number$,1) 42250 IF loc$<>"" THEN 42260 IF INSTR("TBLR",loc$)<>0 THEN val=INSTR("TBLR",loc$)-1 ELSE val=0 42270 ELSE val=0 42280 ENDIF 42290 ?nxtpxn=val:nxtpxn+=5:?nxtpxn=&FF 42300 pxn+=1 42310 ?pixs=pxn:pixs?1=(nxtpxn-pixs) MOD 256:pixs?2=(nxtpxn-pixs) DIV 256 42320 ENDIF 42330ENDIF 42340ENDCASE 42350ENDPROC 42360 42370DEF PROCgetstr(test$,place,RETURN place,RETURN result$) 42380chr$=MID$(test$,place,1) 42390IF chr$=CHR$13 THEN result$="":ENDPROC 42400WHILE chr$=" " OR chr$="," place+=1 42410chr$=MID$(test$,place,1) 42420ENDWHILE 42430 42440IF chr$<>CHR$ 34 PROCerror(6," : "+line$):result$="":ENDPROC 42450place+=1 42460place2=INSTR(line$,CHR$34,place):IF place2<place PROCerror(6," : "+line$):result$="":ENDPROC 42470 42480result$=MID$(line$,place,place2-place) 42490place=place2+1 42500ENDPROC 42510 42520DEF PROClistnouns 42530LOCAL mptr,I%,J%,refs 42540IF obn=1 THEN ENDPROC 42550mptr=nref+4 42560FOR I%=1 TO obn-1 42570PROCput(STR$(I%)+"= ") 42580PROCpvok(I%,1,TRUE):PROCput(",<") 42590refs=?mptr 42600IF refs>0 THEN 42610FOR J%=1 TO refs 42620PROCput(STR$(J%?mptr)) 42630IF J%<refs PROCput(",") 42640NEXT 42650ENDIF 42660mptr+=refs+1 42670PROCput(">"+CHR$13) 42680NEXT 42690PROCput(CHR$0) 42700ENDPROC 42710 42720DEF PROClistverbs 42730IF vbn=1 THEN ENDPROC 42740FOR I%=1 TO vbn-1 42750PROCput(STR$(I%)+"= ") 42760vtype=verb_type?(2*I%) 42770PROCpvok(I%,0,TRUE):PROCput(",<"+STR$(vtype)) 42780olflg=verb_type?(2*I%+1):oloc$="" 42790IF vtype>0 THEN 42800IF (olflg AND 1)<>0 THEN oloc$+="C" 42810IF (olflg AND 2)<>0 THEN oloc$+="P" 42820PROCput(",") 42830ENDIF 42840PROCput(oloc$+">"+CHR$13) 42850NEXT 42860PROCput(CHR$0) 42870ENDPROC 42880 42890DEF PROClistadjs 42900LOCAL mptr,I%,J%,refs 42910IF adn=1 THEN ENDPROC 42920mptr=aref+4 42930FOR I%=1 TO adn-1 42940PROCput(STR$(I%)+"= ") 42950PROCpvok(I%,2,TRUE):PROCput(",<") 42960refs=?mptr 42970IF refs>0 THEN 42980FOR J%=1 TO refs 42990PROCput(STR$(J%?mptr)) 43000IF J%<refs PROCput(",") 43010NEXT 43020ENDIF 43030mptr+=refs+1 43040PROCput(">"+CHR$13) 43050NEXT 43060PROCput(CHR$0) 43070ENDPROC 43080 43090DEF PROClistpreps 43100LOCAL I%,J% 43110IF prn=1 THEN ENDPROC 43120FOR I%=1 TO prn-1 43130PROCput(STR$(I%)+"= ") 43140PROCpvok(I%,3,TRUE):PROCput(CHR$13) 43150NEXT 43160PROCput(CHR$0) 43170ENDPROC 43180 43190DEF PROClistconjs 43200LOCAL I%,J% 43210IF cjn=1 THEN ENDPROC 43220FOR I%=1 TO cjn-1 43230PROCput(STR$(I%)+"= ") 43240PROCpvok(I%,4,TRUE):PROCput(CHR$13) 43250NEXT 43260PROCput(CHR$0) 43270ENDPROC 43280 43290DEF PROClistspecs 43300LOCAL I%,J% 43310IF spn=1 THEN ENDPROC 43320FOR I%=1 TO spn-1 43330PROCput(STR$(I%)+"= ") 43340PROCpvok(I%,5,TRUE):PROCput(CHR$13) 43350NEXT 43360PROCput(CHR$0) 43370ENDPROC 43380 43390DEF PROClistnoise 43400LOCAL I%,J% 43410IF nsn=1 THEN ENDPROC 43420FOR I%=1 TO nsn-1 43430PROCput(STR$(I%)+"= ") 43440PROCpvok(I%,6,TRUE):PROCput(CHR$13) 43450NEXT 43460PROCput(CHR$0) 43470ENDPROC 43480 43490DEF PROCstore_pix 43500SYS "Hourglass_On" 43510errflag=FALSE 43520pxn=1 43530nxtpxn=pixs:?nxtpxn=pxn:nxtpxn?1=3:nxtpxn?2=0:nxtpxn+=3:?nxtpxn=&FF 43540last%=FNfind_lastrow 43550FOR I%=0 TO last% 43560IF NOT errflag PROCword(10,FNrow(I%)) 43570NEXT 43580SYS "Hourglass_Off" 43590 43600ENDPROC 43610 43620DEF PROCstore_vocab 43630SYS "Hourglass_On" 43640errflag=FALSE:PROCremove_markers 43650 43660CASE voc_sect% OF 43670WHEN 1 43680obn=1 43690nxtobj=nouns:?nxtobj=obn:nxtobj?1=3:nxtobj?2=0:nxtobj+=3:?nxtobj=&FF 43700!nref=4 43710WHEN 2 43720vbn=1 43730nxtvrb=verbs:?nxtvrb=vbn:nxtvrb?1=3:nxtvrb?2=0:nxtvrb+=3:?nxtvrb=&FF 43740WHEN 3 43750adn=1 43760nxtadj=adjects:?nxtadj=adn:nxtadj?1=3:nxtadj?2=0:nxtadj+=3:?nxtadj=&FF 43770!aref=4 43780WHEN 4 43790prn=1 43800nxtprp=preps:?nxtprp=prn:nxtprp?1=3:nxtprp?2=0:nxtprp+=3:?nxtprp=&FF 43810WHEN 5 43820cjn=1 43830nxtcjn=conjs:?nxtcjn=cjn:nxtcjn?1=3:nxtcjn?2=0:nxtcjn+=3:?nxtcjn=&FF 43840WHEN 6 43850spn=1 43860nxtspn=specs:?nxtspn=spn:nxtspn?1=3:nxtspn?2=0:nxtspn+=3:?nxtspn=&FF 43870WHEN 7 43880nsn=1 43890nxtnsn=noise:?nxtnsn=nsn:nxtnsn?1=3:nxtnsn?2=0:nxtnsn+=3:?nxtnsn=&FF 43900ENDCASE 43910last%=FNfind_lastrow 43920 43930FOR I%=0 TO last% 43940 IF NOT errflag PROCword(voc_sect%,FNrow(I%)) 43950NEXT 43960IF NOT errflag text_ok=TRUE 43970SYS "Hourglass_Off" 43980ENDPROC 43990 44000DEF FNfindnoun(obj,RETURN J%) 44010REM Finds the number of the noun referring to a specified object 44020LOCAL M%,I%,N%,found 44030M%=nref+4 44040WHILE N%<last_object AND NOT found 44050J%=?M% 44060IF J%>0 THEN 44070FOR I%=1 TO J% 44080IF M%?I%=obj THEN found=TRUE 44090NEXT 44100ENDIF 44110M%+=J%+1 44120N%+=1 44130ENDWHILE 44140IF found THEN=N% ELSE=0 44150 44160 44170DEF PROCwhich_obj(N%,RETURN V$,RETURN R%) 44180REM Returns a string containing the objects referenced by noun N% 44190REM R%=number of objects referenced 44200LOCAL M%,found,I%,J%,K% 44210 44220M%=nref+4 44230IF N%>1 THEN 44240FOR K%=1 TO N%-1 44250 J%=?M% 44260 M%+=J%+1 44270NEXT 44280ENDIF 44290J%=?M% 44300R%=J%:V$="" 44310IF J%>0 THEN 44320FOR I%=1 TO J% 44330 V$+=STR$(I%?M%)+"," 44340NEXT 44350ENDIF 44360ENDPROC 44370 44380DEF PROCpvok(num,type,all) 44390LOCAL temp$,found,ctr 44400IF num=0 THEN ENDPROC 44410 44420CASE type OF 44430WHEN 0: sptr=verbs+3 44440WHEN 1: sptr=nouns+3 44450WHEN 2: sptr=adjects+3 44460WHEN 3: sptr=preps+3 44470WHEN 4: sptr=conjs+3 44480WHEN 5: sptr=specs+3 44490WHEN 6: sptr=noise+3 44500WHEN 10: sptr=pixs+3 44510ENDCASE 44520 44530A%=num:B%=sptr 44540IF NOT all THEN 44550CALL pvok:temp$=$atext:IF temp$<>"" PROCput(temp$) 44560ELSE 44570?pvokflag=0 44580REPEAT 44590CALL pvok 44600IF ?pvokflag=0 THEN 44610IF ctr>0 THEN PROCput(",") 44620temp$=$atext:IF temp$<>"" PROCput(temp$) 44630ctr+=1:B%=!address 44640ENDIF 44650UNTIL ?pvokflag>0 44660ENDIF 44670ENDPROC 44680 44690DEF PROCnonspc(str$,place,RETURN place,RETURN chr$) 44700WHILE MID$(str$,place,1)=" " 44710 place+=1 44720ENDWHILE 44730chr$=MID$(str$,place,1) 44740ENDPROC 44750 44760DEF PROCdodefn 44770IF vbn=maxvbn PROCerror(11,": "+STR$(maxvbn)+" "+error$(46)):ENDPROC 44780?prgptr=def_token:prgptr+=1 44790 44800PROCgetstr(line$,ptr,ptr,vrb$):index=0 44810IF errflag THEN ENDPROC 44820REM WHILE vrb$<>"" AND index<11 44830a_list$(index)=vrb$:index+=1 44840REM PROCgetstr(line$,ptr,ptr,vrb$) 44850REM ENDWHILE 44860 44870IF vrb$="" PROCerror(1,error$(47)):ENDPROC 44880 44890IF errflag THEN ENDPROC 44900 44910flag=FALSE:index-=1 44920FOR I%=0 TO index 44930 PROCgetvbn(a_list$(I%),num,fnd$) 44940 IF num<>0 AND NOT existing_verb PROCerror(8,a_list$(I%)):flag=TRUE 44950 oldvbn=num 44960NEXT I% 44970 44980IF NOT flag AND NOT existing_verb THEN 44990 FOR I%=0 TO index 45000 len2=LEN a_list$(I%) 45010 $nxtvrb=a_list$(I%):?(nxtvrb+len2-1)=?(nxtvrb+len2-1) OR 128 45020 nxtvrb+=len2:?nxtvrb=vbn:nxtvrb+=1 45030 NEXT I% 45040 ?prgptr=vbn:prgptr+=1:?nxtvrb=&FF:vbn+=1 45050 ?verbs=vbn:verbs?1=(nxtvrb-verbs) MOD 256:verbs?2=(nxtvrb-verbs) DIV 256 45060 45070ELSE 45080IF existing_verb THEN ?prgptr=oldvbn:prgptr+=1 45090ENDIF 45100 45110existing_verb=TRUE 45120ENDPROC 45130 45140DEF PROCprtdef 45150vrbnum=?listptr 45160PROCput(CHR$32+CHR$34):PROCpvok(vrbnum,0,FALSE):PROCput(CHR$34) 45170ENDPROC 45180 45190DEF FNfntype(parm) 45200LOCAL temp 45210IF token=prep_token OR token=notprep_token THEN =3 45220temp=parm AND %01000000:REM check if `object` function 45230IF temp<>0 THEN=1 45240temp=parm AND %00100000:REM check if `verb` function 45250IF temp<>0 THEN=2 ELSE =0 45260 45270DEF PROCprntobj 45280LOCAL num 45290objnum=?listptr 45300IF objnum>last_object THEN ENDPROC 45310num=FNfindnoun(objnum,refs) 45320IF refs=1 THEN 45330PROCput(CHR$34):PROCpvok(num,1,FALSE):PROCput(CHR$34) 45340doneit=TRUE 45350ENDIF 45360ENDPROC 45370 45380DEF PROCprntvrb 45390vrbnum=?listptr 45400IF vrbnum>=vbn THEN ENDPROC 45410PROCput(CHR$34):PROCpvok(vrbnum,0,FALSE):PROCput(CHR$34) 45420doneit=TRUE 45430ENDPROC 45440 45450DEF PROCprintprep 45460LOCAL num 45470num=?listptr 45480IF num>=prn THEN ENDPROC 45490PROCput(CHR$34):PROCpvok(num,3,FALSE):PROCput(CHR$34) 45500doneit=TRUE 45510ENDPROC 45520 45530DEF PROCcopy_from_editor 45540LOCAL ldptr,svptr,O%,I%,R% 45550svptr=initsave 45560FOR O%=last_object TO 0 STEP-1 45570ldptr=odata%+O%*o_len 45580!svptr=!ldptr:svptr+=4 45590?svptr=ldptr?12:svptr+=1 45600?svptr=ldptr?14:svptr+=1 45610?svptr=ldptr?15:svptr+=1 45620NEXT 45630FOR R%=last_room TO 0 STEP-1 45640ldptr=rdata%+R%*r_len 45650?svptr=?ldptr:svptr?1=ldptr?1:svptr+=2 45660FOR I%=54 TO 73 STEP4 45670!svptr=I%!ldptr:svptr+=4 45680NEXT 45690NEXT 45700ENDPROC 45710 45720DEF PROCcopy_to_editor 45730LOCAL ldptr,svptr,O%,I%,R% 45740ldptr=initsave 45750FOR O%=last_object TO 0 STEP-1 45760svptr=odata%+O%*o_len 45770!svptr=!ldptr:ldptr+=4 45780svptr?12=?ldptr:ldptr+=1 45790svptr?14=?ldptr:ldptr+=1 45800svptr?15=?ldptr:ldptr+=1 45810NEXT 45820FOR R%=last_room TO 0 STEP-1 45830svptr=rdata%+R%*r_len 45840?svptr=?ldptr:svptr?1=ldptr?1:ldptr+=2 45850FOR I%=54 TO 73 STEP4 45860I%!svptr=!ldptr:ldptr+=4 45870NEXT 45880NEXT 45890ENDPROC 45900 45910DEF PROCswap_data 45920LOCAL ldptr,svptr,O%,I%,R%,T% 45930ldptr=initsave 45940FOR O%=last_object TO 0 STEP-1 45950svptr=odata%+O%*o_len 45960T%=!svptr 45970!svptr=!ldptr:!ldptr=T%:ldptr+=4 45980T%=svptr?12 45990svptr?12=?ldptr:?ldptr=T%:ldptr+=1 46000T%=svptr?14 46010svptr?14=?ldptr:?ldptr=T%:ldptr+=1 46020T%=svptr?15 46030svptr?15=?ldptr:?ldptr=T%:ldptr+=1 46040NEXT 46050FOR R%=last_room TO 0 STEP-1 46060svptr=rdata%+R%*r_len 46070T%=?svptr:?svptr=?ldptr:?ldptr=T%:T%=svptr?1:svptr?1=ldptr?1:ldptr?1=T%:ldptr+=2 46080FOR I%=54 TO 73 STEP4 46090T%=I%!svptr 46100I%!svptr=!ldptr:!ldptr=T%:ldptr+=4 46110NEXT 46120NEXT 46130ENDPROC 46140 46150DEF FNerrorbox(err$,err%,Errorflags,fromPlace%) 46160SYS CreateM,,-1 46170SYS Poll,,block 46180!mistake = err% 46190IF NOT testing AND err%=29 THEN 46200 err$="Sorry - not implemented in this version": Errorflags=1 46210ENDIF 46220IF testing err$+=" (Error code: "+STR$(ERL)+")" 46230IF (err% AND &FF)=&C7 err$="Disk not formatted. Shall I format it now?":Errorflags=3 46240$(mistake+4) = err$+CHR$(0) 46250IF fromPlace%<>-99 THEN Errorflags=Errorflags OR 16:t$="Message from ALPS" ELSE t$="ALPS" 46260SYS "Wimp_ReportError",mistake,Errorflags,t$ TO ,dialogue% 46270ok = (dialogue%=1) 46280 46290IF (err% AND &FF)=&C7 AND ok THEN 46300 *FORMAT 0 E Y 46310 PROCcreate_dirs(FNgeticondata(setuph,2),FNgeticondata(setuph,5)) 46320ENDIF 46330 46340CASE fromPlace% OF 46350WHEN -99: REM *** a proper error *** 46360WHEN 0:IF ok THEN PROCsave_all(path$) 46370WHEN 1:IF ok THEN PROCload_all(path$):PROCopen(ALPSmain,400,800,600,600) 46380WHEN 2:IF ok THEN PROCcreate_dirs 46390WHEN 3:IF ok THEN 46400quit%=TRUE 46410SYS "Wimp_GetCaretPosition",,quitblk+20 :REM Fill up first 5 words 46420quitblk!44=&1FC :REM CTRL-SHIFT-f12 46430!quitblk=48 :REM Size of message block 46440quitblk!12=0 46450quitblk!16=8 :REM Send Key_Pressed message 46460SYS "Wimp_SendMessage",17,quitblk,prequittask% 46470ENDIF 46480WHEN 4:IF ok THEN quit%=TRUE 46490ENDCASE 46500=dialogue% 46510 46520 46530DEF FNOS_Var(V$) 46540SYS "XOS_ReadVarVal",V$,0,-1 TO ,,exists 46550=exists 46560 46570DEF FNReadVarVal(V$) 46580DIM vblk 32 46590SYS "XOS_ReadVarVal",V$,vblk,32,,0,3 TO ,,N% 46600vblk?N%=13 46610=$vblk 46620 46630DEF FNiconbar(sprBlk, spname$, xx,yy) 46640!qBlk%=-1 46650qBlk%!4=0:qBlk%!8=0:qBlk%!12=xx*2:qBlk%!16=yy*4 46660qBlk%!20=&2102 46670DIM qBlk%!24 (LENspname$+1):$(qBlk%!24)=spname$ 46680qBlk%!28=sprBlk 46690qBlk%!32=LENspname$+1 46700SYS "Wimp_CreateIcon",,qBlk% TO theIc% 46710=theIc% 46720 46730 46740DEF PROCreceive(block) 46750ref%=block!8 46760CASE block!16 OF 46770 WHEN 0 :quit%=TRUE 46780 WHEN 2 :REM SaveAck from Filer/another app. 46790 path$=FNname(block+44) 46800 PROCsave_all(path$) 46810 !block=64:block!12=block!8:block!16=3 46820 SYS "Wimp_SendMessage",17,block,block!20,block!24 46830 WHEN 3,5 :PROCload(block) 46840 WHEN 8 :REM PreQuit 46850 IF NOT data_saved THEN 46860 prequittask%=block!4 46870 bytes=!block 46880 FOR I%=0 TO bytes 46890 quitblk!I%=block!I% 46900 NEXT 46910 quitblk!12=quitblk!8 46920 block!12=block!8 46930 SYS "Wimp_SendMessage",19,block 46940 ans = FNerrorbox("There is unsaved data in the memory. Do you really want to quit?",0,3,3) 46950 ENDIF 46960 WHEN &502:PROChelp(block!32,block!36,block) 46970 WHEN &400C1:REM mode change 46980 mode%=MODE 46990 PROCgetmodeinfo 47000 PROCassemble(armcode%):REM Need to allow for different screen size 47010 IF scrnsize>oldsize THEN null=FNerrorbox("Warning! It may not be possible to display pictures in this mode due to memory restrictions. To display pictures quit ALPS and restart in this mode.",0,1,5) 47020ENDCASE 47030ENDPROC 47040 47050DEF PROCload(b) 47060ourtype=EVAL("&"+type$) 47070IF b!40 = ourtype THEN 47080 path$=FNname(b+44) 47090 IF NOT data_saved THEN 47100 PROCLoadAck 47110 PROCensure(1,"Unsaved data in memory. Please confirm that you want to load this file.") 47120 ELSE 47130 PROCload_all(path$) 47140 PROCLoadAck 47150 PROCopen(ALPSmain,400,800,600,600) 47160 ENDIF 47170ENDIF 47180ENDPROC 47190 47200DEF PROCLoadAck 47210block!12=block!8:block!16=4:!block=64 47220SYS "Wimp_SendMessage",17,block,block!4 47230ENDPROC 47240 47250DEF PROCsave 47260path$=FNgeticondata(savehandle,2) 47270PROCgetpointer 47280block!20=64:block!32=0:block!36=1:REM DataSave MSG 47290block!40=handle%:block!44=icon%:block!48=mousex%:block!52=mousey% 47300block!56=10000:REM Estimated size of data??? 47310block!60=EVAL("&"+type$):REM File type 47320$(block+64)=FNleafname(path$)+CHR$0 47330SYS "Wimp_SendMessage",17,block+20,handle%,icon% 47340ENDPROC 47350 47360DEF FNname(indx) 47370LOCAL f$,g$,p,i 47380 47390WHILE ?indx<>0 47400f$+=CHR$(?indx):indx+=1 47410ENDWHILE 47420=f$ 47430 47440DEF FNleafname(f$) 47450p=1 47460REPEAT 47470i=INSTR(f$,"."):IF i<>0 p=i+1:MID$(f$,i,1)="#" 47480UNTIL i=0 47490f$=MID$(f$,p) 47500=f$ 47510 47520DEF FNtick_objected 47530flags%=VAL(FNgeticondata(objhandle,8)) 47540FOR fl%=7 TO 0 STEP -1 47550 flag%=flags% DIV 2^fl% 47560 flags%=flags% MOD 2^fl% 47570 ptr=(m_objflag+28+(7-fl%)*24) 47580 IF flag%=1 THEN 47590 ?ptr=?ptr OR 1 47600 ELSE ?ptr=?ptr AND %11111110 47610 ENDIF 47620NEXT fl% 47630=0 47640 47650DEF FNtick_message 47660 ptr=0 47670 FOR I%=1 TO maxsw% 47680 $(swdata%+ptr)=STR$(switch_vals(I%)) 47690 ptr+=12 47700 IF I%>switch_vals(0) THEN 47710 ?(m_switch%+28+24*I%)=(?(m_switch%+28+24*I%) AND &FE) 47720 ELSE 47730 ?(m_switch%+28+24*I%)=(?(m_switch%+28+24*I%) OR 1) 47740 ENDIF 47750 NEXT 47760 $(m_text%+5)=STR$(mptr) 47770 IF switch_vals(0)<>0 THEN ?(m_switch%+28)=(?(m_switch%+28) AND &FE) ELSE ?(m_switch%+28)=(?(m_switch%+28) OR 1) 47780 IF overwrite THEN 47790 ?(m_text%+28+24)=?(m_text%+28+24) OR 1 47800 ?(m_text%+28)=?(m_text%+28) AND &FE 47810 ELSE 47820 ?(m_text%+28+24)=?(m_text%+28+24) AND &FE 47830 ?(m_text%+28)=?(m_text%+28) OR 1 47840 ENDIF 47850=0 47860 47870DEF FNtick_program 47880 IF overwrite THEN 47890 ?(m_prog%+28+24)=?(m_prog%+28+24) OR 1 47900 ?(m_prog%+28)=?(m_prog%+28) AND &FE 47910 ELSE 47920 ?(m_prog%+28+24)=?(m_prog%+28+24) AND &FE 47930 ?(m_prog%+28)=?(m_prog%+28) OR 1 47940 ENDIF 47950 IF (listoption AND %10)<>0 THEN 47960 ?(m_listopts+28+24)=?(m_listopts+28+24) OR 1 47970 ?(m_listopts+28)=?(m_listopts+28) AND &FE 47980 ELSE 47990 ?(m_listopts+28+24)=?(m_listopts+28+24) AND &FE 48000 ?(m_listopts+28)=?(m_listopts+28) OR 1 48010 ENDIF 48020=0 48030 48040DEF FNtick_vocab 48050 IF overwrite THEN 48060 ?(m_vocab%+28+24)=?(m_vocab%+28+24) OR 1 48070 ?(m_vocab%+28)=?(m_vocab%+28) AND &FE 48080 ELSE 48090 ?(m_vocab%+28+24)=?(m_vocab%+28+24) AND &FE 48100 ?(m_vocab%+28)=?(m_vocab%+28) OR 1 48110 ENDIF 48120 FOR I%=1 TO 7 48130 IF I%=voc_sect% THEN 48140 ?(m_vocab%+28+24*(I%+4))=?(m_vocab%+28+24*(I%+4)) OR 1 48150 ELSE 48160 ?(m_vocab%+28+24*(I%+4))=?(m_vocab%+28+24*(I%+4)) AND &FE 48170 ENDIF 48180 NEXT I% 48190=0 48200 48210 48220DEF FNtick_ 48230=0 48240 48250 48260DEF FNtick_roomedit 48270REM First set the 'tick' bits for each menu item 48280flags%=VAL(FNgeticondata(roomhandle,34)) 48290FOR fl%=7 TO 0 STEP -1 48300 flag%=flags% DIV 2^fl% 48310 flags%=flags% MOD 2^fl% 48320 ptr=(m_rmflag+28+(7-fl%)*24) 48330 IF flag%=1 THEN 48340 ?ptr=?ptr OR 1 48350 ELSE ?ptr=?ptr AND %11111110 48360 ENDIF 48370NEXT fl% 48380=0 48390 48400 48410DEF FNtick_exitedit 48420REM First set the 'tick' bits for each menu item 48430flags%=?(rdata%+rptr*r_len+oldrmicon%) 48440FOR fl%=7 TO 0 STEP -1 48450 flag%=flags% DIV 2^fl% 48460 flags%=flags% MOD 2^fl% 48470 ptr=(m_exitf+28+(7-fl%)*24) 48480 IF flag%=1 THEN 48490 ?ptr=?ptr OR 1 48500 ELSE ?ptr=?ptr AND %11111110 48510 ENDIF 48520NEXT fl% 48530=0 48540 48550 48560DEF FNbutton_misc 48570icon%(THEmiscicon)=-1 48580=0 48590 48600 48610DEF FNtick_misc 48620 ptr=(miscmenu+28+48) 48630 IF datavalid THEN 48640 ?ptr = ?ptr OR 1 48650 ELSE 48660 ?ptr = ?ptr AND %11111110 48670 ENDIF 48680=0 48690 48700 48710DEF PROChelp(w,h,b) 48720LOCAL help$ 48730CASE w OF 48740WHEN -2:help$="This is the ALPS icon.|MClick SELECT to choose an editor.|MClick MENU to quit.|MDrag an 'Alps' file icon to the ALPS icon to load it." 48750WHEN ALPSmain 48760help$="Click SELECT to open the " 48770CASE h OF 48780WHEN 0:help$="Click SELECT to Save files or Set up a disk for use with ALPS." 48790WHEN 1:help$="Click SELECT to display the ALPS variables and status." 48800WHEN 2:help$+="Room Editor and enter your map details.|MClick MENU Print the room data or Import BBC room data." 48810WHEN 3:help$+="Object Editor and enter your object details.|MClick MENU to Print the objects data or Import BBC objects data." 48820WHEN 4:help$+="Message Editor.|MClick MENU to Print the messages or Import BBC messages." 48830WHEN 5:help$="This is the Alpine Software logo. It has no effect." 48840WHEN 6:help$+="Program Editor and enter the game's logic.|MClick MENU to Print the program, Import a BBC program or Run the game." 48850WHEN 7:help$+="Character Designer.|MDouble-click a 'BBC font' file to Load a character set.|MCurrent character set is saved with your game." 48860WHEN 8:help$+="Vocabulary Editor and enter nouns, verbs, adjectives etc.|MClick MENU to Print the vocabulary." 48870WHEN 9:help$="Click SELECT to swap the original data in the editors with the data values obtained during a run of the game.|MA "+CHR$128+" indicates data is original. An X indicates post-run data." 48880WHEN 10:help$+="Picture Editor and edit the picture filenames.|MClick MENU to Print the Picture list." 48890OTHERWISE help$="Click SELECT to choose an editor.|MTo load an 'Alps' file, drag its icon to this window." 48900ENDCASE 48910WHEN roomhandle 48920help$="Click SELECT to " 48930CASE h OF 48940 WHEN 1:help$+="edit the room's flags." 48950 WHEN 5:help$+="display the first room's data." 48960 WHEN 6:help$+="display the last room's data." 48970 WHEN 7:help$+="display the next room's data." 48980 WHEN 8:help$+="display the previous room's data." 48990 WHEN 9:help$+="move forward 10 rooms." 49000 WHEN 10:help$+="move back 10 rooms." 49010 WHEN 11:help$+="enter the displayed data." 49020 WHEN 12:help$+="make this the last room." 49030 WHEN 54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69:help$="Click MENU to edit the exit flags." 49040 OTHERWISE help$="" 49050ENDCASE 49060WHEN objhandle 49070 help$="Click SELECT to " 49080 CASE h OF 49090 WHEN 0:help$+="edit the object's flags." 49100 WHEN 5:help$+="display the first object's data." 49110 WHEN 6:help$+="display the last object's data." 49120 WHEN 27:help$+="display the next object's data." 49130 WHEN 16:help$+="display the previous object's data." 49140 WHEN 20:help$+="move forward 10 objects." 49150 WHEN 21:help$+="move back 10 objects." 49160 WHEN 17:help$+="enter the displayed data." 49170 WHEN 22:help$+="make this the last object." 49180 WHEN 26:help$+="create a container." 49190 OTHERWISE help$="" 49200 ENDCASE 49210WHEN texthandle 49220help$="Click SELECT to position the caret.|MClick MENU to pop up a menu.|MClick ADJUST to insert a marker." 49230WHEN design 49240help$="Click SELECT to " 49250CASE TRUE OF 49260 WHEN h=66:help$+="display next character." 49270 WHEN h=67:help$+="display previous character." 49280 WHEN h=68:help$+="choose a different character." 49290 WHEN h=64:help$="This shows the character actual size." 49300 WHEN (h>=0 AND h<64):help$+="toggle this block." 49310 OTHERWISE help$="This is the Character Designer." 49320ENDCASE 49330ENDCASE 49340b!16=&503:REM Send a message 49350b!12=ref% 49360$(b+20)=help$ 49370b!0=(((20+LEN(help$)+1)DIV4)*4)+4 49380$(b+21+LEN(help$))=CHR$(0) 49390SYS "Wimp_SendMessage",17,b 49400ENDPROC 49410 49420DEF PROCreadPalette 49430FOR col=0 TO 15 49440PROCreadpal(col,16) 49450rgb(col,1)=r%:rgb(col,2)=g%:rgb(col,3)=b% 49460NEXT 49470PROCreadpal(16,24) 49480rgb(16,1)=r%:rgb(16,2)=g%:rgb(16,3)=b% 49490FOR col=17 TO 19 49500PROCreadpal(col-16,25) 49510rgb(col,1)=r%:rgb(col,2)=g%:rgb(col,3)=b% 49520NEXT 49530ENDPROC 49540 49550DEF PROCreadpal(l%,p%) 49560REM Read the rgb values for logical/physical colour l%,p% 49570SYS ReadPal,l%,p% TO R0,R1,palette% 49580r%=(palette%>> 8)AND&FF 49590g%=(palette%>>16)AND&FF 49600b%=(palette%>>24)AND&FF 49610ENDPROC
� >$.!ALPS.!RunImage 5� Copyright Alpine Software/Philip Hawthorne 1989 *� With modifications by Keith McAlpine (!version$="5.08C, 22-Nov-1989" 2 <(� block &200,mistake 300,quitblk 100 F P-� � � 0:� �$:� ":";�:ș"Wimp_CloseDown":� Z d@%=&10:ctr%=0 nmode%=� x testing=� �Aresources_ok=�OS_Var("Alps$Resources") � �OS_Var("Alps$Data") � �ș "OS_GetEnv" � Env$ �I%=�Env$,�34,�Env$,�34)+1) �ef$=�Env$,I%+1) �ȕ �ef$,1)=" " �ef$=�ef$,2) �� � �theLastMenu = 0 : tick$="" � �type$="CF8" � � tempBlk 4 $tempBlk = "TASK" 5ș "Wimp_Initialise",200,!tempBlk,"ALPS" � ,task% " ,�� � resources_ok � � 1,"The ALPS resources are not available. Open up the directory viewer with !ALPS in it.":ș "Wimp_CloseDown",task%,!tempBlk:� 6�install_texted @ �init2 J+� � dialog=�errorbox(�$,�,1,-99):� �dtA T�new ^�assemble(armcode%) h0�fill(text_block%,text_blocksize%,dummy_spc) r#�fill(verb_type,2*(maxvbn+1),0) |�fill(nref+4,nref_size-4,0) ��fill(aref+4,aref_size-4,0) � �clear �'claimpoll$="":claimmenu$="":quit%=� � � path$=ef$ �� ef$<>"" � �$filename%=�leafname(ef$) ��load_all(ef$) �#�open(ALPSmain,400,800,600,600) �� � �� �ș Poll,,block � reason Ȏ reason � � 1: �redraw(!block) � 2: ș OpenW,,block & � 3: �close(!block) 0H � 6: �checkmouse(!block,block!4,block!8,block!12,block!16,block!20) :E � 7: �save:� User has dragged 'Alps' file icon to another window D2 � 8: �userkeypressed(!block,block!4,block!24) N% � 9: �menuselect(!block,block!4) X � 17,18: �receive(block) b � l� quit% vNș "Wimp_CloseDown",task%,!tempBlk:� testing � �("FX4"):�:�" at line ";�:� �� � �� �init2 �!�getmodeinfo:oldsize=scrnsize �data_saved=�:loaded$="" �� a_list$(10) �small_areasize%=30 �!� small_area% small_areasize% � �(� D%(3),shade%(15),scale 15,pixtr 15 �'� --------------------------------- �'� Manifest constants for the system � 2maxrms=1000:maxobs=255:maxsw%=10:maxtokens=128 listoption=2:� Default LISTO * � pos$(3) 4� I%=0 � 3:� pos$(I%):� > � T,B,L,R H R� oldpars 73 \� I%=0 � 72 f� B%:oldpars?I%=B% � &F p� z �� 0,0,0,0,0,1,161,193 �� 161,193,2,1,0,128,128,0 �� 128,0,0,128,0,1,1,1 �� 1,65,1,0,0,0,65,0 �%� 130,194,130,194,193,193,129,129 �#� 193,193,131,195,1,130,128,128 �� 2,2,66,0,1,66,3,67 �� 0,1,1,65,65,65,3,0 �� 1,1,130,130,130,2,130,2 �� 2 � �1maxlen=10:� Maximum word length in vocabulary � 3� Room and object data block lengths (in bytes) r_len=74:o_len=16 $*num_vars=60:� Number of ALPS variables ..var_size=num_vars*2:� 2 bytes per variable 8 B5maxmsg=65535:maxobn=255:maxvbn=255:maxconst=65535 LEmaxadj=255:maxprep=50:maxconj=10:maxspec=30:maxnoise=50:maxpix=50 V `noun_size=3000 jverb_size=3000 tadjc_size=2000 ~-prep_size=400:� Size of prepositions list �,conj_size=50:� size of conjunctions list �;spec_size=100:� size of 'specials' list (IT, THEM, ALL) �4noise_size=200:� size of 'noise' list (THE,A,AN) �=aref_size=2000:� size of adjective object reference table �9nref_size=2000:� size of nouns object reference table �-pix_size=1000:� size of pix filename list � Ά� nouns noun_size,verbs verb_size,adjects adjc_size,preps prep_size,conjs conj_size,specs spec_size,noise noise_size,pixs pix_size � �:� aref aref_size,nref nref_size,verb_type 2*(maxvbn+1) � �5noun_end=nouns+noun_size:verb_end=verbs+verb_size �adjc_end=adjects+adjc_size:prep_end=preps+prep_size:conj_end=conjs+conj_size:spec_end=specs+spec_size:noise_end=noise+noise_size Iaref_end=aref+aref_size:nref_end=nref+nref_size:pix_end=pixs+pix_size � Printer codes etc (condensed=15:reset=64 2pline$=�132,"-") <pline2$=�79,"-") F PK� ------- Set up data areas for rooms and objects and clear them ------ ZB� rdata% (maxrms+1)*r_len,odata% (maxobs+1)*o_len,controom% 12 d n� Set up the save buffers x+initareasize=7*(maxobs+1)+22*(maxrms+1) �=� initsave initareasize,ramsave initareasize+var_size+128 �*$controom%="0":cont_room=0:container=� � �+rptr=1:optr=1:last_room=1:last_object=1 � �&� areas to store flag descriptions �maxd%=13 �'� o_flags% maxd%*8,r_flags% maxd%*8 � �� Set the flag descriptions �� I%=7 � 0 �-1 �� flag$ �($(o_flags%+I%*maxd%)=�flag$,maxd%-1) � � I%=7 � 0 �-1 "� flag$ ,($(r_flags%+I%*maxd%)=�flag$,maxd%-1) 6� @ J� Object Flag descriptions TG� "","",Being worn,Wearable,Scenery,Invisible,Takeable,Light source ^ h� Room flag descriptions r%� "","","","","","",Visited,Light | �!� Room Exit flag descriptions �X� Invisible,Closed door,Open door,Locked door,Unl'ked door,Blocked,Reserved,Reserved � �� exit_flag$(7) �)� flag=7 � 0 �-1:� exit_flag$(flag):� � �� proc% 12,exit% 12,def% 12 � $proc%="":$def%="":$exit%="" � �8� prg_sel% = Section of program selected for editing �1� 2=Main, 3=Proc, 4=Define, 5=Exit �K� progval$ = STR$ value of proc or exit number or name of selected verb � prg_sel%=2:progval$="" <� voc_sect% = Section of vocabulary selected for editing &"� 1=Nouns, 2=Verbs 0voc_sect%=1 : D6pbsize=(scrnsize � 2)+400:� size of picture buffer N X� picbuf pbsize b lprgbsize=&1000 v� prgbuf% prgbsize � �?� ------- Some constants for the character designer ------- � �cur_chr%=�"A":max_chr%=125 �� charnum 12 �$charnum="" � �7� ------- Dimension the other arrays needed ------- �ucsize=500 �Dș "OS_File",5,"<ALPS$Resources>.ASIobjcode" � ftype,,,,codesize �pbyte_size=148 �F� armcode% 1000,pbytes pbyte_size,work% &1100,asicode% codesize+10 �� usercode% ucsize Lrun=asicode%:printmsg=asicode%+4:search=asicode%+12:findcode=asicode%+16 setup=asicode%+20 5�("LOAD <ALPS$Resources>.ASIobjcode "+�~asicode%) � pal%(2) *� q% &2000,erroraddr%(4) 4� indexdata% 32*24+20 >maxbuf%=&3000 H&� buffer% maxbuf%:curbuff%=buffer% Rnh%=32:ni%=11 \,� handle%(nh%+1),wident$(nh%),wptr%(nh%) f>� I%=0�nh%:handle%(I%)=I%-1:wident$(I%)="":�:handleSP%=nh% p � icon%(ni%+1),iconbar$(ni%) z.� I%=0 � ni%:icon%(I%)=-1:� iconbar$(I%):� �icon%(ni%+1)=-1 �oldicon%=0:oldrmicon%=0 � �8� ------ Names of icons (sprites) on icon bar ------ �L� disk35,arclogo,door,key,quill,info,listing,chardes,vocab,swap,eye,face � �0diskicon=0:texticon=4:progicon=6:staricon=99 �0vocabicon=8:faceicon=99:arcicon=1:swapicon=9 �%alpsicon=5:helpicon=13:eyeicon=10 �7THEkeyicon=3:THEdooricon=2:texticon=4:THEcharicon=7 � �.� menufree% &1800:menuend%=menufree%+&1800 �� menulist% &100 � qBlk% 256 +dx%=2:lsY%=40:ypixel%=4:chX%=16:chY%=32 %currentwindow%=-1:currenticon%=-1 $spritef$="" .9� mb_wident% 12,filename% 64,filename2% 64,import% 64 86� testing $filename%="demo" � $filename%="starter" B%$filename2%="charset":$import%="" L(� start(20),sys_b2% &300,os_block 50 V `�KeyWordRead j�ErrorMsgRead t ~9� ----- Define the "Wimp" and "OS" SYS numbers ------ �Wimp=&400C0 �CreateW=Wimp+1 �CreateI=Wimp+2 �DeleteW=Wimp+3 �DeleteI=Wimp+4 �OpenW=Wimp+5 �CloseW=Wimp+6 �Poll=Wimp+7 �RedrawW=Wimp+8 �UpdateW=Wimp+9 �GetW=Wimp+11 �GetWI=Wimp+&C SetCaret=Wimp+&12 GetCaret=Wimp+&13 GetR=Wimp+&A SetI=Wimp+&D (GetI=Wimp+&E 2GetP=Wimp+&F <Drag=Wimp+&10 FForceR=Wimp+&11 PCreateM=Wimp+&14 ZSetP=Wimp+&18 dReadPal=&2F n xF� ------ Set up our own sprite area and read the sprites in ------ �Aș "OS_File",5,"<ALPS$Resources>.AlpsSprite" � ,,,,spritesize �spritesize+=4 �� spritearea% spritesize �!spritearea%=spritesize �Bș "OS_SpriteOp",266,spritearea%,"<Alps$Resources>.AlpsSprite" �#� fontcounts% 255,mb_wident% 24 � �6� ------ Set up the wimps and their handles ------ � ��rgb(19,3) �+�loadtemplates("<Alps$Resources>.ALPS") � �+� ------ Name the window handles ------ .objhandle=handle%(�matchident("objected")) /roomhandle=handle%(�matchident("roomedit")) -texthandle=handle%(�matchident("texted")) ",design=handle%(�matchident("chrdesign")) ,+infohandle=handle%(�matchident("info")) 6-savehandle=handle%(�matchident("saveas")) @8ALPSmain=handle%(�matchident("iconbar")):dialogue%=0 J(setuph=handle%(�matchident("Setup")) Tdesticon=47:exitprogicon=48 ^ hiconbar% = -2 rwindowindex%=nh%+1 | �,�changeicon(infohandle,7,version$,dummy) � �;firstIconBarIcon% = �iconbar(spritearea%, "face",31,19) �!THEmiscicon=firstIconBarIcon% � � �&� ------ Define the colours ------ �barfgcol=11:barbgcol=3 �'`wbcol=0:`tbcol=2:`sco=&3:`mbcol=&B �(`wfcol=7:`tfcol=7:`sci=&D:`tbcol2=&C � �cur_pal%=7:phys_col%=16 � 0first_token=&30:� Lowest keyword token value W�find_token(keyword$(),"INC",var_token,dummy):� Tokens from here up allow variables 4�find_token(keyword$(),"DEFINE",def_token,dummy) &3�find_token(keyword$(),"STOP",stop_token,dummy) 01�find_token(keyword$(),"END",end_token,dummy) :3�find_token(keyword$(),"EXIT",exit_token,dummy) D6�find_token(keyword$(),"DEFPROC",proc_token,dummy) N3�find_token(keyword$(),"PREP",prep_token,dummy) X9�find_token(keyword$(),"NOTPREP",notprep_token,dummy) b l)� ------ Set up the dictionary ------ vdict_size=1000 �%� dict% dict_size,tok$(maxtokens) �!dict%=3:dict%?2=&80 � �-� ------ Find the available memory ------ �memfree=(�-�)-50000 �l� memfree<0 � null=�errorbox("Not enough memory available in 'Next' slot",0,1,-99):ș "Wimp_CloseDown":� �maxtext%=0.83*memfree �code_size%=0.17*memfree � �@� ------ Areas for storing messages, switch info etc; ------ �D� text% maxtext%,swdata% 12*maxsw%,switch_vals(maxsw%),m_msg% 12 �� switch_buf% 2*maxsw%+1 �'$swdata%=�12*maxsw%,�13):$m_msg%="" ,� ------ Initialise the text area ------ ,!text%=1:text%!2=&B:text%!6=0:text%!10=0 � st_msg% 12,end_msg% 12 *$st_msg%="1":$end_msg%="1" 4'mptr=1:� The current message number >Etext_owner$="":� The current owner of any text in the text editor H Rdatavalid=� \ f+� ------ Set up the program area ------ p� program% code_size% z!program%=0 �program%!4=0 � errflag=� � �-� ------ Set up the menu structure ------ �m_controom%=�crmenu �� "#Number,$controom%(5)" �m_contain=�crmenu �&� "Container,Use room>m_controom%" �m_chardes%=�crmenu �� "#CHANGE TO?,$charnum(2)" �char_fname%=�crmenu �"� "#Filename:,$filename2%(11)" �menu_fname%=�crmenu !� "#Filename:,$filename%(11)" m_gotomsg%=�crmenu � "$m_msg%(12)" $m_proc%=�crmenu .� "#Number:,$proc%(4)" 8m_def%=�crmenu B� "#Verb:,$def%(12)" Lm_exit%=�crmenu V� "#Number:,$exit%(4)" `m_listopts=�crmenu j=� "#Display:,Vocabulary as numbers,Vocabulary as strings" tm_import%=�crmenu ~� "#Filename:,$import%(11)" � sw1=�crmenu:nxtsw=swdata%+12 �� "#Value:,$swdata%(12)" �sw2=�crmenu:nxtsw=nxtsw+12 �� "#Value:,$nxtsw" �sw3=�crmenu:nxtsw=nxtsw+12 �� "#Value:,$nxtsw" �sw4=�crmenu:nxtsw=nxtsw+12 �� "#Value:,$nxtsw" �sw5=�crmenu:nxtsw=nxtsw+12 �� "#Value:,$nxtsw" �sw6=�crmenu:nxtsw=nxtsw+12 �� "#Value:,$nxtsw" sw7=�crmenu:nxtsw=nxtsw+12 � "#Value:,$nxtsw" sw8=�crmenu:nxtsw=nxtsw+12 � "#Value:,$nxtsw" (sw9=�crmenu:nxtsw=nxtsw+12 2� "#Value:,$nxtsw" <sw10=�crmenu:nxtsw=nxtsw+12 F� "#Value:,$nxtsw" Pm_switch%=�crmenu ZY� "#Switch,No switches,1>sw1,2>sw2,3>sw3,4>sw4,5>sw5,6>sw6,7>sw7,8>sw8,9>sw9,10>sw10" dm_text%=�crmenu n�� "#MSG: nnnnn,Insert,Overtype#,Cut,Copy,Paste#,Next,Previous,First,Last,Goto msg#>m_gotomsg%,Edit switch#>m_switch%,Print this" xm_prog%=�crmenu ��� "#Program Editor,Insert,Overtype#,Cut,Copy,Paste#,Main,Procedure>m_proc%,Define>m_def%,Exit routine#>m_exit%,Print this,List options>m_listopts" �m_vocab%=�crmenu ��� "#Vocabulary,Insert,Overtype#,Cut,Copy,Paste#,Nouns,Verbs,Adjectives,Prepositions,Conjunctions,Specials,Noise#,Print this" �pixmenu=�crmenu �� "#Pictures,Print" �progmenu=�crmenu �,� "#Program,Print,Import#>m_import%,Run" �charmenu=�crmenu �2� "#CharSet,Save>char_fname%,Load>char_fname%" �vocabmenu=�crmenu �� "#Vocabulary,Print" �diskmenu=�crmenu �-� "#Files,Save all>savehandle,Setup disk" facemenu=�crmenu � "#Actors,Print" miscmenu=�crmenu ""� "#ALPS,Info>infohandle,Quit" ,msg2%=�crmenu 6� "$st_msg%(6)" @msg3%=�crmenu J� "$end_msg%(6)" Tmsg1%=�crmenu ^/� "#From/To?,Start msg>msg2%,End msg>msg3%" htextmenu=�crmenu r*� "#Text,Print>msg1%,Import>m_import%" |objmenu=�crmenu �'� "#Objects,Print,Import>m_import%" �*mo_user5=�crmenu:ofl%=o_flags%+maxd%*3 �#� "#Description:,$o_flags%(13)" �$mo_user4=�crmenu:ofl%=ofl%+maxd% �� "#Description:,$ofl%(13)" �$mo_user3=�crmenu:ofl%=ofl%+maxd% �� "#Description:,$ofl%(13)" �$mo_user2=�crmenu:ofl%=ofl%+maxd% �� "#Description:,$ofl%(13)" �$mo_user1=�crmenu:ofl%=ofl%+maxd% �� "#Description:,$ofl%(13)" �$mo_user0=�crmenu:ofl%=ofl%+maxd% �� "#Description:,$ofl%(13)" m_objflag=�crmenu �� "#Flags,7 Light source,6 Takeable,5 Invisible,4 Scenery,3 Wearable,2 Being worn,1 User flag>mo_user1,0 User flag>mo_user0" roommenu=�crmenu &%� "#Rooms,Print,Import>m_import%" 0*mr_user6=�crmenu:rfl%=r_flags%+maxd%*2 :#� "#Description:,$r_flags%(13)" D$mr_user5=�crmenu:rfl%=rfl%+maxd% N� "#Description:,$rfl%(13)" X$mr_user4=�crmenu:rfl%=rfl%+maxd% b� "#Description:,$rfl%(13)" l$mr_user3=�crmenu:rfl%=rfl%+maxd% v� "#Description:,$rfl%(13)" �$mr_user2=�crmenu:rfl%=rfl%+maxd% �� "#Description:,$rfl%(13)" �$mr_user1=�crmenu:rfl%=rfl%+maxd% �� "#Description:,$rfl%(13)" �$mr_user0=�crmenu:rfl%=rfl%+maxd% �� "#Description:,$rfl%(13)" �m_rmflag=�crmenu ƣ� "#Flags,7 Light,6 Visited,5 User (Trans)>mr_user5,4 User (Open)>mr_user4,3 User flag>mr_user3,2 User flag>mr_user2,1 User flag>mr_user1,0 User flag>mr_user0" �m_exitf=�crmenu �|� "#Flags,7 Invisible exit,6 Closed door,5 Open door,4 Locked door,3 Unlocked door,2 Blocked exit,1 Reserved,0 Reserved" � �� � >� ------ Now we have the Procedures and Functions!! ------ � �getmodeinfo � x,y,xeig,yeig,cols * mode=� 4 >1ș "OS_ReadModeVariable",mode,1 � ,,textcols% H1ș "OS_ReadModeVariable",mode,2 � ,,textrows% Rtext_maxllen%=textcols%-2 \,ș "OS_ReadModeVariable",mode,3 � ,,cols f,ș "OS_ReadModeVariable",mode,4 � ,,xeig p,ș "OS_ReadModeVariable",mode,5 � ,,yeig z0ș "OS_ReadModeVariable",mode,7 � ,,scrnsize �*ș "OS_ReadModeVariable",mode,11 � ,,x �*ș "OS_ReadModeVariable",mode,12 � ,,y �-scrw=((x+1)<<xeig)-1:scrh=((y+1)<<yeig)-1 �� � �� �clear �$�fill(odata%,(maxobs+1)*o_len,0) �$�fill(rdata%,(maxrms+1)*r_len,0) �%�fill(program%+4,code_size%-20,0) �'� PROCfill(initsave,initareasize,0) �� � � � �return(x%,y%) �col(128+12):�col(7) >�centre(" Hit any key/button to return to the editor ",y%) $� .ȗ X%,Y%,B% 8 � B%=0 B L� Vany=�(0) `ȗ X%,Y%,B% j� any>0 � B%>0 t� ~ �� �centre(t$,r) �#�(textcols%-� t$+1) � 2,r);t$; �� � �4� ------ General window handling routines ------ � �� �deletewindow(I%) �!q%=handle%(I%) �&handle%(I%)=handleSP%:handleSP%=I% �ș DeleteW,,q% �wident$(I%)="" �� � �loadtemplates(tfile$) tmp%=0 "ș "Wimp_OpenTemplate",,tfile$ (tf_index%=0:� 2$mb_wident%="*" <tș "Wimp_LoadTemplate",,q%+4,curbuff%,buffer%+maxbuf%,fontcounts%,mb_wident%,tf_index% � ,,curbuff%,,,,tf_index% F+� tf_index%<>0 � �loadtemp($mb_wident%) P� tf_index%=0 Zș "Wimp_CloseTemplate" d� n x� �loadtemp(wident$) �8I%=�matchident(wident$):� I%<>-1 � �deletewindow(I%) �-q%!68=spritearea% : � user sprite area ��crwindow(q%+4,wident$) �� � �� �highlight(I%) �� �-ș SetCaret,handle%(I%),-1,0,0,&2000000,0 �� � �+� �retitle(handle%,newtitle$,� handle%) �index%=windowindex% �� 1 index%-=1: �index%<0 � 255,"Invalid window" � handle%(index%)=handle% !q%=handle% "ș GetWI,,q% ,ș DeleteW,,q% 6$(q%+76)=�newtitle$,11) @ș CreateW,,q%+4 � handle% Jhandle%(index%)=handle% T� ^ h� �crwindow(q%,wident$) rș CreateW,,q% � handle% |Am%=handleSP%:handleSP%=handle%(handleSP%):handle%(m%)=handle% �!q%=handle% �ș GetW,,q% �)currentwindow%=m%:wident$(m%)=wident$ �currenticon%=-1 ��highlight(m%) �� � �� �close(wind) �i%=ni%+1 � Ȏ wind � �? � objhandle:i%=THEkeyicon:� icon%(i%)<>-1 �store_obj(optr) �C � roomhandle: i%=THEdooricon:� icon%(i%)<>-1 �store_room(rptr) � � texthandle i%=texticon �remove_markers Ȏ text_owner$ � & � "texted" : �store_msg 00 � "program" : � � text_ok � �store_prog :/ � "vocab" : � � text_ok � �store_vocab D � "pix" : �store_pix N � X � � errflag � b4 text_owner$="":� release Text Editor window l5 �fill(text_block%,text_blocksize%,dummy_spc) v � � � design: i%=THEcharicon �� ��� (text_owner$="program" � errflag � wind=texthandle) � (text_owner$="vocab" � errflag � wind=texthandle) � (text_owner$="pix" � errflag � wind=texthandle) � (text_owner$="texted" � errflag � wind=texthandle) � �� � icon%(i%)=-1 � !block=wind � ș CloseW,,block �� �� � �� �open(handle,x,y,w,d) �!block=handle �block!4=x:block!8=y-d block!12=x+w:block!16=y block!20=0:block!24=0 block!28=-1 ș OpenW,,block *� 4 >� �redraw(handle) Hblock!0=handle Rș RedrawW,0,block � more% \�info(block+4) f/� handle=texthandle � dummy=�redraw_text(�) p� z �� �forceR(handle) �/� Force the given window ONLY to be redrawn ��getw(handle) �<ș ForceR,handle,scx%,scy%-(y1%-y0%),scx%+(x1%-x0%),scy% �� � �� �matchident(A$) �� A$="" � =-1 �� I% �*I%=nh%+1:�I%=I%-1:�A$=wident$(I%)�I%=0 ��A$=wident$(I%)�=I%�=-1 � �� �getw(handle%) � handle%=iconbar% � !!block=handle%:șGetW,0,block 4�info(block+4):bhandle%=block!28:flags%=block!32 $ontop=flags% � &20000 .� 8 B� �info(b) L7x0%=!b:y0%=b!4:x1%=b!8:y1%=b!12:scx%=b!16:scy%=b!20 Vbx%=x0%-scx%:by%=y1%-scy% `/gwxl%=b!24:gwyb%=b!28:gwxr%=b!32:gwyt%=b!36 j� t ~� �getpointer �șGetP,0,block �Zmousex%=!block:mousey%=block!4:b%=block!8:handle%=block!12:icon%=block!16:ob%=block!20 �� � �F� �sys_claiminputfocus(window%,icon%,xofst%,yofst%,height%,index%) �:șSetCaret, window%,icon%,xofst%,yofst%,height%,index% �� � �R� �sys_getcaretposition(� window%,� icon%,� xofst%,� yofst%,� height%,� indx%) �șGetCaret,0,b �dwindow%=!block: icon%=block!4: xofst%=block!8: yofst%=block!12: height%=block!16: indx%=block!20 �� � �cursor(x%,y%) ^�sys_claiminputfocus(texthandle,-1,(x%-1)*chX%,-y%*lsY%-9*ypixel%,&1000000 �10*ypixel%,-1) � ( 2� �text_menubox <Ȏ text_owner$ � F� "texted" P tick$="message" Z null = �tick_message dB ș CreateM,0,m_text%,mousex%-64,mousey%:claimmenu$="message" n theLastMenu = m_text% x �� "program" � tick$="program" � null = �tick_program �B ș CreateM,0,m_prog%,mousex%-64,mousey%:claimmenu$="program" � theLastMenu = m_prog% � � � "vocab" � tick$="vocab" � null = �tick_vocab �A ș CreateM,0,m_vocab%,mousex%-64,mousey%:claimmenu$="vocab" � theLastMenu = m_vocab% � �� � "<� �checkmouse(mousex%,mousey%,button%,handle%,icon%,ob%) ,�handle%=-1 � � 6�getw(handle%) @�handle%=ALPSmain � J �icon%<>-1 � T#� icon% -= firstIconBarIcon% ^ Ȏ� � h0 �(button%�1)=1 : � adjust does nothing r< �(button%�2)=2 : void=�("FNmenu_"+iconbar$(icon%)) |) �(button%�4)=4 : �openup(icon%) � � � � �� � � handle%=iconbar% � � � The RISC OS icon bar � Ȏ � � �) � (button%�2)=2 : void=�menu_misc � � (button%�4)=4 �C � icon%=firstIconBarIcon% � �open(ALPSmain,400,800,600,600) � � � � � index%=windowindex% � � 5 index%-=1: �index%<0 � 255,"Invalid window" " � handle%(index%)=handle% + void=�("FNbutton_"+wident$(index%)) & � 0� :� D N)� �userkeypressed(handle%,icon%,key%) X�getw(handle%) b�index% lindex%=windowindex% v� �index%-=1: �index%<0 � � ��handle%(index%)=handle% �)void=�("FNkeypress_"+wident$(index%)) �� � � � �menuselect(item0%,item1%) �#ș "Wimp_GetPointerInfo",,block �buTTon = block!8 �&void=�("FNmenuselect_"+claimmenu$) �� buTTon=1 � �: � *** ADJUST pressed so keep the menu structure *** � null = �("FNtick_"+tick$) �# ș CreateM,0,theLastMenu,0,0 � claimmenu$="" � � * 4*� �update(handle%,ux0%,uy0%,ux1%,uy1%) >H!block=handle%:block!4=ux0%:block!8=uy0%:block!12=ux1%:block!16=uy1% H-ș UpdateW,0,block � more%:�info(block+4) R� \ f� �openup(icon%) p� icon%(icon%)=-1 � z� � icon%<>diskicon � icon%<>texticon � icon%<>arcicon � icon%<>swapicon � icon%<>progicon � icon%<>vocabicon � icon%<>eyeicon � icon%(icon%)=icon% � Ȏ icon% � � � diskicon: �6 ș CreateM,0,diskmenu,mousex%-64,mousey% �6 � loaded$<>"" � f$=path$ � f$="AlpsFile" �/ �changeicon(savehandle,2,f$,void) �? claimmenu$="disk35":theLastMenu=diskmenu:tick$="" � � WHEN THEmiscicon: �< � *********** do nothing for this icon ******* � � texticon: � � text_owner$="" � �: �retitle(texthandle,"MESSAGES",texthandle) �1 �open(texthandle,0,1000,scrw,400) �. text_owner$="texted":text_ok=� �show_msg(mptr) � � 7 $ � . � THEdooricon: 8E �open(handle%(�matchident("roomedit")),0,720,1280,1040) B! �restore_room(rptr) L � THEkeyicon: VE �open(handle%(�matchident("objected")),850,560,800,680) ` �restore_obj(optr) j � progicon: t � text_owner$="" � ~9 �retitle(texthandle,"PROGRAM",texthandle) �1 �open(texthandle,0,1000,scrw,400) �/ text_owner$="program":text_ok=� �( �list(prg_sel%,progval$) � � � � 7 � � � � THEcharicon: �E �open(handle%(�matchident("chrdesign")),0,560,1280,860) �$ �display_chr(cur_chr%) �6 �changeicon(design,64,�(cur_chr%),dummy) � � vocabicon: � � text_owner$="" � < �retitle(texthandle,"VOCABULARY",texthandle) 1 �open(texthandle,0,1000,scrw,400) - text_owner$="vocab":text_ok=� & �list_vocab(voc_sect%) ( � 2 � 7 < � F � helpicon: P? �open(handle%(�matchident("HELP")),0,500,960,400) Z � eyeicon: d � text_owner$="" � n: �retitle(texthandle,"PICTURES",texthandle) x1 �open(texthandle,0,1000,scrw,400) �+ text_owner$="pix":text_ok=� � �list_pix � � � � 7 � � �) � arcicon:dummy=�keypress_status � � swapicon �- datavalid=� datavalid:� 7:�swap_data � � datavalid � �8 �changeicon(ALPSmain,swapicon,"swap",swapicon) � � �: �changeicon(ALPSmain,swapicon,"swap_x",swapicon) � � �forceR(ALPSmain) � � "� , 6 @J� ------ `button` routines to deal with clicks in given window ------ J T� �button_texted ^�mx%,my% h� button%<>2 � r�getpointer |)mx%=(mousex%-bx%+chX%�4) �(�(chX%-1)) �-my%=(mousey%-by%) - ((mousey%-by%) �lsY%) �text_col%=1+mx% �chX% �$text_row%=-((mousey%-by%) �lsY%) �-� text_row%>last_row% text_row%=last_row% �K� text_col%>text_rowlen%(text_row%) text_col%=text_rowlen%(text_row%)+1 �� text_col%<1 text_col%=1 �� � �Ȏ button% � �� 2 ��text_menubox �� 4 ��locate_ptr �cursor(text_col%,text_row%) � 1 � text_owner$<>"pix" � &�locate_ptr 0 � mrk<2 � :mark(mrk)=text_ptr% D)col(mrk)=text_col%:row(mrk)=text_row% Nasc(mrk)=?text_ptr% X/� asc(mrk)=13 � �23,dummy_cr � �23,chr(mrk) b?os_block=asc(mrk) lș "OS_Word",&A,os_block v� R%=1 � 8 �row_value=R%?os_block �� row_value � &FF �� �=� asc(mrk)=13 � ?text_ptr%=dummy_cr � ?text_ptr%=chr(mrk) �h�update(texthandle,chX%*(text_col%-1),-(text_row%+1)*lsY%,chX%*(text_col%-1)+chX%,-(text_row%)*lsY%) �dummy=�redraw_text(�) � mrk+=1 � �cursor(text_col%,text_row%) �� �� �� �=0 � !� �locate_ptr !text_ptr%=text_block% !� text_row%>0 � ! � R%=0 � text_row%-1 !*# text_ptr%+=text_rowlen%(R%) !47 � text_rowlen%(R%)<text_maxllen% � text_ptr%+=1 !> � !H� !Rtext_ptr%+=text_col%-1 !\/� text_ptr%>text_end% � text_ptr%=text_end% !f� !p !z� �button_objected !�Ȏ icon% � !�� 0: !� !�2� First set the 'tick' bits for each menu item !�null = �tick_objected !�Cș CreateM,0,m_objflag,mousex%-64,mousey%:claimmenu$="objected" !�tick$="objected" !�theLastMenu = m_objflag !� !�� 5:�first_obj !�� 6:�last_obj !�� 27:�next_obj !�� 16:�prev_obj "� 20:�fwd_obj(10) "� 21:�rewind_obj(10) "� 17 "$�store_obj(optr) ".%optr=�(�geticondata(objhandle,7)) "8� optr<1 � optr=1 "B� optr>maxobs � optr=maxobs "L�restore_obj(optr) "V� 22:last_object=optr "` � 26: "jDș CreateM,0,m_contain,mousex%-64,mousey%:claimmenu$="container" "ttick$="" "~theLastMenu = m_contain "� "�� "�4� optr>last_object last_object=optr:data_saved=� "�=0 "� "�� �button_roomedit "�Ȏ icon% � "�� 1: "�tick$="roomedit" "�null = �tick_roomedit "�Bș CreateM,0,m_rmflag,mousex%-64,mousey%:claimmenu$="roomedit" "�theLastMenu = m_rmflag # # � 5:�first_room #� 6:�last_room #� 7:�next_room #(� 8:�prev_room #2� 9:�fwd_room(10) #<� 10:�rewind_room(10) #F� 11 #P�store_room(rptr) #Z'rptr=�(�geticondata(roomhandle,33)) #d� rptr<1 � rptr=1 #n� rptr>maxrms � rptr=maxrms #x�restore_room(rptr) #� #�� 12:last_room=rptr #�� #�0� rptr>last_room last_room=rptr:data_saved=� #� #�8� Now check for clicking menu on selected EXITR icon #� #� Ȏ � � #� #�� icon%>53 � icon%<70 #� #�oldrmicon%=icon% #�null = �tick_exitedit $tick$="exitedit" $Aș CreateM,0,m_exitf,mousex%-64,mousey%:claimmenu$="exitedit" $theLastMenu = m_exitf $" $,� $6=0 $@ $J� �button_chrdesign $T Ȏ � � $^� icon%>=0 � icon%<64 $h) �set_icon(design,icon%,&50000000,0) $r �write_chr(cur_chr%) $| �set_icon(design,64,0,0) $�� icon%=66 $� cur_chr%+=1 $�+ � cur_chr%>max_chr% cur_chr%=max_chr% $�. �changeicon(design,64,�(cur_chr%),icon%) $� �display_chr(cur_chr%) $�� icon%=67 $� cur_chr%-=1 $� � cur_chr%<32 cur_chr%=32 $�. �changeicon(design,64,�(cur_chr%),icon%) $� �display_chr(cur_chr%) $�� icon%=68 $�D ș CreateM,0,m_chardes%,mousex%-64,mousey%:claimmenu$="chrdef" $�' theLastMenu = m_chardes%:tick$="" %� %=0 % %& %0� �button_info %:� icon%=5 � %D�close(infohandle) %N� %X=0 %b %l� �button_saveas %vȎ icon% � %�/� 0 : �save_all(�geticondata(savehandle,2)) %�� 1 : �getw(savehandle) %�. dummy$=�geticondata(savehandle,1) %�* block!4=5:block!8=block!8+bx% %�" block!12=block!12+by% %�" block!16=block!16+bx% %�" block!20=block!20+by% %�B block!24=0:block!28=0:block!32=scrw+1:block!36=scrh+1 %�% ș "Wimp_DragBox",,block %�� %�=0 %� %�� �button_Setup &Ȏ icon% � &� 0 &C� 1:�create_dirs(�geticondata(setuph,2),�geticondata(setuph,5)) & � &*�close(setuph) &4ȗ ȓ 0,0,scrw,scrh &>=0 &H &RK� ------ `keypress` routines deal with pressing key `key%` in a window &\ &f� �keypress_texted &p Ȏ � � &z-� key%=13:�newline:data_saved=�:text_ok=� &�� key%=&18F:�up &�� key%=&18E:�down &�� key%=&18D:�right &�)� key%=&18A:� I%=1 � tab_set:�right:� &�(� key%=&19A:� I%=1 � tab_set:�left:� &�� key%=&18C:�left &�3� key%=&1AB:�delete_line:data_saved=�:text_ok=� &�3� key%=&1ED:�insert_line:data_saved=�:text_ok=� &�� key%=&1AC:�left_end &�� key%=&1AD:�right_end &�:� key%=&18B:�right:�delete_char:data_saved=�:text_ok=� &�%� key%=&1CD:overwrite=� overwrite &�2� key%=127:�delete_char:data_saved=�:text_ok=� '� (key%>31) � (key%<126) '<� overwrite � �overwrite_char(key%) � �insert_char(key%) 'data_saved=�:text_ok=� '$ ș "Wimp_ProcessKey",key% '.� '8 'B �cursor(text_col%,text_row%) 'L=0 'V '`� �keypress_saveas 'jQ� key%=13 � �save_all(�geticondata(savehandle,2)) � ș "Wimp_ProcessKey",key% '~=0 '� '�� �keypress_objected '�� key%=13 � icon%=7 � '� �store_obj(optr) '�+ optr=�(�geticondata(objhandle,icon%)) '� � optr<1 � optr=1 '�! � optr>maxobs � optr=maxobs '� �restore_obj(optr) '�� '� '� Ȏ key% � '�$� 13,&18E:� Return or down arrow ( � icon%<15 � ( icon%+=1 (� ( icon%=7 ((� (2� &18F:� Up arrow (<� icon%>7 � (F icon%-=1 (P� (Z icon%=15 (d� (n ș "Wimp_ProcessKey",key% (x� (�Q�sys_claiminputfocus(objhandle,icon%,0,0,-1,�(�geticondata(objhandle,icon%))) (�=0 (� (�� �keypress_roomedit (� Ȏ key% � (�� 13,&18E,&18F (� (�� key%=13 � icon%=33 � (� �store_room(rptr) (�, rptr=�(�geticondata(roomhandle,icon%)) (� � rptr<1 � rptr=1 (�! � rptr>maxrms � rptr=maxrms (� �restore_room(rptr) )� ) )� key%=13 � key%=&18E � )" Ȏ � � ),� icon%=37:newicon%=71 )6� icon%=71:newicon%=38 )@� icon%=69:newicon%=33 )J� icon%<37:newicon%=icon%+1 )T-� (icon%>37 � icon%<54):newicon%=icon%+16 )^-� (icon%>53 � icon%<69):newicon%=icon%-15 )h� )r� )| )�� key%=&18F � )� Ȏ � � )�� icon%=71:newicon%=37 )�� icon%=38:newicon%=71 )�� icon%=33:newicon%=69 )�� icon%>33:newicon%=icon%-1 )�-� (icon%>37 � icon%<54):newicon%=icon%-16 )�-� (icon%>53 � icon%<69):newicon%=icon%+15 )�� )�� )� )� ș "Wimp_ProcessKey",key% )�� )�Y�sys_claiminputfocus(roomhandle,newicon%,0,0,-1,�(�geticondata(roomhandle,newicon%))) *=0 * *� �keypress_status *&�col(128+2) *0 � 26,4,12 *:�col(9):�col(128+7) *D<�centre(�27," ")+"System Status Information"+�28," "),0) *N�col(128+2):�col(7) *X�status *b�col(128+7):�col(9) *l5�centre(�31," ")+"Integer Variables"+�32," "),10) *v�col(128+2):�col(7) *� �lvar *��:�return(18,31):� *� � 26,5 *�"ș ForceR,-1,0,0,scrw+1,scrh+1 *�=0 *� *�� �keypress_chrdef *�� key%=13 � icon%=64 � *�*cur_chr%=�(�geticondata(design,icon%)) *��display_chr(cur_chr%) *�,�changeicon(design,64,�(cur_chr%),icon%) *�� *�*� key%<>13 � ș "Wimp_ProcessKey",key% *�� *�=0 *� +� �keypress_Setup +0� key%=&18E � key%=13 � icon%=2 � newicon%=5 +7� key%=13 � icon%=5 � icon%=1:void=�button_Setup:=0 + &� key%=&18E � icon%=5 � newicon%=2 +*&� key%=&18F � icon%=5 � newicon%=2 +4&� key%=&18F � icon%=2 � newicon%=5 +5D� key%<>13 � key%<>&18E � key%<>&18F � ș "Wimp_ProcessKey",key% +>Q�sys_claiminputfocus(setuph,newicon%,0,0,-1,�(�geticondata(setuph,newicon%))) +H=0 +R +\A� ------ The `menu` routines to open the selected menu ------ +f +p� �menu_ +z=0 +� +�� �menu_swap +�=0 +� +�� �menu_arclogo +�=0 +� +�� �menu_info +�=0 +� +� +�� �menu_disk35 +�,ș CreateM,0,diskmenu,mousex%-64,mousey% ,,� loaded$<>"" � f$=path$ � f$="AlpsFile" ,%�changeicon(savehandle,2,f$,void) ,theLastMenu= diskmenu ,$ claimmenu$="disk35":tick$="" ,.=0 ,8 ,B ,L� �menu_key ,V+ș CreateM,0,objmenu,mousex%-64,mousey% ,`theLastMenu = objmenu ,jclaimmenu$="key":tick$="" ,t=0 ,~ ,�� �menu_door ,�,ș CreateM,0,roommenu,mousex%-64,mousey% ,�theLastMenu = roommenu ,�claimmenu$="door":tick$="" ,�=0 ,� ,�� �menu_quill ,�$end_msg%=�(�maxmsg) ,�,ș CreateM,0,textmenu,mousex%-64,mousey% ,�theLastMenu = textmenu ,�claimmenu$="quill":tick$="" ,�=0 - - -� �menu_listing -,ș CreateM,0,progmenu,mousex%-64,mousey% -(theLastMenu = progmenu -2!claimmenu$="listing":tick$="" -<=0 -F -P -Z� �menu_chardes -d=0 -n,ș CreateM,0,charmenu,mousex%-64,mousey% -xtheLastMenu = charmenu -�!claimmenu$="chardes":tick$="" -�=0 -� -�� �menu_vocab -�-ș CreateM,0,vocabmenu,mousex%-64,mousey% -�theLastMenu = vocabmenu -�$claimmenu$="vocabulary":tick$="" -�=0 -� -�� �menu_face -�,ș CreateM,0,facemenu,mousex%-64,mousey% -�theLastMenu = facemenu -� claimmenu$="actors":tick$="" .=0 . .� �menu_misc ."null = �tick_misc .,<ș CreateM,0,miscmenu,mousex%-64,�menuHeight(miscmenu,1) .6theLastMenu = miscmenu .@"claimmenu$="misc":tick$="misc" .J=0 .T .^� �menu_help .h=0 .r .| .�� �menu_eye .�+ș CreateM,0,pixmenu,mousex%-64,mousey% .�theLastMenu = pixmenu .�claimmenu$="eye":tick$="" .�=0 .� .� .�J� `menuselect` functions - called when a selection is made from a menu .�D� `item0%` is the number of selection from first menu (0,1,2...) .�E� `item1%` is the number of selection from second menu (0,1,2...) .� .�� �menuselect_ .�=0 / / /� �menuselect_message /&� changed_msg /0 /:Ȏ item0% � /D � -1 /N! � 0,1:overwrite=� overwrite /X& � 2:�cut(mark(0),mark(1),picbuf) /b' � 3:�copy(mark(0),mark(1),picbuf) /l" � 4:�paste(text_ptr%,picbuf) /v � 5:�next_msg /� � 6:�prev_msg /� � 7:�first_msg /� � 8:�last_msg /� � 9:�goto_msg(�($m_msg%)) /� � 10 /� � item1%>-1 � /� � item1%=0 � /� � I%=0 � maxsw% /� switch_vals(I%)=0 /� � I% /� � /�7 switch_vals(item1%)=�($(swdata%+12*(item1%-1))) /�7 � item1%>switch_vals(0) � switch_vals(0)=item1% 06 � switch_vals(0) stores the number of switches 0 � 0 � 11 0 *FX3,10 0* �print_msg(mptr) 04 *FX3,0 0>� 0H�forceR(texthandle) 0R� changed_msg � 0\text_row%=0:text_col%=1 0f�cursor(1,0) 0p� 0z� claimmenu$="" 0�=0 0� 0�� �cut(start,end,buf) 0�� mrk<2 � � 1,error$(29) 0�Q� end<start � Ȕ start,end:Ȕ col(0),col(1):Ȕ row(0),row(1):Ȕ asc(0),asc(1) 0�cliplen=end-start+1 0��move(start,buf,cliplen) 0�&� SYS"Wimp_CloseDown":MODE 12:STOP 0�;�move(end+1,start,text_end%-end):� was +1 until 16.6.89 0�&?buf=asc(0):buf?(cliplen-1)=asc(1) 0�text_end%=text_end%-cliplen 0�� asc(1)=0 � text_end%+=1 0�+� Restore end marker if it has been cut 13� text_end%<text_block% � text_end%=text_block% 1?text_end%=0 1last_row%=�find_lastrow 1$� I%=0 � last_row% 1.text_rowlen%(I%)=��row(I%) 18� 1Bmrk=0:mark()=+0 1L/� text_row%>last_row% � text_row%=last_row% 1VM� text_col%>text_rowlen%(text_row%) � text_col%=text_rowlen%(text_row%)+1 1`,�locate_ptr:�cursor(text_col%,text_row%) 1jdata_saved=�:text_ok=� 1t� 1~ 1�� �copy(start,end,buf) 1�� mrk<2 � � 1,error$(29) 1�Q� end<start � Ȕ start,end:Ȕ col(0),col(1):Ȕ row(0),row(1):Ȕ asc(0),asc(1) 1�cliplen=end+1-start 1��move(start,buf,cliplen) 1�&?buf=asc(0):buf?(cliplen-1)=asc(1) 1�-?start=asc(0):?end=asc(1):mrk=0:mark()=+0 1�� 1� 1�� �paste(to,from) 1� � cliplen=0 � � 1,error$(30) 1�'�move(to,to+cliplen,text_end%-to+1) 2 �move(from,to,cliplen) 2 text_end%+=cliplen 2last_row%=�find_lastrow 2� I%=0 � last_row% 2(text_rowlen%(I%)=��row(I%) 22� 2<,�locate_ptr:�cursor(text_col%,text_row%) 2Fdata_saved=�:text_ok=� 2P� 2Z 2d� �menuselect_program 2n errflag=� 2x� item0%>4 � item0%<9 � 2��remove_markers 2�� � text_ok � �store_prog 2�prg_sel%=item0%-3 2�text_row%=0:text_col%=1 2��cursor(1,0) 2�� 2� 2�Ȏ item0% � 2�� 0,1:overwrite=� overwrite 2�$� 2:�cut(mark(0),mark(1),picbuf) 2�%� 3:�copy(mark(0),mark(1),picbuf) 2� � 4:�paste(text_ptr%,picbuf) 2�� 5:progval$="" 3� 6:progval$=$proc% 3� 7:progval$=$def% 3� 8:progval$=$exit% 3"� 9:�print_prog_seg 3,� 10:�listo 36� 3@ 3J� (item0%>4 � item0%<9) � 3T � � errflag � 3^ �list(item0%-3,progval$) 3h �forceR(texthandle) 3r � 3|� 3�� (item0%>1 � item0%<5) � 3��forceR(texthandle) 3�� 3�� item0%=10 � 3�� � text_ok � �store_prog 3�� � errflag � 3�text_row%=0:text_col%=1 3��cursor(1,0) 3��list(prg_sel%,progval$) 3��forceR(texthandle) 3�� 3�� 3�=0 4 4� �menuselect_vocab 46� Make a selection from the vocabulary editor menu 4&Ȏ item0% � 40� 0,1:overwrite=� overwrite 4:$� 2:�cut(mark(0),mark(1),picbuf) 4D%� 3:�copy(mark(0),mark(1),picbuf) 4N � 4:�paste(text_ptr%,picbuf) 4X� 5,6,7,8,9,10,11 4b$�remove_markers:� Added 23.08.89 4l� � text_ok � �store_vocab 4v� � errflag � 4�voc_sect%=item0%-4 4��list_vocab(voc_sect%) 4�text_row%=0:text_col%=1 4��cursor(1,0) 4�� 4�� 12:�print_prog_seg 4�� 4�Ȏ item0% � 4�� 2,3,4,5,6,7,8,9,10,11 4��forceR(texthandle) 4�� 4�� claimmenu$="" 4�=0 5 5� �menuselect_exitedit 5xerr%=� 5 � oldrmicon%<>0 � 5*) ptr%=(rdata%+rptr*r_len+oldrmicon%) 54 flags%=?ptr% 5> cl_door%=flags% � &40 5H op_door%=flags% � &20 5R lk_door%=flags% � &10 5\ unlk_door%=flags% � &8 5f% � cl_door% � item0%=2 � xerr%=� 5p% � op_door% � item0%=1 � xerr%=� 5z% � op_door% � item0%=3 � xerr%=� 5�' � unlk_door% � item0%=3 � xerr%=� 5�% � lk_door% � item0%=4 � xerr%=� 5�% � lk_door% � item0%=2 � xerr%=� 5� � xerr% � 5� � 7 5� � 5�# ?ptr%=?ptr% � (&80 >> item0%) 5� � � lk_door% � item0%=3 � 5�+ ?ptr%=?ptr% � %11011111 � %01000000 5� � 5� � lk_door% � item0%=1 � 5� ?ptr%=?ptr% � %11101111 5� � 6 � 6 data_saved=� 6� 6$� claimmenu$="" 6.=0 68 6B� �menuselect_disk35 6LȎ item0% � 6V � 0 6`( path$=�geticondata(savehandle,2) 6j$ ș "OS_File",5,path$ � ftype 6te � ftype=0 � �save_all(path$) � �ensure(item0%,"This file exists. Do you want to replace it?") 6~ � 1 6�* �load_bits(�geticondata(setuph,2)) 6� �setup_disk(item0%) 6�� 6�&icon%(diskicon)=-1:� claimmenu$="" 6�=0 6� 6� 6� 6�� �menuselect_objected 6�+old_flags%=�(�geticondata(objhandle,8)) 6�+new_flags%=old_flags% � (&80 >> item0%) 6�0�changeicon(objhandle,8,�(new_flags%),dummy) 7 � claimmenu$="" 7 =0 7 7� �menuselect_container 7(Ȏ item0% � 72� 0 7<container=� container 7F� container � 7P.�changeicon(objhandle,26,"SIZE <C>",dummy) 7Z� 7d*�changeicon(objhandle,26,"SIZE",dummy) 7n� 7x� 1 7�cont_room=�($controom%) 7�� 7�� data_saved=FALSE 7�� claimmenu$="" 7�=0 7� 7�� �menuselect_roomedit 7�-old_flags%=�(�geticondata(roomhandle,34)) 7�+new_flags%=old_flags% � (&80 >> item0%) 7�2�changeicon(roomhandle,34,�(new_flags%),dummy) 7�� claimmenu$="" 7�=0 7� 8� �menuselect_key 8Ȏ item0% � 8 � 0:�print_objs 8"$ � 1:�import_obj("O."+$import%) 8,� 86� claimmenu$="" 8@=0 8J 8T� �menuselect_door 8^Ȏ item0% � 8h � 0:�print_rooms 8r& � 1:�import_rooms("R."+$import%) 8|� 8�� claimmenu$="" 8�=0 8� 8�� �menuselect_quill 8�Ȏ item0% � 8� � 0:�print_text 8�% � 1:�import_text("T."+$import%) 8�& �load_dict("D."+$import%) 8�� 8�� claimmenu$="" 8�=0 8� 8�� �menuselect_listing 9Ȏ item0% � 9 � 0:�print_program 9 � 1:�convert($import%) 9& � 2:�run 90� 9:� claimmenu$="" 9D=0 9N 9X� �menuselect_chardes 9b2� When `menu` is clicked on the `chardes` icon 9lȎ item0% � 9v5� 0:�save_chars("<Users$Resources>."+$filename2%) 9�� 1 9�,�("PRINT <Alps$Resources>."+$filename2%) 9��display_chr(cur_chr%) 9�"ș ForceR,-1,0,0,scrw+1,scrh+1 9�� 9�� claimmenu$="" 9�=0 9� 9�� �menuselect_chrdef 9�K� When button is clicked on the `SELECT` icon in the char design window 9�chr%=�($charnum) 9� � chr%>31 � chr%<=max_chr% � 9� cur_chr%=chr% :. �changeicon(design,64,�(cur_chr%),icon%) : �display_chr(cur_chr%) :� : � claimmenu$="" :*=0 :4 :>� �menuselect_vocabulary :H-� When SELECT pressed in small vocab menu :RȎ item0% � :\� 0:�print_vocab :f� :p� claimmenu$="" :z=0 :� :�� �menuselect_actors :�2� SELECT pressed in small 'face' menu (Actors) :�Ȏ item0% � :�� 0:�print_actors :�� :�� claimmenu$="" :�=0 :� :�� �menuselect_eye :�3� SELECT pressed in small 'eye' menu (Pictures) :�Ȏ item0% � :�� 0:�print_pix ;� ;� claimmenu$="" ;=0 ;$ ;.� �menuselect_misc ;8Ȏ item0% � ;B � 1: � quit ;L �quit(4) ;V � ;`icon%(THEmiscicon)=-1 ;j=0 ;t ;~ ;�D� ------ Utility procedures and functions for each editor ------ ;� ;�0� ------ Character designer utilities ------ ;� ;�� �write_chr(C%) ;�� 23,C% ;�� row%=0 � 7 ;�row_value=0 ;�� col%=0 � 7 ;�-dummy=�(�geticondata(design,row%*8+col%)) ;�bit=flags% >>> 28 ;�,� bit=7 � row_value=row_value+2^(7-col%) <