   10 REM >!RUNIMAGE
   20 REM DESKTOP STAMP FILES
   30 REM
   40 REM
   50 REM
   60 REM
   70: 
   80 ON ERROR PROCerror(ERR,REPORT$+STR$(ERL))
   90 PROCinitialise
  100:
  110 REPEAT
  120 SYS "Wimp_Poll",51,block% TO A%
  130 CASE A% OF
  140 REM WHEN 2 : SYS "Wimp_OpenWindow",,block%
  150 REM WHEN 3 : PROCclose_window(!block%,FALSE)
  160 WHEN 6 : PROCbutton_click(block%!8,block%!12,block%!16)
  170 REM WHEN 7 : PROCdrag_done
  180 REM WHEN 8 : PROCkey_press(!block%,block%!4,block%!8,block%!24)
  190 WHEN 9 : PROCmenu_select(!block%,block%!4)
  200 WHEN 17,18 : PROCreceive(block%!16)
  210 ENDCASE
  220 UNTIL quit%
  230 SYS "Wimp_CloseDown"
  240 END
  250:
  260 DEFPROCclose_window(W%,del%)
  270 IF W%<>w_diary% THEN
  280 date%(FNget_note_num(W%))=-1
  290 B%=FNaddr(W%)
  300 IF del% OR (B%?4=13 AND B%?45=13 AND B%?86=13 AND B%?127=13) THEN
  310 CALL delete_entry
  320 PROCnew_month(0):PROCupdate_notes(FALSE)
  330 ENDIF
  340 ENDIF
  350 !block%=W%: SYS"Wimp_CloseWindow",,block%
  360 ENDPROC
  370:
  380 DEFPROCbutton_click(B%,W%,I%)
  390 CASE B% OF
  400 REM WHEN 1 : PROCsa_click(12)
  410 WHEN 2 : PROCmenu_click(W%,!block%,block%!4+12)
  420 REM WHEN 4 : PROCsa_click(1)
  430 REM WHEN 16,64 : PROCdrag_click
  440 ENDCASE
  450 ENDPROC
  460:
  470 DEFPROCdrag_done
  480 SYS "Wimp_GetPointerInfo",,block%
  490 block%!20=64:block%!32=0
  500 block%!36=1:block%!40=block%!12
  510 block%!44=block%!16
  520 block%!48=!block%
  530 block%!52=block%!4
  540 block%!56=!next-!first
  550 block%!60=&FEF
  560 $(block%+64)=FNleaf($file_name%)
  570 SYS "Wimp_SendMessage",17,block%+20,block%!12,block%!16
  580 ENDPROC
  590:
  600 DEFPROCkey_press(W%,I%,X%,C%)
  610 CASE C% OF
  620 WHEN 13 : IF W%=w_save% PROCquick_save ELSE PROCcaret(W%,I%-(I%<3),0)
  630 WHEN 30 : PROCcaret(W%,0,0)
  640 WHEN &18E:PROCcaret(W%,I%-(I%<3),X%)
  650 WHEN &18F:PROCcaret(W%,I%+(I%>0),X%)
  660 OTHERWISE SYS"Wimp_ProcessKey",C%
  670 ENDCASE
  680 ENDPROC
  690:
  700 DEFPROCmenu_select(A%,B%)
  720 IF mw%=-2 THEN 
  730 CASE A% OF
  740 WHEN 0 : PROCget_filetype(B%) 
  750 WHEN 1 : quit%=TRUE
  760 ENDCASE
  770 ENDIF
  850 ENDPROC
  860:
  870 DEFPROCreceive(M%)
  880 CASE M% OF
  890 WHEN 0 : quit%=TRUE
  900 REM WHEN 2 :PROCsave_notes(FNget_name(block%+44))
  910 WHEN 3 : IF block%!12=0 PROCload_merge(block%!20,FNget_name(block%+44))
  920 ENDCASE
  930 ENDPROC
  940:
  950 DEFPROCsa_click(inc%)
  960 CASE W% OF
  970 WHEN -2 : PROCnew_month(0):PROCopen_window(w_diary%)
  980 WHEN w_save% : IF I%=i_ok% PROCquick_save
  990 WHEN w_diary% :CASE I% OF
 1000 WHEN 0 : PROCnew_month(-inc%)
 1010 WHEN 1 : PROCnew_month(inc%)
 1020 OTHERWISE PROCdate_selected((month%<<8)+I%-3)
 1030 ENDCASE
 1040 ENDCASE
 1050 ENDPROC
 1060:
 1070 DEFPROCmenu_click(W%,X%,Y%)
 1080 mw%=W%:mx%=X%:my%=Y%
 1090 CASE W% OF
 1100 WHEN -2 : PROCmaster_menu("Stamper","Filetype,Quit,",X%,140)
 1130 ENDCASE
 1140 ENDPROC
 1150 :
 1160 DEFPROCdrag_click
 1170 SYS "Wimp_GetWindowState",,block%+12
 1180 X%=block%!16:Y%=block%!28
 1190 block%!16=I%:SYS "Wimp_GetIconState",,block%+12
 1200 block%!16=5
 1210 block%!20+=X%-2:block%!24+=Y%-4
 1220 block%!28+=X%+2:block%!32+=Y%+4
 1230 block%!36=0:block%!40=0
 1240 block%!44=&7FFFFFFF
 1250 block%!48=&7FFFFFFF
 1260 SYS "Wimp_DragBox",,block%+12
 1270 ENDPROC
 1280:
 1290 DEFPROCnew_month(inc%)
 1300 IF month%+inc% < 0 ENDPROC
 1310 block%!0=w_diary%:FOR I%=4 TO 34:block%!4=I%:SYS "Wimp_DeleteIcon",,block%:NEXT
 1320 month%+=inc%
 1330 m%=month% MOD 12 :y%=month% DIV 12
 1340 $month_buff%=month$(m%)+" "+STR$(y%)
 1350 PROCset_icon_state(w_diary%,3,0,0)
 1360 A%=!first:X%=8+FNday(y%,m%,1)*64:Y%=-152
 1370 FOR D%=1 TO num_days%(m%)-(m%=1 AND FNleap_year(y%))
 1380 E%=(month%<<8)+D%
 1390 B%=FNicon(w_diary%,STR$(D%),X%,Y%,44,44,&27003009-32*(E%=!USR(search)))
 1400 X%+=64:IF X%=456 X%=8:Y%-=48
 1410 NEXT
 1420 SYS "Wimp_ForceRedraw",w_diary%,8,-392,436,-108
 1430 T%=FNtoday:IF T%<>today% today%=T%
 1440 IF month%=(today%>>8) PROCset_icon_state(w_diary%,3+today% AND 255,4,4)
 1450 ENDPROC
 1460:
 1470 DEFPROCdate_selected(E%)
 1480 N%=0:WHILE N%<4 AND date%(N%)<>E% N%+=1:ENDWHILE
 1490 IF date%(N%)=E% PROCtop(N%,FALSE):ENDPROC
 1500 N%=0:WHILE N%<4 AND date%(N%)>0 N%+=1:ENDWHILE
 1510 IF date%(N%)>0 ERROR 1,"Can't open any more note windows."
 1520 A%=USR(find_entry)
 1530 IF !A%<>E% THEN
 1540 IF !next=!max ERROR 1,"No memory for any more entries."
 1550 CALL insert_entry
 1560 !A%=E%:A%!4=13:A%!45=13:A%!86=13:A%!127=13
 1570 PROCset_icon_state(w_diary%,I%,32,32)
 1580 ENDIF
 1590 PROCtop(N%,TRUE)
 1600 ENDPROC
 1610:
 1620 DEFPROCtop(N%,new%)
 1630 PROCopen_window(w_note%(N%))
 1640 IF new% date%(N%)=E%:$note_date%(N%)=FNdate_string(E%):PROCupdate_notes(FALSE)
 1650 PROCcaret(w_note%(N%),0,0)
 1660 ENDPROC
 1670:
 1680 DEFPROCupdate_notes(show%)
 1690 SYS "Wimp_GetCaretPosition",,block%+36
 1700 FOR D%=0 TO 4:E%=date%(D%)
 1710 IF E%>0 THEN
 1720 !block%=w_note%(D%)
 1730 P%=USR(find_entry)+4:Y%=-44
 1740 FOR I%=0 TO 3
 1750 block%!4=I% : SYS"Wimp_DeleteIcon",,block%
 1760 A%=FNind_icon(w_note%(D%),P%,-1,41,"",0,Y%,652,44,&700F101)
 1770 IF show% PROCset_icon_state(w_note%(D%),I%,0,0)
 1780 Y%-=40:P%+=41:NEXT
 1790 ENDIF
 1800 NEXT
 1810 SYS "Wimp_SetCaretPosition",block%!36,block%!40,block%!44,block%!48,block%!52,block%!56
 1820 ENDPROC
 1830:
 1840 DEFPROCclear_entry(W%)
 1850 P%=FNaddr(W%)
 1860 FOR I%=0 TO 3:P%?(I%*41+4)=13
 1870 PROCset_icon_state(W%,I%,0,0)
 1880 NEXT
 1890 PROCcaret(W%,0,0)
 1900 ENDPROC
 1910:
 1920 DEFPROCprint_entries(S%)
 1930 IF !first=!next OR S%=-1 ENDPROC
 1940 LOCAL ERROR
 1950 ON ERROR LOCAL VDU3:OSCLI"FX229,1":ENDPROC
 1960 SYS "OS_Byte",246,0,255 TO ,I%
 1970 VDU 2:*FX 229,0
 1980 FOR P%=!first TO !next-168 STEP 168
 1990 M%=(!P%)>>8
 2000 CASE S% OF
 2010 WHEN 0 : IF month%=M% PROCprint_entry
 2020 WHEN 1 : IF month% DIV 12 = M% DIV 12 PROCprint_entry
 2030 WHEN 2 : PROCprint_entry
 2040 OTHERWISE : IF P%=S% PROCprint_entry
 2050 ENDCASE
 2060 NEXT
 2070 VDU 3 :*FX229,1
 2080 ENDPROC
 2090:
 2100 DEFPROCprint_entry
 2110 PROCprint_line(FNdate_string(!P%))
 2120 FOR A%=4 TO 127 STEP 41
 2130 PROCprint_line($(P%+A%))
 2140 NEXT
 2150 VDU 1,13 :IF I%<>10 VDU 1,10
 2160 ENDPROC
 2170:
 2180 DEFPROCprint_line(A$)
 2190 IF A$="" ENDPROC
 2200 FOR C%=1 TO LEN(A$):VDU 1,ASC(MID$(A$,C%,1)):NEXT
 2210 VDU 1,13 :IF I%<>10 VDU 1,10
 2220 ENDPROC
 2230:
 2240 DEFFNleap_year(Y%)
 2250 =(0=Y% MOD 4 AND (Y% MOD 100 <> 0 OR Y% MOD 400 = 0))
 2260 DEFFNday(Y%,M%,D%)
 2270 =(365*Y%+Y% DIV 4 - Y% DIV 100 +Y% DIV 400 + days_so_far%(M%)+(M%<2 AND FNleap_year(Y%))-2+D%)MOD 7
 2280 DEFFNdate_string(M%)
 2290 D%=M% AND 255:Y%=(M%>>8) DIV 12:M%=(M%>>8) MOD 12
 2300 =day$(FNday(Y%,M%,D%))+" "+STR$(D%)+" "+month$(M%)+" "+STR$(Y%)
 2310:
 2320 DEFPROCload_merge(W%,A$)
 2330 block%!12=block%!8
 2340 block%!16=4:!block%=64
 2350 SYS "Wimp_SendMessage",17,block%,block%!4
 2380 PROCload_notes(A$)
 2400 ENDPROC
 2410:
 2420 DEFPROCload_notes(A$)
 2425 SYS "OS_File",13,A$ TO Object%
 2430 IF Object%=1 SYS "OS_File",18,A$,filetype%
 2520 ENDPROC
 2900:
 2910 DEFFNget_name(P%)
 2920 A$=""
 2930 WHILE ?P%<>0 AND ?P%<>13
 2940 A$=A$+CHR$(?P%):P%+=1
 2950 ENDWHILE
 2960 =A$
 2970:
 2980 DEFPROCset_icon_state(!block%,block%!4,block%!8,block%!12)
 2990 SYS "Wimp_SetIconState",,block%
 3000 ENDPROC
 3010:
 3020 DEFPROCcaret(W%,I%,X%)
 3030 SYS "Wimp_SetCaretPosition",W%,I%,X%,,-1,-1
 3040 ENDPROC
 3050:
 3060 DEFFNaddr(!block%)
 3070 block%!4=0:SYS "Wimp_GetIconState",,block%
 3080 =(block%!28)-4
 3090:
 3100 DEFFNget_note_num(W%)
 3110 N%=0
 3120 WHILE w_note%(N%)<>W% N%+=1:ENDWHILE
 3130 =N%
 3140:
 3150 DEFFNtoday
 3160 ?block%=1:SYS "OS_Word",14,block%
 3170 A%=?block%:Y%=10*(A%>>4)+(A% AND 15)
 3180 A%=block%?1:M%=22799+Y%*12+10*(A%>>4)+(A% AND 15)
 3190 A%=block%?2
 3200 =(M%<<8)+10*(A%>>4)+(A% AND 15)
 3210:
 3220 DEFPROCerror(!block%,$(block%+4))
 3230 SYS "Wimp_ReportError",block%,1,"Stamp"
 3240 ENDPROC
 3250:
 3260 DEFPROCinitialise
 3270 DIM block% 256,menu% 1024,buff% 10,filetypetable%(15)
 3280 filetypetable%()=&FFF,&FFE,&FFD,&FFC,&FFB,&FFA,&FF9,&FF8,&FF7,&FF6,&FF5,&FED,&FEC,&FEB,&BBC
 3370 quit%=FALSE
 3380:
 3390 SYS "Wimp_Initialise",200,&4B534154,"Stamper"
 3400 A%=FNind_icon(-1,1,7,"!stamp",0,0,68,68,&3102)
 3410 filetype%=&FFB
 3610 ENDPROC
 3620:
 3630 DEFFNcreate_window(title$,RETURN buff%,len%,X%,Y%,W%,H%,bg%,hg%,F%)
 3640 $block%=STRING$(88,CHR$(0))
 3650 !block%=X%:block%!4=Y%-H%
 3660 block%!8=X%+W%:block%!12=Y%
 3670 block%!28=F%:block%!32=&207
 3680 block%?35=bg%:block%!36=&103
 3690 block%?38=hg%:block%!44=-H%
 3700 block%!48=W%:block%!56=&19
 3710 $(block%+72)=title$
 3720 IF len%>0 DIM buff% len%:block%!56=&119:block%!72=buff%:block%!76=-1:block%!80=len%
 3730 SYS "Wimp_CreateWindow",,block% TO H%
 3740 =H%
 3750:
 3760 DEFPROCopen_window(!block%)
 3770 SYS"Wimp_GetWindowState",,block%
 3780 block%!28=-1:SYS"Wimp_OpenWindow",,block%
 3790 ENDPROC
 3800:
 3810 DEFFNicon(handle%,text$,X%,Y%,W%,H%,F%)
 3815 block%!0=handle%
 3820 block%!4=X%:block%!8=Y%
 3830 block%!12=X%+W%:block%!16=Y%+H%
 3835 block%!20=F%
 3840 IF text$<>"" $(block%+24)=text$
 3850 SYS "Wimp_CreateIcon",,block% TO I%
 3860 =I%
 3870:
 3880 DEFFNind_icon(window%,scb%,len%,text$,L%,B%,W%,H%,F%)
 3885 block%!28=scb%
 3900 block%!24=buff%:block%!32=len%
 3910 $buff%=text$
 3920 =FNicon(window%,"",L%,B%,W%,H%,F%)
 3930:
 3940 DEFPROCmaster_menu(title$,m$,X%,Y%)
 3950 PROCcreate_menu(menu%,title$,m$)
 3960 SYS "Wimp_CreateMenu",,menu%,X%-menu%!16/2,Y%
 3970 ENDPROC
 3980:
 3990 DEFPROCcreate_menu(M%,title$,m$)
 4000 LOCAL I%,max%
 4010 $M%=title$:M%!12=&70207
 4020 M%!20=44:M%!24=0
 4030 I%=M%+28:max%=LEN(title$)-2
 4040 REPEAT
 4050 A%=INSTR(m$,","):IF A%>max% max%=A%
 4060 !I%=0:I%!4=0
 4070 $(I%+12)=LEFT$(m$,A%-1)
 4080 m$=MID$(m$,A%+1)
 4090 CASE $(I%+12) OF
 4110 WHEN "Filetype" : I%!4=M%+100:PROCcreate_menu(I%!4,"Filetype","Text,Command,Data,Utility,BASIC,Module,Sprite,Absolute,BBC font,Font,PoScript,Palette,Template,Obey,BBC ROM,OTHER,")
 4120 WHEN "OTHER" :I%!4=M%+500:PROCcreate_entry_menu(I%!4,"Filetype")
 4130 ENDCASE
 4140 I%!8=&7000021:I%+=24
 4150 UNTIL m$=""
 4160 I%!-24=&80:M%!16=max%*16
 4170 ENDPROC
 4180:
 4200 DEFPROCcreate_entry_menu(M%,title$)
 4205 LOCAL I%
 4210 $M%=title$:M%!12=&70207
 4220 M%!20=44:M%!24=0
 4230 I%=M%+28
 4260 !I%=4:I%!4=0:$(M%+100)=STR$~(filetype%)
 4270 I%!12=M%+100:I%!16=0:I%!20=4
 4340 I%!8=&7000121
 4360 I%!0=I%!0 OR &80:M%!16=(LEN(title$)-2)*16
 4370 ENDPROC
 4380:
 4390 DEFPROCget_filetype(select%)
 4400 IF select%=15 THEN
 4410 filetype%=EVAL("&"+$(menu%+700))
 4420 ELSE 
 4430 filetype%=filetypetable%(select%)
 4440 ENDIF
 4450 ENDPROC
