Home » Archimedes archive » Archimedes World » AW-1992-09.adf » AWSept92 » !AWSept92/Goodies/Wimp/!FormEd/!RunImage
!AWSept92/Goodies/Wimp/!FormEd/!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 » Archimedes archive » Archimedes World » AW-1992-09.adf » AWSept92 |
| Filename: | !AWSept92/Goodies/Wimp/!FormEd/!RunImage |
| Read OK: | ✔ |
| File size: | 11474 bytes |
| Load address: | 0000 |
| Exec address: | 0000 |
File contents
10REM > <FormEd$Dir>.!FormEd.!RunImage
20REM ******************************************************************
30REM * *
40REM * Title : FormEd *
50REM * Description : Template Editor - for use with Applications *
60REM * Version : 1.36 *
70REM * *
80REM ******************************************************************
90ON ERROR ERROR EXT ERR, REPORT$+" at line "+STR$(ERL)
100SYS"Hourglass_On"
110SYS "OS_GetEnv" TO commandstring$
120DIM fontcounts% 255
130FOR I%=0 TO 255:fontcounts%?I%=0:NEXT
140REM -- Start Wimp going
150DIM taskid%4:$taskid%="TASK"
160SYS "Wimp_Initialise",200,!taskid%,"FormEd" TO version%
170ON ERROR PROCerrordisplay: REM after calling Wimp_Initialise!
180 `wbcol=&0:`tbcol=&D:`sco=&3:`mbcol=&B
190 `wfcol=&7:`tfcol=&7:`sci=&D:`tbcol2=&C
200REM ******************************************************************
210REM ** Gobal Variables *
220REM ******************************************************************
230 tsloss = FALSE
240 _altered = FALSE
250 _prequit = FALSE
260 _biconx% = 10
270 _bicony% = -50
280 _RESET% = FALSE
290 _QUIT% = FALSE
300 _noid% = 0
310 bodgeit% = FALSE
320 DIM _titlestring% 257
330 DIM _wid$(49)
340 DIM _win%(49)
350 DIM _temp% 20
360 DIM _data% 50
370 DIM _BUF100% 100
380 DIM _SPRDIA% 15
390 DIM _SPRWIN% 15
400 $_SPRDIA% = "ssmldialog"+CHR$(0)
410 $_SPRWIN% = "ssmlformed"+CHR$(0)
420 $_titlestring% = "<untitled>"
430REM ******************************************************************
440DIM inv% 27,outv% 23
450DIM px2% 1,px4% 3,px256% 255
460PROCgetmodeinfo
470switched%=FALSE
480DIM factors% 15
490DIM pixtrans% 15
500REM -- dimension arrays
510DIM pal%(2),bright%(15),uncolour%(15)
520DIM q% &2000,erroraddr%(4),oldq% &100
530DIM indexdata% 48*24+20,fontbinding% 255
540maxbuf%=&6000
550DIM buffer% maxbuf%:curbuff%=buffer%:_sloss%=buffer%
560nh%=48
570DIM handle%(nh%+1),wident$(nh%),wptr%(nh%),wlink%(nh%),wflag%(nh%)
580FOR I%=0TOnh%:handle%(I%)=I%-1:wident$(I%)="":_wid$(I%)="*":NEXT:handleSP%=nh%
590DIM spritename% 12
600DIM menulist% &100
610brx%=400:bry%=740
620currentwindow%=-1:currenticon%=-1:dialogue%=-1
630spritef$=""
640DIM errbuf% 150
650templatef$="Templates"
660DIM mb_crsprite% 12,mb_rnsprite% 12
670nsp=80:ns%=10
680DIM spw%(nsp),sph%(nsp),spwx%(nsp),minx%(nsp),miny%(nsp),spname$(nsp)
690DIM spritew%(ns%+1),nsprite%(ns%)
700DIM spritei%(ns%),sprxscale%(ns%),spryscale%(ns%),spriten$(ns%)
710FOR I%=0TOns%:spritew%(I%)=I%-1:spriten$(I%)="":NEXT:sprSP%=ns%:sprSP2%=-1
720SYS "OS_File",5,"<FormEd$Dir>.Sprites" TO type%,,,,systemareasize%
730IF type%<>1 THEN ERROR 0,"Can't find <FormEd$Dir>.Sprites"
740systemareasize%+=4
750DIM systemsprites% systemareasize%
760systemsprites%!0=systemareasize%
770IF MODE = 23 THEN
780 SYS "OS_SpriteOp",&10A,systemsprites%,"<FormEd$Dir>.Sprites23"
790ELSE
800 SYS "OS_SpriteOp",&10A,systemsprites%,"<FormEd$Dir>.Sprites"
810ENDIF
820spriteareasize%=HIMEM-END-32*1024:REM was 16
830DIM spritearea% spriteareasize%
840!spritearea%=spriteareasize%:spritearea%!8=16
850SYS "OS_SpriteOp",&109,spritearea%
860_bob% = OPENIN("<FormEd$Dir>.Default")
870IF NOT(_bob% = 0) THEN PROCloadsprites("<FormEd$Dir>.Default")
880CLOSE#_bob%
890spritef$="Sprites"
900undoname$="":undoscreen%=-1:editbuffer%=-2
910REM -- Create windows
920PROCdefaultwindows
930DIM paltable% 79:SYS "Wimp_ReadPalette",,paltable%
940palcolour%=7
950sprcolour%=7
960paintmode%=16
970grid%=FALSE
980REM -- Create Menus
990PROCmsg_initialise("<FormEd$Dir>.Messages")
1000PROCcreate_menus
1010ic_window% = FNiconbar
1020REM -- if command was '*FormEd <filename>', load a template file
1030I%=INSTR(commandstring$," -quit ")
1040IF I% THEN
1050 I%+=LEN" -quit "
1060 WHILE MID$(commandstring$,I%,1)=" ":I%+=1:ENDWHILE
1070 REPEAT
1080 I%=INSTR(commandstring$+" "," ",I%+1)
1090 REPEATI%+=1:UNTILMID$(commandstring$,I%,1)<>" "
1100 f$=MID$(commandstring$,I%)
1110 f$=LEFT$(f$,INSTR(f$+" "," ")-1)
1120 IF f$<>"" THEN
1130 CASE FNfiletype(f$) OF
1140 WHEN &FEC: _init% = 0:PROCloadtemplates(f$):
1150 $_titlestring% = f$
1160 $mb_templates% = f$
1170 PROCchangewindowtitle(browbox%,_titlestring%)
1180 PROCfront(browbox%)
1190 WHEN &FF9:PROCloadsprites(f$)
1200 WHEN -2: ERROR 0,"File '"+f$+"' not found"
1210 OTHERWISE ERROR 0,"File '"+f$+"' is not a sprite file or template file"
1220 ENDCASE
1230 ENDIF
1240 UNTIL f$=""
1250ENDIF
1260SYS"Hourglass_Off"
1270REM -- Error handler - drops through to Wimp_Poll
1280saveref%=-1
1290scrapref%=-1
1300dragtype%=0
1310inerror%=FALSE
1320oldhelp%=1:_init% = 1
1330ON ERROR PROCerrordisplay
1340REM -- Main Polling loop
1350REPEAT
1360SYS "Wimp_Poll",1,q% TO action%
1370CASE action% OF
1380WHEN 1: REM ****************** Redraw event ****************
1390 PROCredraw(!q%)
1400WHEN 2: REM ****************** Open event ******************
1410 PROCopen(!q%,q%!4,q%!8,q%!12,q%!16,q%!20,q%!24,q%!28)
1420 PROCchck_handle(!q%)
1430WHEN 3: REM ****************** Close event *****************
1440 PROCclose(!q%)
1450WHEN 6: REM ****************** Click event ***********
1460 PROCmouse(!q%,q%!4,q%!8,q%!12,q%!16,q%!20)
1470WHEN 7: REM ****************** User Draw event *************
1480 PROCdecodedrag(!q%,q%!4,q%!8,q%!12)
1490WHEN 8: REM ****************** Key Pressed event ***********
1500 key%=q%!24
1510 PROCprocesskey(q%!0,q%!4,key%)
1520WHEN 9: REM ****************** Menu Selection event ********
1530 I%=0:REPEATmenulist%!I%=q%!I%:I%=I%+4:UNTILq%!(I%-4)=-1
1540 PROCdecodemenu(menuhandle%,menulist%)
1550 PROCgetpointer:IF buttons%AND1 THEN PROCremenu
1560WHEN 10: REM ***************** Scroll Request event ********
1570 PROCopen(!q%,q%!4,q%!8,q%!12,q%!16,q%!20+q%!32*32,q%!24+q%!36*32,q%!28)
1580WHEN 17,18: REM ****** user message & recorded **************
1590 PROCreceive(q%)
1600ENDCASE
1610UNTIL FALSE
1620DEF PROCreceive(q%)
1630FOR I%=0 TO !q%-1 STEP4:oldq%!I%=q%!I%:NEXT
1640CASE q%!16 OF
1650WHEN 0: REM ** Quit From Message ********************
1660 PROCfinish:END
1670WHEN 1:CASE q%!40 OF
1680 WHEN &FF9,&FEC: REM do the scrap file business
1690 SYS "XOS_ReadVarVal","Wimp$Scrap",,-1,0,3 TO ,,exists%
1700 IF exists%=0 THEN ERROR 1,"<Wimp$Scrap> not defined"
1710 q%!36=-1:PROCstring0(q%+44,"<Wimp$Scrap>")
1720 !q%=(48+LEN"<Wimp$Scrap>")ANDNOT3
1730 q%!12=q%!8:q%!16=2:SYS "Wimp_SendMessage",17,q%,q%!4
1740 scrapref%=q%!8
1750 ENDCASE
1760WHEN 2:IF q%!12<>saveref% THEN ERROR 1,"Unexpected DataSave packet received"
1770 _saving% = TRUE
1780 CASE q%!40 OF
1790 WHEN &FEC:PROCsavetemplates(FNstring0(q%+44),q%!36<>-1)
1800 OTHERWISE:ERROR 1,"Unexpected DataSave filetype received"
1810 ENDCASE
1820 oldq%!12=oldq%!8:oldq%!16=3:SYS "Wimp_SendMessage",17,oldq%,oldq%!4
1830 _saving% = FALSE
1840WHEN 3:_tmp$ = FNstring0(q%+44)
1850 CASE q%!40 OF
1860 WHEN &FEC: REM ******** Message_DataLoad 3 **********
1870 _cchange% = FALSE
1880 IF LEFT$($_titlestring%,4) = LEFT$("<untitled>",4) THEN
1890 $mb_templates%=FNstring0(q%+44):$_titlestring%=FNstring0(q%+44)
1900 IF _altered THEN $_titlestring% += " *"
1910 ELSE
1920 IF NOT_altered THEN
1930 PROCaddchange(_titlestring%)
1940 ENDIF
1950 ENDIF
1960 PROCloadtemplates(_tmp$)
1970 PROCfront(browbox%)
1980 PROCchangewindowtitle(browbox%,_titlestring%)
1990 WHEN &FF9:IF q%!20=-2 THEN
2000 PROCloadsprites(FNstring0(q%+44))
2010 ELSE PROCmergesprites(FNstring0(q%+44))
2020 ENDIF
2030 OTHERWISE:ENDPROC
2040 ENDCASE
2050 IF oldq%!12=scrapref% THEN *Delete <Wimp$Scrap>
2060 oldq%!12=oldq%!8:oldq%!16=4:SYS "Wimp_SendMessage",17,oldq%,oldq%!4
2070WHEN 5:IF q%!40 = &FEC THEN
2080 IF NOT(_altered)ANDLEFT$($_titlestring%,4)=LEFT$("<untitled>",4) THEN
2090 $_titlestring% = FNstring0(q%+44)
2100 PROCloadtemplates(FNstring0(q%+44))
2110 $mb_templates% = $_titlestring%
2120 PROCchangewindowtitle(browbox%,_titlestring%)
2130 PROCfront(browbox%)
2140 oldq%!12=oldq%!8:oldq%!16=4:
2150 SYS "Wimp_SendMessage",17,oldq%,oldq%!4
2160 ELSE
2170 REM oldq%!12=oldq%!8:oldq%!16=4
2180 REM SYS "Wimp_SendMessage",17,oldq%,oldq%!4
2190 REM ERROR 1, " Unsaved Template File "
2200 ENDIF
2210 ENDIF
2220WHEN 8: REM **************** Message_PreQuit **********************
2230 IF _altered THEN
2240 PROCobjectclosedown
2250 ENDIF
2260WHEN &400C0:
2270 CASE menuhandle% OF
2280 WHEN w_general%
2290 CASE q%!32 OF
2300 WHEN 1:
2310 CASE q%!36 OF
2320 WHEN 14,15: PROCtickpalette(i_flags%!(36+24*q%!36)>>28)
2330 ENDCASE
2340 WHEN 7: PROCtickpalette(w_colours%!(36+24*q%!36)>>28)
2350 ENDCASE
2360 ENDCASE
2370 SYS "Wimp_CreateSubMenu",,q%!20,q%!24,q%!28
2380WHEN &400C1:PROCgetmodeinfo
2390ENDCASE
2400ENDPROC
2410DEF PROCtickpalette(colour%)
2420LOCAL I%
2430IFcolour%<16 THEN
2440 FOR I%=m_palette%+28 TO m_palette%+28+24*15 STEP 24:!I%=!I%ANDNOT1:NEXT
2450 I%=m_palette%+28+24*colour%:!I%=!I%OR1
2460ENDIF
2470IFcolour%=255 colour%=16
2480FOR I%=m_p1lette%+28 TO m_p1lette%+28+24*16 STEP 24:!I%=!I%ANDNOT1:NEXT
2490I%=m_p1lette%+28+24*colour%:!I%=!I%OR1
2500ENDPROC
2510DEF PROCsendsave(ft%,fn%)
2520LOCAL filename%
2530REPEATfilename%=fn%:fn%+=INSTR($fn%,"."):UNTIL fn%=filename%
2540PROCgetpointer : REM sets up handle%,icon%,mousex%,mousey%
2550IF handle% = m_savetemp% OR handle% = browbox% THEN ENDPROC
2560 SYS "Wimp_CreateMenu",,-1:
2570!q%=(48+LEN$filename%)ANDNOT3
2580q%!12=0:q%!16=1
2590q%!20=handle%:q%!24=icon%:q%!28=mousex%:q%!32=mousey%
2600q%!36=0 : REM file size (inaccurate)
2610q%!40=ft% : REM file type
2620PROCstring0(q%+44,$filename%)
2630SYS "Wimp_SendMessage",17,q%,handle%,icon%
2640saveref%=q%!8
2650ENDPROC
2660DEF FNstring0(a%) LOCALa$:a$="":WHILE ?a%:a$+=CHR$?a%:a%+=1:ENDWHILE:=a$
2670DEF PROCstring0(a%,a$) $a%=a$:a%?LENa$=0:ENDPROC
2680DEF PROCgetmodeinfo
2690inv%!0 = 4
2700inv%!4 = 5
2710inv%!8 = 6
2720inv%!12= 7
2730inv%!16= 11
2740inv%!20= 12
2750inv%!24= -1
2760SYS "OS_ReadVduVariables",inv%,outv%
2770dx%=1<<(outv%!0)
2780dy%=1<<(outv%!4)
2790linelen%=outv%!8
2800screensize%=outv%!12
2810scrx1%=(outv%!16+1)*dx%
2820scry1%=(outv%!20+1)*dy%
2830ENDPROC
2840DEF PROCredraw(handle%)
2850!q%=handle%
2860SYS "Wimp_RedrawWindow",,q% TO more%
2870PROCinfo(q%+4)
2880CASE handle% OF
2890OTHERWISE:PROCtestpattern
2900ENDCASE
2910ENDPROC
2920DEF PROCtestpattern
2930LOCALdx%:dx%=48
2940WHILE more%
2950x0%=q%!28:y0%=q%!32:x1%=q%!36:y1%=q%!40
2960minx0%=x0%-(by%-y0%):maxx0%=x1%-(by%-y1%)
2970minx1%=x0%+(by%-y1%):maxx1%=x1%+(by%-y0%)
2980minx0%=(minx0%-bx%+10000)DIVdx%*dx%+bx%-10000
2990minx1%=(minx1%-bx%+10000)DIVdx%*dx%+bx%-10000
3000FORx%=minx0%TOmaxx0%STEPdx%:MOVEx%,by%:PLOT1,1280,-1280:NEXT
3010FORx%=minx1%TOmaxx1%STEPdx%:MOVEx%,by%:PLOT1,-1280,-1280:NEXT
3020SYS "Wimp_GetRectangle",,q% TO more%
3030ENDWHILE
3040ENDPROC
3050DEF PROCfront(handle%)
3060IF handle% = quitbox% THEN
3070 SYS "Wimp_CreateMenu",,quitbox%,300,640
3080 ENDPROC
3090ENDIF
3100!q%=handle%:SYS "Wimp_GetWindowState",,q%
3110q%!28=-1:SYS "Wimp_OpenWindow",,q%
3120ENDPROC
3130DEF PROCgetw(handle%)
3140!q%=handle%:SYS "Wimp_GetWindowState",,q%:PROCinfo(q%+4)
3150ENDPROC
3160DEF PROCgeti(h%,i%)
3170!q%=h%:q%!4=i%:SYS "Wimp_GetIconState",,q%
3180ix0%=q%!8:iy0%=q%!12:ix1%=q%!16:iy1%=q%!20
3190iflags%=q%!24:idata%=q%+28
3200ENDPROC
3210DEF PROCinfo(p%)
3220x0%=!p%:y0%=p%!4:x1%=p%!8:y1%=p%!12
3230scx%=p%!16:scy%=p%!20:bhandle%=p%!24:flags%=p%!28
3240bx%=x0%-scx%:by%=y1%-scy% : REM all drawing should be relative to bx%,by%
3250ENDPROC
3260DEF PROCupicon(handle%,icon%)
3270!q%=handle%:q%!4=icon%:q%!8=0:q%!12=0:SYS "Wimp_SetIconState",,q%
3280ENDPROC
3290DEF PROCopen(handle%,x0%,y0%,x1%,y1%,scx%,scy%,bhandle%)
3300LOCAL d%
3310!q%=handle%
3320q%!4=x0%:q%!8=y0%:q%!12=x1%:q%!16=y1%
3330q%!20=scx%:q%!24=scy%
3340q%!28=bhandle%
3350SYS "Wimp_OpenWindow",,q%
3360IF handle%=dialogue% THEN
3370 PROCgetw(handle%)
3380 MOUSE RECTANGLE x0%,y0%,x1%-x0%,y1%-y0%+40
3390ENDIF
3400ENDPROC
3410DEF PROCclose(handle%)
3420LOCAL i%
3430IF NOT(handle% = quitbox%) THEN
3440IFhandle%=dialogue% THEN MOUSE RECTANGLE 0,0,1279,1023:dialogue%=-1
3450ENDIF
3460IF handle%=browbox% AND _altered THEN
3470 PROCsoftreset:ENDPROC
3480ELSE
3490 IF handle% =browbox% THEN PROCresetwindowdefs
3500ENDIF
3510!q%=handle%:SYS "Wimp_CloseWindow",,q%
3520ENDPROC
3530DEF PROCmouse(mousex%,mousey%,buttons%,handle%,icon%,oldbuttons%)
3540CASE handle% OF
3550WHEN quitbox%: CASE icon% OF
3560 WHEN 0: REM ***************** Yes Quit Application *********
3570 IF _RESET% = TRUE THEN
3580 PROCresetwindowdefs
3590 PROCclose(quitbox%)
3600 PROCclose(browbox%)
3610 ELSE
3620 IF _prequit THEN
3630 SYS"Wimp_ProcessKey",&1FC
3640 PROCclose(handle%):PROCfinish
3650 END
3660 ELSE
3670 PROCfinish:END
3680 ENDIF
3690 ENDIF
3700 WHEN 2: _QUIT%=FALSE:_RESET%=FALSE:PROCclose(handle%)
3710 WHEN 3: SYS "Wimp_GetPointerInfo",,q%
3720 SYS "Wimp_CreateMenu",,-1
3730 SYS "Wimp_CreateMenu",,m_savetemp%,!q%-30,q%!4+60
3740 _RESET% = TRUE
3750 ENDCASE
3760WHEN browbox%: CASE buttons% OF
3770 WHEN &02: REM ********************* MENU **********
3780 PROCmenu(m_browser%)
3790 WHEN -1: PROCselection_unset
3800 OTHERWISE
3810 IF icon% = -1 THEN
3820 PROCselection_unset
3830 ELSE
3840 PROCshowwindow(icon%,buttons%)
3850 ENDIF
3860 ENDCASE
3870OTHERWISE: CASE buttons% OF
3880 WHEN &02 : REM -- MENU button
3890 I%=FNwhichwindow(handle%):IFI%<>-1THENPROCwindowmenu(I%):ENDPROC
3900 CASE handle% OF
3910 WHEN -2: CASE icon% OF
3920 WHEN ic_window%:PROCmenu(mainmenu%)
3930 ENDCASE
3940 ENDCASE
3950 WHEN &01,&04 : REM -- SELECT/ADJUST buttons
3960 REM PROCaddchange(_titlestring%)
3970 CASE handle% OF
3980 WHEN -2: CASE icon% OF
3990 WHEN ic_window%
4000 IF FNchck_newtemplate THEN PROCresetwindowdefs ELSE PROCfront(browbox%)
4010 ENDCASE
4020 WHEN m_workarea%:PROCaddchange(_titlestring%)
4030 PROCsetwork(q%,mb_workarea0%)
4040 PROCsetwork(q%+8,mb_workarea1%)
4050 x0%=!q%:y0%=q%!4:x1%=q%!8:y1%=q%!12
4060 CASE icon% OF
4070 WHEN 0:y1%+=4
4080 WHEN 1:x1%+=2
4090 WHEN 2:x0%-=2
4100 WHEN 3:y0%-=4
4110 WHEN 5:x0%+=2:IF x0%>mwx0% THEN x0%=mwx0%
4120 WHEN 6:x1%-=2:IF x1%<mwx1% THEN x1%=mwx1%
4130 WHEN 7:y1%-=4:IF y1%<mwy1% THEN y1%=mwy1%
4140 WHEN 8:y0%+=4:IF y0%>mwy0% THEN y0%=mwy0%
4150 WHEN 11:PROCxor(m_workarea%,11,6)
4160 PROCsetworkarea(currentwindow%)
4170 IF (buttons%AND1)=0 THEN SYS "Wimp_CreateMenu",,-1
4180 ENDCASE
4190 w0$=STR$x0%+","+STR$y0%
4200 w1$=STR$x1%+","+STR$y1%
4210 IFw0$<>$mb_workarea0%THEN$mb_workarea0%=w0$:PROCupicon(m_workarea%,9)
4220 IFw1$<>$mb_workarea1%THEN$mb_workarea1%=w1$:PROCupicon(m_workarea%,10)
4230 WHEN m_savetemp%
4240 IF icon%=2 THEN
4250 PROCcheckfull($mb_templates%)
4260 PROCsavetemplates($mb_templates%,TRUE)
4270 IF buttons% AND &01 ELSE SYS "Wimp_CreateMenu",,-1
4280 ENDIF
4290 ENDCASE
4300 WHEN &10,&40 : REM -- SELECT/ADJUST dragging
4310 CASE handle% OF
4320 WHEN m_savetemp%:PROCdragicon(mousex%,mousey%,handle%,icon%)
4330 OTHERWISE:IFicon%<>-1THENPROCdrag(buttons%,handle%,icon%)
4340 ENDCASE
4350 ENDCASE
4360ENDCASE
4370ENDPROC
4380DEF PROCprocesskey(handle%,icon%,key%)
4390CASE handle% OF
4400WHEN m_workarea%
4410 IF key%=13 THEN
4420 PROCxor(m_workarea%,11,6)
4430 PROCsetworkarea(currentwindow%)
4440 SYS "Wimp_CreateMenu",,-1
4450 ENDPROC
4460 ENDIF
4470WHEN m_savetemp%
4480 IF key%=13 THEN
4490 PROCcheckfull($mb_templates%)
4500 PROCsavetemplates($mb_templates%,TRUE)
4510 SYS "Wimp_CreateMenu",,-1
4520 ENDPROC
4530 ENDIF
4540ENDCASE
4550SYS "Wimp_ProcessKey",key%
4560ENDPROC
4570------------------------------------------------------------------------------
4580DEF PROCdrag(b%,handle%,icon%)
4590I%=FNwhichwindow(handle%):IFI%=-1THENENDPROC
4600currentwindow%=I%:currenticon%=icon%:PROChighlight(I%)
4610dragtype%=b%:draghandle%=handle%:dragicon%=icon%
4620PROCgetcurw
4630PROCgetcuri
4640cx0%+=bx%:cy0%+=by%:cx1%+=bx%:cy1%+=by%
4650x0%=0:y0%=0:x1%=scrx1%:y1%=scry1%
4660IFb%=&10THEN
4670 PROCgetminxy(flags%,text$,sprite$,valid%)
4680 mx0%=mousex%-cx0%:mx1%=cx1%-mousex%
4690 my0%=mousey%-cy0%:my1%=cy1%-mousey%
4700 x0%=cx0%+minx%:y0%=0:x1%=scrx1%:y1%=cy1%-miny%
4710 IFmx0%<mx1%THENPROCswapx:x0%=0:x1%=cx0%-minx%:x0%+=1:x1%-=1
4720 IFmy0%>my1%THENPROCswapy:y0%=cy1%+miny%:y1%=scry1%:y0%+=1:y1%-=1
4730 x0%+=cx0%-cx1%:y1%+=cy1%-cy0% : REM bodge
4740ENDIF
4750!q%=handle%:IF b%=&40 THEN q%!4=5 ELSE q%!4=6
4760q%!8=cx0%:q%!12=cy0%:q%!16=cx1%:q%!20=cy1%
4770q%!24=x0%:q%!28=y0%:q%!32=x1%:q%!36=y1%
4780SYS "Wimp_DragBox",,q%
4790ENDPROC
4800DEF PROCdragicon(mousex%,mousey%,handle%,icon%)
4810dragtype%=&FF:draghandle%=handle%
4820PROCgetw(handle%)
4830PROCgeti(handle%,icon%)
4840!q%=handle%:q%!4=5
4850q%!8=bx%+ix0%:q%!12=by%+iy0%:q%!16=bx%+ix1%:q%!20=by%+iy1%
4860q%!24=q%!8-mousex%:q%!28=q%!12-mousey%
4870q%!32=scrx1%+q%!16-mousex%:q%!36=scry1%+q%!20-mousey%
4880SYS "Wimp_DragBox",,q%
4890ENDPROC
4900DEF PROCswapx
4910cx0%=cx0%EORcx1%:cx1%=cx1%EORcx0%:cx0%=cx0%EORcx1%:cx0%-=1:cx1%+=1
4920ENDPROC
4930DEF PROCswapy
4940cy0%=cy0%EORcy1%:cy1%=cy1%EORcy0%:cy0%=cy0%EORcy1%:cy0%-=1:cy1%+=1
4950ENDPROC
4960DEF PROCunshade(mh%,I%)
4970mh%!(28+8+24*I%)=mh%!(28+8+24*I%)AND&FFBFFFFF:ENDPROC
4980DEF PROCgetminxy(flags%,text$,sprite$,valid%)
4990LOCAL x0%,y0%,x1%,y1%,mx%,my%
5000minx%=0:miny%=0
5010IF flags%AND&01 THEN
5020 IF FNgetcommand(valid%,"L")<>"" THEN ENDPROC :REM can be formatted
5030 IF flags%AND&40 THEN
5040 SYS "Font_ReadInfo",flags%>>24 TO ,,y0%,,y1%
5050 SYS "Font_StringBBox",,CHR$26+CHR$(flags%>>24)+text$ TO ,x0%,,x1%
5060 SYS "Font_ConverttoOS",,x0% TO ,x0%
5070 SYS "Font_ConverttoOS",,x1% TO ,x1%
5080 minx%=x1%-x0%:miny%=y1%-y0%
5090 ELSE minx%=6*dx%+16*LENtext$:miny%=32
5100 ENDIF
5110 IF flags%AND&04 THEN miny%+=2*dy%
5120ENDIF
5130IF flags%AND&02 THEN
5140 SYS "XOS_SpriteOp",&128,spritearea%,sprite$ TO ,,,mx%,my%,,spm% ; P%
5150 IF (P%AND1)=0 THEN
5160 SYS "XOS_ReadModeVariable",spm%,4 TO ,,spx%:mx%=mx%<<spx%
5170 SYS "XOS_ReadModeVariable",spm%,5 TO ,,spy%:my%=my%<<spy%
5180 IF flags%AND&800 THEN mx%=mx%/2:my%=my%/2
5190 IF (flags%AND&21B)=&13 THEN mx%=minx%+mx% :REM sprite+text (V~H~R)
5200 IF mx%>minx% THEN minx%=mx%
5210 IF my%>miny% THEN miny%=my%
5220 ENDIF
5230ENDIF
5240ENDPROC
5250DEF PROCdecodedrag(cx0%,cy0%,cx1%,cy1%)
5260dragtype%=0
5270IF draghandle%=m_savetemp% THEN PROCsendsave(&FEC,mb_templates%):ENDPROC
5280PROCgeti(draghandle%,dragicon%)
5290oldflags%=iflags%:odt0%=idata%!0:odt1%=idata%!4:odt2%=idata%!8
5300PROCdeleteicon(draghandle%,dragicon%)
5310PROCgetw(draghandle%)
5320cx0%-=bx%:cy0%-=by%:cx1%-=bx%:cy1%-=by%
5330IFcx0%>cx1%THENPROCswapx
5340IFcy0%>cy1%THENPROCswapy
5350currenticon%=FNcricon(!q%,cx0%,cy0%,cx1%,cy1%,oldflags%,odt0%,odt1%,odt2%)
5360ENDPROC
5370DEF FNcricon(handle%,x0%,y0%,x1%,y1%,flags%,dt0%,dt1%,dt2%)
5380LOCAL ic%,v%
5390!q%=handle%
5400q%!20=flags%:q%!24=dt0%:q%!28=dt1%:q%!32=dt2%
5410text$=FNiconstring(flags%,q%+24)
5420IF flags% AND &100 THEN v%=q%!28 ELSE v%=-1
5430PROCgetminxy(flags%,text$,text$,v%) : REM bodge
5440IFx1%-x0%<minx% THEN x1%=x0%+minx%
5450IFy1%-y0%<miny% THEN y1%=y0%+miny%
5460q%!4=x0%:q%!8=y0%:q%!12=x1%:q%!16=y1%
5470SYS "Wimp_CreateIcon",,q% TO ic%
5480SYS "Wimp_ForceRedraw",!q%,q%!4,q%!8,q%!12,q%!16
5490SYS "Wimp_GetCaretPosition",,q%
5500IF!q%=handle%IFq%!4=ic%:SYS "Wimp_SetCaretPosition",handle%,ic%,0,0,-1,0
5510=ic%
5520DEF PROCdeleteicon(handle%,icon%)
5530!q%=handle%:q%!4=icon%:SYS "Wimp_GetIconState",,q%
5540SYS "Wimp_DeleteIcon",,q%
5550SYS "Wimp_ForceRedraw",!q%,q%!8,q%!12,q%!16,q%!20
5560ENDPROC
5570------------------------------------------------------------------------------
5580DEF PROCmenu(m%)
5590menuhandle%=m%
5600IF FNencodemenu(m%) THEN
5610 IF handle%=-2 THEN
5620 I%=m%!20+m%!24:J%=m%+28:K%=96-m%!24
5630 REPEAT K%+=I%:J%+=24:UNTILJ%!-24AND&80
5640 REM K%+=24 dotted line separator!
5650 ELSE K%=mousey%+12
5660 ENDIF
5670 SYS "Wimp_CreateMenu",,menuhandle%,mousex%-102,K%
5680 oldhandle%=handle%:oldicon%=icon%
5690ENDIF
5700ENDPROC
5710DEF PROCremenu
5720handle%=oldhandle%:icon%=oldicon%
5730IF FNencodemenu(menuhandle%) THEN
5740 SYS "Wimp_CreateMenu",,menuhandle%,mousex%-102,mousey%+12 :REM default coords
5750ENDIF
5760ENDPROC
5770------------------------------------------------------------------------------
5780DEF PROCwindowmenu(I%)
5790mmousex%=mousex%:mmousey%=mousey%
5800currentwindow%=I%:PROChighlight(I%)
5810currenticon%=icon%:PROCmenu(w_general%)
5820ENDPROC
5830DEF PROChighlight(I%)
5840ENDPROC
5850SYS "Wimp_SetCaretPosition",handle%(I%),-1,0,0,&2000000,0
5860ENDPROC
5870------------------------------------------------------------------------------
5880DEF PROCencodemenu(menuhandle%)
5890IF FNencodemenu(menuhandle%) ELSE ERROR 1,"Menu shouldn't be allowed"
5900ENDPROC
5910DEF FNencodemenu(menuhandle%)
5920IFmenuhandle%<&8000 THEN ERROR 1,"Bad menuhandle"
5930LOCALI%
5940I%=menuhandle%+28:_RESET% = FALSE:_QUIT% = FALSE
5950REPEAT!I%=!I%ANDNOT&01:I%!8=I%!8ANDNOT&400000:I%+=24:UNTILI%!-24AND&80
5960CASE menuhandle% OF
5970WHEN mainmenu%
5980 $mb_wident%="":$mb_templates%=templatef$
5990WHEN i_flags%
6000 PROCgetcuri
6010 PROCencodeicon(i_flags%,11,flags%,q%+28,ib_text%,ib_sprite%)
6020 $ib_buffersize%=STR$L%
6030 $ib_validation%=""
6040 PROCencodemenu(i_buffersize%)
6050 IF (flags%AND&01)=0 THEN
6060 PROCshade(i_buffersize%,1)
6070 ELSE IF flags%AND&100 THEN
6080 IF q%!32>0 THEN $ib_validation%=$(q%!32):PROCmenu_tick(i_buffersize%,1)
6090 ENDIF
6100 ENDIF
6110 IF NOT(_fonttra%) THEN PROCshade(i_flags%,6)
6120 $(i_flags%+28+12+24*14)="Fg colour"
6130 $(i_flags%+28+12+24*15)="Bg colour"
6140 IF flags% AND &02 THEN $(i_flags%+28+12+24*14)="EOR colour"
6150 IF flags% AND &20 ELSE $(i_flags%+28+12+24*15)="EOR colour"
6160 IF flags% AND &40 THEN
6170 i_flags%?(28+11+24*14)=7
6180 i_flags%?(28+11+24*15)=7
6190 PROCshade(i_flags%,14):PROCshade(i_flags%,15)
6200 ELSE
6210 i_flags%?(28+11+24*14)=FNforeback((flags%>>24)AND&F)
6220 i_flags%?(28+11+24*15)=FNforeback((flags%>>28)AND&F)
6230 ENDIF
6240 PROCencodemenu(i_esg%)
6250WHEN i_esg%
6260 PROCmenu_tick(i_esg%,(flags%>>16)AND&0F)
6270WHEN i_button%
6280 PROCmenu_tick(i_button%,(flags%>>12)AND&0F)
6290WHEN m_browser%
6300 PROCselection_on
6310 PROCselection_name
6320WHEN w_general%
6330 IF currentwindow%=-1 THEN =FALSE : REM deleted!
6340 $mb_wident%=wident$(currentwindow%)
6350 $(m_ident%!(28+12)) = wident$(currentwindow%)
6360 PROCgetcuri:$mb_ixcon%=STR$(q%!8):$mb_iycon%=STR$(q%!12)
6370 IF flags%AND&800000 THEN currenticon%=-1 : REM has been deleted!
6380 IF currenticon%<>-1 THEN
6390 $(w_general%!(28+24*1+12)+LEN"Amend icon ")="#"+STR$currenticon%
6400 $(w_general%!(28+24*2+12)+LEN"Renumber ")="#"+STR$VAL$mb_renumber%
6410 PROCencodemenu(i_flags%)
6420 PROCencodemenu(i_button%)
6430 ELSE $(w_general%!(28+24*1+12)+LEN"Amend icon ")=""
6440 $(w_general%!(28+24*2+12)+LEN"Renumber ")=""
6450 FORI%=1TO5:PROCshade(w_general%,I%):NEXT
6460 ENDIF
6470 PROCencodemenu(w_flags%)
6480 $mb_workarea0%=STR$(q%!44)+","+STR$(q%!48)
6490 $mb_workarea1%=STR$(q%!52)+","+STR$(q%!56)
6500 $mb_minx%=STR$(q%!72 AND &FFFF)
6510 $mb_miny%=STR$(q%!72 >> 16)
6520 mwx0%=q%!20:mwy0%=q%!24+(q%!8-q%!16)
6530 mwx1%=q%!20+(q%!12-q%!4):mwy1%=q%!24
6540 PROCencodepalmenu(-1)
6550 I%=w_colours%+28
6560 FOR J%=q%+36 TO q%+42
6570 IF ?J% = &FF THEN
6580 I%?11=(0<<4)ORuncolour%(0):I%+=24
6590 ELSE
6600 I%?11=(?J%<<4)ORuncolour%(?J%):I%+=24
6610 ENDIF
6620 NEXT
6630WHEN w_flags%
6640 !q%=handle%(currentwindow%)
6650 SYS "Wimp_GetWindowInfo",,q%
6660 FOR I%=0 TO 7
6670 IF q%!32 AND (1<<I%) THEN PROCmenu_tick(w_flags%,I%)
6680 NEXT
6690 IF q%!32 AND (1<<8) THEN
6700 PROCmenu_tick(w_flags%,8)
6710 PROCmenu_tick(w_scroll%,0):PROCuntick(w_scroll%,1)
6720 ELSE
6730 PROCuntick(w_scroll%,0)
6740 ENDIF
6750 IF q%!32 AND (1<<9) THEN
6760 PROCmenu_tick(w_flags%,8):
6770 PROCmenu_tick(w_scroll%,1):PROCuntick(w_scroll%,0)
6780 ELSE
6790 PROCuntick(w_scroll%,1)
6800 ENDIF
6810 IF q%!32 AND (1<<10) THEN PROCmenu_tick(w_flags%,9) :REM real
6820 IF q%!32 AND (1<<11) THEN PROCmenu_tick(w_flags%,10) :REM back window
6830 IF q%!32 AND (1<<12) THEN PROCmenu_tick(w_flags%,11) :REM grab keys
6840 PROCencodemenu(t_flags%)
6850 IF currenticon%=-1 THEN
6860 flags%=q%!64:PROCencodemenu(i_button%)
6870 ELSE PROCshade(w_flags%,12)
6880 ENDIF
6890 FOR I%=14 TO 20
6900 IF q%!32 AND (1<<(I%+24-14)) THEN PROCmenu_tick(w_flags%,I%)
6910 NEXT
6920 IF q%!32 AND &80000000 THEN
6930 PROCmenu_tick(w_flags%,13)
6940 PROCshade(w_flags%,0)
6950 PROCshade(w_flags%,2)
6960 PROCshade(w_flags%,3)
6970 PROCshade(w_flags%,7)
6980 ELSE
6990 FOR I%=14 TO 20:PROCshade(w_flags%,I%):NEXT
7000 ENDIF
7010WHEN t_flags%
7020 q%!60=q%!60 OR &24 : REM must be filled with border
7030 PROCencodeicon(t_flags%,6,q%!60,q%+76,tb_text%,tb_sprite%)
7040 $tb_buffersize%=STR$L%
7050 IF NOT(_fonttra%) THEN PROCshade(t_flags%,6)
7060 IFq%!60AND&100THENPROCmenu_tick(t_flags%,7)
7070 IFq%!60AND&200THENPROCmenu_tick(t_flags%,8)
7080WHEN w_scroll%
7090 PROCgetcurw
7100 IFflags%AND&100THENPROCmenu_tick(w_scroll%,0)
7110 IFflags%AND&200THENPROCmenu_tick(w_scroll%,1)
7120ENDCASE
7130=TRUE
7140DEF PROCshade(mh%,I%)
7150mh%!(28+8+24*I%)=mh%!(28+8+24*I%)OR&400000:ENDPROC
7160DEF PROCencodeicon(iconmenu%,nmenu%,flags%,q%,itext%,isprite%)
7170IF i_font%<0 THEN PROCshade(iconmenu%,6)
7180$itext%="":$isprite%=""
7190IF flags% AND &01 THEN $itext%=FNiconstring(flags%,q%)
7200IF (flags%AND &03)=&02 THEN $isprite%=FNiconstring(flags%,q%)
7210IF flags% AND &100 THEN L%=q%!8 ELSE L%=12 : REM returned to caller
7220I%=iconmenu%+28:J%=1
7230FORitem%=0TOnmenu%:IFflags%ANDJ%THEN!I%=!I%OR&01
7240I%+=24:J%+=J%:NEXT
7250ENDPROC
7260DEF PROCdecodemenu(menuhandle%,menus%)
7270CASE menuhandle% OF
7280WHEN mainmenu%
7290 CASE !menus% OF
7300 WHEN 0:REM info box
7310 WHEN 1: IF NOT(_altered) THEN
7320 PROCresetwindowdefs
7330 PROCfront(browbox%)
7340 ELSE
7350 PROCsoftreset
7360 ENDIF
7370 WHEN 2: IF _altered THEN
7380 PROCicon_write(quitbox%,1,FNmsg_0("Q1"))
7390 _QUIT% = TRUE:PROCfront(quitbox%):_prequit = FALSE:_RESET%= FALSE
7400 ELSE
7410 PROCfinish:END
7420 ENDIF
7430 ENDCASE
7440WHEN m_browser%
7450 CASE !menus% OF
7460 WHEN 0: REM *********** saveas
7470 PROCsavetemplates($mb_templates%,TRUE)
7480 WHEN 1: REM *********** Select
7490 PROCselection_name
7500 PROCdecodemenu(m_selwin%,menus%+4)
7510 WHEN 2: REM *********** Create Window
7520 IF mb_newident%?0 = 0 THEN
7530 ERROR 1,"No identifier"
7540 ELSE PROCreformat_string(mb_newident%)
7550 IF FNchk_duplicates($mb_newident%) THEN
7560 ERROR 1 , "Duplicate identifiers"
7570 ELSE
7580 PROCcreatewindow(brx%,bry%,$mb_newident%)
7590 brx%+=60:bry%-=40
7600 IF bry% < 340 THEN bry% = 1000
7610 IF brx% > 1040 THEN brx% = 40
7620 ENDIF
7630 ENDIF
7640 ENDCASE
7650WHEN m_selwin%
7660 CASE !menus% OF
7670 WHEN 0 : REM *** Copy Window
7680 IF NOT(mb_cpywin%?0 = 0) THEN
7690 PROCreformat_string(mb_cpywin%)
7700 PROCreformat_string(mb_renwin%)
7710 IF NOT($mb_cpywin% = $mb_renwin%) THEN
7720 IF FNchk_duplicates($mb_cpywin%) THEN
7730 ERROR 1 , "Duplicate identifiers"
7740 ELSE
7750 PROCselection_copy:REM *** Copy Window
7760 ENDIF
7770 ENDIF
7780 ENDIF
7790 WHEN 1 : REM *** Rename Window
7800 IF NOT(mb_renwin%?0 = 0) THEN
7810 PROCreformat_string(mb_renwin%)
7820 PROCreformat_string(mb_cpywin%)
7830 IF NOT($mb_cpywin% = $mb_renwin%) THEN
7840 REM PRINT LEN($mb_renwin%)
7850 IF FNchk_duplicates($mb_renwin%) THEN
7860 ERROR 1 , "Duplicate identifiers"
7870 ELSE
7880 PROCselection_rename:REM *** Rename Window
7890 ENDIF
7900 ENDIF
7910 ENDIF
7920 REM *spool
7930 WHEN 2 : PROCselection_delete:REM *** Delete Window
7940 ENDCASE
7950WHEN w_general%
7960 CASE !menus% OF
7970 WHEN 0: REM ****************** Create Icon ****************
7980 PROCaddchange(_titlestring%):PROCgetcurw
7990 mx%=mmousex%-bx%:my%=mmousey%-by%
8000 ix%=default%!96-default%!88
8010 iy%=default%!100-default%!92
8020 q%!4=mx%-ix%/2:q%!8=my%-iy%/2:q%!12=q%!4+ix%:q%!16=q%!8+iy%
8030 FOR I%=0 TO 12 STEP 4:q%!(20+I%)=default%!(104+I%):NEXT
8040 SYS "Wimp_CreateIcon",,q% TO currenticon%
8050 SYS "Wimp_ForceRedraw",!q%,q%!4,q%!8,q%!12,q%!16
8060 WHEN 1: REM ****************** Amend Icon *****************
8070 IF NOT(_altered) THEN
8080 PROCaddchange(_titlestring%)
8090 ENDIF
8100 PROCgetcuri
8110 PROCdeleteicon(!q%,q%!4)
8120 PROCdecodeicon(menus%+4,q%+24,q%+28,ib_text%,ib_sprite%,ib_buffersize%,$ib_validation%)
8130 currenticon%=FNcricon(!q%,q%!8,q%!12,q%!16,q%!20,q%!24,q%!28,q%!32,q%!36)
8140 WHEN 2: REM ****************** Renumber
8150 PROCaddchange(_titlestring%)
8160 renumber%=VAL$mb_renumber%
8170 PROCrenumber(currentwindow%,currenticon%,renumber%)
8180 PROCaddchange(_titlestring%)
8190 WHEN 3: REM ****************** Copy Icon
8200 PROCaddchange(_titlestring%):PROCgetcuri
8210 IFflags%AND&100THEN
8220 B%=FNworkspace(q%!36):$B%=text$:q%!28=B%
8230 IFq%!32>0THENB%=FNworkspace(LEN$(q%!32)+1):$B%=$(q%!32):q%!32=B%
8240 ENDIF
8250 x0%=q%!8:y0%=q%!12:x1%=q%!16:y1%=q%!20
8260 CASE menus%!4 OF
8270 WHEN -1:copyx%=16:copyy%=-16
8280 WHEN 0:copyx%=x0%-x1%:copyy%=0
8290 WHEN 1:copyx%=x1%-x0%:copyy%=0
8300 WHEN 2:copyx%=0:copyy%=y1%-y0%
8310 WHEN 3:copyx%=0:copyy%=y0%-y1%
8320 ENDCASE
8330 x0%+=copyx%:y0%+=copyy%:x1%+=copyx%:y1%+=copyy%
8340 currenticon%=FNcricon(!q%,x0%,y0%,x1%,y1%,q%!24,q%!28,q%!32,q%!36)
8350 WHEN 4: REM ** Move Icon
8360 PROCaddchange(_titlestring%):PROCgetcuri
8370 PROCaddchange(_titlestring%)
8380 h%=handle%(currentwindow%)
8390 PROCgeti(h%,currenticon%)
8400 oldf%=iflags%:o0%=idata%!0:o1%=idata%!4:o2%=idata%!8
8410 PROCdeleteicon(h%,currenticon%)
8420 CASE menus%!4 OF
8430 WHEN 0:ix0%-=dx%:ix1%-=dx%
8440 WHEN 1:ix0%+=dx%:ix1%+=dx%
8450 WHEN 2:iy0%+=dy%:iy1%+=dy%
8460 WHEN 3:iy0%-=dy%:iy1%-=dy%
8470 WHEN 4:ix0%=VAL($mb_ixcon%):PROCmove_xdir(ix0%,ix1%)
8480 WHEN 5:iy0%=VAL($mb_iycon%):PROCmove_ydir(iy0%,iy1%)
8490 ENDCASE
8500 currenticon%=FNcricon(h%,ix0%,iy0%,ix1%,iy1%,oldf%,o0%,o1%,o2%)
8510 WHEN 5: REM ** Delete Icon
8520 PROCaddchange(_titlestring%)
8530 q%?(36+menus%!4)=menus%!8
8540 PROCdeleteicon(handle%(currentwindow%),currenticon%)
8550 WHEN 6:PROCdecodemenu(w_flags%,menus%+4)
8560 WHEN 7:IF menus%!4<>-1 AND menus%!8<>-1 THEN
8570 PROCaddchange(_titlestring%)
8580 !q%=handle%(currentwindow%)
8590 SYS "Wimp_GetWindowInfo",,q%
8600 q%?(36+menus%!4)=menus%!8
8610 IFmenus%!8=16 q%?(36+menus%!4)=255
8620 curw%=currentwindow%
8630 $mb_newident% = "#"
8640 PROCcrwindow(q%+4,wident$(curw%))
8650 N% = q%!4
8660 PROCdeletewindow(curw%)
8670 q%!0 = N%
8680 PROCreshow_window(q%)
8690 $mb_newident% = ""
8700 ENDIF
8710 WHEN 8:PROCaddchange(_titlestring%):PROCsetworkarea(currentwindow%)
8720 WHEN 10: q%!0 = handle%(currentwindow%)
8730 SYS "Wimp_CloseWindow",,q%:currentwindow%=-1
8740 ENDCASE
8750WHEN w_flags%:PROCaddchange(_titlestring%)
8760 IF !menus%=-1 THEN ENDPROC
8770 !q%=handle%(currentwindow%)
8780 SYS "Wimp_GetWindowInfo",,q%
8790 CASE !menus% OF
8800 WHEN 0:PROCdecodetitle(1)
8810 WHEN 1:q%!32=q%!32EOR&02
8820 WHEN 2:q%!32=q%!32EOR&04
8830 WHEN 3:q%!32=q%!32EOR&08
8840 WHEN 4:q%!32=q%!32EOR&10
8850 WHEN 5:q%!32=q%!32EOR&20
8860 WHEN 6:q%!32=q%!32EOR&40
8870 WHEN 7:q%!32=q%!32EOR&80
8880 WHEN 8:q%!32=q%!32ANDNOT&300
8890 CASE menus%!4 OF
8900 WHEN 0:q%!32=q%!32OR&100
8910 WHEN 1:q%!32=q%!32OR&200
8920 ENDCASE
8930 ENDIF
8940 WHEN 9:q%!32=q%!32EOR&400
8950 WHEN 10:q%!32=q%!32EOR&800
8960 WHEN 11:q%!32=q%!32EOR&1000
8970 WHEN 12:IF menus%!4<>-1 THEN q%!64=(menus%!4)<<12
8980 WHEN 13:q%!32=q%!32EOR&80000000
8990 WHEN 14,15,17,18,19,20:q%!32=q%!32 EOR (1<<(10+!menus%))
9000 WHEN 16:PROCdecodetitle(1<<26)
9010 ENDCASE
9020 curw%=currentwindow%
9030 $mb_newident% = "#"
9040 PROCcrwindow(q%+4,wident$(curw%))
9050 N% = q%!4
9060 PROCdeletewindow(curw%)
9070 q%!0 = N%
9080 PROCreshow_window(q%)
9090 $mb_newident% = ""
9100 PROCzzzz(q%!0)
9110ENDCASE
9120ENDPROC
9130DEF PROCloadsprites(f$) REM LOCAL I%,f$
9140SYS "OS_SpriteOp",&10A,spritearea%,f$
9150IF f$<>"<Wimp$Scrap>" THEN spritef$=f$
9160PROCredrawwindows
9170ENDPROC
9180DEF PROCmergesprites(f$)
9190SYS "OS_SpriteOp",&10B,spritearea%,f$
9200PROCredrawwindows
9210ENDPROC
9220DEF PROCredrawwindows
9230LOCAL I%
9240FOR I%=0 TO nh%
9250IF handle%(I%)>nh% THEN SYS "Wimp_ForceRedraw",handle%(I%),-1E8,-1E8,1E8,1E8
9260NEXT
9270ENDPROC
9280DEF FNfiletype(f$)
9290LOCAL f%,type%
9300SYS "OS_File",17,f$ TO type%,,f%
9310IF type%<>1 THEN = -2
9320IF (f%>>>20)=&FFF THEN = (f%>>>8)AND&FFF ELSE = -1
9330DEF PROCdecodetitle(bit%)
9340CASE menus%!4 OF
9350WHEN -1:q%!32=q%!32EORbit%
9360OTHERWISE:q%!32=q%!32ORbit%
9370ENDCASE
9380IFmenus%!4=8THENmenus%!4=9 : REM bodge for 'right-justified' bit
9390IFmenus%!4=7THENmenus%!4=8 : REM bodge for 'indirected' bit
9400PROCdecodeicon(menus%+4,q%+60,q%+76,tb_text%,tb_sprite%,tb_buffersize%,"")
9410ENDPROC
9420DEF PROCsetwork(q%,v%)
9430!q%=VAL$v%:q%!4=VAL$(v%+INSTR($v%,","))
9440ENDPROC
9450DEF PROCsetworkarea(curw%)
9460LOCAL h%
9470h%=handle%(curw%)
9480PROCsetwork(q%,mb_workarea0%)
9490PROCsetwork(q%+8,mb_workarea1%)
9500SYS "Wimp_SetExtent",h%,q%
9510min% = (VAL$mb_minx% AND &FFFF) OR (VAL$mb_miny% << 16)
9520!q%=h%:SYS "Wimp_GetWindowInfo",,q%
9530IF q%!72<>min% THEN
9540 q%!72=min%:SYS "Wimp_CreateWindow",,q%+4 TO handle%(curw%)
9550 !q%=handle%(curw%):SYS "Wimp_OpenWindow",,q%
9560 !q%=h%:SYS "Wimp_DeleteWindow",,q%
9570ENDIF
9580ENDPROC
9590DEF PROCdecodeicon(menus%,fptr%,qptr%,mb_text%,mb_sprite%,mb_buffersize%,v$)
9600CASE !menus% OF
9610WHEN 0: REM ** text
9620 oldf%=!fptr%
9630 CASE menus%!4 OF
9640 WHEN -1:!fptr%=!fptr% EOR &01
9650REM IF!fptr%AND&01THEN!fptr%=!fptr%ANDNOT&02
9660 OTHERWISE:!fptr%=!fptr%OR&01
9670 IF (oldf%AND&01)=0 THEN !fptr%=!fptr%ANDNOT&02
9680 ENDCASE
9690 PROCputiconstring(oldf%,fptr%,qptr%,$mb_text%)
9700WHEN 1: REM ** sprites
9710 oldf%=!fptr%
9720 CASE menus%!4 OF
9730 WHEN -1:!fptr%=!fptr% EOR &02
9740REM IF!fptr%AND&02THEN!fptr%=!fptr%ANDNOT&01
9750 OTHERWISE:!fptr%=(!fptr%ANDNOT&03)OR&02
9760 ENDCASE
9770 IF !fptr% AND &01 THEN A$=$mb_text% ELSE A$=$mb_sprite%
9780 PROCputiconstring(oldf%,fptr%,qptr%,A$)
9790WHEN 2:!fptr%=!fptr%EOR&04
9800WHEN 3:!fptr%=!fptr%EOR&08
9810WHEN 4:!fptr%=!fptr%EOR&10
9820WHEN 5:!fptr%=!fptr%EOR&20
9830WHEN 6:SYS "Wimp_DecodeMenu",,i_font%,menus%+4,STRING$(100," ")TO,,,fontname$
9840 IF menus%!4<>-1 IF menus%!8=4 THEN fontname$+=" point"
9850 IF fontname$="" THEN
9860 !fptr%=!fptr%ANDNOT&40
9870 fptr%?3=&D7
9880 ELSE !fptr%=!fptr%OR&40
9890 IF RIGHT$(fontname$,5)="point" THEN
9900 I%=LENfontname$
9910 REPEATI%=I%-1:UNTILMID$(fontname$,I%,1)="."
9920 psiz%=VALMID$(fontname$,I%+1)
9930 fontname$=LEFT$(fontname$,I%-1)
9940 ELSE psiz%=12
9950 ENDIF
9960 fptr%?3=FNfindfont(fontname$,psiz%)
9970 ENDIF
9980WHEN 7:!fptr%=!fptr%EOR&80
9990WHEN 8:IF!fptr%AND&100THENB$=$!qptr%ELSEB$=$qptr%
10000 IFmenus%!4=-1 THEN !fptr%=!fptr%EOR&100 ELSE !fptr%=!fptr%OR&100
10010 IF!fptr%AND&100THEN
10020 qptr%!8=VAL$mb_buffersize%
10030 !qptr%=FNworkspace(qptr%!8):$!qptr%=LEFT$(B$,qptr%!8-1)
10040 IF v$="" THEN
10050 qptr%!4=-1
10060 ELSE IF (!fptr%AND&03)=&02 THEN
10070 qptr%!4=spritearea%
10080 ELSE qptr%!4=FNworkspace(LENv$+1):$(qptr%!4)=v$
10090 ENDIF
10100 ENDIF
10110 ELSE $qptr%=LEFT$(B$,11)
10120 ENDIF
10130 IF (!fptr% AND &103) = &102 THEN
10140 IF qptr%!4 > 1 THEN !fptr%=!fptr% AND NOT &02
10150 ENDIF
10160WHEN 9:!fptr%=!fptr%EOR&200
10170WHEN 10:!fptr%=!fptr%EOR&400
10180WHEN 11:!fptr%=!fptr%EOR&800
10190WHEN 12:!fptr%=FNfield(!fptr%,12,4,menus%!4)
10200WHEN 13:!fptr%=FNfield(!fptr%,16,5,menus%!4)
10210WHEN 14:!fptr%=FNfield(!fptr%,24,4,menus%!4)
10220WHEN 15:!fptr%=FNfield(!fptr%,28,4,menus%!4)
10230ENDCASE
10240ENDPROC
10250DEF FNfield(flg%,b0%,nb%,i%)
10260IFi%<>-1THEN=flg%ANDNOT(((1<<nb%)-1)<<b0%)OR(i%<<b0%)ELSE=flg%
10270DEF PROCputiconstring(oldf%,fptr%,qptr%,A$)
10280IF oldf%AND&100 THEN
10290 IF (!fptr% AND &03)=&02 THEN qptr%!4=-1 : REM no sprite area
10300 IF LENA$<qptr%!8 THEN
10310 $!qptr%=A$:!fptr%=!fptr%OR&100:ENDPROC
10320 ENDIF
10330ELSE IF LENA$<12 THEN
10340 $qptr%=A$:!fptr%=!fptr%ANDNOT&100:ENDPROC
10350 ENDIF
10360ENDIF
10370!fptr%=!fptr% OR &100
10380!qptr%=FNworkspace(LENA$+1):qptr%!8=LENA$+1
10390$!qptr%=A$
10400IF (oldf%AND&100)=0 THEN qptr%!4=-1 : REM keep old validation string, if any
10410ENDPROC
10420------------------------------------------------------------------------------
10430DEF PROCrenumber(curw%,curi%,newi%)
10440LOCAL M%,N%
10450!q%=handle%(curw%)
10460SYS "Wimp_GetWindowInfo",,q%
10470IF q%!88 <= newi% THEN ERROR 1,"Icon number out of range"
10480M%=q%+4+88+32*curi%
10490N%=q%+4+88+32*newi%
10500FOR I%=0 TO 28 STEP4:SWAP M%!I%,N%!I%:NEXT
10510I%=q%!88
10520WHILE I%>0
10530 IF q%!(4+88+32*(I%-1)+16) AND (1<<23) THEN I%-=1:q%!88=I% ELSE I%=0
10540ENDWHILE
10550$mb_newident% = "#"
10560PROCcrwindow(q%+4,wident$(curw%)) : REM Help !!!!
10570N% = q%!4
10580PROCdeletewindow(curw%) : REM Interesting ???
10590q%!0 =N%
10600PROCreshow_window(q%)
10610$mb_newident% = ""
10620ENDPROC
10630------------------------------------------------------------------------------
10640DEF PROCstandardwindow(brx%,bry%)
10650FOR I%=0 TO 84 STEP4:q%!I%=default%!I%:NEXT:q%!84=0
10660q%!64=spritearea%
10670I%=q%!8-q%!0:q%!0=brx%:q%!8=q%!0+I%
10680I%=q%!4-q%!12:q%!12=bry%:q%!4=q%!12+I%
10690ENDPROC
10700!q%=brx%:q%!4=bry%-200:q%!8=brx%+200:q%!12=bry%:q%!16=0:q%!20=0:q%!24=-1
10710q%!28=&1F
10720q%?32=`tfcol:q%?33=`tbcol:q%?34=`wfcol:q%?35=`wbcol
10730q%?36=4:q%?37=`tbcol:q%?38=`tbcol2:q%?39=0
10740q%!40=0:q%!44=-1024:q%!48=1280:q%!52=0
10750q%!56=&0000003D:q%!60=&00003000
10760q%!64=spritearea%:q%!68=0
10770$(q%+72)="<Untitled>"
10780q%!84=0
10790ENDPROC
10800DEF PROCcreatewindow(brx%,bry%,wident$)
10810PROCstandardwindow(brx%,bry%)
10820PROCcrwindow(q%,wident$)
10830PROCaddchange(_titlestring%)
10840ENDPROC
10850DEF PROCcrwindow(q%,wident$)
10860REM IF handleSP% <= 20 THEN ENDPROC
10870IF NOT( $mb_newident% = "#" ) THEN
10880 PROCadd_to_array(wident$)
10890 _ans% = q%!28>>>30
10900 IF _ans% = 0 THEN
10910 _ans% = q%!28AND&0C
10920 ELSE
10930 _ans% = q%!28>>>28AND&05
10940 ENDIF
10950ENDIF
10960 REM PRINT "0.1.2.1"
10970SYS "XWimp_CreateWindow",,q% TO handle%;VFLAG%
10980IF (VFLAG% MOD 2) = 1 THEN ERROR _init%, "Cannot create any more windows"
10990 REM PRINT "0.1.2.2"
11000m%=handleSP%:handleSP%=handle%(handleSP%):handle%(m%)=handle%
11010!q%=handle%
11020currentwindow%=m%:wident$(m%)=wident$
11030currenticon%=-1
11040 REM PRINT "0.1.2.3"
11050 PROChighlight(m%)
11060 IF NOT( $mb_newident% = "#" ) THEN PROCbuildbrowsericon(wident$,_ans%)
11070ENDPROC
11080DEF FNwhichwindow(handle%)
11090LOCAL I%
11100IF handle%=-1 THEN =-1
11110handle%(nh%+1)=handle%
11120I%=-1:REPEATI%+=1:UNTIL handle%(I%)=handle%
11130IF I% > nh% THEN =-1 ELSE =I%
11140DEF PROCdeletewindow(I%)
11150!q%=handle%(I%): REM TO CHECK # IN BROWSER mb_ident%
11160handle%(I%)=handleSP%:handleSP%=I%
11170SYS "Wimp_DeleteWindow",,q%
11180wident$(I%)=""
11190ENDPROC
11200DEF PROCgetcurw
11210!q%=handle%(currentwindow%)
11220SYS "Wimp_GetWindowState",,q%
11230PROCinfo(q%+4)
11240ENDPROC
11250DEF PROCgetcuri
11260LOCAL i%
11270!q%=handle%(currentwindow%)
11280q%!4=currenticon%
11290SYS "Wimp_GetIconState",,q%
11300cx0%=q%!8:cy0%=q%!12:cx1%=q%!16:cy1%=q%!20
11310flags%=q%!24
11320IF flags% AND &100 THEN
11330 text$=$(q%!28)
11340 valid% = q%!32
11350ELSE
11360 i%=q%?40:q%?40=13:text$=$(q%+28):q%?40=i%
11370 valid% = -1
11380ENDIF
11390IF (flags%AND&103)=&103 THEN sprite$=MID$(FNgetcommand(valid%,"S"),2) ELSE sprite$=text$
11400ENDPROC
11410DEF FNgetcommand(v%,c$)
11420IF v%<=0 THEN =""
11430LOCALI%
11440I%=INSTR(";"+$v%,";"+c$):IF I%=0 THEN =""
11450=LEFT$($(v%+I%-1),INSTR($(v%+I%-1)+";",";")-1)
11460DEF FNiconstring(flg%,p%)
11470LOCAL i%,i$
11480IF flg%AND&100 THEN i$=$!p% ELSE i%=p%?12:p%?12=13:i$=$p%:p%?12=i%
11490=i$
11500DEF PROCgetpointer
11510SYS "Wimp_GetPointerInfo",,q%
11520mousex%=!q%:mousey%=q%!4:buttons%=q%!8
11530handle%=q%!12:icon%=q%!16
11540ENDPROC
11550------------------------------------------------------------------------------
11560DEF PROCerrordisplay
11570IF tsloss = TRUE THEN SYS "Wimp_CloseTemplate"
11580REM OSCLI("CLOSE")
11590err%=ERR:!errbuf%=err%
11600CASE err% OF
11610WHEN 1,2:$(errbuf%+4)=REPORT$+CHR$0
11620OTHERWISE
11630 REM$(errbuf%+4)="At Line "+STR$ERL+" reports "+REPORT$+CHR$0
11640 $(errbuf%+4)= REPORT$+CHR$0
11650ENDCASE
11660SYS "Wimp_ReportError",errbuf%,1,"FormEd"
11670IF err%=1 THEN ENDPROC
11680IF REPORT$ ="Too many windows" THEN PROCselection_removeicon:ENDPROC
11690ENDPROC
11700#
11710DEF PROCfinish
11720FORI%=0TO255
11730WHILE fontcounts%?I%>0:SYS "Font_LoseFont",I%:fontcounts%?I%-=1:ENDWHILE
11740NEXT
11750SYS "Wimp_CloseDown"
11760ENDPROC
11770------------------------------------------------------------------------------
11780DEF FNworkspace(L%)
11790IF curbuff%+L%>buffer%+maxbuf% THEN ERROR 1,"No more buffer space"
11800curbuff%+=L%:=curbuff%-L%
11810------------------------------------------------------------------------------
11820DEF FNfindfont(f$,p)
11830LOCALf%
11840SYS "Font_FindFont",,f$,p*16,p*16,0,0 TO f%
11850fontcounts%?f%+=1
11860IF fontcounts%?f%>=255 THEN ERROR 1,"Internal font table full"
11870=f%
11880------------------------------------------------------------------------------
11890DEF PROCxor(handle%,icon%,ntimes%)
11900LOCALI%:FORI%=1TOntimes%:PROCseti(handle%,icon%,&200000,0)
11910tempt%=TIME:REPEATUNTILTIME-tempt%>3:NEXT
11920ENDPROC
11930
11940DEF PROCseti(handle%,icon%,eor%,bic%)
11950!q%=handle%:q%!4=icon%:q%!8=eor%:q%!12=bic%:SYS "Wimp_SetIconState",,q%
11960ENDPROC
11970
11980DEF PROCreadpal(c%,c2%)
11990IF c2%=16 THEN
12000 palword%=paltable%!(4*c%)
12010ELSE SYS "OS_ReadPalette",c%,c2% TO ,,palword%
12020ENDIF
12030r%=(palword%>> 8)AND&FF
12040g%=(palword%>>16)AND&FF
12050b%=(palword%>>24)AND&FF
12060ENDPROC
12070
12080------------------------------------------------------------------------------
12090DEF PROCencodepalmenu(tickcolour%)
12100LOCAL I%,J%
12110PROCencodepal(0,15)
12120I%=m_palette%+28:J%=m_p1lette%+28
12130FOR c%=0 TO 15
12140 I%?11=(c%<<4)+uncolour%(c%):I%!8=I%!8 OR &08 : REM h centred
12150 J%?11=(c%<<4)+uncolour%(c%):J%!8=J%!8 OR &08 : REM h centred
12160 IF c%=tickcolour% THEN
12170 !I%=!I%OR&01
12180 !J%=!J%OR&01
12190 ELSE
12200 !I%=!I%ANDNOT&01
12210 !J%=!J%ANDNOT&01
12220 ENDIF
12230 I%+=24
12240 J%+=24
12250NEXT
12260J%?11=(0<<4)+uncolour%(0):J%!8=J%!8 OR &08
12270IFtickcolour%=255 THEN
12280 !J%=!J%OR1
12290ELSE
12300 !J%=!J%ANDNOT1
12310ENDIF
12320ENDPROC
12330DEF PROCencodepal(c1%,c2%)
12340LOCAL c%,d%,e%,br%,maxd%,maxe%
12350SYS "Wimp_ReadPalette",,paltable%
12360FORc%=c1%TOc2%:bright%(c%)=FNbrightness(c%):NEXT
12370FORc%=c1%TOc2%:br%=bright%(c%):maxe%=-1
12380FORd%=0TO15:e%=ABS(bright%(d%)-br%)
12390IFe%>maxe%THENmaxe%=e%:maxd%=d%
12400NEXT:uncolour%(c%)=maxd%:NEXT
12410ENDPROC
12420DEF FNbrightness(c%)
12430LOCALr%,g%,b%
12440PROCreadpal(c%,16)
12450=r%+g%+g%+b%
12460DEF FNforeback(c%) = (c%<<4)ORuncolour%(c%)
12470------------------------------------------------------------------------------
12480DEF PROCcheckfull(f$)
12490IF INSTR(f$,".") OR INSTR(f$,":") THEN ENDPROC
12500ERROR 1,"To save, drag the file icon to a directory viewer"
12510DEF FNmatchident(A$)
12520IF A$="" THEN =-1
12530LOCAL I%
12540I%=nh%+1:REPEATI%=I%-1:UNTILA$=wident$(I%)ORI%=0
12550IFA$=wident$(I%)THEN=I%ELSE=-1
12560DEF PROCsavetemplates(tfile$,safe%)
12570SYS"Wimp_WhichIcon",browbox%,q%,1<<23,0
12580IF q%!0 = -1 THEN ERROR 1,"No templates to save"
12590IF tfile$ = "Templates" THEN ENDPROC
12600J%=0:FORI%=0TOnh%
12610IF handle%(I%) >nh% THEN
12620 IF wident$(I%)="" THEN ERROR 1,"Only named windows can be saved"
12630 wptr%(J%)=I%:J%+=1
12640ENDIF
12650NEXT
12660REM *** PROCsortwindows removed
12670FORI%=0TO255:fontbinding%?I%=0:NEXT
12680freef%=1 : REM internal font handle allocation
12690tf_hdr%=16
12700tf_fsize%=48
12710tf_handle%=OPENOUT(tfile$)
12720IF tf_handle%=0 THEN ERROR 1,"Can't open file '"+tfile$+"'"
12730tf_dataptr%=tf_hdr%+J%*24+4
12740FORI%=0TOtf_hdr%-1:indexdata%?I%=0:NEXT
12750tf_index%=indexdata%+tf_hdr%
12760FOR I%=J%-1TO0STEP-1
12770!q%=handle%(wptr%(I%)):SYS "Wimp_GetWindowInfo",,q%
12780 q%!68 = 1 : REM *** Assume common sprite area when re-loading
12790tf_datasize%=88+32*q%!88
12800PROCprocessicon(q%+60,q%+76)
12810 q%!28 = -1 : REM *** Place on top of stack
12820IF q%!88>0 THEN PROCprocessicons
12830SYS "OS_GBPB",1,tf_handle%,q%+4,tf_datasize%,tf_dataptr%
12840tf_index%!0=tf_dataptr%
12850tf_index%!4=tf_datasize%
12860tf_index%!8=1
12870$(tf_index%+12)=wident$(wptr%(I%))
12880tf_index%+=24:tf_dataptr%+=tf_datasize%
12890NEXT
12900!tf_index%=0
12910IF freef%=1 THEN !indexdata%=-1 ELSE !indexdata%=tf_dataptr%
12920SYS "OS_GBPB",1,tf_handle%,indexdata%,tf_index%+4-indexdata%,0
12930IF freef%>1 THEN
12940 FOR I%=0 TO tf_fsize%-1:indexdata%?I%=0:NEXT
12950 FOR I%=1 TO freef%-1
12960 J%=0:REPEATJ%+=1:UNTILfontbinding%?J%=I%
12970 SYS "Font_ReadDefn",J%,indexdata%+8 TO ,,indexdata%!0,indexdata%!4
12980 SYS "OS_GBPB",1,tf_handle%,indexdata%,tf_fsize%,tf_dataptr%
12990 tf_dataptr%+=tf_fsize%
13000 NEXT
13010ENDIF
13020CLOSE #tf_handle%
13030OSCLI("Settype "+tfile$+" &FEC")
13040OSCLI("Stamp "+tfile$)
13050IF safe% THEN templatef$=tfile$:_altered = FALSE
13060$_titlestring% = templatef$: $mb_templates% = templatef$
13070PROCchangewindowtitle(browbox%,_titlestring%)
13080IF _RESET% THEN
13090 IF _QUIT% THEN PROCfinish:END
13100 PROCresetwindowdefs
13110 PROCclose(browbox%)
13120ENDIF
13130ENDPROC
13140DEF PROCprocessicons
13150LOCAL I%,J%
13160J%=q%+92
13170FOR I%=0 TO q%!88-1:PROCprocessicon(J%+16,J%+20):J%+=32:NEXT
13180ENDPROC
13190DEF PROCprocessicon(fptr%,qptr%)
13200IF !fptr% AND &40 THEN
13210 extf%=fptr%?3:intf%=fontbinding%?extf%
13220 IF intf%=0 THEN intf%=freef%:freef%+=1:fontbinding%?extf%=intf%
13230 fptr%?3=intf%
13240ENDIF
13250IF !fptr% AND &100 THEN
13260 B%=q%+4+tf_datasize%
13270 $B%=$!qptr%:!qptr%=tf_datasize%:tf_datasize%+=LEN$B%+1
13280 IF qptr%!4>0 THEN
13290 B%=q%+4+tf_datasize%
13300 $B%=$(qptr%!4):qptr%!4=tf_datasize%:tf_datasize%+=LEN$B%+1
13310 ENDIF
13320ENDIF
13330ENDPROC
13340DEF PROCloadtemplates(tfile$)
13350LOCAL I%,f$
13360 REM *SPOOL buggy
13370REM tsloss = TRUE
13380IF tfile$="" THEN ENDPROC
13390SYS "Wimp_OpenTemplate",,tfile$
13400IF tfile$<>"<Wimp$Scrap>" THEN templatef$=tfile$ : REM only if load succeeded!
13410REM LOCAL ERROR
13420REM ON ERROR LOCAL:ON ERROR RESTORE:SYS "Wimp_CloseTemplate":ERROR ERR,REPORT$:ENDPROC
13430tf_index%=0:REPEAT
13440$mb_wident%="*"
13450 REM PRINT "0.1"
13460SYS "XWimp_LoadTemplate",,q%+4,curbuff%,buffer%+maxbuf%,fontcounts%,mb_wident%,tf_index% TO ,,curbuff%,,,,tf_index%;VFLAGS%
13470IF ( VFLAGS% MOD 2 ) = 1 THEN ERROR _init%, "Cannot load Template File"
13480$_data% = $mb_wident%
13490uio%=0:WHILE NOT(_data%?uio%=0OR_data%?uio%=13):uio%+=1:ENDWHILE:$mb_wident%=LEFT$($_data%,uio%):mb_wident%?(uio%)=13
13500IF tf_index%<>0 THEN PROCloadtemp($mb_wident%)
13510 REM PRINT "0.2"
13520UNTIL tf_index%=0
13530SYS "Wimp_CloseTemplate"
13540REM *** tsloss = FALSE: *CLOSE
13550ENDPROC
13560DEF PROCloadtemp(wident$)
13570 REM PRINT "0.1.1"
13580I%=FNmatchident(wident$):
13590IF I%<>-1 THEN ENDPROC
13600q%!68=spritearea% : REM user sprite area
13610 REM PRINT "0.1.2"
13620PROCcrwindow(q%+4,wident$)
13630ENDPROC
13640------------------------------------------------------------------------------
13650DEF PROCdefaultwindows
13660SYS "Wimp_OpenTemplate",,"<FormEd$Dir>.Templates"
13670DIM default% (88+1*32)
13680PROCloadcrtemp("default",default%)
13690m_info% = FNcrtemp("info")
13700m_workarea% = FNcrtemp("m_workarea")
13710m_savetemp% = FNcrtemp("save_temp")
13720REM errorbox% = FNcrtemp("errorbox")
13730quitbox% = FNcrtemp("quitbox")
13740browbox% = FNcrtemp("browser")
13750SYS "Wimp_CloseTemplate"
13760mb_templates% = FNiconaddr(m_savetemp%,1)
13770mb_workarea0% = FNiconaddr(m_workarea%,9)
13780mb_workarea1% = FNiconaddr(m_workarea%,10)
13790mb_minx% = FNiconaddr(m_workarea%,14)
13800mb_miny% = FNiconaddr(m_workarea%,15)
13810ENDPROC
13820DEF FNcrtemp(wident$)
13830PROCloadcrtemp(wident$,q%)
13840 IF wident$ = "browser" THEN _ptrtitle% = q%!72
13850SYS "XWimp_CreateWindow",,q% TO I%;VFLAGS%
13860 IF ( VFLAGS% MOD 2 ) = 1 THEN ERROR 0 , "Could not create window"
13870=I%
13880DEF PROCloadcrtemp(wident$,q%)
13890LOCAL I%,c%,c2%,w$
13900c%=curbuff%:c2%=buffer%+maxbuf%
13910w$=wident$+STRING$(12-LENwident$,CHR$13)
13920SYS "Wimp_LoadTemplate",,q%,c%,c2%,fontcounts%,w$,0 TO ,,curbuff%,,,,c%
13930IF c%=0 THEN SYS"XWimp_CloseTemplate":ERROR 0,"Window '"+wident$+"' not found"
13940q%!64=systemsprites%
13950IF wident$="save_temp" THEN q%!64=1
13960_sloss% = curbuff%
13970ENDPROC
13980DEF FNiconaddr(h%,i%)
13990!q%=h%:q%!4=i%:SYS "Wimp_GetIconState",,q%
14000IF q%!24AND&100 THEN =q%!28
14010ERROR 1,"Icon is not indirected"
14020DEF FNiconbar
14030LOCAL ic%
14040!q%=-1
14050q%!4=0
14060q%!8=0
14070q%!12=69
14080q%!16=68
14090q%!20=&3002
14100$(q%+24)="!formed"
14110SYS "Wimp_CreateIcon",,q% TO ic%
14120=ic%
14130------------------------------------------------------------------------------
14140DEF PROCobjectclosedown
14150 q%!12 = q%!8:SYS "Wimp_SendMessage",19,q%
14160 _prequit = TRUE
14170 PROCicon_write(quitbox%,1,FNmsg_0("Q1"))
14180 PROCfront(quitbox%):_RESET% = FALSE
14190ENDPROC
14200#
14210 REM *********************************************
14220 REM ************** Browser Control **************
14230 REM *********************************************
14240#
14250DEF PROCbuildbrowsericon(wident$,_type%)
14260 DIM _text% 15
14270 LOCAL _ptr%,_sprite%
14280 _ptr% = _BUF100%
14290 $_text% = wident$+CHR$0+CHR$13
14300 IF _type% = 0 THEN _sprite% = _SPRDIA% ELSE _sprite% = _SPRWIN%
14310 REM bit 1 - is a sprite
14320 REM bit 4 - v vertically centred
14330 REM bit 5 - filled background
14340 REM bit 8 - indirected
14350 REM bit 12-15 - icon type
14360 !(_ptr%+0) = browbox%
14370 !(_ptr%+4) = _biconx%
14380 !(_ptr%+8) = _bicony%
14390 !(_ptr%+12) = _biconx% + 220:REM OLD Value '300'
14400 !(_ptr%+16) = _bicony% + 50
14410 !(_ptr%+20) = %00010111000000001010000100110011
14420 !(_ptr%+24) = _text%
14430 IF _type% = 0 THEN
14440 !(_ptr%+28) = _SPRDIA%
14450 ELSE
14460 !(_ptr%+28) = _SPRWIN%
14470 ENDIF
14480 !(_ptr%+32) = LEN($_text%) + LEN($_sprite%)+30:REM was + 2
14490 SYS "Wimp_CreateIcon",,_ptr% TO _iconhandle%
14500 SYS "Wimp_ForceRedraw",browbox%,_biconx%,_bicony%,_biconx%+300,_bicony% + 50
14510 _biconx% += 300
14520 IF _biconx% > 900 THEN
14530 _bicony% -= 50
14540 _biconx% = 10
14550 ENDIF
14560 !(_ptr%+0) = 0
14570 IF _biconx% = 10 THEN !(_ptr%+4)=_bicony% ELSE !(_ptr%+4)=_bicony%
14580 !(_ptr%+8) = 850
14590 !(_ptr%+12) = 0
14600 SYS "Wimp_SetExtent",browbox%,_ptr%
14610ENDPROC
14620DEF PROCbrowser_redraw
14630ENDPROC
14640#
14650DEF PROCadd_to_array(newstring$)
14660 LOCAL h%
14670 WHILE NOT (_wid$(h%)= "*" OR h% = nh% ):h% += 1:ENDWHILE
14680 IF newstring$ = "" THEN
14690 newstring$ = "NoIdent"+STR$_noid%
14700 ELSE
14710 _wid$(h%) = newstring$
14720 ENDIF
14730ENDPROC
14740#
14750DEF PROCchangewindowtitle (_w%,_newtitle%)
14760 q%!0 = _w%
14770 SYS "Wimp_GetWindowInfo",,q%
14780 _p% = !(q%+76)
14790 $_p% = $_newtitle%
14800 SYS "Wimp_ForceRedraw",-1,q%!4,(q%!16)-36,q%!12,q%!16+36
14810ENDPROC
14820#
14830DEF PROCshowwindow(icon%,buttons%)
14840 q%!0 = browbox%
14850 q%!4 = icon%
14860 IF buttons% = &04 THEN
14870 SYS "Wimp_GetIconState",,q%
14880 _p% = !(q%+28)
14890 REM _p%?12 = 13
14900 REM OSCLI ("*SPOOL zxc"):P. ?(_p%+LEN($_p%)-1):OSCLI("*SPOOL")
14910 IF ?(_p%+LEN($_p%)-1) = 0 THEN
14920 _p%?(LEN($_p%)-1) = 13
14930 ENDIF
14940 REM *SPOOL XZC
14950 m% = FNequalid($_p%):_p%?(LEN($_p%)) = 0
14960 REM *SPOOL
14970 $mb_cpywin% = $_p% : $mb_renwin% = $_p%
14980 q%!0 = handle%(m%)
14990 SYS "Wimp_GetWindowState",,q%
15000 q%!28 = -1
15010 SYS "Wimp_OpenWindow",,q%
15020 currentwindow%=m%:handle% = m%
15030 currenticon%=-1
15040 ENDIF
15050 IF buttons% = &04*256 THEN PROCselection_unset
15060 IF buttons% = &01*256 OR buttons% = &01 THEN
15070 PROCselection_unseticon(icon%)
15080 ELSE
15090 q%!8 = %00000000001000000000000000000000
15100 q%!12 = %00000000001000000000000000000000
15110 q%!4 = icon%
15120 q%!0 = browbox%
15130 SYS "Wimp_SetIconState",,q%
15140 SYS "Wimp_GetIconState",,q%
15150 ENDIF
15160 _p% = !(q%+28):_p%?12 = 13
15170 IF ?(_p%+LEN($_p%)-1) = 0 THEN _p%?(LEN($_p%)-1) = 13
15180 _p%?(LEN($_p%)) = 0
15190 $mb_cpywin% = $_p% : $mb_renwin% = $_p%
15200 IF buttons% = &04 THEN PROCselection_unset
15210ENDPROC
15220#
15230DEF FNequalid(st$)
15240 FOR UI% = 1 TO nh%
15250 IF wident$(UI%) = st$ THEN =UI%
15260 NEXT UI%
15270=-1
15280#
15290DEF PROCaddchange(_t%)
15300LOCAL length%
15310 IF NOT(_altered) THEN
15320 length% = LEN($_t%)
15330 $_t% = $_t% + CHR$(32)
15340 $_t% = $_t% + CHR$(42)
15350 $_t% = $_t% + CHR$(13)
15360 $_t% = $_t% + CHR$(0)
15370 PROCchangewindowtitle(browbox%,_t%)
15380 _altered = TRUE
15390 ENDIF
15400ENDPROC
15410#
15420DEF PROCresetwindowdefs
15430 LOCAL AA%,displacement%
15440 FOR AA% = 0 TO nh%:
15450 IF NOT ( wident$(AA%) = "" ) THEN
15460 PROCdeletewindow(AA%)
15470 handle%(AA%) = -1:wident$(AA%) = ""
15480 ENDIF
15490 NEXT
15500 SYS "Wimp_WhichIcon",browbox%,q%,&01,&01
15510 WHILE NOT ( q%!displacement% = -1 )
15520 _temp%!0 = browbox%
15530 _temp%!4 = q%!displacement%
15540 displacement% += 4
15550 SYS "Wimp_DeleteIcon",,_temp%
15560 ENDWHILE
15570 q%!0 = 0
15580 q%!4 = -60
15590 q%!8 = 850
15600 q%!12 = 0
15610 SYS "Wimp_SetExtent",browbox%,q%
15620 $_titlestring% = "<untitled>"
15630 PROCchangewindowtitle(browbox%,_titlestring%)
15640 PROCrefreash_browser
15650 _biconx% = 10 : _bicony% = -50 : _altered = FALSE :
15660FOR I%=0TOnh%:handle%(I%)=I%-1:wident$(I%)="":_wid$(I%)="*":NEXT:handleSP%=nh%
15670curbuff%=_sloss%
15680$mb_templates% = "Templates"
15690ENDPROC
15700#
15710DEF PROCselection_unset
15720 LOCAL displacement%
15730 SYS "Wimp_WhichIcon",browbox%,q%,1<<21,1<<21
15740 WHILE NOT ( q%!displacement% = -1 )
15750 _temp%!8 = 0
15760 _temp%!12 = %00000000001000000000000000000000
15770 _temp%!4 = q%!displacement%
15780 _temp%!0 = browbox%
15790 SYS "Wimp_SetIconState",,_temp%
15800 displacement% += 4
15810 ENDWHILE
15820ENDPROC
15830#
15840DEF PROCselection_delete
15850 LOCAL displacement%
15860 SYS "Wimp_WhichIcon",browbox%,q%,1<<21,1<<21
15870 WHILE NOT ( q%!displacement% = -1 )
15880 _temp%!0 = browbox%
15890 _temp%!4 = q%!displacement%
15900 displacement%+=4
15910 PROCselection_removewindow(_temp%!4)
15920 SYS "Wimp_DeleteIcon",,_temp%
15930 ENDWHILE
15940 PROCselection_shuffle
15950 IF NOT(_altered) THEN
15960 PROCaddchange(_titlestring%)
15970 ENDIF
15980ENDPROC
15990#
16000DEF PROCselection_name
16010 LOCAL displacement%
16020 CASE FNselnum OF
16030 WHEN 0 : REM *** No Selection Made ***
16040 $(m_browser%!(28+24*1+12)) = "Selection "
16050 PROCshade(m_browser%,1)
16060 ENDPROC
16070 WHEN 1 : REM *** Single Selection Made ***
16080 PROCunshade(m_selwin%,0)
16090 PROCunshade(m_selwin%,1)
16100 q%!4 = q%!0
16110 q%!0 = browbox%
16120 SYS "Wimp_GetIconState",,q%
16130 REM $mb_renwin% = $(!(q%+28)):$mb_cpywin% = $(!(q%+28))
16140 _p% = !(q%+28):_p%?(LEN($_p%)-1) = ASC("'")
16150 $(m_browser%!(28+24*1+12)) = "Sel.'"+$_p%
16160 _p%?(LEN($_p%)-1) = 0
16170 WHEN 42 : REM *** Multiple Selection Made ***
16180 q%!4 = q%!0
16190 q%!0 = browbox%
16200 SYS "Wimp_GetIconState",,q%
16210 $(m_browser%!(28+24*1+12)) = "Selection "
16220 PROCshade(m_selwin%,0)
16230 PROCshade(m_selwin%,1)
16240 ENDCASE
16250ENDPROC
16260#
16270DEF PROCselection_seticon(sicon%)
16280 q%!0 = browbox%
16290 q%!4 = sicon%
16300 SYS "Wimp_GetIconState",,q%
16310 _temp%!8 = 1<<21
16320 _temp%!12 = %00000000001000000000000000000000
16330 _temp%!4 = sicon%
16340 _temp%!0 = browbox%
16350 REM $mb_renwin% = $(!(q%+28)):$mb_cpywin% = $(!(q%+28))
16360 SYS "Wimp_SetIconState",,_temp%
16370ENDPROC
16380#
16390DEF FNselnum
16400 LOCAL displacement%
16410 SYS "Wimp_WhichIcon",browbox%,q%,1<<21,1<<21
16420 IF q%!displacement% = -1 THEN = 0
16430 displacement% += 4
16440 IF q%!displacement% = -1 THEN = 1
16450=42
16460#
16470DEF PROCreshow_window(q%)
16480 SYS"Wimp_GetWindowState",,q%
16490 SYS"Wimp_OpenWindow",,q%
16500ENDPROC
16510#
16520DEF PROCreformat_string(stg%)
16530 LOCAL ref%
16540 REM *spool debug
16550 WHILE NOT(stg%?ref%=32) AND NOT(stg%?ref%=0) AND NOT(stg%?ref%=13)
16560 REM PRINT stg%?ref% " = "CHR$(stg%?ref%)
16570 ref%+=1
16580 ENDWHILE
16590 stg%?ref% = 13: REM *** Might replace with 13 - I did
16600 REM P. LEN($stg%)
16610ENDPROC
16620#
16630DEF FNchk_duplicates(str$)
16640 LOCAL dup%
16650 FOR dup% = 0 TO nh%:IF wident$(dup%) = str$ THEN =TRUE
16660 NEXT
16670= FALSE
16680#
16690DEF FNicon_identifier(str$)
16700LOCAL win%,temp$
16710 FOR win% = 0 TO nh%:temp$ = wident$(win%)+CHR$(0)
16720 IF str$ = temp$ THEN = win%
16730 NEXT
16740= -1
16750#
16760DEF PROCselection_removewindow(I%)
16770LOCAL rwin%,t%
16780 t% = _BUF100%
16790 t%!4 = I%
16800 t%!0 = browbox%
16810 SYS "Wimp_GetIconState",,t%
16820 _p% = !(t%+28)
16830 rwin% = FNicon_identifier($_p%)
16840 IF rwin% = -1 THEN
16850 ERROR 1, "Could not link to window"
16860 ELSE
16870 PROCdeletewindow(rwin%)
16880 ENDIF
16890ENDPROC
16900#
16910DEF PROCselection_removeicon
16920 q%!0 = browbox%
16930 q%!4 = _iconhandle%
16940 SYS "Wimp_GetIconState",,q%
16950 SYS "Wimp_DeleteIcon",,q%
16960ENDPROC
16970#
16980DEF PROCselection_shuffle
16990LOCAL displacement%,arrnum%,search%,EW%,handle%,t%
17000t% = _BUF100%
17010FOR EW% = 0 TO nh%:_win%(EW%)=-1:NEXT
17020SYS "Wimp_WhichIcon",browbox%,q%,1<<23,0<<23
17030 WHILE NOT ( q%!displacement% = -1 )
17040 t%!0 = browbox%
17050 t%!4 = q%!displacement%
17060 SYS "Wimp_GetIconState",,t%
17070 arrnum% = (t%!20/-50)*3+(t%!8/300)
17080 _win%(arrnum%)=t%!4
17090 displacement%+=4
17100 ENDWHILE
17110 REM *** Shuffle Windows
17120 FOR arrnum% = 0 TO nh%
17130 IF _win%(arrnum%) = -1 THEN
17140 search% = arrnum%+1
17150 WHILE search% <= nh% AND _win%(search%) = -1:search%+=1:ENDWHILE
17160 IF NOT(search% >= nh%) THEN
17170 _win%(arrnum%) = _win%(search%)
17180 _win%(search%) = -1
17190 ENDIF
17200 ENDIF
17210 NEXT
17220 FOR arrnum% = 0 TO nh%
17230 IF NOT (_win%(arrnum%) = -1) THEN
17240 t%!0 = browbox%
17250 t%!4 = _win%(arrnum%)
17260 SYS "Wimp_GetIconState",,t%
17270 SYS "Wimp_DeleteIcon",,t%
17280 t%!4 = browbox%
17290 t%!8 = 10+((arrnum% - (arrnum%DIV3)*3))*300
17300 t%!12 = (arrnum%DIV3+1)*-50
17310 t%!16 = t%!8 + 300
17320 t%!20 = t%!12 + 50
17330 SYS "Wimp_CreateIcon",,(t%+4) TO handle%
17340 ENDIF
17350 NEXT
17360 q%!0 = 0
17370 q%!4 = t%!12-10
17380 q%!8 = 850
17390 q%!12 = 0
17400 SYS "Wimp_SetExtent",browbox%,q%
17410 _biconx% = t%!8+300:_bicony% = t%!12
17420 IF _biconx% > 900 THEN _biconx% = 10:_bicony% -=50
17430 IF _win%(0) = -1 THEN _biconx% = 10:_bicony% = -50
17440 PROCrefreash_browser
17450ENDPROC
17460#
17470DEF PROCrefreash_browser
17480 q%!0 = browbox%
17490 SYS "Wimp_GetWindowState",,q%
17500 SYS "Wimp_CloseWindow" ,,q%
17510 SYS "Wimp_OpenWindow" ,,q%
17520ENDPROC
17530#
17540DEF PROCselection_rename
17550LOCAL rwin%,_p%,strcpy$
17560 strcpy$ = $mb_renwin%
17570 rwin% = FNicon_identifier(strcpy$)
17580 IF NOT( rwin% = -1 ) THEN
17590 ERROR 1, "Duplicate identifiers"
17600 ELSE
17610 SYS "Wimp_WhichIcon",browbox%,q%,1<<21,1<<21
17620 IF NOT( q%!0 = -1 ) THEN
17630 q%!4 = q%!0
17640 q%!0 = browbox%
17650 SYS "Wimp_GetIconState",,q%
17660 REM mb_renwin%?(LEN($mb_renwin%)) = 13
17670 _p% = q%!28
17680 rwin% = FNicon_identifier($_p%)
17690 wident$(rwin%) = $mb_renwin%
17700 mb_renwin%?(LEN($mb_renwin%)+1)=13
17710 mb_renwin%?(LEN($mb_renwin%)) =0
17720 $_p% = $mb_renwin%
17730 ENDIF
17740 ENDIF
17750 IF NOT(_altered) THEN
17760 PROCaddchange(_titlestring%)
17770 ENDIF
17780 PROCrefreash_browser
17790ENDPROC
17800#
17810DEF PROCcopy_title ( t% )
17820 IF t%!56AND&100 THEN
17830 B% = FNworkspace ( t%!80 ):$B% = $(t%!72): t%!72 = B%
17840 IFt%!76>0THENB% = FNworkspace ( t%!80 ):$B% = $(t%!76): t%!76 = B%
17850 ENDIF
17860ENDPROC
17870#
17880DEF PROCcopy_icons ( t% )
17890 LOCAL wq%,xcount%
17900 xcount% = t%!84
17910 WHILE NOT ( xcount% = 0 )
17920 wq% = 88+(32*(xcount%-1))
17930 IF t%!(wq%+16)AND&100 THEN
17940 B% = FNworkspace(t%!(wq%+28)):$B%=$(t%!(wq%+20)):t%!(wq%+20)=B%
17950 IFt%!24>0THENB%=FNworkspace(t%!(wq%+28)):$B%=$(t%!(wq%+24)):t%!(wq%+24)=B%
17960 ENDIF
17970 xcount% = xcount% - 1
17980 ENDWHILE
17990ENDPROC
18000#
18010DEF PROCselection_copy
18020LOCAL rwin%,_p%,strcpy$
18030 SYS "Wimp_WhichIcon",browbox%,q%,1<<21,1<<21
18040 IF NOT( q%!0 = -1 ) THEN
18050 q%!4 = q%!0
18060 q%!0 = browbox%
18070 SYS "Wimp_GetIconState",,q%
18080 _p% = q%!28
18090 rwin% = FNicon_identifier($_p%)
18100 IF rwin% = -1 THEN ENDPROC ELSE q%!0 = handle%(rwin%)
18110 SYS "Wimp_GetWindowInfo",,q%
18120 REM mb_cpywin%?(LEN($mb_cpywin%)+1) = 13
18130 REM mb_cpywin%?(LEN($mb_cpywin%)) = 0
18140 PROCcopy_title ( q%+4 )
18150 PROCcopy_icons ( q%+4 )
18160 PROCcrwindow ( q%+4 , $mb_cpywin%)
18170 ENDIF
18180 IF NOT(_altered) THEN
18190 PROCaddchange(_titlestring%)
18200 ENDIF
18210ENDPROC
18220#
18230DEF PROCchck_handle(chandle%)
18240LOCAL ui%
18250 IF _altered THEN ENDPROC
18260 FOR ui% = 0 TO nh%:
18270 IF handle%(ui%) = chandle% AND NOT(_altered) THEN
18280 PROCaddchange(_titlestring%)
18290 ENDIF
18300 NEXT ui%
18310ENDPROC
18320#
18330DEF FNchck_newtemplate
18340 LOCAL count%
18350 FOR count% = 0 TO nh%: IF wident$(count%) <> "" THEN =FALSE
18360 NEXT
18370=TRUE
18380#
18390DEF PROCmove_xdir(RETURN xmag%,RETURN xsize%)
18400LOCAL ix0%,iy0%,sx%,sy%
18410 ix0% = q%!8
18420 sx% = q%!16 - ix0%
18430 SYS"Wimp_GetWindowInfo",,q%
18440 IF xmag% > q%!52 OR (xmag%+sx%) < q%!44 THEN xmag% = ix0%
18450 xsize% = xmag% + sx%
18460ENDPROC
18470#
18480DEF PROCmove_ydir(RETURN ymag%,RETURN ysize%)
18490LOCAL ix0%,iy0%,sx%,sy%
18500 iy0% = q%!12
18510 sy% = q%!20 - iy0%
18520 SYS"Wimp_GetWindowInfo",,q%
18530 IF ymag% > q%!56 OR (ymag%+sy%) < q%!48 THEN ymag% = iy0%
18540 ysize% = ymag% + sy%
18550ENDPROC
18560#
18570DEF PROCuntick(mh%,I%)
18580mh%!(28+24*I%)=(mh%!(28+24*I%)>>2)<<2:ENDPROC
18590#
18600DEF PROCselection_on
18610 SYS"Wimp_GetPointerInfo",,q%
18620 IF q%!16 = -1 THEN ENDPROC
18630 IF NOT( FNselnum = 0) THEN ENDPROC
18640 SYS"Wimp_GetPointerInfo",,q%
18650 PROCshowwindow(q%!16,&04*256)
18660ENDPROC
18670#
18680DEF PROCzzzz(handle%)
18690 q%!0 = handle%
18700 SYS "Wimp_GetWindowState",,q%
18710 _ans% = q%!32>>>30
18720 IF _ans% = 0 THEN
18730 _ans% = q%!32AND&0C
18740 ELSE
18750 _ans% = q%!32>>>28AND&05
18760 ENDIF
18770 wicon% = FNiconwanted(wident$(currentwindow%)+CHR$0)
18780 REM *spool
18790 REM ERROR 1 , " Icon Number "+STR$(wicon%)
18800 IF wicon% > -1 THEN
18810 REM VDU7
18820 q%!0 = browbox%
18830 q%!4 = wicon%
18840 SYS "Wimp_GetIconState",,q%
18850 REM PRINT " WINDOW TYPE SET TO "_ans%
18860 IF _ans% = 0 THEN
18870 q%!32 = _SPRDIA%
18880 ELSE
18890 q%!32 = _SPRWIN%
18900 ENDIF
18910 SYS "Wimp_DeleteIcon",,q%
18920 q%!4 = q%!0
18930 SYS "Wimp_CreateIcon",,q%+4 TO _vvvvvvv%
18940 SYS "Wimp_ForceRedraw",browbox%,q%!8,q%!12,q%!16,q%!20
18950 ENDIF
18960ENDPROC
18970#
18980DEF FNiconwanted ( string$ )
18990LOCAL displacement%: DIM t% 200
19000REM *SPOOL ICON
19010REM PRINT "STRING WANT "string$" len "LEN(string$)
19020SYS "Wimp_WhichIcon",browbox%,t%,1,1
19030 IF NOT( t%!0 = -1 ) THEN
19040 WHILE NOT ( t%!displacement% = -1 )
19050 q%!0 = browbox%
19060 q%!4 = t%!displacement%
19070 SYS "Wimp_GetIconState",,q%
19080 REM PRINT "COMPARING "$(q%!28)" len "LEN($(q%!28))
19090 IF $(q%!28) = string$ THEN =displacement%/4
19100 REM PRINT "COMPARING "$(q%!28)" len "LEN($(q%!28))
19110 displacement%+=4
19120 ENDWHILE
19130 ENDIF
19140=-1
19150#
19160DEF PROCselection_unseticon(icon%)
19170 LOCAL set%
19180 q%!4 = icon%
19190 q%!0 = browbox%
19200 SYS "Wimp_GetIconState",,q%
19210 set% = q%!24 AND 1<<21
19220 IF set%>0 THEN set% = 0 ELSE set% = 1<<21
19230 q%!8 = set%
19240 q%!12 = 1<<21
19250 q%!4 = icon%
19260 q%!0 = browbox%
19270 SYS "Wimp_SetIconState",,q%
19280 SYS "Wimp_GetIconState",,q%
19290ENDPROC
19300#
19310:
19320REM
19330REM Code added by Fil
19340REM
19350DEFPROCmsg_initialise(N$)
19360LOCAL c%,c$,i%
19370c%=OPENIN(N$)
19380IFc%=0 ERROR 0, "Cannot find messages file"
19390ms_tags%=0
19400SYS"Hourglass_On"
19410WHILE NOT(EOF#c%)
19420 c$=GET$#c%
19430 IFc$<>"" THEN
19440 IFLEFT$(c$,1)<>"#" THEN
19450 IFINSTR(c$,":")<>0 ms_tags%+=1
19460 ENDIF
19470 ENDIF
19480ENDWHILE
19490IFms_tags%<>0 THEN
19500 DIM ms_text$(ms_tags%-1),ms_tags$(ms_tags%-1)
19510 PTR#c%=0
19520 i%=0
19530 WHILE NOTEOF#c%
19540 c$=GET$#c%
19550 IFc$<>"" THEN
19560 IFLEFT$(c$,1)<>"#" THEN
19570 ms_tags$(i%)=LEFT$(c$,INSTR(c$,":")-1)
19580 ms_text$(i%)=MID$(c$,INSTR(c$,":")+1)
19590 i%+=1
19600 ENDIF
19610 ENDIF
19620 ENDWHILE
19630ENDIF
19640CLOSE#c%
19650SYS"Hourglass_Off"
19660ENDPROC
19670:
19680DEFFNmsg_0(T$)
19690=FNmsg_4(T$,"","","","")
19700:
19710DEFFNmsg_1(T$,S$)
19720=FNmsg_4(T$,S$,"","","")
19730:
19740DEFFNmsg_2(T$,S0$,S1$)
19750=FNmsg_4(T$,S0$,S1$,"","")
19760:
19770DEFFNmsg_3(T$,S0$,S1$,S2$)
19780=FNmsg_4(T$,S0$,S1$,S2$,"")
19790:
19800DEFFNmsg_4(T$,S0$,S1$,S2$,S3$)
19810LOCAL i%,f%
19820IFms_tags%=0 THEN
19830 =T$
19840ELSE
19850 FORi%=0 TO ms_tags%-1
19860 IFT$=ms_tags$(i%) THEN
19870 T$=ms_text$(i%)
19880 f%=INSTR(T$,"%0")
19890 IFf%<>0 T$=LEFT$(T$,f%-1)+S0$+MID$(T$,f%+2)
19900 f%=INSTR(T$,"%1")
19910 IFf%<>0 T$=LEFT$(T$,f%-1)+S1$+MID$(T$,f%+2)
19920 f%=INSTR(T$,"%2")
19930 IFf%<>0 T$=LEFT$(T$,f%-1)+S2$+MID$(T$,f%+2)
19940 f%=INSTR(T$,"%3")
19950 IFf%<>0 T$=LEFT$(T$,f%-1)+S3$+MID$(T$,f%+2)
19960 i%=ms_tags%
19970 ENDIF
19980 NEXT
19990ENDIF
20000=T$
20010:
20020DEFPROCmsg_end
20030ENDPROC
20040:
20050DEFPROCmenu_initialise(men_ws%,men_df%)
20060menu_max_ws%=men_ws%:DIM menu_ws% men_ws%
20070menu_max_df%=men_df%:DIM menu_df% men_df%
20080menu_end%=menu_df%+men_df%
20090menu_curws%=menu_ws%
20100ENDPROC
20110:
20120DEFFNmenu_create(menu$)
20130LOCAL M%,m$,I%,menuptr%,maxx%
20140IF (menu_df%+28>menu_end%) ERROR 0, "Out of menu workspace - increase 2nd parameter to initialisation"
20150menuptr%=menu_df%
20160I%=0
20170IF LEFT$(menu$,1)="#" THEN
20180 I%=1
20190 menutitle$=FNmenu_par(menu$,",",I%)
20200ELSE
20210 menutitle$=""
20220ENDIF
20230$menuptr%=LEFT$(menutitle$,12)
20240menuptr%?12=7
20250menuptr%?13=2
20260menuptr%?14=7
20270menuptr%?15=0
20280menuptr%!16=196
20290menuptr%!20=44
20300menuptr%!24=0
20310menuptr%+=28
20320maxx%=LENmenutitle$-3
20330REPEAT
20340 item$=FNmenu_par(menu$,",",I%)
20350 PROCmenu_item(item$,maxx%,menuptr%)
20360UNTIL item$=""
20370M%=menu_df%
20380M%!16=(maxx%*8+6)*2
20390menu_df%=menuptr%
20400=M%
20410:
20420DEFPROCmenu_item(text$,RETURN maxx%,RETURN menuptr%)
20430LOCAL I%,F%,L%
20440IF text$="" menuptr%!-24=(menuptr%!-24)OR &80:ENDPROC
20450IF (menuptr%+24>menu_end%) ERROR 0, "Out of menu workspace - increase 2nd parameter to initialisation"
20460F%=&00
20470IF RIGHT$(text$,1)="#" text$=LEFT$(text$):F%+=&02:REM dotted line follows item
20480IF RIGHT$(text$,1)="@" text$=LEFT$(text$):F%+=&08:REM generate a menu warning
20490menuptr%!0=F%
20500menuptr%!4=-1
20510menuptr%!8=&07000021
20520IF LEFT$(text$,1)="$" THEN
20530 !menuptr%+=&04 :REM item is writeable
20540 text$=STRING$(12," ")
20550ELSE
20560 IF LENtext$<=12 THEN
20570 $(menuptr%+12)=text$
20580 ELSE
20590 I%=FNmenu_workspace(LENtext$+1):$I%=text$
20600 menuptr%!12=I%:menuptr%!16=-1:menuptr%!20=LENtext$+1
20610 menuptr%!8=menuptr%!8OR &100
20620 ENDIF
20630ENDIF
20640IF LENtext$>maxx% maxx%=LENtext$
20650menuptr%+=24
20660ENDPROC
20670:
20680DEFPROCmenu_attach(menu%,item%,ptr%,traverse%)
20690menu%+=28+item%*24
20700IF traverse% !menu%=!menu% OR (1<<4)
20710menu%!4=ptr%
20720ENDPROC
20730:
20740DEFPROCmenu_writeable(menu%,item%,ptr%,size%)
20750REM This routine just sets the width, ptr and size of the
20760REM specified writeable option. It must have been made
20770REM writeable earlier by FNmenu_create
20780LOCAL M%,L%
20790M%=0
20800WHILE menu%?M%<>13 AND M%<>12 M%+=1:ENDWHILE
20810M%-=3
20820L%=size%:IF L%>16 L%=16
20830IF L%>M% M%=L%
20840IFmenu%!16<(M%*8+6)*2 menu%!16=(M%*8+6)*2
20850menu%+=28+item%*24
20860menu%!8=menu%!8 OR &100
20870menu%!12=ptr%
20880menu%!16=-1
20890menu%!20=size%
20900ENDPROC
20910:
20920DEFFNmenu_par(menu$,sep$,RETURN I%)
20930LOCAL L%
20940L%=I%+1
20950I%=INSTR(menu$+sep$,sep$,L%)
20960=MID$(menu$,L%,I%-L%)
20970:
20980DEFPROCmenu_shade(menuhandle%,item%,value%)
20990IF -((menuhandle%!(28+8+24*item%) AND &400000)=&400000)<>value% THEN
21000 menuhandle%!(28+8+24*item%)=menuhandle%!(28+8+24*item%)EOR &400000
21010ENDIF
21020ENDPROC
21030:
21040DEFPROCmenu_tick(menuhandle%,item%)
21050menuhandle%!(28+24*item%)=menuhandle%!(28+24*item%)OR 1:REM was EOR
21060ENDPROC
21070:
21080DEFFNmenu_workspace(L%)
21090IF menu_curws%+L%>menu_ws%+menu_max_ws% ERROR 0, "Out of menu workspace - increase 1st parameter to initialisation"
21100menu_curws%+=L%
21110=menu_curws%-L%
21120:
21130DEFPROCmenu_submenu(p%,x%,y%)
21140SYS"Wimp_CreateSubMenu",,p%,x%,y%
21150ENDPROC
21160:
21170DEFPROCmenu_window(h%,x%,y%)
21180SYS"Wimp_CreateMenu",,h%,x%,y%
21190ENDPROC
21200:
21210DEFPROCmenu_close
21220SYS"Wimp_CreateMenu",,-1
21230ENDPROC
21240:
21250DEFPROCcreate_menus
21260PROCmenu_initialise(256,5000)
21270DIM ib_text% 80,ib_sprite% 12,ib_buffersize% 6,ib_validation% 80
21280DIM tb_text% 40,tb_sprite% 12,tb_buffersize% 6
21290DIM mb_fsize% 6:$mb_fsize%="30"
21300DIM mb_renwin% 12 , mb_cpywin% 12
21310DIM mb_wident% 12 , mb_newident% 12:$mb_newident% = ""+CHR$(0)
21320DIM mb_ixcon% 5 , mb_iycon% 5:$mb_ixcon%="0":$mb_iycon%="0"
21330DIM mb_renumber% 5:$mb_renumber%="0"
21340 m_palette%=FNmenu_create(FNmsg_0("MPal"))
21350 m_p1lette%=FNmenu_create(FNmsg_0("MPl1"))
21360 i_esg%=FNmenu_create(FNmsg_0("IESG"))
21370 i_button%=FNmenu_create(FNmsg_0("IBut"))
21380 m_fsize%=FNmenu_create(FNmsg_0("MFSz")):PROCmenu_writeable(m_fsize%,4,mb_fsize%,6)
21390 PROCbuild_font_menu
21400 i_text%=FNmenu_create(FNmsg_0("ITxt")):PROCmenu_writeable(i_text%,0,ib_text%,80)
21410 i_sprite%=FNmenu_create(FNmsg_0("ISpr")):PROCmenu_writeable(i_sprite%,0,ib_sprite%,12)
21420i_validation%=FNmenu_create(FNmsg_0("IVal")):PROCmenu_writeable(i_validation%,0,ib_validation%,80)
21430i_buffersize%=FNmenu_create(FNmsg_0("IBuf")):PROCmenu_writeable(i_buffersize%,0,ib_buffersize%,6)
21440 PROCmenu_attach(i_buffersize%,1,i_validation%,FALSE)
21450 i_flags%=FNmenu_create(FNmsg_0("IFlg")):PROCmenu_attach(i_flags%,0,i_text%,FALSE)
21460 PROCmenu_attach(i_flags%,1,i_sprite%,FALSE)
21470 PROCmenu_attach(i_flags%,6,i_font%,FALSE)
21480 PROCmenu_attach(i_flags%,8,i_buffersize%,FALSE)
21490 PROCmenu_attach(i_flags%,12,i_button%,FALSE)
21500 PROCmenu_attach(i_flags%,13,i_esg%,FALSE)
21510 PROCmenu_attach(i_flags%,14,m_palette%,FALSE)
21520 PROCmenu_attach(i_flags%,15,m_palette%,FALSE)
21530 t_text%=FNmenu_create(FNmsg_0("TTxt")):PROCmenu_writeable(t_text%,0,tb_text%,40)
21540 t_sprite%=FNmenu_create(FNmsg_0("TSpr")):PROCmenu_writeable(t_sprite%,0,tb_sprite%,12)
21550t_buffersize%=FNmenu_create(FNmsg_0("TBuf")):PROCmenu_writeable(t_buffersize%,0,tb_buffersize%,6)
21560 t_flags%=FNmenu_create(FNmsg_0("TFlg")):PROCmenu_attach(t_flags%,0,t_text%,FALSE)
21570 PROCmenu_attach(t_flags%,1,t_sprite%,FALSE)
21580 PROCmenu_attach(t_flags%,6,i_font%,FALSE)
21590 PROCmenu_attach(t_flags%,7,t_buffersize%,FALSE)
21600 w_scroll%=FNmenu_create(FNmsg_0("WScr"))
21610 w_flags%=FNmenu_create(FNmsg_0("WFlg")):PROCmenu_attach(w_flags%,0,t_flags%,FALSE)
21620 PROCmenu_attach(w_flags%,8,w_scroll%,FALSE)
21630 PROCmenu_attach(w_flags%,12,i_button%,FALSE)
21640 PROCmenu_attach(w_flags%,16,t_flags%,FALSE)
21650 w_colours%=FNmenu_create(FNmsg_0("WCol")):PROCmenu_attach(w_colours%,0,m_p1lette%,FALSE)
21660 PROCmenu_attach(w_colours%,1,m_palette%,FALSE)
21670 PROCmenu_attach(w_colours%,2,m_palette%,FALSE)
21680 PROCmenu_attach(w_colours%,3,m_p1lette%,FALSE)
21690 PROCmenu_attach(w_colours%,4,m_palette%,FALSE)
21700 PROCmenu_attach(w_colours%,5,m_palette%,FALSE)
21710 PROCmenu_attach(w_colours%,6,m_palette%,FALSE)
21720 w_ident%=FNmenu_create(FNmsg_0("WIdn")):PROCmenu_writeable(w_ident%,0,mb_wident%,12)
21730 i_renumber%=FNmenu_create(FNmsg_0("IRen")):PROCmenu_writeable(i_renumber%,0,mb_renumber%,5)
21740 i_copy%=FNmenu_create(FNmsg_0("ICop"))
21750 i_xcoord%=FNmenu_create(FNmsg_0("IXCo")):PROCmenu_writeable(i_xcoord%,0,mb_ixcon%,5)
21760 i_ycoord%=FNmenu_create(FNmsg_0("IYCo")):PROCmenu_writeable(i_ycoord%,0,mb_iycon%,5)
21770 i_move%=FNmenu_create(FNmsg_0("IMov")):PROCmenu_attach(i_move%,4,i_xcoord%,FALSE)
21780 PROCmenu_attach(i_move%,5,i_ycoord%,FALSE)
21790 w_general%=FNmenu_create(FNmsg_0("WGen")):PROCmenu_attach(w_general%,1,i_flags%,FALSE)
21800 PROCmenu_attach(w_general%,2,i_renumber%,FALSE)
21810 PROCmenu_attach(w_general%,3,i_copy%,FALSE)
21820 PROCmenu_attach(w_general%,4,i_move%,FALSE)
21830 PROCmenu_attach(w_general%,6,w_flags%,FALSE)
21840 PROCmenu_attach(w_general%,7,w_colours%,FALSE)
21850 PROCmenu_attach(w_general%,8,m_workarea%,FALSE)
21860 m_ident%=FNmenu_create(FNmsg_0("WIdt")): PROCmenu_attach(w_general%,9,m_ident%,FALSE)
21870 mainmenu%=FNmenu_create(FNmsg_0("MMnu")):PROCmenu_attach(mainmenu%,0,m_info%,FALSE)
21880 m_cpywin%=FNmenu_create(FNmsg_0("MCpy")):PROCmenu_writeable(m_cpywin%,0,mb_cpywin%,12)
21890 m_renwin%=FNmenu_create(FNmsg_0("MRen")):PROCmenu_writeable(m_renwin%,0,mb_renwin%,12)
21900 m_wident%=FNmenu_create(FNmsg_0("MIdn")):PROCmenu_writeable(m_wident%,0,mb_newident%,12)
21910 m_selwin%=FNmenu_create(FNmsg_0("MSel")):PROCmenu_attach(m_selwin%,0,m_cpywin%,FALSE)
21920 PROCmenu_attach(m_selwin%,1,m_renwin%,FALSE)
21930 m_browser%=FNmenu_create(FNmsg_0("MBrs")):PROCmenu_attach(m_browser%,0,m_savetemp%,FALSE)
21940 PROCmenu_attach(m_browser%,1,m_selwin%,FALSE)
21950 PROCmenu_attach(m_browser%,2,m_wident%,FALSE)
21960ENDPROC
21970:
21980DEFPROCbuild_font_menu
21990LOCAL i%,j%,k%,m%,s$
22000REPEAT
22010 SYS"Font_ListFonts",,q%,i%,-1 TO ,,i%
22020 IFi%<>-1 THEN
22030 j%+=1
22040 IFLEN($q%)>m% m%=LEN($q%)
22050 ENDIF
22060UNTIL i%=-1
22070IF j% = 0 THEN _fonttra% = FALSE ELSE _fonttra% = TRUE
22080DIM i_font% 28+j%*24
22090$i_font%="Fonts"
22100i_font%?12=7
22110i_font%?13=2
22120i_font%?14=7
22130i_font%?15=0
22140i_font%!16=(m%*8+6)*2
22150i_font%!20=44
22160i_font%!24=0
22170i%=i_font%+28
22180j%=0
22190m%=0
22200REPEAT
22210 SYS"Font_ListFonts",,q%,j%,-1 TO ,,j%
22220 IFj%<>-1 THEN
22230 !i%=0
22240 i%!4=-1
22250 i%!8=&07000121
22260 s$=$q%
22270 DIM k% LEN(s$)+1
22280 $k%=s$
22290 i%!12=k%
22300 i%!16=-1
22310 i%!20=LEN(s$)+1
22320 PROCmenu_attach(i_font%,m%,m_fsize%,FALSE)
22330 m%+=1
22340 i%+=24
22350 ENDIF
22360UNTIL j%=-1
22370i%!-24=&80:REM mark the last one!
22380ENDPROC
22390:
22400DEFPROCicon_write(a%,b%,s$)
22410!q%=a%
22420q%!4=b%
22430SYS"Wimp_GetIconState",,q%
22440$(q%!28)=s$
22450q%!8=0:q%!12=0
22460SYS"Wimp_SetIconState",,q%
22470ENDPROC
22480:
22490DEF PROCsoftreset
22500 PROCicon_write(quitbox%,1,FNmsg_0("Q2"))
22510 _RESET% = TRUE
22520 PROCfront(quitbox%)
22530ENDPROC
&� > <FormEd$Dir>.!FormEd.!RunImage
H� ******************************************************************
H� * *
(H� * Title : FormEd *
2H� * Description : Template Editor - for use with Applications *
<H� * Version : 1.36 *
FH� * *
PH� ******************************************************************
Z"� � � � �, �$+" at line "+�(�)
dÈ™"Hourglass_On"
n#ș "OS_GetEnv" � commandstring$
x� fontcounts% 255
�#� I%=0 � 255:fontcounts%?I%=0:�
�� -- Start Wimp going
�� taskid%4:$taskid%="TASK"
�9ș "Wimp_Initialise",200,!taskid%,"FormEd" � version%
�7� � �errordisplay: � after calling Wimp_Initialise!
�+ `wbcol=&0:`tbcol=&D:`sco=&3:`mbcol=&B
�, `wfcol=&7:`tfcol=&7:`sci=&D:`tbcol2=&C
�H� ******************************************************************
�H� ** Gobal Variables *
�H� ******************************************************************
� tsloss = �
� _altered = �
� _prequit = �
_biconx% = 10
_bicony% = -50
_RESET% = �
" _QUIT% = �
, _noid% = 0
6 bodgeit% = �
@ � _titlestring% 257
J � _wid$(49)
T � _win%(49)
^ � _temp% 20
h � _data% 50
r � _BUF100% 100
| � _SPRDIA% 15
� � _SPRWIN% 15
�% $_SPRDIA% = "ssmldialog"+�(0)
�% $_SPRWIN% = "ssmlformed"+�(0)
�% $_titlestring% = "<untitled>"
�H� ******************************************************************
�� inv% 27,outv% 23
�� px2% 1,px4% 3,px256% 255
��getmodeinfo
�switched%=�
�� factors% 15
�� pixtrans% 15
�� -- dimension arrays
�'� pal%(2),bright%(15),uncolour%(15)
'� q% &2000,erroraddr%(4),oldq% &100
*� indexdata% 48*24+20,fontbinding% 255
maxbuf%=&6000
&6� buffer% maxbuf%:curbuff%=buffer%:_sloss%=buffer%
0
nh%=48
:D� handle%(nh%+1),wident$(nh%),wptr%(nh%),wlink%(nh%),wflag%(nh%)
DL� I%=0�nh%:handle%(I%)=I%-1:wident$(I%)="":_wid$(I%)="*":�:handleSP%=nh%
N� spritename% 12
X� menulist% &100
bbrx%=400:bry%=740
l2currentwindow%=-1:currenticon%=-1:dialogue%=-1
vspritef$=""
�� errbuf% 150
�templatef$="Templates"
�%� mb_crsprite% 12,mb_rnsprite% 12
�nsp=80:ns%=10
�G� spw%(nsp),sph%(nsp),spwx%(nsp),minx%(nsp),miny%(nsp),spname$(nsp)
�#� spritew%(ns%+1),nsprite%(ns%)
�A� spritei%(ns%),sprxscale%(ns%),spryscale%(ns%),spriten$(ns%)
�H� I%=0�ns%:spritew%(I%)=I%-1:spriten$(I%)="":�:sprSP%=ns%:sprSP2%=-1
�Dș "OS_File",5,"<FormEd$Dir>.Sprites" � type%,,,,systemareasize%
�6� type%<>1 � � 0,"Can't find <FormEd$Dir>.Sprites"
�systemareasize%+=4
�$� systemsprites% systemareasize%
�$systemsprites%!0=systemareasize%
� � = 23 �
B È™ "OS_SpriteOp",&10A,systemsprites%,"<FormEd$Dir>.Sprites23"
�
@ È™ "OS_SpriteOp",&10A,systemsprites%,"<FormEd$Dir>.Sprites"
*�
4(spriteareasize%=�-�-32*1024:� was 16
>!� spritearea% spriteareasize%
H1!spritearea%=spriteareasize%:spritearea%!8=16
R%È™ "OS_SpriteOp",&109,spritearea%
\%_bob% = �("<FormEd$Dir>.Default")
f9� �(_bob% = 0) � �loadsprites("<FormEd$Dir>.Default")
p�#_bob%
zspritef$="Sprites"
�.undoname$="":undoscreen%=-1:editbuffer%=-2
�� -- Create windows
��defaultwindows
�3� paltable% 79:ș "Wimp_ReadPalette",,paltable%
�palcolour%=7
�sprcolour%=7
�paintmode%=16
�grid%=�
�� -- Create Menus
�,�msg_initialise("<FormEd$Dir>.Messages")
��create_menus
�ic_window% = �iconbar
�B� -- if command was '*FormEd <filename>', load a template file
!I%=�commandstring$," -quit ")
� I% �
I%+=�" -quit "
$* ȕ �commandstring$,I%,1)=" ":I%+=1:�
. �
8( I%=�commandstring$+" "," ",I%+1)
B* �I%+=1:��commandstring$,I%,1)<>" "
L f$=�commandstring$,I%)
V f$=�f$,�f$+" "," ")-1)
` � f$<>"" �
j Ȏ �filetype(f$) �
t0 � &FEC: _init% = 0:�loadtemplates(f$):
~( $_titlestring% = f$
�( $mb_templates% = f$
�? �changewindowtitle(browbox%,_titlestring%)
�% �front(browbox%)
�! � &FF9:�loadsprites(f$)
�. � -2: � 0,"File '"+f$+"' not found"
�E � 0,"File '"+f$+"' is not a sprite file or template file"
� �
� �
�
� f$=""
��
�ș"Hourglass_Off"
�3� -- Error handler - drops through to Wimp_Poll
saveref%=-1
scrapref%=-1
dragtype%=0
inerror%=�
(oldhelp%=1:_init% = 1
2� � �errordisplay
<� -- Main Polling loop
F�
P!ș "Wimp_Poll",1,q% � action%
ZȎ action% �
d<� 1: � ****************** Redraw event ****************
n �redraw(!q%)
x<� 2: � ****************** Open event ******************
�? �open(!q%,q%!4,q%!8,q%!12,q%!16,q%!20,q%!24,q%!28)
� �chck_handle(!q%)
�<� 3: � ****************** Close event *****************
� �close(!q%)
�7� 6: � ****************** Click event ***********
�3 �mouse(!q%,q%!4,q%!8,q%!12,q%!16,q%!20)
�<� 7: � ****************** User Draw event *************
�, �decodedrag(!q%,q%!4,q%!8,q%!12)
�<� 8: � ****************** Key Pressed event ***********
� key%=q%!24
�' �processkey(q%!0,q%!4,key%)
�<� 9: � ****************** Menu Selection event ********
�: I%=0:�menulist%!I%=q%!I%:I%=I%+4:�q%!(I%-4)=-1
. �decodemenu(menuhandle%,menulist%)
. �getpointer:� buttons%�1 � �remenu
<� 10: � ***************** Scroll Request event ********
"P �open(!q%,q%!4,q%!8,q%!12,q%!16,q%!20+q%!32*32,q%!24+q%!36*32,q%!28)
,<� 17,18: � ****** user message & recorded **************
6 �receive(q%)
@�
J� �
T� �receive(q%)
^&� I%=0 � !q%-1 �4:oldq%!I%=q%!I%:�
hȎ q%!16 �
r4� 0: � ** Quit From Message ********************
| �finish:�
�� 1:Ȏ q%!40 �
�5 � &FF9,&FEC: � do the scrap file business
�D ș "XOS_ReadVarVal","Wimp$Scrap",,-1,0,3 � ,,exists%
�< � exists%=0 � � 1,"<Wimp$Scrap> not defined"
�7 q%!36=-1:�string0(q%+44,"<Wimp$Scrap>")
�+ !q%=(48+�"<Wimp$Scrap>")��3
�C q%!12=q%!8:q%!16=2:ș "Wimp_SendMessage",17,q%,q%!4
� scrapref%=q%!8
� �
�E� 2:� q%!12<>saveref% � � 1,"Unexpected DataSave packet received"
� _saving% = �
� Ȏ q%!40 �
�; � &FEC:�savetemplates(�string0(q%+44),q%!36<>-1)
8 :� 1,"Unexpected DataSave filetype received"
�
M oldq%!12=oldq%!8:oldq%!16=3:È™ "Wimp_SendMessage",17,oldq%,oldq%!4
& _saving% = �
0� 3:_tmp$ = �string0(q%+44)
: Ȏ q%!40 �
D; � &FEC: � ******** Message_DataLoad 3 **********
N _cchange% = �
X4 � �$_titlestring%,4) = �"<untitled>",4) �
bI $mb_templates%=�string0(q%+44):$_titlestring%=�string0(q%+44)
l/ � _altered � $_titlestring% += " *"
v �
� � �_altered �
�& �addchange(_titlestring%)
�
�
� �
�! �loadtemplates(_tmp$)
� �front(browbox%)
�6 �changewindowtitle(browbox%,_titlestring%)
� � &FF9:� q%!20=-2 �
�3 �loadsprites(�string0(q%+44))
�5 � �mergesprites(�string0(q%+44))
� �
� :�
� �
6 � oldq%!12=scrapref% � *Delete <Wimp$Scrap>
M oldq%!12=oldq%!8:oldq%!16=4:È™ "Wimp_SendMessage",17,oldq%,oldq%!4
� 5:� q%!40 = &FEC �
9 � �(_altered)��$_titlestring%,4)=�"<untitled>",4) �
*- $_titlestring% = �string0(q%+44)
4, �loadtemplates(�string0(q%+44))
>, $mb_templates% = $_titlestring%
H7 �changewindowtitle(browbox%,_titlestring%)
R �front(browbox%)
\) oldq%!12=oldq%!8:oldq%!16=4:
f3 È™ "Wimp_SendMessage",17,oldq%,oldq%!4
p
�
z* � oldq%!12=oldq%!8:oldq%!16=4
�6 � SYS "Wimp_SendMessage",17,oldq%,oldq%!4
�1 � ERROR 1, " Unsaved Template File "
�
�
� �
�B� 8: � **************** Message_PreQuit **********************
� � _altered �
� �objectclosedown
�
�
�
� &400C0:
� Ȏ menuhandle% �
� � w_general%
� Ȏ q%!32 �
� � 1:
Ȏ q%!36 �
; � 14,15: �tickpalette(i_flags%!(36+24*q%!36)>>28)
�
$7 � 7: �tickpalette(w_colours%!(36+24*q%!36)>>28)
. �
8 �
B0 È™ "Wimp_CreateSubMenu",,q%!20,q%!24,q%!28
L� &400C1:�getmodeinfo
V�
`�
j� �tickpalette(colour%)
t� I%
~�colour%<16 �
�? � I%=m_palette%+28 � m_palette%+28+24*15 � 24:!I%=!I%��1:�
�* I%=m_palette%+28+24*colour%:!I%=!I%�1
��
��colour%=255 colour%=16
�>� I%=m_p1lette%+28 � m_p1lette%+28+24*16 � 24:!I%=!I%��1:�
�)I%=m_p1lette%+28+24*colour%:!I%=!I%�1
��
�� �sendsave(ft%,fn%)
�� filename%
�2�filename%=fn%:fn%+=�$fn%,"."):� fn%=filename%
�9�getpointer : � sets up handle%,icon%,mousex%,mousey%
�4� handle% = m_savetemp% � handle% = browbox% � �
È™ "Wimp_CreateMenu",,-1:
!q%=(48+�$filename%)��3
q%!12=0:q%!16=1
9q%!20=handle%:q%!24=icon%:q%!28=mousex%:q%!32=mousey%
((q%!36=0 : � file size (inaccurate)
2q%!40=ft% : � file type
<�string0(q%+44,$filename%)
F-È™ "Wimp_SendMessage",17,q%,handle%,icon%
Psaveref%=q%!8
Z�
d8� �string0(a%) �a$:a$="":ȕ ?a%:a$+=�?a%:a%+=1:�:=a$
n'� �string0(a%,a$) $a%=a$:a%?�a$=0:�
x� �getmodeinfo
�inv%!0 = 4
�inv%!4 = 5
�inv%!8 = 6
�inv%!12= 7
�inv%!16= 11
�inv%!20= 12
�inv%!24= -1
�'ș "OS_ReadVduVariables",inv%,outv%
�dx%=1<<(outv%!0)
�dy%=1<<(outv%!4)
�linelen%=outv%!8
�screensize%=outv%!12
�scrx1%=(outv%!16+1)*dx%
scry1%=(outv%!20+1)*dy%
�
� �redraw(handle%)
"!q%=handle%
,&ș "Wimp_RedrawWindow",,q% � more%
6�info(q%+4)
@Ȏ handle% �
J:�testpattern
T�
^�
h� �testpattern
r�dx%:dx%=48
|È• more%
�+x0%=q%!28:y0%=q%!32:x1%=q%!36:y1%=q%!40
�-minx0%=x0%-(by%-y0%):maxx0%=x1%-(by%-y1%)
�-minx1%=x0%+(by%-y1%):maxx1%=x1%+(by%-y0%)
�/minx0%=(minx0%-bx%+10000)�dx%*dx%+bx%-10000
�/minx1%=(minx1%-bx%+10000)�dx%*dx%+bx%-10000
�1�x%=minx0%�maxx0%�dx%:�x%,by%:�1,1280,-1280:�
�2�x%=minx1%�maxx1%�dx%:�x%,by%:�1,-1280,-1280:�
�&ș "Wimp_GetRectangle",,q% � more%
��
��
�� �front(handle%)
�� handle% = quitbox% �
�+ ș "Wimp_CreateMenu",,quitbox%,300,640
�
�
,!q%=handle%:È™ "Wimp_GetWindowState",,q%
&%q%!28=-1:È™ "Wimp_OpenWindow",,q%
0�
:� �getw(handle%)
D8!q%=handle%:ș "Wimp_GetWindowState",,q%:�info(q%+4)
N�
X� �geti(h%,i%)
b-!q%=h%:q%!4=i%:È™ "Wimp_GetIconState",,q%
l.ix0%=q%!8:iy0%=q%!12:ix1%=q%!16:iy1%=q%!20
viflags%=q%!24:idata%=q%+28
��
�� �info(p%)
�'x0%=!p%:y0%=p%!4:x1%=p%!8:y1%=p%!12
�5scx%=p%!16:scy%=p%!20:bhandle%=p%!24:flags%=p%!28
�Nbx%=x0%-scx%:by%=y1%-scy% : � all drawing should be relative to bx%,by%
��
�� �upicon(handle%,icon%)
�D!q%=handle%:q%!4=icon%:q%!8=0:q%!12=0:ș "Wimp_SetIconState",,q%
��
�7� �open(handle%,x0%,y0%,x1%,y1%,scx%,scy%,bhandle%)
�� d%
�!q%=handle%
�)q%!4=x0%:q%!8=y0%:q%!12=x1%:q%!16=y1%
q%!20=scx%:q%!24=scy%
q%!28=bhandle%
È™ "Wimp_OpenWindow",,q%
� handle%=dialogue% �
* �getw(handle%)
4& È— È“ x0%,y0%,x1%-x0%,y1%-y0%+40
>�
H�
R� �close(handle%)
\� i%
f� �(handle% = quitbox%) �
p9�handle%=dialogue% � ȗ ȓ 0,0,1279,1023:dialogue%=-1
z�
�#� handle%=browbox% � _altered �
� �softreset:�
��
�+ � handle% =browbox% � �resetwindowdefs
��
�)!q%=handle%:ș "Wimp_CloseWindow",,q%
��
�@� �mouse(mousex%,mousey%,buttons%,handle%,icon%,oldbuttons%)
�Ȏ handle% �
�� quitbox%: Ȏ icon% �
�J � 0: � ***************** Yes Quit Application *********
�# � _RESET% = � �
�% �resetwindowdefs
% �close(quitbox%)
% �close(browbox%)
�
$! � _prequit �
.. È™"Wimp_ProcessKey",&1FC
8- �close(handle%):�finish
B �
L �
V �finish:�
` �
j �
t; � 2: _QUIT%=�:_RESET%=�:�close(handle%)
~5 � 3: ș "Wimp_GetPointerInfo",,q%
�4 ș "Wimp_CreateMenu",,-1
�L ș "Wimp_CreateMenu",,m_savetemp%,!q%-30,q%!4+60
�' _RESET% = �
� �
�� browbox%: Ȏ buttons% �
�A � &02: � ********************* MENU **********
�% �menu(m_browser%)
�* � -1: �selection_unset
�
�" � icon% = -1 �
�% �selection_unset
� �
0 �showwindow(icon%,buttons%)
�
�
: Ȏ buttons% �
(. � &02 : � -- MENU button
2E I%=�whichwindow(handle%):�I%<>-1��windowmenu(I%):�
< Ȏ handle% �
F# � -2: Ȏ icon% �
P9 � ic_window%:�menu(mainmenu%)
Z �
d �
n8 � &01,&04 : � -- SELECT/ADJUST buttons
x1 � PROCaddchange(_titlestring%)
� Ȏ handle% �
�# � -2: Ȏ icon% �
�( � ic_window%
�V � �chck_newtemplate � �resetwindowdefs � �front(browbox%)
� �
�: � m_workarea%:�addchange(_titlestring%)
�. �setwork(q%,mb_workarea0%)
�0 �setwork(q%+8,mb_workarea1%)
�7 x0%=!q%:y0%=q%!4:x1%=q%!8:y1%=q%!12
� Ȏ icon% �
� � 0:y1%+=4
� � 1:x1%+=2
� � 2:x0%-=2
� 3:y0%-=4
6 � 5:x0%+=2:� x0%>mwx0% � x0%=mwx0%
6 � 6:x1%-=2:� x1%<mwx1% � x1%=mwx1%
"6 � 7:y1%-=4:� y1%<mwy1% � y1%=mwy1%
,6 � 8:y0%+=4:� y0%>mwy0% � y0%=mwy0%
6/ � 11:�xor(m_workarea%,11,6)
@8 �setworkarea(currentwindow%)
JG � (buttons%�1)=0 � ș "Wimp_CreateMenu",,-1
T �
^% w0$=�x0%+","+�y0%
h% w1$=�x1%+","+�y1%
rR �w0$<>$mb_workarea0%�$mb_workarea0%=w0$:�upicon(m_workarea%,9)
|S �w1$<>$mb_workarea1%�$mb_workarea1%=w1$:�upicon(m_workarea%,10)
� � m_savetemp%
� � icon%=2 �
�/ �checkfull($mb_templates%)
�5 �savetemplates($mb_templates%,�)
�@ � buttons% � &01 � ș "Wimp_CreateMenu",,-1
� �
� �
�9 � &10,&40 : � -- SELECT/ADJUST dragging
� Ȏ handle% �
�I � m_savetemp%:�dragicon(mousex%,mousey%,handle%,icon%)
�= :�icon%<>-1��drag(buttons%,handle%,icon%)
� �
� �
�
�
%� �processkey(handle%,icon%,key%)
&Ȏ handle% �
0� m_workarea%
: � key%=13 �
D! �xor(m_workarea%,11,6)
N' �setworkarea(currentwindow%)
X# È™ "Wimp_CreateMenu",,-1
b �
l
�
v� m_savetemp%
� � key%=13 �
�% �checkfull($mb_templates%)
�+ �savetemplates($mb_templates%,�)
�# ș "Wimp_CreateMenu",,-1
� �
�
�
��
�ș "Wimp_ProcessKey",key%
��
�R------------------------------------------------------------------------------
�� �drag(b%,handle%,icon%)
�%I%=�whichwindow(handle%):�I%=-1��
�7currentwindow%=I%:currenticon%=icon%:�highlight(I%)
4dragtype%=b%:draghandle%=handle%:dragicon%=icon%
�getcurw
�getcuri
+cx0%+=bx%:cy0%+=by%:cx1%+=bx%:cy1%+=by%
*%x0%=0:y0%=0:x1%=scrx1%:y1%=scry1%
4�b%=&10�
>, �getminxy(flags%,text$,sprite$,valid%)
H) mx0%=mousex%-cx0%:mx1%=cx1%-mousex%
R) my0%=mousey%-cy0%:my1%=cy1%-mousey%
\4 x0%=cx0%+minx%:y0%=0:x1%=scrx1%:y1%=cy1%-miny%
f: �mx0%<mx1%��swapx:x0%=0:x1%=cx0%-minx%:x0%+=1:x1%-=1
p? �my0%>my1%��swapy:y0%=cy1%+miny%:y1%=scry1%:y0%+=1:y1%-=1
z. x0%+=cx0%-cx1%:y1%+=cy1%-cy0% : � bodge
��
�*!q%=handle%:� b%=&40 � q%!4=5 � q%!4=6
�.q%!8=cx0%:q%!12=cy0%:q%!16=cx1%:q%!20=cy1%
�+q%!24=x0%:q%!28=y0%:q%!32=x1%:q%!36=y1%
�ș "Wimp_DragBox",,q%
��
�.� �dragicon(mousex%,mousey%,handle%,icon%)
�%dragtype%=&FF:draghandle%=handle%
��getw(handle%)
��geti(handle%,icon%)
�!q%=handle%:q%!4=5
�>q%!8=bx%+ix0%:q%!12=by%+iy0%:q%!16=bx%+ix1%:q%!20=by%+iy1%
�*q%!24=q%!8-mousex%:q%!28=q%!12-mousey%
9q%!32=scrx1%+q%!16-mousex%:q%!36=scry1%+q%!20-mousey%
È™ "Wimp_DragBox",,q%
�
$� �swapx
.@cx0%=cx0%�cx1%:cx1%=cx1%�cx0%:cx0%=cx0%�cx1%:cx0%-=1:cx1%+=1
8�
B� �swapy
L@cy0%=cy0%�cy1%:cy1%=cy1%�cy0%:cy0%=cy0%�cy1%:cy0%-=1:cy1%+=1
V�
`� �unshade(mh%,I%)
j1mh%!(28+8+24*I%)=mh%!(28+8+24*I%)�&FFBFFFFF:�
t,� �getminxy(flags%,text$,sprite$,valid%)
~� x0%,y0%,x1%,y1%,mx%,my%
�minx%=0:miny%=0
�� flags%�&01 �
�< � �getcommand(valid%,"L")<>"" � � :� can be formatted
� � flags%�&40 �
�5 ș "Font_ReadInfo",flags%>>24 � ,,y0%,,y1%
�D ș "Font_StringBBox",,�26+�(flags%>>24)+text$ � ,x0%,,x1%
�, ș "Font_ConverttoOS",,x0% � ,x0%
�, ș "Font_ConverttoOS",,x1% � ,x1%
�& minx%=x1%-x0%:miny%=y1%-y0%
�& � minx%=6*dx%+16*�text$:miny%=32
� �
�! � flags%�&04 � miny%+=2*dy%
�
� flags%�&02 �
I ș "XOS_SpriteOp",&128,spritearea%,sprite$ � ,,,mx%,my%,,spm% ; P%
� (P%�1)=0 �
(A ș "XOS_ReadModeVariable",spm%,4 � ,,spx%:mx%=mx%<<spx%
2A ș "XOS_ReadModeVariable",spm%,5 � ,,spy%:my%=my%<<spy%
<- � flags%�&800 � mx%=mx%/2:my%=my%/2
FD � (flags%�&21B)=&13 � mx%=minx%+mx% :� sprite+text (V~H~R)
P! � mx%>minx% � minx%=mx%
Z! � my%>miny% � miny%=my%
d �
n�
x�
�&� �decodedrag(cx0%,cy0%,cx1%,cy1%)
�dragtype%=0
�?� draghandle%=m_savetemp% � �sendsave(&FEC,mb_templates%):�
� �geti(draghandle%,dragicon%)
�Boldflags%=iflags%:odt0%=idata%!0:odt1%=idata%!4:odt2%=idata%!8
�&�deleteicon(draghandle%,dragicon%)
��getw(draghandle%)
�+cx0%-=bx%:cy0%-=by%:cx1%-=bx%:cy1%-=by%
��cx0%>cx1%��swapx
��cy0%>cy1%��swapy
�Mcurrenticon%=�cricon(!q%,cx0%,cy0%,cx1%,cy1%,oldflags%,odt0%,odt1%,odt2%)
��
�<� �cricon(handle%,x0%,y0%,x1%,y1%,flags%,dt0%,dt1%,dt2%)
� ic%,v%
!q%=handle%
1q%!20=flags%:q%!24=dt0%:q%!28=dt1%:q%!32=dt2%
"#text$=�iconstring(flags%,q%+24)
,&� flags% � &100 � v%=q%!28 � v%=-1
60�getminxy(flags%,text$,text$,v%) : � bodge
@"�x1%-x0%<minx% � x1%=x0%+minx%
J"�y1%-y0%<miny% � y1%=y0%+miny%
T)q%!4=x0%:q%!8=y0%:q%!12=x1%:q%!16=y1%
^"ș "Wimp_CreateIcon",,q% � ic%
h3È™ "Wimp_ForceRedraw",!q%,q%!4,q%!8,q%!12,q%!16
r"È™ "Wimp_GetCaretPosition",,q%
|I�!q%=handle%�q%!4=ic%:ș "Wimp_SetCaretPosition",handle%,ic%,0,0,-1,0
�=ic%
� � �deleteicon(handle%,icon%)
�5!q%=handle%:q%!4=icon%:ș "Wimp_GetIconState",,q%
�ș "Wimp_DeleteIcon",,q%
�4ș "Wimp_ForceRedraw",!q%,q%!8,q%!12,q%!16,q%!20
��
�R------------------------------------------------------------------------------
�� �menu(m%)
�menuhandle%=m%
�� �encodemenu(m%) �
� � handle%=-2 �
�+ I%=m%!20+m%!24:J%=m%+28:K%=96-m%!24
�# � K%+=I%:J%+=24:�J%!-24�&80
' � K%+=24 dotted line separator!
� K%=mousey%+12
�
&6 È™ "Wimp_CreateMenu",,menuhandle%,mousex%-102,K%
0' oldhandle%=handle%:oldicon%=icon%
:�
D�
N
� �remenu
X%handle%=oldhandle%:icon%=oldicon%
b � �encodemenu(menuhandle%) �
lP ș "Wimp_CreateMenu",,menuhandle%,mousex%-102,mousey%+12 :� default coords
v�
��
�R------------------------------------------------------------------------------
�� �windowmenu(I%)
�%mmousex%=mousex%:mmousey%=mousey%
�$currentwindow%=I%:�highlight(I%)
�(currenticon%=icon%:�menu(w_general%)
��
�� �highlight(I%)
��
�<ș "Wimp_SetCaretPosition",handle%(I%),-1,0,0,&2000000,0
��
�R------------------------------------------------------------------------------
�� �encodemenu(menuhandle%)
@� �encodemenu(menuhandle%) � � 1,"Menu shouldn't be allowed"
�
� �encodemenu(menuhandle%)
-�menuhandle%<&8000 � � 1,"Bad menuhandle"
*�I%
4,I%=menuhandle%+28:_RESET% = �:_QUIT% = �
>7�!I%=!I%��&01:I%!8=I%!8��&400000:I%+=24:�I%!-24�&80
HȎ menuhandle% �
R� mainmenu%
\1 $mb_wident%="":$mb_templates%=templatef$
f� i_flags%
p �getcuri
zB �encodeicon(i_flags%,11,flags%,q%+28,ib_text%,ib_sprite%)
� $ib_buffersize%=�L%
� $ib_validation%=""
�# �encodemenu(i_buffersize%)
� � (flags%�&01)=0 �
�% �shade(i_buffersize%,1)
� � � flags%�&100 �
�P � q%!32>0 � $ib_validation%=$(q%!32):�menu_tick(i_buffersize%,1)
� �
�
�
�, � �(_fonttra%) � �shade(i_flags%,6)
�, $(i_flags%+28+12+24*14)="Fg colour"
�, $(i_flags%+28+12+24*15)="Bg colour"
�> � flags% � &02 � $(i_flags%+28+12+24*14)="EOR colour"
> � flags% � &20 � $(i_flags%+28+12+24*15)="EOR colour"
� flags% � &40 �
# i_flags%?(28+11+24*14)=7
$# i_flags%?(28+11+24*15)=7
.2 �shade(i_flags%,14):�shade(i_flags%,15)
8
�
B< i_flags%?(28+11+24*14)=�foreback((flags%>>24)�&F)
L< i_flags%?(28+11+24*15)=�foreback((flags%>>28)�&F)
V
�
` �encodemenu(i_esg%)
j� i_esg%
t, �menu_tick(i_esg%,(flags%>>16)�&0F)
~� i_button%
�/ �menu_tick(i_button%,(flags%>>12)�&0F)
�� m_browser%
� �selection_on
� �selection_name
�� w_general%
�. � currentwindow%=-1 � =� : � deleted!
�, $mb_wident%=wident$(currentwindow%)
�6 $(m_ident%!(28+12)) = wident$(currentwindow%)
�8 �getcuri:$mb_ixcon%=�(q%!8):$mb_iycon%=�(q%!12)
�A � flags%�&800000 � currenticon%=-1 : � has been deleted!
� � currenticon%<>-1 �
�F $(w_general%!(28+24*1+12)+�"Amend icon ")="#"+�currenticon%
H $(w_general%!(28+24*2+12)+�"Renumber ")="#"+û$mb_renumber%
�encodemenu(i_flags%)
! �encodemenu(i_button%)
7 � $(w_general%!(28+24*1+12)+�"Amend icon ")=""
(: $(w_general%!(28+24*2+12)+�"Renumber ")=""
2- �I%=1�5:�shade(w_general%,I%):�
<
�
F �encodemenu(w_flags%)
P- $mb_workarea0%=�(q%!44)+","+�(q%!48)
Z- $mb_workarea1%=�(q%!52)+","+�(q%!56)
d# $mb_minx%=�(q%!72 � &FFFF)
n! $mb_miny%=�(q%!72 >> 16)
x- mwx0%=q%!20:mwy0%=q%!24+(q%!8-q%!16)
�- mwx1%=q%!20+(q%!12-q%!4):mwy1%=q%!24
� �encodepalmenu(-1)
� I%=w_colours%+28
� � J%=q%+36 � q%+42
� � ?J% = &FF �
�+ I%?11=(0<<4)�uncolour%(0):I%+=24
� �
�/ I%?11=(?J%<<4)�uncolour%(?J%):I%+=24
� �
�
�
�� w_flags%
�$ !q%=handle%(currentwindow%)
�$ ș "Wimp_GetWindowInfo",,q%
� I%=0 � 7
4 � q%!32 � (1<<I%) � �menu_tick(w_flags%,I%)
�
" � q%!32 � (1<<8) �
, �menu_tick(w_flags%,8)
66 �menu_tick(w_scroll%,0):�untick(w_scroll%,1)
@
�
J �untick(w_scroll%,0)
T
�
^ � q%!32 � (1<<9) �
h! �menu_tick(w_flags%,8):
r6 �menu_tick(w_scroll%,1):�untick(w_scroll%,0)
|
�
� �untick(w_scroll%,1)
�
�
�= � q%!32 � (1<<10) � �menu_tick(w_flags%,9) :� real
�D � q%!32 � (1<<11) � �menu_tick(w_flags%,10) :� back window
�B � q%!32 � (1<<12) � �menu_tick(w_flags%,11) :� grab keys
� �encodemenu(t_flags%)
� � currenticon%=-1 �
�. flags%=q%!64:�encodemenu(i_button%)
� � �shade(w_flags%,12)
�
�
� � I%=14 � 20
�< � q%!32 � (1<<(I%+24-14)) � �menu_tick(w_flags%,I%)
�
�
� q%!32 � &80000000 �
" �menu_tick(w_flags%,13)
�shade(w_flags%,0)
& �shade(w_flags%,2)
0 �shade(w_flags%,3)
: �shade(w_flags%,7)
D
�
N- � I%=14 � 20:�shade(w_flags%,I%):�
X
�
b� t_flags%
lM q%!60=q%!60 � &24 : � must be filled with border
v@ �encodeicon(t_flags%,6,q%!60,q%+76,tb_text%,tb_sprite%)
� $tb_buffersize%=�L%
�, � �(_fonttra%) � �shade(t_flags%,6)
�+ �q%!60�&100��menu_tick(t_flags%,7)
�+ �q%!60�&200��menu_tick(t_flags%,8)
�� w_scroll%
� �getcurw
�- �flags%�&100��menu_tick(w_scroll%,0)
�- �flags%�&200��menu_tick(w_scroll%,1)
��
�=�
�� �shade(mh%,I%)
�/mh%!(28+8+24*I%)=mh%!(28+8+24*I%)�&400000:�
�=� �encodeicon(iconmenu%,nmenu%,flags%,q%,itext%,isprite%)
%� i_font%<0 � �shade(iconmenu%,6)
$itext%="":$isprite%=""
3� flags% � &01 � $itext%=�iconstring(flags%,q%)
:� (flags%� &03)=&02 � $isprite%=�iconstring(flags%,q%)
*<� flags% � &100 � L%=q%!8 � L%=12 : � returned to caller
4I%=iconmenu%+28:J%=1
>*�item%=0�nmenu%:�flags%�J%�!I%=!I%�&01
HI%+=24:J%+=J%:�
R�
\%� �decodemenu(menuhandle%,menus%)
fȎ menuhandle% �
p� mainmenu%
z Ȏ !menus% �
� � 0:� info box
� � 1: � �(_altered) �
�" �resetwindowdefs
�" �front(browbox%)
� �
� �softreset
� �
� � 2: � _altered �
�6 �icon_write(quitbox%,1,�msg_0("Q1"))
�E _QUIT% = �:�front(quitbox%):_prequit = �:_RESET%= �
� �
� �finish:�
� �
�
� m_browser%
Ȏ !menus% �
$# � 0: � *********** saveas
.2 �savetemplates($mb_templates%,�)
8# � 1: � *********** Select
B! �selection_name
L1 �decodemenu(m_selwin%,menus%+4)
V* � 2: � *********** Create Window
`( � mb_newident%?0 = 0 �
j& � 1,"No identifier"
t2 � �reformat_string(mb_newident%)
~5 � �chk_duplicates($mb_newident%) �
�1 � 1 , "Duplicate identifiers"
� �
�: �createwindow(brx%,bry%,$mb_newident%)
�% brx%+=60:bry%-=40
�/ � bry% < 340 � bry% = 1000
�- � brx% > 1040 � brx% = 40
� �
� �
�
�
�� m_selwin%
� Ȏ !menus% �
�! � 0 : � *** Copy Window
+ � �(mb_cpywin%?0 = 0) �
1 �reformat_string(mb_cpywin%)
1 �reformat_string(mb_renwin%)
5 � �($mb_cpywin% = $mb_renwin%) �
(6 � �chk_duplicates($mb_cpywin%) �
24 � 1 , "Duplicate identifiers"
< �
F8 �selection_copy:� *** Copy Window
P �
Z �
d �
n# � 1 : � *** Rename Window
x+ � �(mb_renwin%?0 = 0) �
�1 �reformat_string(mb_renwin%)
�1 �reformat_string(mb_cpywin%)
�5 � �($mb_cpywin% = $mb_renwin%) �
�. � PRINT LEN($mb_renwin%)
�6 � �chk_duplicates($mb_renwin%) �
�4 � 1 , "Duplicate identifiers"
� �
�< �selection_rename:� *** Rename Window
� �
� �
� �
� � *spool
�5 � 2 : �selection_delete:� *** Delete Window
�
� w_general%
Ȏ !menus% �
"? � 0: � ****************** Create Icon ****************
,2 �addchange(_titlestring%):�getcurw
61 mx%=mmousex%-bx%:my%=mmousey%-by%
@+ ix%=default%!96-default%!88
J, iy%=default%!100-default%!92
TK q%!4=mx%-ix%/2:q%!8=my%-iy%/2:q%!12=q%!4+ix%:q%!16=q%!8+iy%
^> � I%=0 � 12 � 4:q%!(20+I%)=default%!(104+I%):�
h7 ș "Wimp_CreateIcon",,q% � currenticon%
r? È™ "Wimp_ForceRedraw",!q%,q%!4,q%!8,q%!12,q%!16
|? � 1: � ****************** Amend Icon *****************
� � �(_altered) �
�* �addchange(_titlestring%)
� �
� �getcuri
�% �deleteicon(!q%,q%!4)
�d �decodeicon(menus%+4,q%+24,q%+28,ib_text%,ib_sprite%,ib_buffersize%,$ib_validation%)
�X currenticon%=�cricon(!q%,q%!8,q%!12,q%!16,q%!20,q%!24,q%!28,q%!32,q%!36)
�+ � 2: � ****************** Renumber
�) �addchange(_titlestring%)
�( renumber%=�$mb_renumber%
�@ �renumber(currentwindow%,currenticon%,renumber%)
�) �addchange(_titlestring%)
�, � 3: � ****************** Copy Icon
2 �addchange(_titlestring%):�getcuri
�flags%�&100�
9 B%=�workspace(q%!36):$B%=text$:q%!28=B%
&K �q%!32>0�B%=�workspace(�$(q%!32)+1):$B%=$(q%!32):q%!32=B%
0 �
:6 x0%=q%!8:y0%=q%!12:x1%=q%!16:y1%=q%!20
D Ȏ menus%!4 �
N) � -1:copyx%=16:copyy%=-16
X+ � 0:copyx%=x0%-x1%:copyy%=0
b+ � 1:copyx%=x1%-x0%:copyy%=0
l+ � 2:copyx%=0:copyy%=y1%-y0%
v+ � 3:copyx%=0:copyy%=y0%-y1%
� �
�? x0%+=copyx%:y0%+=copyy%:x1%+=copyx%:y1%+=copyy%
�Q currenticon%=�cricon(!q%,x0%,y0%,x1%,y1%,q%!24,q%!28,q%!32,q%!36)
� � 4: � ** Move Icon
�2 �addchange(_titlestring%):�getcuri
�) �addchange(_titlestring%)
�* h%=handle%(currentwindow%)
�& �geti(h%,currenticon%)
�D oldf%=iflags%:o0%=idata%!0:o1%=idata%!4:o2%=idata%!8
�, �deleteicon(h%,currenticon%)
� Ȏ menus%!4 �
�' � 0:ix0%-=dx%:ix1%-=dx%
�' � 1:ix0%+=dx%:ix1%+=dx%
!' � 2:iy0%+=dy%:iy1%+=dy%
!' � 3:iy0%-=dy%:iy1%-=dy%
!< � 4:ix0%=�($mb_ixcon%):�move_xdir(ix0%,ix1%)
! < � 5:iy0%=�($mb_iycon%):�move_ydir(iy0%,iy1%)
!* �
!4N currenticon%=�cricon(h%,ix0%,iy0%,ix1%,iy1%,oldf%,o0%,o1%,o2%)
!> � 5: � ** Delete Icon
!H. �addchange(_titlestring%)
!R, q%?(36+menus%!4)=menus%!8
!\A �deleteicon(handle%(currentwindow%),currenticon%)
!f+ � 6:�decodemenu(w_flags%,menus%+4)
!p, � 7:� menus%!4<>-1 � menus%!8<>-1 �
!z* �addchange(_titlestring%)
!�, !q%=handle%(currentwindow%)
!�, ș "Wimp_GetWindowInfo",,q%
!�* q%?(36+menus%!4)=menus%!8
!�2 �menus%!8=16 q%?(36+menus%!4)=255
!�% curw%=currentwindow%
!�$ $mb_newident% = "#"
!�/ �crwindow(q%+4,wident$(curw%))
!� N% = q%!4
!�% �deletewindow(curw%)
!� q%!0 = N%
!�# �reshow_window(q%)
!�# $mb_newident% = ""
!� �
"C � 8:�addchange(_titlestring%):�setworkarea(currentwindow%)
"- � 10: q%!0 = handle%(currentwindow%)
"< È™ "Wimp_CloseWindow",,q%:currentwindow%=-1
"$
�
".(� w_flags%:�addchange(_titlestring%)
"8 � !menus%=-1 � �
"B$ !q%=handle%(currentwindow%)
"L$ È™ "Wimp_GetWindowInfo",,q%
"V Ȏ !menus% �
"` � 0:�decodetitle(1)
"j � 1:q%!32=q%!32�&02
"t � 2:q%!32=q%!32�&04
"~ � 3:q%!32=q%!32�&08
"� � 4:q%!32=q%!32�&10
"� � 5:q%!32=q%!32�&20
"� � 6:q%!32=q%!32�&40
"� � 7:q%!32=q%!32�&80
"� � 8:q%!32=q%!32��&300
"� Ȏ menus%!4 �
"�$ � 0:q%!32=q%!32�&100
"�$ � 1:q%!32=q%!32�&200
"� �
"� �
"� � 9:q%!32=q%!32�&400
"� � 10:q%!32=q%!32�&800
# � 11:q%!32=q%!32�&1000
#
3 � 12:� menus%!4<>-1 � q%!64=(menus%!4)<<12
## � 13:q%!32=q%!32�&80000000
#< � 14,15,17,18,19,20:q%!32=q%!32 � (1<<(10+!menus%))
#(! � 16:�decodetitle(1<<26)
#2
�
#< curw%=currentwindow%
#F $mb_newident% = "#"
#P' �crwindow(q%+4,wident$(curw%))
#Z N% = q%!4
#d �deletewindow(curw%)
#n q%!0 = N%
#x �reshow_window(q%)
#� $mb_newident% = ""
#� �zzzz(q%!0)
#��
#��
#�$� �loadsprites(f$) � LOCAL I%,f$
#�(ș "OS_SpriteOp",&10A,spritearea%,f$
#�&� f$<>"<Wimp$Scrap>" � spritef$=f$
#��redrawwindows
#��
#�� �mergesprites(f$)
#�(ș "OS_SpriteOp",&10B,spritearea%,f$
#��redrawwindows
#��
$� �redrawwindows
$� I%
$� I%=0 � nh%
$"K� handle%(I%)>nh% � ș "Wimp_ForceRedraw",handle%(I%),-1E8,-1E8,1E8,1E8
$,�
$6�
$@� �filetype(f$)
$J� f%,type%
$T"ș "OS_File",17,f$ � type%,,f%
$^� type%<>1 � = -2
$h-� (f%>>>20)=&FFF � = (f%>>>8)�&FFF � = -1
$r� �decodetitle(bit%)
$|Ȏ menus%!4 �
$�� -1:q%!32=q%!32�bit%
$�:q%!32=q%!32�bit%
$��
$�>�menus%!4=8�menus%!4=9 : � bodge for 'right-justified' bit
$�9�menus%!4=7�menus%!4=8 : � bodge for 'indirected' bit
$�K�decodeicon(menus%+4,q%+60,q%+76,tb_text%,tb_sprite%,tb_buffersize%,"")
$��
$�� �setwork(q%,v%)
$�"!q%=�$v%:q%!4=�$(v%+�$v%,","))
$��
$�� �setworkarea(curw%)
$�� h%
$�h%=handle%(curw%)
%�setwork(q%,mb_workarea0%)
% �setwork(q%+8,mb_workarea1%)
%È™ "Wimp_SetExtent",h%,q%
%&4min% = (�$mb_minx% � &FFFF) � (�$mb_miny% << 16)
%0&!q%=h%:È™ "Wimp_GetWindowInfo",,q%
%:� q%!72<>min% �
%D> q%!72=min%:ș "Wimp_CreateWindow",,q%+4 � handle%(curw%)
%N1 !q%=handle%(curw%):È™ "Wimp_OpenWindow",,q%
%X' !q%=h%:È™ "Wimp_DeleteWindow",,q%
%b�
%l�
%vK� �decodeicon(menus%,fptr%,qptr%,mb_text%,mb_sprite%,mb_buffersize%,v$)
%�Ȏ !menus% �
%�� 0: � ** text
%� oldf%=!fptr%
%� Ȏ menus%!4 �
%�# � -1:!fptr%=!fptr% � &01
%�9� IF!fptr%AND&01THEN!fptr%=!fptr%ANDNOT&02
%� :!fptr%=!fptr%�&01
%�9 � (oldf%�&01)=0 � !fptr%=!fptr%��&02
%� �
%�6 �puticonstring(oldf%,fptr%,qptr%,$mb_text%)
%�� 1: � ** sprites
%� oldf%=!fptr%
%� Ȏ menus%!4 �
&# � -1:!fptr%=!fptr% � &02
&9� IF!fptr%AND&02THEN!fptr%=!fptr%ANDNOT&01
&% :!fptr%=(!fptr%��&03)�&02
& �
&*9 � !fptr% � &01 � A$=$mb_text% � A$=$mb_sprite%
&4/ �puticonstring(oldf%,fptr%,qptr%,A$)
&>� 2:!fptr%=!fptr%�&04
&H� 3:!fptr%=!fptr%�&08
&R� 4:!fptr%=!fptr%�&10
&\� 5:!fptr%=!fptr%�&20
&fE� 6:ș "Wimp_DecodeMenu",,i_font%,menus%+4,�100," ")�,,,fontname$
&p< � menus%!4<>-1 � menus%!8=4 � fontname$+=" point"
&z � fontname$="" �
&�" !fptr%=!fptr%��&40
&� fptr%?3=&D7
&� � !fptr%=!fptr%�&40
&�) � �fontname$,5)="point" �
&�" I%=�fontname$
&�3 �I%=I%-1:��fontname$,I%,1)="."
&�, psiz%=��fontname$,I%+1)
&�/ fontname$=�fontname$,I%-1)
&� � psiz%=12
&� �
&�2 fptr%?3=�findfont(fontname$,psiz%)
&� �
&�� 7:!fptr%=!fptr%�&80
')� 8:�!fptr%�&100�B$=$!qptr%�B$=$qptr%
'A �menus%!4=-1 � !fptr%=!fptr%�&100 � !fptr%=!fptr%�&100
' �!fptr%�&100�
'$% qptr%!8=�$mb_buffersize%
'.> !qptr%=�workspace(qptr%!8):$!qptr%=�B$,qptr%!8-1)
'8 � v$="" �
'B qptr%!4=-1
'L# � � (!fptr%�&03)=&02 �
'V* qptr%!4=spritearea%
'`; � qptr%!4=�workspace(�v$+1):$(qptr%!4)=v$
'j �
't �
'~ � $qptr%=�B$,11)
'� �
'�% � (!fptr% � &103) = &102 �
'�2 � qptr%!4 > 1 � !fptr%=!fptr% � � &02
'� �
'�� 9:!fptr%=!fptr%�&200
'�� 10:!fptr%=!fptr%�&400
'�� 11:!fptr%=!fptr%�&800
'�,� 12:!fptr%=�field(!fptr%,12,4,menus%!4)
'�,� 13:!fptr%=�field(!fptr%,16,5,menus%!4)
'�,� 14:!fptr%=�field(!fptr%,24,4,menus%!4)
'�,� 15:!fptr%=�field(!fptr%,28,4,menus%!4)
'��
( �
(
� �field(flg%,b0%,nb%,i%)
(6�i%<>-1�=flg%��(((1<<nb%)-1)<<b0%)�(i%<<b0%)�=flg%
(*� �puticonstring(oldf%,fptr%,qptr%,A$)
((� oldf%�&100 �
(2= � (!fptr% � &03)=&02 � qptr%!4=-1 : � no sprite area
(< � �A$<qptr%!8 �
(F+ $!qptr%=A$:!fptr%=!fptr%�&100:�
(P
�
(Z� � �A$<12 �
(d+ $qptr%=A$:!fptr%=!fptr%��&100:�
(n
�
(x�
(�!fptr%=!fptr% � &100
(�*!qptr%=�workspace(�A$+1):qptr%!8=�A$+1
(�$!qptr%=A$
(�H� (oldf%�&100)=0 � qptr%!4=-1 : � keep old validation string, if any
(��
(�R------------------------------------------------------------------------------
(�"� �renumber(curw%,curi%,newi%)
(�� M%,N%
(�!q%=handle%(curw%)
(�ș "Wimp_GetWindowInfo",,q%
(�5� q%!88 <= newi% � � 1,"Icon number out of range"
(�M%=q%+4+88+32*curi%
(�N%=q%+4+88+32*newi%
)#� I%=0 � 28 �4:Ȕ M%!I%,N%!I%:�
)I%=q%!88
)È• I%>0
)"@ � q%!(4+88+32*(I%-1)+16) � (1<<23) � I%-=1:q%!88=I% � I%=0
),�
)6$mb_newident% = "#"
)@0�crwindow(q%+4,wident$(curw%)) : � Help !!!!
)JN% = q%!4
)T6�deletewindow(curw%) : � Interesting ???
)^q%!0 =N%
)h�reshow_window(q%)
)r$mb_newident% = ""
)|�
)�R------------------------------------------------------------------------------
)� � �standardwindow(brx%,bry%)
)�.� I%=0 � 84 �4:q%!I%=default%!I%:�:q%!84=0
)�q%!64=spritearea%
)�'I%=q%!8-q%!0:q%!0=brx%:q%!8=q%!0+I%
)�*I%=q%!4-q%!12:q%!12=bry%:q%!4=q%!12+I%
)��
)�L!q%=brx%:q%!4=bry%-200:q%!8=brx%+200:q%!12=bry%:q%!16=0:q%!20=0:q%!24=-1
)�
q%!28=&1F
)�7q%?32=`tfcol:q%?33=`tbcol:q%?34=`wfcol:q%?35=`wbcol
)�.q%?36=4:q%?37=`tbcol:q%?38=`tbcol2:q%?39=0
)�*q%!40=0:q%!44=-1024:q%!48=1280:q%!52=0
)�#q%!56=&0000003D:q%!60=&00003000
*q%!64=spritearea%:q%!68=0
*$(q%+72)="<Untitled>"
*q%!84=0
*&�
*0&� �createwindow(brx%,bry%,wident$)
*:�standardwindow(brx%,bry%)
*D�crwindow(q%,wident$)
*N�addchange(_titlestring%)
*X�
*b� �crwindow(q%,wident$)
*l%� IF handleSP% <= 20 THEN ENDPROC
*v � �( $mb_newident% = "#" ) �
*� �add_to_array(wident$)
*� _ans% = q%!28>>>30
*� � _ans% = 0 �
*� _ans% = q%!28�&0C
*� �
*� _ans% = q%!28>>>28�&05
*� �
*��
*� � PRINT "0.1.2.1"
*�0ș "XWimp_CreateWindow",,q% � handle%;VFLAG%
*�C� (VFLAG% � 2) = 1 � � _init%, "Cannot create any more windows"
*� � PRINT "0.1.2.2"
*�Am%=handleSP%:handleSP%=handle%(handleSP%):handle%(m%)=handle%
+!q%=handle%
+)currentwindow%=m%:wident$(m%)=wident$
+currenticon%=-1
+ � PRINT "0.1.2.3"
+* �highlight(m%)
+4B � �( $mb_newident% = "#" ) � �buildbrowsericon(wident$,_ans%)
+>�
+H� �whichwindow(handle%)
+R� I%
+\� handle%=-1 � =-1
+fhandle%(nh%+1)=handle%
+p&I%=-1:�I%+=1:� handle%(I%)=handle%
+z� I% > nh% � =-1 � =I%
+�� �deletewindow(I%)
+�6!q%=handle%(I%): � TO CHECK # IN BROWSER mb_ident%
+�&handle%(I%)=handleSP%:handleSP%=I%
+�ș "Wimp_DeleteWindow",,q%
+�wident$(I%)=""
+��
+�� �getcurw
+�!q%=handle%(currentwindow%)
+� ș "Wimp_GetWindowState",,q%
+��info(q%+4)
+��
+�� �getcuri
+�� i%
,!q%=handle%(currentwindow%)
,q%!4=currenticon%
,È™ "Wimp_GetIconState",,q%
,$.cx0%=q%!8:cy0%=q%!12:cx1%=q%!16:cy1%=q%!20
,.flags%=q%!24
,8� flags% � &100 �
,B text$=$(q%!28)
,L valid% = q%!32
,V�
,`. i%=q%?40:q%?40=13:text$=$(q%+28):q%?40=i%
,j valid% = -1
,t�
,~N� (flags%�&103)=&103 � sprite$=��getcommand(valid%,"S"),2) � sprite$=text$
,��
,�� �getcommand(v%,c$)
,�� v%<=0 � =""
,��I%
,�$I%=�";"+$v%,";"+c$):� I%=0 � =""
,�(=�$(v%+I%-1),�$(v%+I%-1)+";",";")-1)
,�� �iconstring(flg%,p%)
,�� i%,i$
,�=� flg%�&100 � i$=$!p% � i%=p%?12:p%?12=13:i$=$p%:p%?12=i%
,�=i$
,�� �getpointer
,� ș "Wimp_GetPointerInfo",,q%
- *mousex%=!q%:mousey%=q%!4:buttons%=q%!8
-
handle%=q%!12:icon%=q%!16
-�
-R------------------------------------------------------------------------------
-(� �errordisplay
-2*� tsloss = � � ș "Wimp_CloseTemplate"
-<� OSCLI("CLOSE")
-Ferr%=�:!errbuf%=err%
-P
Ȏ err% �
-Z� 1,2:$(errbuf%+4)=�$+�0
-d
-nA �$(errbuf%+4)="At Line "+STR$ERL+" reports "+REPORT$+CHR$0
-x $(errbuf%+4)= �$+�0
-��
-�,ș "Wimp_ReportError",errbuf%,1,"FormEd"
-�� err%=1 � �
-�6� �$ ="Too many windows" � �selection_removeicon:�
-��
-�#
-�
� �finish
-�
�I%=0�255
-�Aȕ fontcounts%?I%>0:ș "Font_LoseFont",I%:fontcounts%?I%-=1:�
-��
-�ș "Wimp_CloseDown"
-��
-�R------------------------------------------------------------------------------
.� �workspace(L%)
.>� curbuff%+L%>buffer%+maxbuf% � � 1,"No more buffer space"
.curbuff%+=L%:=curbuff%-L%
."R------------------------------------------------------------------------------
.,� �findfont(f$,p)
.6�f%
.@-ș "Font_FindFont",,f$,p*16,p*16,0,0 � f%
.Jfontcounts%?f%+=1
.T:� fontcounts%?f%>=255 � � 1,"Internal font table full"
.^=f%
.hR------------------------------------------------------------------------------
.r!� �xor(handle%,icon%,ntimes%)
.|4�I%:�I%=1�ntimes%:�seti(handle%,icon%,&200000,0)
.�tempt%=�:���-tempt%>3:�
.��
.�
.�$� �seti(handle%,icon%,eor%,bic%)
.�J!q%=handle%:q%!4=icon%:q%!8=eor%:q%!12=bic%:ș "Wimp_SetIconState",,q%
.��
.�
.�� �readpal(c%,c2%)
.�� c2%=16 �
.�" palword%=paltable%!(4*c%)
.�-� ș "OS_ReadPalette",c%,c2% � ,,palword%
.��
.�r%=(palword%>> 8)�&FF
/g%=(palword%>>16)�&FF
/b%=(palword%>>24)�&FF
/�
/&
/0R------------------------------------------------------------------------------
/:!� �encodepalmenu(tickcolour%)
/D� I%,J%
/N�encodepal(0,15)
/X%I%=m_palette%+28:J%=m_p1lette%+28
/b� c%=0 � 15
/l> I%?11=(c%<<4)+uncolour%(c%):I%!8=I%!8 � &08 : � h centred
/v> J%?11=(c%<<4)+uncolour%(c%):J%!8=J%!8 � &08 : � h centred
/� � c%=tickcolour% �
/� !I%=!I%�&01
/� !J%=!J%�&01
/� �
/� !I%=!I%��&01
/� !J%=!J%��&01
/� �
/� I%+=24
/� J%+=24
/��
/�-J%?11=(0<<4)+uncolour%(0):J%!8=J%!8 � &08
/��tickcolour%=255 �
/� !J%=!J%�1
0�
0 !J%=!J%��1
0�
0 �
0*� �encodepal(c1%,c2%)
04� c%,d%,e%,br%,maxd%,maxe%
0>$È™ "Wimp_ReadPalette",,paltable%
0H-�c%=c1%�c2%:bright%(c%)=�brightness(c%):�
0R(�c%=c1%�c2%:br%=bright%(c%):maxe%=-1
0\"�d%=0�15:e%=�(bright%(d%)-br%)
0f�e%>maxe%�maxe%=e%:maxd%=d%
0p�:uncolour%(c%)=maxd%:�
0z�
0�� �brightness(c%)
0�
�r%,g%,b%
0��readpal(c%,16)
0�=r%+g%+g%+b%
0�+� �foreback(c%) = (c%<<4)�uncolour%(c%)
0�R------------------------------------------------------------------------------
0�� �checkfull(f$)
0�� �f$,".") � �f$,":") � �
0�;� 1,"To save, drag the file icon to a directory viewer"
0�� �matchident(A$)
0�� A$="" � =-1
0�� I%
0�*I%=nh%+1:�I%=I%-1:�A$=wident$(I%)�I%=0
1�A$=wident$(I%)�=I%�=-1
1"� �savetemplates(tfile$,safe%)
1*È™"Wimp_WhichIcon",browbox%,q%,1<<23,0
1$,� q%!0 = -1 � � 1,"No templates to save"
1.� tfile$ = "Templates" � �
18J%=0:�I%=0�nh%
1B� handle%(I%) >nh% �
1L> � wident$(I%)="" � � 1,"Only named windows can be saved"
1V wptr%(J%)=I%:J%+=1
1`�
1j�
1t!� *** PROCsortwindows removed
1~!�I%=0�255:fontbinding%?I%=0:�
1�1freef%=1 : � internal font handle allocation
1�tf_hdr%=16
1�tf_fsize%=48
1�tf_handle%=�(tfile$)
1�7� tf_handle%=0 � � 1,"Can't open file '"+tfile$+"'"
1�tf_dataptr%=tf_hdr%+J%*24+4
1�%�I%=0�tf_hdr%-1:indexdata%?I%=0:�
1� tf_index%=indexdata%+tf_hdr%
1�� I%=J%-1�0�-1
1�6!q%=handle%(wptr%(I%)):ș "Wimp_GetWindowInfo",,q%
1�A q%!68 = 1 : � *** Assume common sprite area when re-loading
1�tf_datasize%=88+32*q%!88
2 �processicon(q%+60,q%+76)
2
- q%!28 = -1 : � *** Place on top of stack
2� q%!88>0 � �processicons
2;È™ "OS_GBPB",1,tf_handle%,q%+4,tf_datasize%,tf_dataptr%
2(tf_index%!0=tf_dataptr%
22tf_index%!4=tf_datasize%
2<tf_index%!8=1
2F&$(tf_index%+12)=wident$(wptr%(I%))
2P+tf_index%+=24:tf_dataptr%+=tf_datasize%
2Z�
2d!tf_index%=0
2n9� freef%=1 � !indexdata%=-1 � !indexdata%=tf_dataptr%
2xAÈ™ "OS_GBPB",1,tf_handle%,indexdata%,tf_index%+4-indexdata%,0
2�� freef%>1 �
2�, � I%=0 � tf_fsize%-1:indexdata%?I%=0:�
2� � I%=1 � freef%-1
2�% J%=0:�J%+=1:�fontbinding%?J%=I%
2�F ș "Font_ReadDefn",J%,indexdata%+8 � ,,indexdata%!0,indexdata%!4
2�@ ș "OS_GBPB",1,tf_handle%,indexdata%,tf_fsize%,tf_dataptr%
2� tf_dataptr%+=tf_fsize%
2� �
2��
2�� #tf_handle%
2� �("Settype "+tfile$+" &FEC")
2��("Stamp "+tfile$)
2�,� safe% � templatef$=tfile$:_altered = �
3<$_titlestring% = templatef$: $mb_templates% = templatef$
3.�changewindowtitle(browbox%,_titlestring%)
3� _RESET% �
3" � _QUIT% � �finish:�
3, �resetwindowdefs
36 �close(browbox%)
3@�
3J�
3T� �processicons
3^� I%,J%
3hJ%=q%+92
3r7� I%=0 � q%!88-1:�processicon(J%+16,J%+20):J%+=32:�
3|�
3�� �processicon(fptr%,qptr%)
3�� !fptr% � &40 �
3�, extf%=fptr%?3:intf%=fontbinding%?extf%
3�A � intf%=0 � intf%=freef%:freef%+=1:fontbinding%?extf%=intf%
3� fptr%?3=intf%
3��
3�� !fptr% � &100 �
3� B%=q%+4+tf_datasize%
3�: $B%=$!qptr%:!qptr%=tf_datasize%:tf_datasize%+=�$B%+1
3� � qptr%!4>0 �
3� B%=q%+4+tf_datasize%
3�@ $B%=$(qptr%!4):qptr%!4=tf_datasize%:tf_datasize%+=�$B%+1
3� �
4�
4�
4� �loadtemplates(tfile$)
4&� I%,f$
40 � *SPOOL buggy
4:� tsloss = TRUE
4D� tfile$="" � �
4N"È™ "Wimp_OpenTemplate",,tfile$
4XL� tfile$<>"<Wimp$Scrap>" � templatef$=tfile$ : � only if load succeeded!
4b� LOCAL ERROR
4lX� ON ERROR LOCAL:ON ERROR RESTORE:SYS "Wimp_CloseTemplate":ERROR ERR,REPORT$:ENDPROC
4vtf_index%=0:�
4�$mb_wident%="*"
4� � PRINT "0.1"
4�}ș "XWimp_LoadTemplate",,q%+4,curbuff%,buffer%+maxbuf%,fontcounts%,mb_wident%,tf_index% � ,,curbuff%,,,,tf_index%;VFLAGS%
4�A� ( VFLAGS% � 2 ) = 1 � � _init%, "Cannot load Template File"
4�$_data% = $mb_wident%
4�guio%=0:ȕ �(_data%?uio%=0�_data%?uio%=13):uio%+=1:�:$mb_wident%=�$_data%,uio%):mb_wident%?(uio%)=13
4�+� tf_index%<>0 � �loadtemp($mb_wident%)
4� � PRINT "0.2"
4�� tf_index%=0
4�ș "Wimp_CloseTemplate"
4� � *** tsloss = FALSE: *CLOSE
4��
4�� �loadtemp(wident$)
5 � PRINT "0.1.1"
5I%=�matchident(wident$):
5� I%<>-1 � �
5 -q%!68=spritearea% : � user sprite area
5* � PRINT "0.1.2"
54�crwindow(q%+4,wident$)
5>�
5HR------------------------------------------------------------------------------
5R� �defaultwindows
5\4È™ "Wimp_OpenTemplate",,"<FormEd$Dir>.Templates"
5f� default% (88+1*32)
5p#�loadcrtemp("default",default%)
5zm_info% = �crtemp("info")
5�+m_workarea% = �crtemp("m_workarea")
5�*m_savetemp% = �crtemp("save_temp")
5�(� errorbox% = FNcrtemp("errorbox")
5�(quitbox% = �crtemp("quitbox")
5�(browbox% = �crtemp("browser")
5�ș "Wimp_CloseTemplate"
5�.mb_templates% = �iconaddr(m_savetemp%,1)
5�.mb_workarea0% = �iconaddr(m_workarea%,9)
5�/mb_workarea1% = �iconaddr(m_workarea%,10)
5�/mb_minx% = �iconaddr(m_workarea%,14)
5�/mb_miny% = �iconaddr(m_workarea%,15)
5��
5�� �crtemp(wident$)
6�loadcrtemp(wident$,q%)
6/ � wident$ = "browser" � _ptrtitle% = q%!72
6,ș "XWimp_CreateWindow",,q% � I%;VFLAGS%
6$< � ( VFLAGS% � 2 ) = 1 � � 0 , "Could not create window"
6.=I%
68� �loadcrtemp(wident$,q%)
6B� I%,c%,c2%,w$
6L#c%=curbuff%:c2%=buffer%+maxbuf%
6V w$=wident$+�12-�wident$,�13)
6`Iș "Wimp_LoadTemplate",,q%,c%,c2%,fontcounts%,w$,0 � ,,curbuff%,,,,c%
6jI� c%=0 � ș"XWimp_CloseTemplate":� 0,"Window '"+wident$+"' not found"
6tq%!64=systemsprites%
6~#� wident$="save_temp" � q%!64=1
6�_sloss% = curbuff%
6��
6�� �iconaddr(h%,i%)
6�-!q%=h%:q%!4=i%:ș "Wimp_GetIconState",,q%
6�� q%!24�&100 � =q%!28
6� � 1,"Icon is not indirected"
6�� �iconbar
6� � ic%
6�
!q%=-1
6�
q%!4=0
6�
q%!8=0
6�q%!12=69
7 q%!16=68
7
q%!20=&3002
7$(q%+24)="!formed"
7"ș "Wimp_CreateIcon",,q% � ic%
7(=ic%
72R------------------------------------------------------------------------------
7<� �objectclosedown
7F- q%!12 = q%!8:È™ "Wimp_SendMessage",19,q%
7P _prequit = �
7Z) �icon_write(quitbox%,1,�msg_0("Q1"))
7d! �front(quitbox%):_RESET% = �
7n�
7x#
7�4 � *********************************************
7�4 � ************** Browser Control **************
7�4 � *********************************************
7�#
7�'� �buildbrowsericon(wident$,_type%)
7� � _text% 15
7� � _ptr%,_sprite%
7� _ptr% = _BUF100%
7� $_text% = wident$+�0+�13
7�= � _type% = 0 � _sprite% = _SPRDIA% � _sprite% = _SPRWIN%
7� � bit 1 - is a sprite
7�' � bit 4 - v vertically centred
7�$ � bit 5 - filled background
8 � bit 8 - indirected
8 � bit 12-15 - icon type
8 !(_ptr%+0) = browbox%
8" !(_ptr%+4) = _biconx%
8, !(_ptr%+8) = _bicony%
863 !(_ptr%+12) = _biconx% + 220:� OLD Value '300'
8@ !(_ptr%+16) = _bicony% + 50
8J4 !(_ptr%+20) = %00010111000000001010000100110011
8T !(_ptr%+24) = _text%
8^ � _type% = 0 �
8h !(_ptr%+28) = _SPRDIA%
8r �
8| !(_ptr%+28) = _SPRWIN%
8� �
8�9 !(_ptr%+32) = �($_text%) + �($_sprite%)+30:� was + 2
8�/ ș "Wimp_CreateIcon",,_ptr% � _iconhandle%
8�P ș "Wimp_ForceRedraw",browbox%,_biconx%,_bicony%,_biconx%+300,_bicony% + 50
8� _biconx% += 300
8� � _biconx% > 900 �
8� _bicony% -= 50
8� _biconx% = 10
8� �
8� !(_ptr%+0) = 0
8�@ � _biconx% = 10 � !(_ptr%+4)=_bicony% � !(_ptr%+4)=_bicony%
8� !(_ptr%+8) = 850
8� !(_ptr%+12) = 0
9' È™ "Wimp_SetExtent",browbox%,_ptr%
9�
9� �browser_redraw
9&�
90#
9:� �add_to_array(newstring$)
9D � h%
9N0 ȕ � (_wid$(h%)= "*" � h% = nh% ):h% += 1:�
9X � newstring$ = "" �
9b% newstring$ = "NoIdent"+�_noid%
9l �
9v _wid$(h%) = newstring$
9� �
9��
9�#
9�)� �changewindowtitle (_w%,_newtitle%)
9� q%!0 = _w%
9�! ș "Wimp_GetWindowInfo",,q%
9� _p% = !(q%+76)
9� $_p% = $_newtitle%
9�= ș "Wimp_ForceRedraw",-1,q%!4,(q%!16)-36,q%!12,q%!16+36
9��
9�#
9�!� �showwindow(icon%,buttons%)
9� q%!0 = browbox%
: q%!4 = icon%
: � buttons% = &04 �
: È™ "Wimp_GetIconState",,q%
: _p% = !(q%+28)
:* � _p%?12 = 13
:4B � OSCLI ("*SPOOL zxc"):P. ?(_p%+LEN($_p%)-1):OSCLI("*SPOOL")
:> � ?(_p%+�($_p%)-1) = 0 �
:H _p%?(�($_p%)-1) = 13
:R �
:\ � *SPOOL XZC
:f. m% = �equalid($_p%):_p%?(�($_p%)) = 0
:p � *SPOOL
:z- $mb_cpywin% = $_p% : $mb_renwin% = $_p%
:� q%!0 = handle%(m%)
:�" ș "Wimp_GetWindowState",,q%
:� q%!28 = -1
:� ș "Wimp_OpenWindow",,q%
:�$ currentwindow%=m%:handle% = m%
:� currenticon%=-1
:� �
:�- � buttons% = &04*256 � �selection_unset
:�. � buttons% = &01*256 � buttons% = &01 �
:�# �selection_unseticon(icon%)
:� �
:�1 q%!8 = %00000000001000000000000000000000
:�1 q%!12 = %00000000001000000000000000000000
; q%!4 = icon%
; q%!0 = browbox%
;" È™ "Wimp_SetIconState",,q%
;$" È™ "Wimp_GetIconState",,q%
;. �
;8" _p% = !(q%+28):_p%?12 = 13
;B7 � ?(_p%+�($_p%)-1) = 0 � _p%?(�($_p%)-1) = 13
;L _p%?(�($_p%)) = 0
;V/ $mb_cpywin% = $_p% : $mb_renwin% = $_p%
;`+ � buttons% = &04 � �selection_unset
;j�
;t#
;~� �equalid(st$)
;� � UI% = 1 � nh%
;�! � wident$(UI%) = st$ � =UI%
;�
� UI%
;�=-1
;�#
;�� �addchange(_t%)
;�
� length%
;� � �(_altered) �
;� length% = �($_t%)
;� $_t% = $_t% + �(32)
;� $_t% = $_t% + �(42)
;� $_t% = $_t% + �(13)
<