Home » Archimedes archive » Archimedes World » AW-1991-03.adf » !AWMar91/Goodies/CardBase/!cardbase/!runimage
!AWMar91/Goodies/CardBase/!cardbase/!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-1991-03.adf |
| Filename: | !AWMar91/Goodies/CardBase/!cardbase/!runimage |
| Read OK: | ✔ |
| File size: | D164 bytes |
| Load address: | FFFFFB42 |
| Exec address: | 8F054359 |
File contents
10REM !runimage for CardBase
20REM Trial Version
30REM Adrian Lane
40REM 3 Lansdowne Gardens
50REM Hailsham
60REM BN27 1LQ
70
80
90ON ERROR MODE 0:REPORT:PRINTERL:a=GET:END
100
110PROCenvironment
120
130PROCconstants
140PROCvars
150PROCsetup
160PROCcreate_variables
170PROCcreateicons
180PROCread_virus
190IF c$<>"" THEN PROCload(c$)
200ON ERROR PROCerror
210REPEAT
220 PROCpoll(1)
230UNTIL quit
240 PROCclose_down_file
250 SYS "Wimp_CloseDown"
260END
270
280DEF PROCpoll(mask%)
290 SYS Poll%,mask%,q% TO reason%
300 CASE reason% OF
310 WHEN 1 :PROCredraw_window(!q%)
320 WHEN 2 :SYS"Wimp_OpenWindow",,q%
330 WHEN 3 :PROCcloseawindow(!q%)
340 WHEN 6 :PROCbuttons(q%)
350 WHEN 7 : IF loaded% THEN
360 PROCstart_disk_list
370 ELSE
380 PROCnew_save
390 ENDIF
400 WHEN 8 :PROCkey(q%!24)
410 WHEN 9 : PROCmenu_select(!q%)
420 WHEN 17,18:PROCreceive(q%)
430 ENDCASE
440ENDPROC
450
460DEF PROCmenu_select(item%)
470CASE item% OF
480 WHEN 0 : PROCcreate
490 WHEN 1 : IF NOT inhibit% THEN PROCopen_window(display_window%)
500 WHEN 2 : IF NOT inhibit% THEN PROCopen_window(sort_window%)
510 WHEN 3 : IF NOT inhibit% THEN PROCopen_window(output_window%)
520 WHEN 4 : IF NOT inhibit% THEN PROCopen_window(fields_window%)
530 WHEN 5 : PROCclose_down_file
540 WHEN 7 : quit = TRUE
550ENDCASE
560ENDPROC
570
580
590
600DEF PROCbuttons(b)
610LOCAL window%, icon%, button%
620 window% = b!12
630 icon% = b!16
640 button% = b!8
650 IF virus_set% AND RND(20) = 1 THEN
660 PROCshow_virus
670 ELSE
680 CASE window% OF
690 WHEN -2 : IF button% =2 THEN PROCmenu(b)
700 WHEN newfile_window% : IF (button% AND &50) <> 0 THEN PROCstart_drag
710 WHEN display_window% : CASE icon% OF
720 WHEN 2 : PROCstart
730 WHEN 3 : PROCend_of_file
740 WHEN 4 : PROCprevious_record
750 WHEN 5 : PROCnext_record
760 WHEN 6 : PROCdelete_record
770 ENDCASE
780 WHEN output_window% : CASE icon% OF
790 WHEN 9 : PROCprinter
800 WHEN 10 : PROCscreen
810 WHEN 11 : PROCfile_output
820 WHEN case_sens_icon%:PROCcase_sens_toggle
830 WHEN cr_icon% : PROCcrlf_toggle
840 WHEN tab_icon% : PROCtab_toggle
850 ENDCASE
860 WHEN save_window% : CASE icon% OF
870 WHEN 3 : PROCstart_output_drag
880 WHEN 0 : PROCquick_save
890 ENDCASE
900 WHEN screen_window% : IF icon% = 1 THEN escape% = TRUE
910 WHEN sort_window% : CASE icon% OF
920 WHEN 3 : PROCsort
930 WHEN 4 : sort_case_sens% = NOT sort_case_sens%
940 ENDCASE
950 ENDCASE
960 ENDIF
970ENDPROC
980
990DEF FNread_icon_text(window%,icon%)
1000!block% = window%
1010block%!4 = icon%
1020SYS "Wimp_GetIconState",,block%
1030= $(block%!28)
1040
1050
1060
1070DEF PROCopen_window(handle%)
1080 !block% = handle%
1090 SYS"Wimp_GetWindowState",,block%
1100 block%!28 = -1 : REM open on top
1110 SYS OpenW ,,block%
1120ENDPROC
1130
1140
1150
1160DEF PROCkey(k)
1170LOCAL window%, icon%, new_pos%
1180SYS "Wimp_ProcessKey",k
1190IF k = 13 OR k = &18E OR k = &18F OR k = &19D OR k = &19E THEN
1200 SYS"Wimp_GetCaretPosition",,caret%
1210 window% = caret%!0
1220 icon% = caret%!4
1230 new_pos% = icon%
1240 CASE window% OF
1250 WHEN newfile_window% : IF icon% = nf_1% THEN
1260 new_pos% = nf_2%
1270 ELSE
1280 new_pos% = nf_1%
1290 ENDIF
1300 PROCset_caret
1310 SYS"Wimp_ForceRedraw",fields_window%,0,-100,1000,0
1320 WHEN output_window% : IF k = 13 OR k =&18E THEN
1330 IF icon% < output_icon%(6) THEN
1340 new_pos%=icon%+1
1350 ELSE
1360 new_pos% = output_icon%(0)
1370 ENDIF
1380 ELSE
1390 IF icon% > output_icon%(0) THEN
1400 new_pos%=icon%-1
1410 ELSE
1420 new_pos% = output_icon%(6)
1430 ENDIF
1440
1450 ENDIF
1460 PROCset_caret
1470
1480 WHEN sort_window% : IF k = 13 THEN
1490 IF icon% < sort_icon%(11) THEN
1500 new_pos%=icon%+1
1510 ELSE
1520 new_pos% = sort_icon%(0)
1530 ENDIF
1540 PROCset_caret
1550 ENDIF
1560 IF k =&18F THEN
1570 IF icon% > sort_icon%(1) THEN
1580 new_pos%=icon%-2
1590 ELSE
1600 new_pos% = sort_icon%(11)
1610 ENDIF
1620 PROCset_caret
1630 ENDIF
1640 IF k =&18E THEN
1650 IF icon% < sort_icon%(10) THEN
1660 new_pos%=icon%+2
1670 ELSE
1680 new_pos% = sort_icon%(0)
1690 ENDIF
1700 PROCset_caret
1710 ENDIF
1720 WHEN fields_window% : IF k= 13 OR k= &19D THEN
1730 IF icon% < list%(max_fields) THEN
1740 new_pos%=icon%+1
1750 ELSE
1760 new_pos% = name%(0)
1770 ENDIF
1780 PROCset_caret
1790 ENDIF
1800 IF k =&18F THEN
1810 IF icon% >= name%(1) THEN
1820 new_pos%=icon%-7
1830 PROCset_caret
1840 ENDIF
1850 ENDIF
1860 IF k =&18E THEN
1870 IF icon% < name%(max_fields) THEN
1880 new_pos%=icon%+7
1890 PROCset_caret
1900 ENDIF
1910 ENDIF
1920 IF k= &19C THEN
1930 IF icon% > name%(0) THEN
1940 new_pos%=icon%+1
1950 PROCset_caret
1960 ENDIF
1970 ENDIF
1980 WHEN display_window% :IF k = 13 OR k =&18E THEN
1990 IF icon% <display_icon%(number_of_fields%-1)THEN
2000 new_pos%=icon%+2
2010 ELSE
2020 new_pos% = display_icon%(0)
2030 IF k = 13 THEN PROCset_caret:PROCnext_record :
2040 ENDIF
2050 ELSE
2060 IF icon% > display_icon%(0) THEN
2070 new_pos%=icon%-2
2080 ELSE
2090 new_pos% = display_icon%(number_of_fields%-1)
2100 ENDIF
2110 ENDIF
2120 PROCset_caret
2130 WHEN password_window% : IF k= 13 THEN PROCpassword
2140 WHEN save_window% : IF k=13 THEN PROCquick_save
2150 ENDCASE
2160ENDIF
2170ENDPROC
2180
2190DEF PROCset_caret
2200 SYS"Wimp_SetCaretPosition",window%,new_pos%,,,-1,-1
2210ENDPROC
2220
2230
2240
2250DEF PROCmenu(b)
2260flag1% = &7000021
2270flag2% = &7400021
2280IF loaded% SWAP flag1%,flag2%
2290$menu="CardBase"
2300menu!12=&70207
2310menu!16=156
2320menu!20=40
2330menu!24=0
2340
2350
2360
2370menu!28 = &00
2380menu!32 = -1
2390menu!36 = flag1%
2400$(menu+40) = "Create"
2410
2420menu!52 = &00
2430menu!56 = -1
2440menu!60 = flag2%
2450$(menu+64) = "Disp Edit"
2460
2470menu!76 = &00
2480menu!80 = -1
2490menu!84 = flag2%
2500$(menu+88) = "Sort"
2510
2520
2530menu!100 = &00
2540menu!104 = -1
2550menu!108 = flag2%
2560$(menu+112) = "Output"
2570
2580menu!124 = &00
2590menu!128 = -1
2600menu!132 = flag2%
2610$(menu+136) = "Fields"
2620
2630menu!148 = &00
2640menu!152 = -1
2650menu!156 = flag2%
2660$(menu+160) = "Close"
2670
2680
2690
2700menu!172 = &00
2710menu!176 = info_window%
2720menu!180 = &7000021
2730$(menu+184) = "Info"
2740
2750
2760menu!196=&80
2770menu!200= -1
2780menu!204=&7000021
2790$(menu+208)="Quit"
2800
2810SYS "Wimp_CreateMenu",,menu,!b-64,136
2820ENDPROC
2830
2840
2850
2860DEF PROCcloseawindow(handle%)
2870!block%=handle%
2880 SYS"Wimp_CloseWindow",,block%
2890IF handle% = output_window% THEN PROCcloseawindow(save_window%)
2900 REM recursive bit
2910ENDPROC
2920
2930DEF PROCreceive(q%)
2940CASE q%!16 OF
2950WHEN 0:PROCfinish:END
2960WHEN 2: PROCdatasave(q%)
2970WHEN 3,5 : IF q%!12 = 0 THEN PROCdataload(q%)
2980ENDCASE
2990ENDPROC
3000
3010
3020
3030
3040DEF PROCsetup
3050DIM block% 600
3060DIM taskid%4:$taskid%="TASK"
3070DIM q% &900,buffer% &800,endbuf% -1
3080DIM menu 500
3090DIM indirect% 2200
3100DIM caret% 40
3110curbuf%=buffer%
3120SYS "Wimp_Initialise",200,!taskid%,"CardBase" TO version%
3130SYS "Wimp_OpenTemplate",,"<CardBase$Dir>.Templates"
3140SYS "Wimp_LoadTemplate",,q%,indirect%,indirect%+199,-1,"display",0
3150SYS "Wimp_CreateWindow",,q% TO display_window%
3160SYS "Wimp_LoadTemplate",,q%,indirect%+200,indirect%+399,-1,"fields",0
3170SYS "Wimp_CreateWindow",,q% TO fields_window%
3180SYS "Wimp_LoadTemplate",,q%,indirect%+400,indirect%+599,-1,"output",0
3190SYS "Wimp_CreateWindow",,q% TO output_window%
3200SYS "Wimp_LoadTemplate",,q%,indirect%+600,indirect%+799,-1,"proginfo",0
3210SYS "Wimp_CreateWindow",,q% TO info_window%
3220SYS "Wimp_LoadTemplate",,q%,indirect%+800,indirect%+999,-1,"sort",0
3230SYS "Wimp_CreateWindow",,q% TO sort_window%
3240SYS "Wimp_LoadTemplate",,q%,indirect%+1000,indirect%+1199,-1,"create",0
3250SYS "Wimp_CreateWindow",,q% TO newfile_window%
3260SYS "Wimp_LoadTemplate",,q%,indirect%+1200,indirect%+1399,-1,"password",0
3270SYS "Wimp_CreateWindow",,q% TO password_window%
3280SYS "Wimp_LoadTemplate",,q%,indirect%+1400,indirect%+1599,-1,"screen",0
3290SYS "Wimp_CreateWindow",,q% TO screen_window%
3300SYS "Wimp_LoadTemplate",,q%,indirect%+1600,indirect%+2000,-1,"save",0
3310q%!64 = 1
3320
3330SYS "Wimp_CreateWindow",,q% TO save_window%
3340SYS "Wimp_CloseTemplate"
3350S%=OPENIN"<CardBase$Dir>.!Sprites"
3360T%=EXT#S%+160
3370CLOSE#S%
3380DIM sprites% T%
3390!sprites%=T%:sprites%!8=1
3400SYS "OS_SpriteOp",&109,sprites%
3410SYS "OS_SpriteOp",&10A,sprites%,"<CardBase$Dir>.!Sprites"
3420iccalc%=FNiconbar
3430quit = FALSE
3440abort% = FALSE
3450!q% = save_window%
3460q%!4 = 2
3470SYS"Wimp_GetIconState",,q%
3480text_file_name% = q%!28
3490ENDPROC
3500
3510
3520
3530DEF FNiconbar
3540!q%=-1
3550q%!4=0
3560q%!8=0
3570q%!12=63
3580q%!16=68
3590q%!20=&2102
3600spname$="!CardBase"
3610DIM q%!24 (LENspname$+1)
3620$(q%!24)=spname$
3630q%!28=sprites%
3640q%!32=LENspname$+1
3650SYS "Wimp_CreateIcon",,q% TO ic%
3660=ic%
3670
3680
3690
3700
3710
3720DEF PROCvars
3730Wimp = (1<<18) + (3<<6)
3740CreateW = Wimp+1
3750OpenW = Wimp+5
3760CloseW = Wimp+6
3770Poll% = Wimp+7
3780RedrawW = Wimp+8
3790UpdateW = Wimp+9
3800GetR% = Wimp+10
3810GetW = Wimp+11
3820GetP = Wimp+15
3830Drag = Wimp+16
3840CrMenu = Wimp+20
3850DcMenu = Wimp+21
3860file% = 0
3870inhibit% = FALSE
3880case_sens_icon% = 13
3890cr_icon% = 15
3900tab_icon% = 17
3910tabulate% = TRUE
3920sort_case_sens% = FALSE
3930output_file_handle% = 0
3940ENDPROC
3950
3960
3970DEF PROCerror
3980IF ERR = 17 THEN
3990 PROCerror_message("Escape pressed"):END
4000ELSE
4010 PROCerror_message(REPORT$+" (internal error) "+STR$(ERL))
4020ENDIF
4030IF output_file_handle% > 0 THEN
4040 CLOSE# output_file_handle%
4050 output_file_handle%=0
4060ENDIF
4070abort% = FALSE
4080ENDPROC
4090
4100
4110
4120
4130
4140
4150DEF PROCerror_message(text$)
4160SYS"Hourglass_Smash"
4170SYS"Wimp_DragBox",,-1
4180!block%=ERR
4190$(block%+4)=text$
4200SYS "Wimp_ReportError",block%,1,"!CardBase"
4210ENDPROC
4220
4230
4240DEF FNcancel_message(text$)
4250REM returns 0,1,2 for
4260LOCAL r0,r1
4270SYS"Hourglass_Smash"
4280SYS"Wimp_DragBox",,-1
4290!block%=ERR
4300$(block%+4)=text$
4310SYS "Wimp_ReportError",block%,7,"!CardBase" TO r0,r1
4320=r1
4330ENDPROC
4340
4350
4360DEF PROCglass(o%)
4370IF o% THEN
4380 SYS"Hourglass_On"
4390ELSE
4400 SYS"Hourglass_Off"
4410ENDIF
4420ENDPROC
4430
4440
4450DEF PROCfinish
4460SYS "Wimp_CloseDown"
4470ENDPROC
4480
4490
4500
4510
4520DEF PROCredraw_window(handle%)
4530!block% = handle%
4540SYS"Wimp_RedrawWindow",,block% TO more%
4550WHILE more%
4560 SYS "Wimp_GetRectangle",,block% TO more%
4570ENDWHILE
4580ENDPROC
4590
4600
4610DEF FNicon(whandle%,ix%,iy%,iw%,ih%,flag%, text$, d1%, d2%, d3%)
4620block%!0 = whandle%
4630block%!4 = ix%
4640block%!8 = iy%
4650block%!12 = ix% + iw%
4660block%!16 = iy% + ih%
4670block%!20 = flag%
4680IF d1% = 0 THEN
4690 $(block%!24) = text$
4700ELSE
4710 block%!24 = d1%
4720 block%!28 = d2%
4730 block%!32 = d3%
4740ENDIF
4750SYS"Wimp_CreateIcon",,block% TO ihandle%
4760=ihandle%
4770
4780
4790DEF PROCcreate_variables
4800DIM message_block% 100
4810DIM name%(max_fields),type%(max_fields),width%(max_fields),dp%(max_fields),min%(max_fields),max%(max_fields),list%(max_fields)
4820DIM record_a$(max_fields), record_b$(max_fields), highest$(max_fields)
4830DIM sort_line$(12), sort_operator$(6)
4840DIM field_used%(max_fields)
4850DIM current_field_value$(max_fields)
4860DIM output_list$(6)
4870DIM filename% 20
4880DIM pathname% 200
4890DIM record_number% 13
4900DIM password% 13
4910DIM in_password% 13
4920DIM valid_name% 20
4930DIM valid_password% 20
4940DIM rec_number% 13
4950DIM valid_type% 20
4960DIM field_des% 2200
4970DIM valid_integer% 10
4980DIM output_list% 500
4990DIM search_list% 200
5000DIM output_icon%(6)
5010DIM sort_field% 300
5020DIM sort_icon%(12)
5030DIM valid_sort% 20
5040DIM display_data% 3000
5050DIM display_icon%(max_fields*2)
5060DIM output_display% 2000
5070DIM matches% 20
5080DIM output_rec% 20
5090
5100$valid_name%="Aa-zA-Z0-9"
5110$valid_password% ="D*"
5120$valid_type% = "ADNTdnt"
5130$valid_integer% = "A0-9"
5140$valid_sort% = "AaADd"
5150
5160
5170$filename% = "DataFile"
5180$pathname% = "DataFile"
5190$password% = ""
5200$in_password% = ""
5210$rec_number% = "0"
5220$search_list% = ""
5230
5240loaded% = FALSE
5250DIM f$(19,6)
5260
5270$text_file_name% = "Output"
5280ENDPROC
5290
5300
5310DEF PROCcreateicons
5320REM windowhandle,minx,miny,length, height, flags, sprite,text, valid, length
5330REM text, no background is &7000511
5340REM text, with background is &7000135
5350REM writable icon, validated, in box is &700F53D
5360nf_1% = FNicon(newfile_window%,200,-54,200,48,&700F53D,"",filename%,valid_name%,12)
5370nf_2% =FNicon(newfile_window%,200,-108,200,48,&700F53D,"",password%,valid_password%,12)
5380pw% =FNicon(password_window%,400,-200,200,48,&700F53D,"",in_password%,valid_password%,12)
5390d% =FNicon(display_window%,270,-62,200,48,&7000135,"",filename%,-1,12)
5400d% =FNicon(fields_window%,280,-62,200,48,&7000135,"",filename%,-1,12)
5410d% =FNicon(output_window%,280,-62,200,48,&7000135,"",filename%,-1,12)
5420d% =FNicon(screen_window%,280,-62,200,48,&7000135,"",filename%,-1,12)
5430d% =FNicon(sort_window%,280,-62,200,48,&7000135,"",filename%,-1,12)
5440d% =FNicon(display_window%,700,-62,180,48,&7000135,"",rec_number%,-1,12)
5450
5460FOR a% = field_des% TO field_des% + 2196 STEP 4
5470 !a% = &D0D0D0D : REM SET THE AYYAY TO EMPTY
5480NEXT
5490
5500FOR a% = 0 TO 496 STEP 4
5510 output_list%!a% = &D0D0D0D
5520NEXT
5530
5540FOR a% = 0 TO 296 STEP 4
5550 sort_field%!a% = &D0D0D0D
5560NEXT
5570
5580FOR a% = 0 TO 1996 STEP 4
5590 output_display%!a% = &D0D0D0D
5600NEXT
5610
5620FOR a% = 0 TO 196 STEP 4
5630 search_list%!a% = &D0D0D0D
5640NEXT
5650
5660FOR a% = 0 TO 1996 STEP 4
5670 output_display%!a% = &D0D0D0D
5680NEXT
5690
5700
5710
5720FOR row% = 0 TO max_fields
5730name%(row%) = FNicon(fields_window%,50,-250-row%*60,200,48,&700F535,"",field_des%+100*row%,valid_name%,20)
5740type%(row%) = FNicon(fields_window%,330,-250-row%*60,40,48,&700F535,"",field_des%+22+100*row%,valid_type%,2)
5750width%(row%) = FNicon(fields_window%,470,-250-row%*60,80,48,&700F535,"",field_des%+26+100*row%,valid_integer%,3)
5760dp%(row%) = FNicon(fields_window%,600,-250-row%*60,80,48,&700F535,"",field_des%+32+100*row%,valid_integer%,2)
5770min%(row%) = FNicon(fields_window%,730,-250-row%*60,130,48,&700F535,"",field_des%+35+100*row%,-1,12)
5780max%(row%) = FNicon(fields_window%,870,-250-row%*60,130,48,&700F535,"",field_des%+47+100*row%,-1,12)
5790list%(row%) =FNicon(fields_window%,1010,-250-row%*60,250,48,&700F535,"",field_des%+60+100*row%,-1,38)
5800NEXT
5810
5820y% = -120
5830FOR a% = 0 TO 5
5840 output_icon%(a%) = FNicon(output_window%,200,y%-60*a%,700,48,&700F535,"",output_list%+70*a%,-1,60)
5850NEXT
5860output_icon%(6) =FNicon(output_window%,280,-480,620,48,&700F535,"",search_list%,-1,200)
5870
5880
5890
5900y% = -260
5910FOR a% = 0 TO 10 STEP 2
5920 sort_icon%(a%) =FNicon(sort_window%,20,y%-30*a%,300,48,&700F535,"",sort_field%+25*a%,-1,20)
5930 sort_icon%(a%+1) =FNicon(sort_window%,450,y%-30*a%,50,48,&700F535,"",sort_field%+22+25*a%,valid_sort%,2)
5940NEXT
5950
5960
5970
5980REM this is the output display dindow
5990
6000y% = -120
6010FOR a% = 0 TO 5
6020 d% = FNicon(screen_window%,200,y%-60*a%,700,48,&7000511,"",output_display%+300*a%,-1,250)
6030NEXT
6040d% =FNicon(screen_window%,620,-62,150,48,&7000135,"",output_rec%,-1,12)
6050d% =FNicon(screen_window%,900,-62,150,48,&7000135,"",matches%,-1,12)
6060
6070
6080REM d% = FNicon(function%,16,-50,250,48,&7000511,"",t1%,-1,20)
6090ENDPROC
6100
6110
6120DEF PROCconstants
6130 max_fields = 19
6140 over_size = 1.25
6150 ALL = TRUE
6160 case_sens% = FALSE
6170 crlf% = FALSE
6180 tabulate% = TRUE
6190ENDPROC
6200
6210DEF PROCcreate
6220FOR a% = field_des% TO field_des% + 2196 STEP 4
6230 !a% = &D0D0D0D : REM SET THE AYYAY TO EMPTY
6240NEXT
6250$filename% = "DataFile"
6260$pathname% = "DataFile"
6270$password% = ""
6280$rec_number% = "0"
6290$search_list% = ""
6300PROCopen_window(newfile_window%)
6310PROCopen_window(fields_window%)
6320window% = newfile_window%
6330new_pos% = nf_1%
6340PROCset_caret
6350ENDPROC
6360
6370DEF PROCextract_field_description
6380LOCAL rec%,pos%
6390FOR rec% = 0 TO max_fields
6400 pos% = field_des%+rec%*100
6410 f$(rec%,0) = $pos%
6420 pos% = field_des%+rec%*100+22
6430 f$(rec%,1) = $pos%
6440 pos% = field_des%+rec%*100+26
6450 f$(rec%,2) = $pos%
6460 pos% = field_des%+rec%*100+32
6470 f$(rec%,3) = $pos%
6480 pos% = field_des%+rec%*100+35
6490 f$(rec%,4) = $pos%
6500 pos% = field_des%+rec%*100+47
6510 f$(rec%,5) = $pos%
6520 pos% = field_des%+rec%*100+60
6530 f$(rec%,6) = $pos%
6540 IF LEN f$(rec%,0) > 0 THEN
6550 field_used%(rec%) = TRUE
6560 ELSE
6570 field_used%(rec%) = FALSE
6580 ENDIF
6590NEXT
6600d=FNField_des_ok
6610ENDPROC
6620
6630
6640DEF FNfield_name_ok
6650LOCAL rec%, rec1%, rec2%, length%, field%
6660ok=TRUE
6670FOR rec% = 0 TO max_fields
6680 length% = 0
6690 FOR field% = 0 TO 6
6700 length% = length% + LEN(f$(rec%,field%))
6710 NEXT
6720 IF length% > 0 AND LEN(f$(rec%,0))=0 THEN
6730 ok = FALSE
6740 PROCerror_message("Field number "+STR$(rec%+1)+" does not have a name")
6750 ENDIF
6760NEXT
6770FOR rec1% = 0 TO max_fields-1
6780 FOR rec2% = rec1%+1 TO max_fields
6790 IF f$(rec1%,0) = f$(rec2%,0) AND LEN(f$(rec2%,0)) >0 THEN
6800 ok = FALSE
6810 PROCerror_message("There are two fields with the name "+f$(rec2%,0))
6820 ENDIF
6830 NEXT
6840NEXT
6850=ok
6860
6870
6880
6890DEF FNfield_len_ok
6900LOCAL rec%
6910FOR rec% = 0 TO max_fields
6920 IF LEN(f$(rec%,0))>0 THEN
6930 IF VAL(f$(rec%,2))=0 THEN
6940 PROCerror_message("Field '"+f$(rec%,0)+"' must have a width greater than zero")
6950 ENDIF
6960 IF (f$(rec%,1)="N" OR f$(rec%,1)="n") AND VAL(f$(rec%,2)) > 20 THEN
6970 PROCerror_message("Field '"+f$(rec%,0)+"' is numeric so its width must not exceed 20")
6980 ENDIF
6990 ENDIF
7000NEXT
7010=TRUE
7020
7030
7040DEF FNfield_type_ok
7050LOCAL rec%
7060FOR rec% = 0 TO max_fields
7070 IF LEN(f$(rec%,0))>0 AND LEN(f$(rec%,1))=0 THEN
7080 PROCerror_message("Field "+f$(rec%,0)+" does not have a type")
7090 ENDIF
7100NEXT
7110=TRUE
7120
7130
7140DEF FNfield_max_ok
7150LOCAL rec%, ok%
7160FOR rec% = 0 TO max_fields
7170 IF LEN(f$(rec%,0))>0 AND (f$(rec%,1) ="N" OR f$(rec%,1) ="n") THEN
7180 IF NOT FNnumeric(f$(rec%,4)) THEN
7190 PROCerror_message("Field "+f$(rec%,0)+" does not have a numeric minimum")
7200 ENDIF
7210 ENDIF
7220NEXT
7230FOR rec% = 0 TO max_fields
7240 IF LEN(f$(rec%,0))>0 AND (f$(rec%,1) ="N" OR f$(rec%,1) ="n") THEN
7250 IF NOT FNnumeric(f$(rec%,5)) THEN
7260 PROCerror_message("Field "+f$(rec%,0)+" does not have a numeric maximum")
7270 ENDIF
7280 ENDIF
7290NEXT
7300=ok%
7310
7320
7330DEF FNfield_date_ok
7340LOCAL rec%, ok%
7350FOR rec% = 0 TO max_fields
7360 IF LEN(f$(rec%,0))>0 AND (f$(rec%,1) ="D" OR f$(rec%,1) ="d") THEN
7370 IF NOT FNvalid_date(f$(rec%,4)) AND LEN(f$(rec%,4))>0 THEN
7380 PROCerror_message("Field "+f$(rec%,0)+" does not have a correctly formed minimum date")
7390 ENDIF
7400 ENDIF
7410NEXT
7420FOR rec% = 0 TO max_fields
7430 IF LEN(f$(rec%,0))>0 AND (f$(rec%,1) ="d" OR f$(rec%,1) ="D") THEN
7440 IF NOT FNvalid_date(f$(rec%,5)) AND LEN(f$(rec%,5))>0 THEN
7450 PROCerror_message("Field "+f$(rec%,0)+" does not have a correctly formed maximum date")
7460 ENDIF
7470 ENDIF
7480NEXT
7490=ok%
7500
7510
7520
7530
7540DEF FNField_des_ok
7550IF FNfield_name_ok AND FNfield_len_ok AND FNfield_type_ok AND FNfield_max_ok AND FNfield_date_ok THEN
7560 = TRUE
7570ELSE
7580 =FALSE
7590ENDIF
7600
7610
7620DEF FNnumeric(text$)
7630LOCAL i%, ok%
7640ok%=TRUE
7650IF LEN(text$) > 0 THEN
7660 FOR i% = 1 TO LEN(text$)
7670 c$ = MID$(text$,i%,1)
7680 IF c$ <"." OR c$>"9" OR c$="/" THEN ok% = FALSE
7690 NEXT
7700ENDIF
7710= ok%
7720
7730DEF FNvalid_date(date$)
7740LOCAL ok%, day%, month%, year%
7750ok% = TRUE : REM allow zero null entries
7760IF LEN(date$) >0 THEN
7770IF LEN(date$) <>8 THEN
7780 ok% = FALSE
7790ELSE
7800 day% = VAL(LEFT$(date$,2))
7810 month% = VAL(MID$(date$,4,2))
7820 year% = VAL(MID$(date$,7,2))
7830 IF year% MOD 4 = 0 THEN
7840 days_in_feb% = 29
7850 ELSE
7860 days_in_feb% = 28
7870 ENDIF
7880 IF (day% > 31) OR (day% < 1) THEN ok% = FALSE
7890 IF (month% >12) OR (month% < 1) THEN ok% = FALSE
7900 CASE month% OF
7910 WHEN 4,6,9,11 : IF day% > 30 THEN ok% = FALSE
7920 WHEN 2 : IF day% > days_in_feb% THEN ok% = FALSE
7930 ENDCASE
7940ENDIF
7950ENDIF
7960=ok%
7970
7980
7990DEF PROCstart_drag
8000 LOCAL wex%,wey%
8010 !block% = newfile_window%
8020 SYS"Wimp_GetWindowState",,block%
8030 wex% = block%!4 - block%!20
8040 wey% = block%!16 - block%!24
8050 block%!4 = 2 : REM icon handle for drag icon
8060 SYS"Wimp_GetIconState",,block%
8070 !block% = newfile_window%
8080 block%!4 = 5
8090 block%!8 = block%!8 +wex%
8100 block%!12 = block%!12 +wey%
8110 block%!16 = block%!16 +wex%
8120 block%!20 = block%!20 +wey%
8130 block%!24 = 0
8140 block%!28 = 0
8150 block%!32 = &7FFFFFFF
8160 block%!36 = &7FFFFFFF
8170 SYS"Wimp_DragBox",,block%
8180ENDPROC
8190
8200
8210DEF PROCnew_save
8220PROCextract_field_description
8230number_of_fields% = 0
8240FOR rec% = 0 TO max_fields
8250 IF LEN(f$(rec%,0)) > 0 THEN
8260 number_of_fields% +=1
8270 ENDIF
8280NEXT
8290IF number_of_fields% = 0 THEN
8300 PROCerror_message("There must be at least one field defined")
8310ELSE
8320SYS"Wimp_GetPointerInfo",,block%
8330block%!20 = 64
8340block%!32 = 0
8350block%!36 = 1
8360block%!40 = block%!12
8370block%!44 = block%!16
8380block%!48 = !block%
8390block%!52 = block%!4
8400block%!56 = 10000 : REM size of the file
8410block%!60 = &778 : REM file type of the file
8420$(block%+64) = $filename%
8430?(block%+65+LEN($filename%)) = 0
8440SYS"Wimp_SendMessage",17,block%+20,block%!12,block%!16
8450ENDIF
8460ENDPROC
8470
8480DEF FNget_name(P%)
8490A$=""
8500WHILE ?P%<>0 AND ?P%<> 13
8510 A$ = A$+CHR$?P%:P%+=1
8520ENDWHILE
8530=A$
8540
8550
8560DEF FNleaf(path$)
8570WHILE INSTR(path$,".")
8580path$=MID$(path$,INSTR(path$,".")+1)
8590ENDWHILE
8600=path$
8610
8620
8630DEF PROCdatasave(b)
8640IF loaded% THEN
8650FOR i% = 0 TO 96 STEP 4
8660 message_block%!i% = b!i%
8670NEXT
8680REM copy the message block since wimp poll currupts it!
8690PROCproduce_output(FNget_name(message_block%+44))
8700IF FNget_name(message_block%+44) <> "<Wimp$Scrap>" THEN
8710 $text_file_name% = FNget_name(message_block%+44)
8720ENDIF
8730message_block%!12=message_block%!8
8740message_block%!16=3
8750!message_block% = 64
8760SYS"Wimp_SendMessage",17,message_block%,message_block%!20,message_block%!24
8770
8780ELSE
8790PROCsaveit(FNget_name(b+44))
8800$pathname% = FNget_name(b+44)
8810$filename% = FNleaf($pathname%)
8820b!12=b!8
8830b!16=3
8840!b = 64
8850SYS"Wimp_SendMessage",17,b,b!20,b!24
8860ENDIF
8870ENDPROC
8880
8890
8900
8910DEF PROCsaveit(name$)
8920REM This saves a file the first time
8930LOCAL rec%
8940file% = OPENOUT(name$)
8950FOR a% = field_des% TO field_des% + 2196 STEP 4
8960 PRINT#file%,!a%
8970NEXT
8980current_field_value$() = ""
8990number_of_fields% = 0
9000number_of_records% = 1
9010record_size% = 0
9020FOR rec% = 0 TO max_fields
9030 record_size%=record_size%+VAL(f$(rec%,2))+2
9040 IF LEN(f$(rec%,0)) > 0 THEN
9050 number_of_fields% +=1
9060 ENDIF
9070NEXT
9080record_size%=20+record_size%*over_size
9090PRINT #file%,$password%
9100PRINT #file%, $filename%
9110PRINT #file%, number_of_records%
9120PRINT #file%, record_size%
9130PRINT #file%, number_of_fields%
9140PRINT #file%, 1 : REM record number
9150
9160FOR rec% = 0 TO max_fields
9170 PRINT #file%, field_used%(rec%)
9180NEXT
9190
9200FOR a% = output_list% TO output_list%+496 STEP 4
9210 PRINT #file%,!a%
9220NEXT
9230
9240FOR a% = search_list% TO search_list%+196 STEP 4
9250 PRINT #file%,!a%
9260NEXT
9270
9280FOR a% = sort_field% TO sort_field%+296 STEP 4
9290 PRINT #file%,!a%
9300NEXT
9310
9320
9330
9340
9350
9360PROCwrite_record(1)
9370CLOSE #file%
9380file% = 0
9390OSCLI("settype "+name$+" 778")
9400PROCcloseawindow(newfile_window%)
9410PROCcloseawindow(fields_window%)
9420loaded% = FALSE
9430PROCload(name$)
9440ENDPROC
9450
9460
9470
9480DEF PROCload(name$)
9490IF loaded% THEN
9500 PROCerror_message("The file '"+$filename%+"' is still open and must be closed before a new file can be loaded")
9510ELSE
9520 PROCcloseawindow(newfile_window%)
9530 PROCcloseawindow(fields_window%)
9540 current_file_name$ = name$
9550 file% = OPENUP(name$)
9560 FOR a% = field_des% TO field_des% + 2196 STEP 4
9570 INPUT#file%,!a%
9580 NEXT
9590 INPUT #file%,$password%
9600 INPUT #file%, $filename%
9610 INPUT #file%, number_of_records%
9620 INPUT #file%, record_size%
9630 INPUT #file%, number_of_fields%
9640 INPUT #file%, current_rec%
9650
9660 FOR rec% = 0 TO max_fields
9670 INPUT #file%, field_used%(rec%)
9680 NEXT
9690
9700 FOR a% = output_list% TO output_list%+496 STEP 4
9710 INPUT #file%,!a%
9720 NEXT
9730
9740 FOR a% = search_list% TO search_list%+196 STEP 4
9750 INPUT #file%,!a%
9760 NEXT
9770
9780 FOR a% = sort_field% TO sort_field%+296 STEP 4
9790 INPUT #file%,!a%
9800 NEXT
9810
9820 PROCread_record(current_rec%)
9830 $rec_number% = STR$(current_rec%)
9840 loaded% = TRUE
9850 PROCextract_field_description
9860 PROCcreate_display_icons
9870 PROCpassword_check
9880 IF NOT inhibit% PROCopen_window(display_window%)
9890ENDIF
9900ENDPROC
9910
9920
9930DEF PROCcreate_display_icons
9940REM change validation string to match the type definition
9950LOCAL d%, f%,l%,w%
9960FOR f% = 0 TO number_of_fields% -1
9970display_icon%(f%+number_of_fields%)=FNicon(display_window%,50,-300-f%*60,300,48,&7000511,"",field_des%+100*f%,-1,20)
9980l% = VAL(f$(f%,2)) : REM set length of box to a suitable value
9990w% = l%*16 +48
10000IF w%>400 THEN w%=400
10010display_icon%(f%) = FNicon(display_window%,400,-300-f%*60,w%,48,&700F535,"",display_data%+300*f%,-1,l%+1)
10020NEXT
10030ENDPROC
10040
10050DEF PROCdestroy_display_icons
10060FOR f% = 2*number_of_fields% -1 TO 0 STEP -1
10070 IF display_icon%(f%) > 0 THEN
10080 !block% = display_window%
10090 block%!4 = display_icon%(f%)
10100 SYS"Wimp_DeleteIcon",,block%
10110 ENDIF
10120NEXT
10130ENDPROC
10140
10150
10160
10170DEF PROCenvironment
10180SYS "OS_GetEnv" TO c$
10190c$=RIGHT$(c$,LENc$-20)
10200WHILE LEFT$(c$,1) <>" " AND LENc$ <>0
10210 c$=RIGHT$(c$,LENc$-1)
10220ENDWHILE
10230IF c$ = " " THEN c$ =""
10240ENDPROC
10250
10260REM DEF PROCenvironment
10270SYS "OS_GetEnv" TO c$
10280p = INSTR(c$,"""",INSTR(c$,"""")+1)
10290c$=MID$(c$,p+1)
10300WHILE LEFT$(c$,1)=" "
10310 c$=MID$(c$,2)
10320ENDWHILE
10330
10340ENDPROC
10350
10360
10370
10380
10390
10400
10410
10420DEF PROCackload(b)
10430b!12=b!8
10440b!16 = 4
10450!b = 64
10460SYS"Wimp_SendMessage",17,b,b!4
10470ENDPROC
10480
10490DEF PROCdataload(b)
10500IF b!40 = &778 THEN
10510 PROCload(FNget_name(b+44))
10520 PROCackload(b)
10530ENDIF
10540ENDPROC
10550
10560
10570
10580
10590
10600
10610DEF PROCextract_record_data
10620REM This takes the data from the icons and puts them into an array
10630LOCAL f%
10640FOR f% = 0 TO number_of_fields%-1
10650 p% =display_data%+f%*300
10660 current_field_value$(f%) = $p%
10670NEXT
10680ENDPROC
10690
10700DEF PROCclear_record
10710LOCAL f%
10720FOR f% = 0 TO number_of_fields%-1
10730 p% =display_data%+f%*300
10740 $p% = ""
10750NEXT
10760ENDPROC
10770
10780
10790DEF FNdate(date$)
10800 =VAL(LEFT$(date$,2))+100*VAL(MID$(date$,4,2))+10000*VAL(RIGHT$(date$,2))
10810
10820
10830
10840DEF FNvalid_min(value$,type$,min$)
10850LOCAL ok%
10860ok% = TRUE
10870IF LEN min$ >0 AND LEN value$ > 0 THEN
10880CASE type$ OF
10890 WHEN "t","T" : IF value$ < min$ THEN ok% = FALSE
10900 WHEN "N","n" : IF VAL(value$) < VAL(min$) THEN ok% = FALSE
10910 WHEN "D","d" : IF FNdate(value$) < FNdate(min$) THEN ok% = FALSE
10920ENDCASE
10930ENDIF
10940=ok%
10950
10960DEF FNvalid_max(value$,type$,max$)
10970LOCAL ok%
10980ok% = TRUE
10990IF LEN max$ >0 AND LEN value$ > 0 THEN
11000CASE type$ OF
11010 WHEN "t","T" : IF value$ > max$ THEN ok% = FALSE
11020 WHEN "N","n" : IF VAL(value$) > VAL(max$) THEN ok% = FALSE
11030 WHEN "D","d" : IF FNdate(value$) > FNdate(max$) THEN ok% = FALSE
11040ENDCASE
11050ENDIF
11060=ok%
11070
11080DEF FNvalid_list(value$,type$,list$)
11090LOCAL ok%
11100ok% = TRUE
11110IF LEN list$ >0 THEN
11120 IF INSTR(list$,value$) = 0 THEN ok% = FALSE
11130ENDIF
11140=ok%
11150
11160
11170DEF FNvalid_record
11180ok% = TRUE
11190f% = -1
11200WHILE ok% AND f% < max_fields
11210 f%+=1
11220 IF field_used%(f%) THEN
11230 IF (f$(f%,1) = "d" OR f$(f%,1) ="D") AND NOT FNvalid_date(current_field_value$(f%)) THEN
11240 ok% = FALSE
11250 PROCerror_message("'"+f$(f%,0)+"' has an invalid date")
11260 ELSE
11270 IF NOT FNvalid_min(current_field_value$(f%),f$(f%,1),f$(f%,4)) THEN
11280 ok%=FALSE
11290 PROCerror_message("'"+f$(f%,0)+"' has a value which is too low" )
11300 ELSE
11310 IF NOT FNvalid_max(current_field_value$(f%),f$(f%,1),f$(f%,5)) THEN
11320 ok%=FALSE
11330 PROCerror_message("'"+f$(f%,0)+"' has a value which is too high" )
11340 ELSE
11350 IF NOT FNvalid_list(current_field_value$(f%),f$(f%,1),f$(f%,6)) THEN
11360 ok%=FALSE
11370 PROCerror_message("'"+f$(f%,0)+"' has a value which is not in the list")
11380 ELSE
11390 IF f$(f%,1) = "N" OR f$(f%,1)="n" AND VAL(f$(f%,3)) > 0 THEN
11400 A% = @%
11410 @% =&0102000A + VAL(f$(f%,3))*&100
11420 IF LENcurrent_field_value$(f%) >0 THEN
11430 current_field_value$(f%) = STR$(VAL(current_field_value$(f%)))
11440 ENDIF
11450 @%=A%
11460 IF RIGHT$(current_field_value$(f%),1) ="." THEN
11470 current_field_value$(f%)= LEFT$(current_field_value$(f%))
11480 ENDIF
11490 ENDIF
11500 ENDIF
11510 ENDIF
11520 ENDIF
11530 ENDIF
11540 ENDIF
11550ENDWHILE
11560=ok%
11570
11580DEF FNrecord_space
11590LOCAL total%
11600total% = 0
11610FOR f% = 0 TO max_fields
11620 total% = total% + LENcurrent_field_value$(f%)
11630NEXT
11640=total%
11650
11660
11670DEF PROCnext_record
11680PROCextract_record_data
11690IF FNvalid_record THEN
11700 IF NOT(FNrecord_space = 0 AND VAL($rec_number%) = number_of_records%) THEN
11710 PROCwrite_record(VAL($rec_number%))
11720 $rec_number% = STR$(VAL($rec_number%)+1)
11730 IF VAL($rec_number%) > number_of_records% THEN
11740 number_of_records%+=1
11750 PROCclear_record
11760 ELSE
11770 PROCread_record(VAL($rec_number%))
11780 ENDIF
11790 ENDIF
11800ENDIF
11810PROCupdate_display
11820ENDPROC
11830
11840DEF PROCprevious_record
11850PROCextract_record_data
11860IF FNvalid_record THEN
11870 PROCwrite_record(VAL($rec_number%))
11880 IF VAL($rec_number%) > 1 THEN
11890 $rec_number% = STR$(VAL($rec_number%)-1)
11900 PROCread_record(VAL($rec_number%))
11910 ELSE
11920 VDU7
11930 ENDIF
11940ENDIF
11950PROCupdate_display
11960ENDPROC
11970
11980DEF PROCstart
11990PROCextract_record_data
12000IF FNvalid_record THEN
12010 PROCwrite_record(VAL($rec_number%))
12020 IF VAL($rec_number%) > 1 THEN
12030 $rec_number% = STR$(1)
12040 PROCread_record(VAL($rec_number%))
12050 ELSE
12060 VDU7
12070 ENDIF
12080ENDIF
12090PROCupdate_display
12100ENDPROC
12110
12120
12130
12140
12150DEF PROCend_of_file
12160PROCextract_record_data
12170IF FNvalid_record THEN
12180 PROCwrite_record(VAL($rec_number%))
12190 IF VAL($rec_number%) < number_of_records% THEN
12200 $rec_number% = STR$( number_of_records%)
12210 PROCread_record(VAL($rec_number%))
12220 ELSE
12230 VDU7
12240 ENDIF
12250ENDIF
12260PROCupdate_display
12270ENDPROC
12280
12290DEF PROCupdate_display
12300 SYS"Wimp_ForceRedraw",display_window%,0,-1000,1000,0
12310 SYS"Wimp_GetCaretPosition",,caret%
12320 window% = caret%!0
12330 icon% = caret%!4
12340 new_pos% = icon%
12350 PROCset_caret
12360ENDPROC
12370
12380
12390
12400DEF PROCread_record(position%)
12410LOCAL p%, pointer%, f%
12420current_field_value$() = ""
12430pointer% = 5000+position%*record_size%
12440PTR#file% = pointer%
12450bad_field% = FALSE
12460LOCAL ERROR
12470f% = 0
12480WHILE f% <(number_of_fields% ) AND NOT bad_field%
12490 ON ERROR LOCAL bad_field% = TRUE
12500 IF NOT bad_field% THEN
12510 INPUT #file%, current_field_value$(f%)
12520 p% =display_data%+f%*300
12530 $p% =current_field_value$(f%)
12540 f% +=1
12550 ENDIF
12560ENDWHILE
12570RESTORE ERROR
12580ENDPROC
12590
12600
12610DEF PROCwrite_record(position%)
12620LOCAL p%, pointer%
12630pointer% = 5000+position%*record_size%
12640PTR#file% = pointer%
12650FOR f% = 0 TO number_of_fields%-1
12660 PRINT #file%, current_field_value$(f%)
12670NEXT
12680ENDPROC
12690
12700
12710DEF PROCclose_down_file
12720IF file% <> 0 THEN
12730 PTR#file% = 0
12740 number_of_fields% = 0
12750 FOR rec% = 0 TO max_fields
12760 IF LEN(f$(rec%,0)) > 0 THEN
12770 number_of_fields% +=1
12780 ENDIF
12790 NEXT
12800 IF FNfield_length_ok THEN
12810 FOR a% = field_des% TO field_des% + 2196 STEP 4
12820 PRINT#file%,!a%
12830 NEXT
12840 PRINT #file%,$password%
12850 PRINT #file%, $filename%
12860 PRINT #file%, number_of_records%
12870 PRINT #file%, record_size%
12880 PRINT #file%, number_of_fields%
12890 PRINT #file%, VAL($rec_number%)
12900 FOR rec% = 0 TO max_fields
12910 PRINT #file%, field_used%(rec%)
12920 NEXT
12930
12940 FOR a% = output_list% TO output_list%+496 STEP 4
12950 PRINT #file%,!a%
12960 NEXT
12970
12980 FOR a% = search_list% TO search_list%+196 STEP 4
12990 PRINT #file%,!a%
13000 NEXT
13010
13020 FOR a% = sort_field% TO sort_field%+296 STEP 4
13030 PRINT #file%,!a%
13040 NEXT
13050 PROCextract_record_data
13060 PROCwrite_record(VAL($rec_number%))
13070 CLOSE #file%
13080 file% = 0
13090 loaded% = FALSE
13100 inhibit% = FALSE
13110 PROCcloseawindow(display_window%)
13120 PROCcloseawindow(sort_window%)
13130 PROCcloseawindow(output_window%)
13140 PROCcloseawindow(fields_window%)
13150 PROCcloseawindow(password_window%)
13160 PROCcloseawindow(screen_window%)
13170 PROCcloseawindow(save_window%)
13180
13190 PROCdestroy_display_icons
13200 ELSE
13210 PROCerror_message("The field descriptor has been changed and is now too long. Either reduce the number of fields or reduce their length")
13220 quit% = FALSE
13230 ENDIF
13240ENDIF
13250ENDPROC
13260
13270DEF FNfield_length_ok
13280PROCextract_field_description
13290total% = 0
13300control% = 0
13310FOR f% = 0 TO max_fields
13320 total% = total% + VAL(f$(f%,2))
13330 IF LEN(f$(f%,0)) > 0 THEN control%+=2
13340NEXT
13350IF total% > record_size% - control% THEN
13360=FALSE
13370ELSE
13380=TRUE
13390
13400
13410DEF PROCpassword_check
13420 IF $password% <> "" THEN
13430 $in_password% = ""
13440 PROCopen_window(password_window%)
13450 inhibit% = TRUE
13460 ENDIF
13470ENDPROC
13480
13490
13500
13510DEF PROCpassword
13520 PROCcloseawindow(password_window%)
13530 IF LEFT$($password%,4) = LEFT$($in_password%,4) THEN
13540 inhibit% = FALSE
13550 PROCopen_window(display_window%)
13560 ELSE
13570 PROCerror_message("Incorrect password. File closing")
13580 PROCclose_down_file
13590 ENDIF
13600ENDPROC
13610
13620
13630DEF FNupper(text$)
13640LOCAL result$,i%,c$
13650result$=""
13660FOR i% = 1 TO LENtext$
13670 c$=MID$(text$,i%,1)
13680 IF c$>="a" AND c$<="z" THEN c$=CHR$(ASC(c$)AND&DF)
13690 result$=result$+c$
13700NEXT
13710=result$
13720
13730DEF FNreplace(object$,target$,by$)
13740LOCAL start%, position%
13750start% = INSTR(object$,target$)
13760WHILE start%
13770position% = LEN(object$)-LEN(target$)-start%+1
13780object$ = LEFT$(object$,start%-1)+by$+RIGHT$(object$,position%)
13790start% = INSTR(object$,target$,start%+LEN(by$))
13800ENDWHILE
13810=object$
13820
13830DEF FNoutput_upper(text$)
13840LOCAL result$,i%,c$
13850quote% = FALSE
13860result$=""
13870FOR i% = 1 TO LENtext$
13880 c$=MID$(text$,i%,1)
13890 IF c$ = CHR$34 THEN quote% = NOT quote%
13900 IF c$="," THEN c$ = "+"
13910 IF c$=";" AND i% < LENtext$ AND i% > 1 THEN c$="+"+CHR$34+" "+CHR$34+"+"
13920 IF NOT quote% THEN
13930 IF c$>="a" AND c$<="z" THEN c$=CHR$(ASC(c$)AND&DF)
13940 ENDIF
13950 result$=result$+c$
13960NEXT
13970=result$
13980
13990
14000DEF PROCextract_output_list
14010FOR list% = 0 TO 5
14020 pointer% = output_list% + list% * 70
14030 output_list$(list%) = $pointer%
14040 output_list$(list%) = FNoutput_upper(output_list$(list%))
14050NEXT
14060FOR f% = 0 TO max_fields
14070 IF LEN(f$(f%,0)) >0 THEN
14080 FOR list% = 0 TO 5
14090 IF LEN output_list$(list%) > 0 THEN
14100 output_list$(list%) = FNreplace(output_list$(list%),FNupper(f$(f%,0)),"current_field_value$("+STR$(f%)+")")
14110 ENDIF
14120 NEXT
14130 ENDIF
14140NEXT
14150FOR list% = 0 TO 5
14160IF LENoutput_list$(list%)>0 THEN
14170 LOCAL ERROR
14180 ON ERROR LOCAL : RESTORE ERROR :PROCoutput_error : NEXT
14190 REM PRINTEVAL(output_list$(list%)
14200 RESTORE ERROR
14210ENDIF
14220NEXT
14230ENDPROC
14240
14250
14260
14270DEF PROCoutput_error
14280 CASE ERR OF
14290 WHEN 9 : PROCerror_message("Output line "+STR$(list%+1)+" contains an unmatched quote")
14300 WHEN 26 : PROCerror_message("Output line "+STR$(list%+1)+" contains a reference to an unknown field")
14310 OTHERWISE : PROCerror_message("Looks like some other error at "+STR$(ERL))
14320 ENDCASE
14330ENDPROC
14340
14350ENDPROC
14360
14370
14380
14390DEF PROCcreate_search_string
14400 search_string$ = $search_list%
14410 IF case_sens% THEN
14420 search_string$ =FNoutput_upper(search_string$)
14430 ELSE
14440 search_string$ =FNupper(search_string$)
14450 ENDIF
14460FOR f% = 0 TO max_fields
14470 IF LEN(f$(f%,0)) >0 THEN
14480 CASE f$(f%,1) OF
14490 WHEN "t","T" : search_string$= FNreplace(search_string$,FNupper(f$(f%,0)),"current_field_value$("+STR$(f%)+")")
14500 WHEN "n","N" : search_string$= FNreplace(search_string$,FNupper(f$(f%,0)),"VALcurrent_field_value$("+STR$(f%)+")")
14510 WHEN "D","d" : PROCinsert_date
14520 ENDCASE
14530 ENDIF
14540NEXT
14550REM PRINT search_string$
14560REM PRINT EVAL(search_string$)
14570ENDPROC
14580
14590DEF PROCinsert_date
14600LOCAL l$,r$,position%
14610position% = INSTR(search_string$,FNupper(f$(f%,0)))
14620WHILE position% > 0
14630 position% = position% + LEN f$(f%,0)
14640 WHILE (MID$(search_string$,position%,1) <"0" OR MID$(search_string$,position%,1) >"1") AND position% < LENsearch_string$
14650 position% = position% +1
14660 ENDWHILE
14670 search_string$ = LEFT$(search_string$,position%-1)+"FNdate("+CHR$34+MID$(search_string$,position%,8)+CHR$34+")"+RIGHT$(search_string$,LENsearch_string$-position%-8)
14680l$ = LEFT$(search_string$,position%)
14690r$ = RIGHT$(search_string$,LEN(search_string$)-position%)
14700l$= FNreplace(l$,FNupper(f$(f%,0)),"FNdate(current_field_value$("+STR$(f%)+"))")
14710search_string$ = l$ + r$
14720position% = INSTR(search_string$,FNupper(f$(f%,0)))
14730ENDWHILE
14740ENDPROC
14750
14760
14770
14780
14790
14800DEF FNvalid_search_criteria
14810LOCAL total%, ok%, list%, d
14820ok% = TRUE
14830IF LEN search_string$ = 0 THEN
14840 PROCerror_message("A search string must be entered. Use ALL to list all records")
14850ok%=FALSE
14860ENDIF
14870total% = 0
14880 FOR list% = 0 TO 5
14890 total% = total% + LEN (output_list$(list%))
14900 NEXT
14910IF total% = 0 THEN
14920ok%=FALSE
14930 PROCerror_message("At least one of the output lines must contain a field name.")
14940ENDIF
14950LOCAL ERROR
14960ON ERROR LOCAL ok% = FALSE :PROCerror_message("The search string contains a syntax error")
14970IF ok% THEN d=EVAL(search_string$)
14980RESTORE ERROR
14990=ok%
15000
15010DEF PROCscreen
15020error% = FALSE
15030PROCextract_record_data
15040IF FNvalid_record THEN
15050 PROCwrite_record(VAL($rec_number%)) : REM save the latest record
15060 PROCextract_output_list
15070 PROCcreate_search_string
15080 IF FNvalid_search_criteria THEN
15090 FOR list% = 0 TO 5
15100 pointer% = output_display%+list%*300
15110 $pointer% = ""
15120 NEXT
15130 PROCopen_window(screen_window%)
15140 rec% = 1
15150 match% = 0
15160 $output_rec% = STR$rec%
15170 $matches% = STR$match%
15180 SYS"Wimp_ForceRedraw",screen_window%,0,-500,4000,0
15190 escape% = FALSE
15200 PROCpoll(0)
15210 WHILE rec% <= number_of_records% AND NOT escape%
15220 PROCread_record(rec%)
15230 IF NOT case_sens% THEN PROCconvert_record_case
15240 IF EVAL(search_string$) THEN
15250 PROCread_record(rec%) : REM because the case may be changed
15260 IF tabulate% THEN PROCtabulate
15270 match% +=1
15280 $output_rec% = STR$rec%
15290 $matches% = STR$match%
15300 FOR list% = 0 TO 5
15310 pointer% = output_display%+list%*300
15320 IF LEN(output_list$(list%)) >0 THEN
15330 PROCdo_list
15340 ELSE
15350 $pointer% = ""
15360 ENDIF
15370 NEXT
15380 SYS"Wimp_ForceRedraw",screen_window%,0,-500,4000,0
15390 ELSE
15400 $output_rec% = STR$rec%
15410 SYS"Wimp_ForceRedraw",screen_window%,620,-62,770,-14
15420 ENDIF
15430 rec% +=1
15440 PROCpoll(0)
15450 ENDWHILE
15460 PROCread_record(VAL($rec_number%)) : REM reload the latest record
15470 IF NOT error% THEN
15480 IF escape% THEN
15490 PROCerror_message("Stop selected. Search incomplete. "+STR$(match%)+" matches have been found so far")
15500 ELSE
15510 PROCerror_message("Search complete. "+STR$(match%)+" matches have been found")
15520 ENDIF
15530 ENDIF
15540 ENDIF
15550ENDIF
15560ENDPROC
15570
15580
15590DEF PROCprinter
15600escape% = FALSE
15610IF FNprinter_on THEN
15620PROCextract_record_data
15630IF FNvalid_record THEN
15640 PROCwrite_record(VAL($rec_number%)) : REM save the latest record
15650 PROCextract_output_list
15660 PROCcreate_search_string
15670 IF FNvalid_search_criteria THEN
15680 FOR list% = 0 TO 5
15690 pointer% = output_display%+list%*300
15700 $pointer% = ""
15710 NEXT
15720 PROCopen_window(screen_window%)
15730 rec% = 1
15740 match% = 0
15750 $output_rec% = STR$rec%
15760 $matches% = STR$match%
15770 SYS"Wimp_ForceRedraw",screen_window%,0,-500,4000,0
15780 escape% = FALSE
15790 PROCpoll(0)
15800 WHILE rec% <= number_of_records% AND NOT escape%
15810 PROCread_record(rec%)
15820 IF NOT case_sens% THEN PROCconvert_record_case
15830 IF EVAL(search_string$) THEN
15840 PROCread_record(rec%) : REM because the case may be changed
15850 IF tabulate% THEN PROCtabulate
15860 match% +=1
15870 $output_rec% = STR$rec%
15880 $matches% = STR$match%
15890 FOR list% = 0 TO 5
15900 pointer% = output_display%+list%*300
15910 IF LEN(output_list$(list%)) >0 THEN
15920 PROCdo_list
15930 PROCprint($pointer%)
15940 ELSE
15950 $pointer% = ""
15960 ENDIF
15970 NEXT
15980 SYS"Wimp_ForceRedraw",screen_window%,0,-500,4000,0
15990 ELSE
16000 $output_rec% = STR$rec%
16010 SYS"Wimp_ForceRedraw",screen_window%,620,-62,770,-14
16020 ENDIF
16030 rec% +=1
16040 PROCpoll(0)
16050 ENDWHILE
16060 PROCread_record(VAL($rec_number%)) : REM reload the latest record
16070 IF NOT error% THEN
16080 IF escape% THEN
16090 PROCerror_message("Stop selected. Search incomplete. "+STR$(match%)+" matches have been found so far")
16100 ELSE
16110 PROCerror_message("Search complete. "+STR$(match%)+" matches have been found")
16120 ENDIF
16130 ENDIF
16140 ENDIF
16150ENDIF
16160ENDIF
16170ENDPROC
16180
16190
16200DEF PROCdo_list
16210 LOCAL ERROR
16220 ON ERROR LOCAL error% =TRUE
16230 IF NOT error% THEN
16240 $pointer% = EVAL(output_list$(list%))
16250 ELSE
16260 PROCcloseawindow(screen_window%)
16270 PROCerror_message("Line "+STR$(list%+1)+" contains an unknown field name or a syntax error")
16280 escape% = TRUE
16290 ENDIF
16300 RESTORE ERROR
16310ENDPROC
16320
16330
16340
16350
16360
16370DEF PROCfile_output
16380 PROCopen_window(save_window%)
16390 window% = save_window%
16400 new_pos% = 2
16410 PROCset_caret
16420ENDPROC
16430
16440
16450DEF PROCprint(text$)
16460VDU2
16470FOR i%= 1 TO LENtext$
16480 VDU1,ASC(MID$(text$,i%,1))
16490NEXT
16500VDU1,13,1,10
16510VDU3
16520ENDPROC
16530
16540
16550
16560DEF FNprinter_on
16570VDU7
16580VDU 2,1,65,1,127,3
16590IF ADVAL(-4) >= 1023 THEN
16600=TRUE
16610ELSE
16620PROCerror_message("Printer is not responding. Output cancelled")
16630=FALSE
16640ENDIF
16650
16660
16670DEF PROCcase_sens_toggle
16680case_sens% = NOT case_sens%
16690ENDPROC
16700
16710
16720DEF PROCcrlf_toggle
16730crlf% = NOT crlf%
16740ENDPROC
16750
16760DEF PROCtab_toggle
16770tabulate% = NOT tabulate%
16780ENDPROC
16790
16800
16810DEF PROCconvert_record_case
16820LOCAL f%
16830FOR f% = 0 TO number_of_fields%
16840 current_field_value$(f%) = FNupper(current_field_value$(f%))
16850NEXT
16860ENDPROC
16870
16880
16890DEF PROCstart_output_drag
16900 LOCAL wex%,wey%
16910 IF (button% AND &50) <> 0 THEN
16920 !block% = save_window%
16930 SYS"Wimp_GetWindowState",,block%
16940 wex% = block%!4 - block%!20
16950 wey% = block%!16 - block%!24
16960 block%!4 = 3 : REM icon handle for drag icon
16970 SYS"Wimp_GetIconState",,block%
16980 !block% = save_window%
16990 block%!4 = 5
17000 block%!8 = block%!8 +wex%
17010 block%!12 = block%!12 +wey%
17020 block%!16 = block%!16 +wex%
17030 block%!20 = block%!20 +wey%
17040 block%!24 = 0
17050 block%!28 = 0
17060 block%!32 = &7FFFFFFF
17070 block%!36 = &7FFFFFFF
17080 SYS"Wimp_DragBox",,block%
17090 ENDIF
17100ENDPROC
17110
17120
17130DEF PROCstart_disk_list
17140SYS"Wimp_GetPointerInfo",,block%
17150block%!20 = 64
17160block%!32 = 0
17170block%!36 = 1
17180block%!40 = block%!12
17190block%!44 = block%!16
17200block%!48 = !block%
17210block%!52 = block%!4
17220block%!56 = 10000 : REM size of the file
17230block%!60 = &FFF : REM file type of the file
17240$(block%+64) = FNleaf($text_file_name%)
17250?(block%+65+LENFNleaf($text_file_name%)) = 0
17260SYS"Wimp_SendMessage",17,block%+20,block%!12,block%!16
17270ENDPROC
17280
17290
17300
17310DEF PROCproduce_output(filename$)
17320error% = FALSE
17330PROCextract_record_data
17340IF FNvalid_record AND FNoverwrite_ok(filename$) THEN
17350 PROCwrite_record(VAL($rec_number%)) : REM save the latest record
17360 PROCextract_output_list
17370 PROCcreate_search_string
17380 IF FNvalid_search_criteria THEN
17390 FOR list% = 0 TO 5
17400 pointer% = output_display%+list%*300
17410 $pointer% = ""
17420 NEXT
17430 PROCopen_window(screen_window%)
17440 output_file_handle% = OPENOUT(filename$)
17450 rec% = 1
17460 match% = 0
17470 $output_rec% = STR$rec%
17480 $matches% = STR$match%
17490 SYS"Wimp_ForceRedraw",screen_window%,0,-500,4000,0
17500 escape% = FALSE
17510 PROCpoll(0)
17520 WHILE rec% <= number_of_records% AND NOT escape%
17530 PROCread_record(rec%)
17540 IF NOT case_sens% THEN PROCconvert_record_case
17550 IF EVAL(search_string$) THEN
17560 PROCread_record(rec%) : REM because the case may be changed
17570 IF tabulate% THEN PROCtabulate
17580 match% +=1
17590 $output_rec% = STR$rec%
17600 $matches% = STR$match%
17610 FOR list% = 0 TO 5
17620 pointer% = output_display%+list%*300
17630 IF LEN(output_list$(list%)) >0 THEN
17640 PROCdo_list
17650 PROCprint_to_the_disk($pointer%)
17660 ELSE
17670 $pointer% = ""
17680 ENDIF
17690 NEXT
17700 SYS"Wimp_ForceRedraw",screen_window%,0,-500,4000,0
17710 ELSE
17720 $output_rec% = STR$rec%
17730 SYS"Wimp_ForceRedraw",screen_window%,620,-62,770,-14
17740 ENDIF
17750 rec% +=1
17760 PROCpoll(0)
17770 ENDWHILE
17780 PROCread_record(VAL($rec_number%)) : REM reload the latest record
17790 IF NOT error% THEN
17800 IF escape% THEN
17810 PROCerror_message("Stop selected. Search incomplete. "+STR$(match%)+" matches have been found so far")
17820 ELSE
17830 PROCerror_message("Search complete. "+STR$(match%)+" matches have been found")
17840 ENDIF
17850 ENDIF
17860 CLOSE# output_file_handle%
17870 OSCLI("settype "+filename$+" text")
17880 ENDIF
17890 PROCcloseawindow(save_window%)
17900ENDIF
17910ENDPROC
17920
17930
17940DEF PROCprint_to_the_disk(text$)
17950IF LENtext$ > 0 THEN
17960FOR i%= 1 TO LENtext$
17970 BPUT#output_file_handle%,ASC(MID$(text$,i%,1))
17980NEXT
17990ENDIF
18000 IF crlf% THEN BPUT #output_file_handle%,13
18010 BPUT #output_file_handle%,10
18020ENDPROC
18030
18040
18050DEF PROCquick_save
18060 IF INSTR($text_file_name%,".") = 0 THEN
18070 PROCerror_message("To save, drag the icon to a directory viewer.")
18080 ELSE
18090 PROCproduce_output($text_file_name%)
18100 ENDIF
18110ENDPROC
18120
18130
18140
18150DEF FNoverwrite_ok(filename$)
18160LOCAL name$, type%
18170name$ = filename$ + CHR$0
18180SYS"OS_File",5,name$,,,,,0 TO type%
18190CASE type% OF
18200 WHEN 0 : = TRUE
18210 WHEN 1 : result% = FNcancel_message("A file of this name exists. Click on OK to replace it. Click on CANCEL to abort search")
18220 IF result% = 1 THEN
18230 = TRUE
18240 ELSE
18250 = FALSE
18260 ENDIF
18270 WHEN 2 : PROCerror_message("This is a directory name"):= FALSE
18280ENDCASE
18290
18300DEF FNfile_size
18310LOCAL r0,r1,r2
18320SYS"OS_Args",2,file% TO r0,r1,r2
18330=r2
18340
18350DEF PROCdelete_record
18360LOCAL present%
18370IF number_of_records% = 1 THEN
18380 PROCerror_message("The file contains only one record. This can not be deleted")
18390ELSE
18400 present% = VAL($rec_number%)
18410 IF present% = number_of_records% THEN
18420 number_of_records%=number_of_records%-1
18430 $rec_number% = STR$(number_of_records%)
18440 PROCread_record(VAL($rec_number%))
18450 PROCupdate_display
18460 ELSE
18470 proceed% = FALSE
18480 IF number_of_records% - present% < 500 THEN
18490 proceed% = TRUE
18500 ELSE
18510 IF FNcancel_message("This may take some time. Select OK to continue") = 1 THEN
18520 proceed% = TRUE
18530 ENDIF
18540 ENDIF
18550 IF proceed% THEN
18560 PROCglass(TRUE)
18570 total% = number_of_records% - present%
18580
18590 done% = 0
18600 FOR i% = present% TO number_of_records% -1
18610 PROCread_record(i%+1)
18620 PROCwrite_record(i%)
18630 SYS"Hourglass_Percentage", done%/total% * 100
18640 done% +=1
18650 NEXT
18660 PROCglass(FALSE)
18670 number_of_records%=number_of_records%-1
18680 PROCread_record(present%)
18690 PROCupdate_display
18700 ENDIF
18710ENDIF
18720ENDIF
18730ENDPROC
18740
18750DEF PROCtabulate
18760LOCAL f%
18770FOR f% = 0 TO number_of_fields%
18780 current_field_value$(f%)=current_field_value$(f%)+STRING$(VALf$(f%,2)," ")
18790 current_field_value$(f%)=LEFT$( current_field_value$(f%),VALf$(f%,2))
18800NEXT
18810ENDPROC
18820
18830
18840
18850DEF PROCsort
18860LOCAL memory%
18870memory_sort% = TRUE
18880IF FNextract_sort_condition THEN
18890 PROCextract_record_data
18900 PROCwrite_record(VAL($rec_number%))
18910 size% = FNfile_size + 5000
18920
18930 LOCAL ERROR
18940 ON ERROR LOCAL memory_sort% = FALSE
18950 IF memory_sort% THEN
18960 SYS"OS_Module",6,,,size% TO r0,r1,memory%
18970 RESTORE ERROR
18980 PROCload_file_to_memory
18990
19000 PROCmemory_sort
19010
19020 PROCsave_file_from_memory
19030 SYS"OS_Module",7,,memory%
19040 ELSE
19050 RESTORE ERROR
19060 VDU7
19070 PROCdiscsort
19080 ENDIF
19090 PROCread_record(VAL($rec_number%))
19100 PROCupdate_display
19110ENDIF
19120ENDPROC
19130
19140
19150DEF PROCmemory_sort
19160PROCglass(TRUE)
19170max = number_of_records%
19180FOR current = 1 TO max-1
19190 PROCrecall_from_memory_a(current)
19200 highest = current :REM record_b is highest so far
19210 PROCrecall_from_memory_b(current)
19220 FOR i = current +1 TO max
19230 PROCrecall_from_memory_a(i)
19240 IF FNcompare THEN
19250 highest = i
19260 PROCrecall_from_memory_b(highest)
19270 ENDIF
19280 NEXT
19290 PROCrecall_from_memory_a(current)
19300 PROCstore_in_memory_a(highest)
19310 PROCstore_in_memory_b(current)
19320 REM SWAP r(current),r(highest)
19330 SYS"Hourglass_Percentage", current/max * 100
19340 PROCpoll(0)
19350NEXT
19360PROCglass(FALSE)
19370ENDPROC
19380
19390
19400
19410DEF PROCdiscsort
19420max = number_of_records%
19430PROCglass(TRUE)
19440FOR current = 1 TO max-1
19450 PROCread_record_a(current)
19460 highest = current :REM record_b is highest so far
19470 PROCread_record_b(current)
19480 FOR i = current +1 TO max
19490 PROCread_record_a(i)
19500 IF FNcompare THEN
19510 highest = i
19520 PROCread_record_b(highest)
19530 ENDIF
19540 NEXT
19550 PROCread_record_a(current)
19560 PROCwrite_record_a(highest)
19570 PROCwrite_record_b(current)
19580 REM SWAP r(current),r(highest)
19590 SYS"Hourglass_Percentage", current/max * 100
19600 PROCpoll(0)
19610NEXT
19620PROCglass(FALSE)
19630ENDPROC
19640
19650
19660
19670
19680
19690
19700
19710
19720
19730DEF PROCread_record_a(position%)
19740LOCAL pointer%, f%
19750record_a$()=""
19760pointer% = 5000+position%*record_size%
19770PTR#file% = pointer%
19780bad_field% = FALSE
19790LOCAL ERROR
19800f% = 0
19810WHILE f% <(number_of_fields% ) AND NOT bad_field%
19820 ON ERROR LOCAL bad_field% = TRUE
19830 IF NOT bad_field% THEN
19840 INPUT #file%, record_a$(f%)
19850 f% +=1
19860 ENDIF
19870ENDWHILE
19880RESTORE ERROR
19890ENDPROC
19900
19910
19920DEF PROCwrite_record_a(position%)
19930LOCAL pointer%
19940pointer% = 5000+position%*record_size%
19950PTR#file% = pointer%
19960FOR f% = 0 TO number_of_fields%-1
19970 PRINT #file%, record_a$(f%)
19980NEXT
19990ENDPROC
20000
20010DEF PROCread_record_b(position%)
20020LOCAL pointer%, f%
20030record_b$() = ""
20040pointer% = 5000+position%*record_size%
20050PTR#file% = pointer%
20060bad_field% = FALSE
20070LOCAL ERROR
20080f% = 0
20090WHILE f% <(number_of_fields% ) AND NOT bad_field%
20100 ON ERROR LOCAL bad_field% = TRUE
20110 IF NOT bad_field% THEN
20120 INPUT #file%, record_b$(f%)
20130 f% +=1
20140 ENDIF
20150ENDWHILE
20160RESTORE ERROR
20170ENDPROC
20180
20190
20200DEF PROCwrite_record_b(position%)
20210LOCAL pointer%
20220pointer% = 5000+position%*record_size%
20230PTR#file% = pointer%
20240FOR f% = 0 TO number_of_fields%-1
20250 PRINT #file%, record_b$(f%)
20260NEXT
20270ENDPROC
20280
20290
20300
20310DEF FNextract_sort_condition
20320LOCAL a%, left$, right$, f%
20330ok% = TRUE
20340FOR a% = 0 TO 5
20350 sort_line$(a%) = FNupper($(sort_field%+50*a%))
20360 pointer% = sort_field%+50*a%+22
20370 CASE $pointer% OF
20380 WHEN "A","a" : sort_operator$(a%) = "<"
20390 WHEN "D","d" : sort_operator$(a%) = ">"
20400 OTHERWISE
20410 sort_operator$(a%) = "TRUE"
20420 ENDCASE
20430 IF LEN sort_line$(a%) >0 THEN
20440 IF LEN $pointer% = 0 THEN
20450 PROCerror_message("Line "+STR$(a%+1)+" has a field name but the direction of the sort has not been specified.")
20460 ok% = FALSE
20470 ELSE
20480 f% = 0
20490 WHILE sort_line$(a%) <> FNupper(f$(f%,0)) AND f% < number_of_fields%
20500 f%+=1
20510 ENDWHILE
20520 IF sort_line$(a%) <> FNupper(f$(f%,0)) THEN
20530 PROCerror_message("Line "+STR$(a%+1)+" has a field called "+sort_line$(a%)+" this field does not exist")
20540 ok% = FALSE
20550 ENDIF
20560 left$ = sort_line$(a%)
20570 right$ = sort_line$(a%)
20580 CASE f$(f%,1) OF
20590 WHEN "D","d" : left$ = "FNdate(record_a$("+STR$f%+"))"
20600 right$= "FNdate(record_b$("+STR$f%+"))"
20610 WHEN "N","n" : left$ = "VAL(record_a$("+STR$f%+"))"
20620 : right$= "VAL(record_b$("+STR$f%+"))"
20630 WHEN "T","t" : IF sort_case_sens% THEN
20640 left$ = "record_a$("+STR$f%+")"
20650 right$= "record_b$("+STR$f%+")"
20660 ELSE
20670 left$ = "FNupper(record_a$("+STR$f%+"))"
20680 right$= "FNupper(record_b$("+STR$f%+"))"
20690 ENDIF
20700 ENDCASE
20710 IF sort_operator$(a%) = "TRUE" THEN
20720 sort_line$(a%)="TRUE"
20730 ELSE
20740 sort_line$(a%) = left$+sort_operator$(a%)+right$
20750 sort_line$(a%+6) = left$+"="+right$
20760 ENDIF
20770 ENDIF
20780 ELSE
20790 sort_line$(a%)="TRUE"
20800 sort_line$(a%+6)="TRUE"
20810 ENDIF
20820NEXT
20830=ok%
20840
20850
20860
20870DEF FNcompare
20880LOCAL result%
20890result% = FALSE
20900IF EVALsort_line$(0) THEN
20910 result% = TRUE
20920ELSE
20930 IF EVALsort_line$(6) THEN
20940
20950 IF EVALsort_line$(1) THEN
20960 result% = TRUE
20970 ELSE
20980 IF EVALsort_line$(7) THEN
20990
21000 IF EVALsort_line$(2) THEN
21010 result% = TRUE
21020 ELSE
21030 IF EVALsort_line$(8) THEN
21040
21050 IF EVALsort_line$(3) THEN
21060 result% = TRUE
21070 ELSE
21080 IF EVALsort_line$(9) THEN
21090
21100 IF EVALsort_line$(4) THEN
21110 result% = TRUE
21120 ELSE
21130 IF EVALsort_line$(10) THEN
21140
21150 IF EVALsort_line$(5) THEN
21160 result% = TRUE
21170 ELSE
21180 IF EVALsort_line$(11) THEN
21190
21200 ENDIF
21210 ENDIF
21220
21230 ENDIF
21240 ENDIF
21250
21260 ENDIF
21270 ENDIF
21280
21290 ENDIF
21300 ENDIF
21310
21320 ENDIF
21330 ENDIF
21340
21350 ENDIF
21360ENDIF
21370=result%
21380
21390DEF PROCload_file_to_memory
21400FOR rec% = 1 TO number_of_records%
21410 PROCread_record_a(rec%)
21420 PROCstore_in_memory_a(rec%)
21430NEXT
21440ENDPROC
21450
21460DEF PROCsave_file_from_memory
21470FOR rec% = 1 TO number_of_records%
21480 PROCrecall_from_memory_a(rec%)
21490 PROCwrite_record_a(rec%)
21500NEXT
21510ENDPROC
21520
21530
21540DEF PROCstore_in_memory_a(rec%)
21550pointer% = rec%*record_size%+memory%
21560FOR f% = 0 TO number_of_fields% -1
21570 $pointer% = record_a$(f%)
21580 pointer% = pointer% + LENrecord_a$(f%)+1
21590NEXT
21600ENDPROC
21610
21620DEF PROCstore_in_memory_b(rec%)
21630pointer% = rec%*record_size%+memory%
21640FOR f% = 0 TO number_of_fields% -1
21650 $pointer% = record_b$(f%)
21660 pointer% = pointer% + LENrecord_b$(f%)+1
21670NEXT
21680ENDPROC
21690
21700
21710DEF PROCrecall_from_memory_a(rec%)
21720pointer% = rec%*record_size%+memory%
21730FOR f% = 0 TO number_of_fields% -1
21740 record_a$(f%) = $pointer%
21750 pointer% = pointer% + LENrecord_a$(f%)+1
21760NEXT
21770ENDPROC
21780
21790DEF PROCrecall_from_memory_b(rec%)
21800pointer% = rec%*record_size%+memory%
21810FOR f% = 0 TO number_of_fields% -1
21820 record_b$(f%) = $pointer%
21830 pointer% = pointer% + LENrecord_b$(f%)+1
21840NEXT
21850ENDPROC
21860
21870
21880DEF PROCread_virus
21890LOCAL f%
21900f% = OPENIN("<CardBase$Dir>.date")
21910IF f% > 0 THEN
21920 virus_set% = TRUE
21930 DIM virus$(12)
21940 count% = -1
21950 REPEAT
21960 count% +=1
21970 no_more% = FNread_virus_line
21980 UNTIL count% = 10 OR no_more%
21990 CLOSE #f%
22000 IF LEFT$(virus$(0),6) <> MID$(TIME$,5,6) THEN
22010 virus_set% = FALSE
22020 ELSE
22030 no_of_vir_mess% = 0
22040 FOR j% = 1 TO 10
22050 IF LENvirus$(j%) > 0 THEN no_of_vir_mess%+=1
22060 NEXT
22070 current_vir_mess% = 1
22080 IF no_of_vir_mess% = 0 THEN virus_set% = FALSE
22090 ENDIF
22100ELSE
22110 virus_set% = FALSE
22120ENDIF
22130ENDPROC
22140
22150
22160DEF FNread_virus_line
22170 PROCget_a_line
22180 WHILE LEFT$(line$,1) ="|" AND NOT EOF#f%
22190 PROCget_a_line
22200 ENDWHILE
22210 virus$(count%) = line$
22220= EOF #f%
22230
22240
22250DEF PROCget_a_line
22260 line$ =""
22270 c% = BGET#f%
22280 WHILE c% <> 10
22290 line$ = line$+CHR$c%
22300 c% = BGET#f%
22310 ENDWHILE
22320ENDPROC
22330
22340
22350
22360DEF PROCshow_virus
22370PROCerror_message(virus$(current_vir_mess%))
22380current_vir_mess% +=1
22390IF current_vir_mess% > no_of_vir_mess% THEN
22400 current_vir_mess% =1
22410ENDIF
22420ENDPROC
22430
22440REM dummy
22450
22460
22470dummy
� !runimage for CardBase
� Trial Version
� Adrian Lane
(� 3 Lansdowne Gardens
2� Hailsham
<� BN27 1LQ
F
P
Z� � � 0:�:�:a=�:�
d
n�environment
x
��constants
� �vars
�
�setup
��create_variables
��createicons
��read_virus
�� c$<>"" � �load(c$)
�� � �error
��
� �poll(1)
�
� quit
� �close_down_file
� ș "Wimp_CloseDown"
�
� �poll(mask%)
"! ș Poll%,mask%,q% � reason%
, Ȏ reason% �
6 � 1 :�redraw_window(!q%)
@" � 2 :ș"Wimp_OpenWindow",,q%
J � 3 :�closeawindow(!q%)
T � 6 :�buttons(q%)
^ � 7 : � loaded% �
h" �start_disk_list
r �
| �new_save
� �
� � 8 :�key(q%!24)
� � 9 : �menu_select(!q%)
� � 17,18:�receive(q%)
� �
��
�
�� �menu_select(item%)
�Ȏ item% �
� � 0 : �create
�8 � 1 : � � inhibit% � �open_window(display_window%)
�5 � 2 : � � inhibit% � �open_window(sort_window%)
�7 � 3 : � � inhibit% � �open_window(output_window%)
7 � 4 : � � inhibit% � �open_window(fields_window%)
� 5 : �close_down_file
� 7 : quit = �
&�
0�
:
D
N
X� �buttons(b)
b� window%, icon%, button%
l window% = b!12
v icon% = b!16
� button% = b!8
� � virus_set% � �(20) = 1 �
� �show_virus
� �
� Ȏ window% �
�' � -2 : � button% =2 � �menu(b)
�> � newfile_window% : � (button% � &50) <> 0 � �start_drag
�$ � display_window% : Ȏ icon% �
�, � 2 : �start
�2 � 3 : �end_of_file
�6 � 4 : �previous_record
�2 � 5 : �next_record
�4 � 6 : �delete_record
�
$ � output_window% : Ȏ icon% �
/ � 9 : �printer
. � 10 : �screen
*3 � 11 : �file_output
4C � case_sens_icon%:�case_sens_toggle
>? � cr_icon% : �crlf_toggle
H> � tab_icon% : �tab_toggle
R �
\$ � save_window% : Ȏ icon% �
f9 � 3 : �start_output_drag
p2 � 0 : �quick_save
z �
�4 � screen_window% : � icon% = 1 � escape% = �
�% � sort_window% : Ȏ icon% �
�) � 3 : �sort
�G � 4 : sort_case_sens% = � sort_case_sens%
� �
� �
� �
��
�
�$� �read_icon_text(window%,icon%)
�!block% = window%
�block%!4 = icon%
�"ș "Wimp_GetIconState",,block%
= $(block%!28)
$
.� �open_window(handle%)
8 !block% = handle%
B$ È™"Wimp_GetWindowState",,block%
L# block%!28 = -1 : � open on top
V È™ OpenW ,,block%
`�
j
t
~
�
� �key(k)
�� window%, icon%, new_pos%
�ș "Wimp_ProcessKey",k
�;� k = 13 � k = &18E � k = &18F � k = &19D � k = &19E �
�( ș"Wimp_GetCaretPosition",,caret%
� window% = caret%!0
� icon% = caret%!4
� new_pos% = icon%
� Ȏ window% �
�, � newfile_window% : � icon% = nf_1% �
�1 new_pos% = nf_2%
� �
1 new_pos% = nf_1%
�
) �set_caret
P È™"Wimp_ForceRedraw",fields_window%,0,-100,1000,0
(/ � output_window% : � k = 13 � k =&18E �
2< � icon% < output_icon%(6) �
<3 new_pos%=icon%+1
F" �
P= new_pos% = output_icon%(0)
Z" �
d �
n< � icon% > output_icon%(0) �
x3 new_pos%=icon%-1
�" �
�= new_pos% = output_icon%(6)
�" �
�
� �
�) �set_caret
�
�' � sort_window% : � k = 13 �
�; � icon% < sort_icon%(11) �
�3 new_pos%=icon%+1
�" �
�; new_pos% = sort_icon%(0)
�" �
+ �set_caret
�
* � k =&18F �
": � icon% > sort_icon%(1) �
,3 new_pos%=icon%-2
6" �
@< new_pos% = sort_icon%(11)
J" �
T+ �set_caret
^ �
h* � k =&18E �
r; � icon% < sort_icon%(10) �
|3 new_pos%=icon%+2
�" �
�; new_pos% = sort_icon%(0)
�" �
�+ �set_caret
� �
�0 � fields_window% : � k= 13 � k= &19D �
�> � icon% < list%(max_fields) �
�3 new_pos%=icon%+1
�# �
�6 new_pos% = name%(0)
�# �
�, �set_caret
�! �
+ � k =&18F �
6 � icon% >= name%(1) �
3 new_pos%=icon%-7
&+ �set_caret
0" �
: �
D* � k =&18E �
N> � icon% < name%(max_fields) �
X3 new_pos%=icon%+7
b+ �set_caret
l" �
v �
�* � k= &19C �
�5 � icon% > name%(0) �
�3 new_pos%=icon%+1
�, �set_caret
�! �
�! �
�1 � display_window% :� k = 13 � k =&18E �
�M � icon% <display_icon%(number_of_fields%-1)�
�3 new_pos%=icon%+2
�" �
�> new_pos% = display_icon%(0)
�G � k = 13 � �set_caret:�next_record :
�" �
�
= � icon% > display_icon%(0) �
3 new_pos%=icon%-2
" �
*P new_pos% = display_icon%(number_of_fields%-1)
4" �
> �
H) �set_caret
R0 � password_window% : � k= 13 � �password
\1 � save_window% : � k=13 � �quick_save
f �
p�
z�
�
�� �set_caret
�: ș"Wimp_SetCaretPosition",window%,new_pos%,,,-1,-1
��
�
�
�
�� �menu(b)
�flag1% = &7000021
�flag2% = &7400021
�� loaded% Ȕ flag1%,flag2%
�$menu="CardBase"
�menu!12=&70207
menu!16=156
menu!20=40
menu!24=0
$
.
8
Bmenu!28 = &00
Lmenu!32 = -1
Vmenu!36 = flag1%
`$(menu+40) = "Create"
j
tmenu!52 = &00
~menu!56 = -1
�menu!60 = flag2%
�$(menu+64) = "Disp Edit"
�
�menu!76 = &00
�menu!80 = -1
�menu!84 = flag2%
�$(menu+88) = "Sort"
�
�
�menu!100 = &00
�menu!104 = -1
�menu!108 = flag2%
$(menu+112) = "Output"
menu!124 = &00
menu!128 = -1
(menu!132 = flag2%
2$(menu+136) = "Fields"
<
Fmenu!148 = &00
Pmenu!152 = -1
Zmenu!156 = flag2%
d$(menu+160) = "Close"
n
x
�
�menu!172 = &00
�menu!176 = info_window%
�menu!180 = &7000021
�$(menu+184) = "Info"
�
�
�menu!196=&80
�menu!200= -1
�menu!204=&7000021
�$(menu+208)="Quit"
�
�(ș "Wimp_CreateMenu",,menu,!b-64,136
�
"
,� �closeawindow(handle%)
6!block%=handle%
@! È™"Wimp_CloseWindow",,block%
J<� handle% = output_window% � �closeawindow(save_window%)
T � recursive bit
^�
h
r� �receive(q%)
|Ȏ q%!16 �
�� 0:�finish:�
�� 2: �datasave(q%)
�'� 3,5 : � q%!12 = 0 � �dataload(q%)
��
��
�
�
�
�
�� �setup
�� block% 600
�� taskid%4:$taskid%="TASK"
�%� q% &900,buffer% &800,endbuf% -1
� menu 500
� indirect% 2200
� caret% 40
&curbuf%=buffer%
0;ș "Wimp_Initialise",200,!taskid%,"CardBase" � version%
:6È™ "Wimp_OpenTemplate",,"<CardBase$Dir>.Templates"
DEÈ™ "Wimp_LoadTemplate",,q%,indirect%,indirect%+199,-1,"display",0
N0ș "Wimp_CreateWindow",,q% � display_window%
XHÈ™ "Wimp_LoadTemplate",,q%,indirect%+200,indirect%+399,-1,"fields",0
b/ș "Wimp_CreateWindow",,q% � fields_window%
lHÈ™ "Wimp_LoadTemplate",,q%,indirect%+400,indirect%+599,-1,"output",0
v/ș "Wimp_CreateWindow",,q% � output_window%
�Jș "Wimp_LoadTemplate",,q%,indirect%+600,indirect%+799,-1,"proginfo",0
�-ș "Wimp_CreateWindow",,q% � info_window%
�Fș "Wimp_LoadTemplate",,q%,indirect%+800,indirect%+999,-1,"sort",0
�-ș "Wimp_CreateWindow",,q% � sort_window%
�Jș "Wimp_LoadTemplate",,q%,indirect%+1000,indirect%+1199,-1,"create",0
�0ș "Wimp_CreateWindow",,q% � newfile_window%
�Lș "Wimp_LoadTemplate",,q%,indirect%+1200,indirect%+1399,-1,"password",0
�1ș "Wimp_CreateWindow",,q% � password_window%
�Jș "Wimp_LoadTemplate",,q%,indirect%+1400,indirect%+1599,-1,"screen",0
�/ș "Wimp_CreateWindow",,q% � screen_window%
�Hș "Wimp_LoadTemplate",,q%,indirect%+1600,indirect%+2000,-1,"save",0
�
q%!64 = 1
�
-ș "Wimp_CreateWindow",,q% � save_window%
È™ "Wimp_CloseTemplate"
!S%=�"<CardBase$Dir>.!Sprites"
T%=�#S%+160
*�#S%
4� sprites% T%
>!sprites%=T%:sprites%!8=1
H"È™ "OS_SpriteOp",&109,sprites%
R<È™ "OS_SpriteOp",&10A,sprites%,"<CardBase$Dir>.!Sprites"
\iccalc%=�iconbar
fquit = �
pabort% = �
z!q% = save_window%
�q%!4 = 2
�ș"Wimp_GetIconState",,q%
�text_file_name% = q%!28
��
�
�
�
�� �iconbar
�
!q%=-1
�
q%!4=0
�
q%!8=0
�q%!12=63
�q%!16=68
q%!20=&2102
spname$="!CardBase"
� q%!24 (�spname$+1)
$$(q%!24)=spname$
.q%!28=sprites%
8q%!32=�spname$+1
B"ș "Wimp_CreateIcon",,q% � ic%
L=ic%
V
`
j
t
~
�� �vars
�Wimp = (1<<18) + (3<<6)
�CreateW = Wimp+1
�OpenW = Wimp+5
�CloseW = Wimp+6
�Poll% = Wimp+7
�RedrawW = Wimp+8
�UpdateW = Wimp+9
�GetR% = Wimp+10
�GetW = Wimp+11
�GetP = Wimp+15
�Drag = Wimp+16
CrMenu = Wimp+20
DcMenu = Wimp+21
file% = 0
inhibit% = �
(case_sens_icon% = 13
2cr_icon% = 15
<tab_icon% = 17
Ftabulate% = �
Psort_case_sens% = �
Zoutput_file_handle% = 0
d�
n
x
�� �error
�� � = 17 �
�' �error_message("Escape pressed"):�
��
�2 �error_message(�$+" (internal error) "+�(�))
��
�� output_file_handle% > 0 �
� �# output_file_handle%
� output_file_handle%=0
��
�abort% = �
��
�
"
,
6� �error_message(text$)
@È™"Hourglass_Smash"
JÈ™"Wimp_DragBox",,-1
T
!block%=�
^$(block%+4)=text$
h.È™ "Wimp_ReportError",block%,1,"!CardBase"
r�
|
�
�� �cancel_message(text$)
�� returns 0,1,2 for
�� r0,r1
�ș"Hourglass_Smash"
�ș"Wimp_DragBox",,-1
�
!block%=�
�$(block%+4)=text$
�6ș "Wimp_ReportError",block%,7,"!CardBase" � r0,r1
�=r1
��
�
�
� �glass(o%)
� o% �
È™"Hourglass_On"
&�
0 È™"Hourglass_Off"
:�
D�
N
X
b
� �finish
lÈ™ "Wimp_CloseDown"
v�
�
�
�
�
�� �redraw_window(handle%)
�!block% = handle%
�)ș"Wimp_RedrawWindow",,block% � more%
�ȕ more%
�, ș "Wimp_GetRectangle",,block% � more%
��
��
�
�
A� �icon(whandle%,ix%,iy%,iw%,ih%,flag%, text$, d1%, d2%, d3%)
block%!0 = whandle%
block%!4 = ix%
block%!8 = iy%
*block%!12 = ix% + iw%
4block%!16 = iy% + ih%
>block%!20 = flag%
H� d1% = 0 �
R $(block%!24) = text$
\�
f block%!24 = d1%
p block%!28 = d2%
z block%!32 = d3%
��
�*ș"Wimp_CreateIcon",,block% � ihandle%
�
=ihandle%
�
�
�� �create_variables
�� message_block% 100
ʀ� name%(max_fields),type%(max_fields),width%(max_fields),dp%(max_fields),min%(max_fields),max%(max_fields),list%(max_fields)
�H� record_a$(max_fields), record_b$(max_fields), highest$(max_fields)
�'� sort_line$(12), sort_operator$(6)
�� field_used%(max_fields)
�&� current_field_value$(max_fields)
�� output_list$(6)
� filename% 20
� pathname% 200
� record_number% 13
$� password% 13
.� in_password% 13
8� valid_name% 20
B� valid_password% 20
L� rec_number% 13
V� valid_type% 20
`� field_des% 2200
j� valid_integer% 10
t� output_list% 500
~� search_list% 200
�� output_icon%(6)
�� sort_field% 300
�� sort_icon%(12)
�� valid_sort% 20
�� display_data% 3000
�!� display_icon%(max_fields*2)
�� output_display% 2000
�� matches% 20
�� output_rec% 20
�
�$valid_name%="Aa-zA-Z0-9"
�$valid_password% ="D*"
$valid_type% = "ADNTdnt"
$valid_integer% = "A0-9"
$valid_sort% = "AaADd"
(
2$filename% = "DataFile"
<$pathname% = "DataFile"
F$password% = ""
P$in_password% = ""
Z$rec_number% = "0"
d$search_list% = ""
n
xloaded% = �
�� f$(19,6)
�
�$text_file_name% = "Output"
��
�
�
�� �createicons
�N� windowhandle,minx,miny,length, height, flags, sprite,text, valid, length
�%� text, no background is &7000511
�'� text, with background is &7000135
�2� writable icon, validated, in box is &700F53D
�Vnf_1% = �icon(newfile_window%,200,-54,200,48,&700F53D,"",filename%,valid_name%,12)
�Znf_2% =�icon(newfile_window%,200,-108,200,48,&700F53D,"",password%,valid_password%,12)
\pw% =�icon(password_window%,400,-200,200,48,&700F53D,"",in_password%,valid_password%,12)
Id% =�icon(display_window%,270,-62,200,48,&7000135,"",filename%,-1,12)
Hd% =�icon(fields_window%,280,-62,200,48,&7000135,"",filename%,-1,12)
"Hd% =�icon(output_window%,280,-62,200,48,&7000135,"",filename%,-1,12)
,Hd% =�icon(screen_window%,280,-62,200,48,&7000135,"",filename%,-1,12)
6Fd% =�icon(sort_window%,280,-62,200,48,&7000135,"",filename%,-1,12)
@Kd% =�icon(display_window%,700,-62,180,48,&7000135,"",rec_number%,-1,12)
J
T-� a% = field_des% � field_des% + 2196 � 4
^2 !a% = &D0D0D0D : � SET THE AYYAY TO EMPTY
h�
r
|� a% = 0 � 496 � 4
� output_list%!a% = &D0D0D0D
��
�
�� a% = 0 � 296 � 4
� sort_field%!a% = &D0D0D0D
��
�
�� a% = 0 � 1996 � 4
�# output_display%!a% = &D0D0D0D
��
�
�� a% = 0 � 196 � 4
� search_list%!a% = &D0D0D0D
�
� a% = 0 � 1996 � 4
&# output_display%!a% = &D0D0D0D
0�
:
D
N
X� row% = 0 � max_fields
bmname%(row%) = �icon(fields_window%,50,-250-row%*60,200,48,&700F535,"",field_des%+100*row%,valid_name%,20)
lotype%(row%) = �icon(fields_window%,330,-250-row%*60,40,48,&700F535,"",field_des%+22+100*row%,valid_type%,2)
vswidth%(row%) = �icon(fields_window%,470,-250-row%*60,80,48,&700F535,"",field_des%+26+100*row%,valid_integer%,3)
�pdp%(row%) = �icon(fields_window%,600,-250-row%*60,80,48,&700F535,"",field_des%+32+100*row%,valid_integer%,2)
�gmin%(row%) = �icon(fields_window%,730,-250-row%*60,130,48,&700F535,"",field_des%+35+100*row%,-1,12)
�gmax%(row%) = �icon(fields_window%,870,-250-row%*60,130,48,&700F535,"",field_des%+47+100*row%,-1,12)
�hlist%(row%) =�icon(fields_window%,1010,-250-row%*60,250,48,&700F535,"",field_des%+60+100*row%,-1,38)
��
�
�
y% = -120
�� a% = 0 � 5
�h output_icon%(a%) = �icon(output_window%,200,y%-60*a%,700,48,&700F535,"",output_list%+70*a%,-1,60)
��
�Zoutput_icon%(6) =�icon(output_window%,280,-480,620,48,&700F535,"",search_list%,-1,200)
�
�
y% = -260
� a% = 0 � 10 � 2
` sort_icon%(a%) =�icon(sort_window%,20,y%-30*a%,300,48,&700F535,"",sort_field%+25*a%,-1,20)
*l sort_icon%(a%+1) =�icon(sort_window%,450,y%-30*a%,50,48,&700F535,"",sort_field%+22+25*a%,valid_sort%,2)
4�
>
H
R
\'� this is the output display dindow
f
p
y% = -120
z� a% = 0 � 5
�^ d% = �icon(screen_window%,200,y%-60*a%,700,48,&7000511,"",output_display%+300*a%,-1,250)
��
�Jd% =�icon(screen_window%,620,-62,150,48,&7000135,"",output_rec%,-1,12)
�Gd% =�icon(screen_window%,900,-62,150,48,&7000135,"",matches%,-1,12)
�
�
�@� d% = FNicon(function%,16,-50,250,48,&7000511,"",t1%,-1,20)
��
�
�
�� �constants
� max_fields = 19
� over_size = 1.25
ALL = �
case_sens% = �
crlf% = �
$ tabulate% = �
.�
8
B
� �create
L-� a% = field_des% � field_des% + 2196 � 4
V2 !a% = &D0D0D0D : � SET THE AYYAY TO EMPTY
`�
j$filename% = "DataFile"
t$pathname% = "DataFile"
~$password% = ""
�$rec_number% = "0"
�$search_list% = ""
�!�open_window(newfile_window%)
� �open_window(fields_window%)
�window% = newfile_window%
�new_pos% = nf_1%
��set_caret
��
�
� � �extract_field_description
�� rec%,pos%
�� rec% = 0 � max_fields
pos% = field_des%+rec%*100
f$(rec%,0) = $pos%
# pos% = field_des%+rec%*100+22
f$(rec%,1) = $pos%
(# pos% = field_des%+rec%*100+26
2 f$(rec%,2) = $pos%
<# pos% = field_des%+rec%*100+32
F f$(rec%,3) = $pos%
P# pos% = field_des%+rec%*100+35
Z f$(rec%,4) = $pos%
d# pos% = field_des%+rec%*100+47
n f$(rec%,5) = $pos%
x# pos% = field_des%+rec%*100+60
� f$(rec%,6) = $pos%
� � � f$(rec%,0) > 0 �
� field_used%(rec%) = �
� �
� field_used%(rec%) = �
� �
��
�d=�Field_des_ok
��
�
�
�� �field_name_ok
�)� rec%, rec1%, rec2%, length%, field%
ok=�
� rec% = 0 � max_fields
length% = 0
" � field% = 0 � 6
,/ length% = length% + �(f$(rec%,field%))
6 �
@( � length% > 0 � �(f$(rec%,0))=0 �
J ok = �
TK �error_message("Field number "+�(rec%+1)+" does not have a name")
^ �
h�
r� rec1% = 0 � max_fields-1
|% � rec2% = rec1%+1 � max_fields
�: � f$(rec1%,0) = f$(rec2%,0) � �(f$(rec2%,0)) >0 �
� ok = �
�L �error_message("There are two fields with the name "+f$(rec2%,0))
�
�
� �
��
�=ok
�
�
�
�� �field_len_ok
�
� rec%
�� rec% = 0 � max_fields
� �(f$(rec%,0))>0 �
� �(f$(rec%,2))=0 �
V �error_message("Field '"+f$(rec%,0)+"' must have a width greater than zero")
& �
0A � (f$(rec%,1)="N" � f$(rec%,1)="n") � �(f$(rec%,2)) > 20 �
:] �error_message("Field '"+f$(rec%,0)+"' is numeric so its width must not exceed 20")
D �
N �
X�
b=�
l
v
�� �field_type_ok
�
� rec%
�� rec% = 0 � max_fields
�, � �(f$(rec%,0))>0 � �(f$(rec%,1))=0 �
�E �error_message("Field "+f$(rec%,0)+" does not have a type")
� �
��
�=�
�
�
�� �field_max_ok
�� rec%, ok%
�� rec% = 0 � max_fields
> � �(f$(rec%,0))>0 � (f$(rec%,1) ="N" � f$(rec%,1) ="n") �
� � �numeric(f$(rec%,4)) �
N �error_message("Field "+f$(rec%,0)+" does not have a numeric minimum")
�
* �
4�
>� rec% = 0 � max_fields
H> � �(f$(rec%,0))>0 � (f$(rec%,1) ="N" � f$(rec%,1) ="n") �
R � � �numeric(f$(rec%,5)) �
\N �error_message("Field "+f$(rec%,0)+" does not have a numeric maximum")
f �
p �
z�
�=ok%
�
�
�� �field_date_ok
�� rec%, ok%
�� rec% = 0 � max_fields
�? � �(f$(rec%,0))>0 � (f$(rec%,1) ="D" � f$(rec%,1) ="d") �
�6 � � �valid_date(f$(rec%,4)) � �(f$(rec%,4))>0 �
�\ �error_message("Field "+f$(rec%,0)+" does not have a correctly formed minimum date")
� �
� �
��
�� rec% = 0 � max_fields
> � �(f$(rec%,0))>0 � (f$(rec%,1) ="d" � f$(rec%,1) ="D") �
5 � � �valid_date(f$(rec%,5)) � �(f$(rec%,5))>0 �
\ �error_message("Field "+f$(rec%,0)+" does not have a correctly formed maximum date")
$ �
. �
8�
B=ok%
L
V
`
j
t� �Field_des_ok
~[� �field_name_ok � �field_len_ok � �field_type_ok � �field_max_ok � �field_date_ok �
� = �
��
� =�
��
�
�
�� �numeric(text$)
�
� i%, ok%
� ok%=�
�� �(text$) > 0 �
� � i% = 1 � �(text$)
� c$ = �text$,i%,1)
- � c$ <"." � c$>"9" � c$="/" � ok% = �
�
�
= ok%
(
2� �valid_date(date$)
<� ok%, day%, month%, year%
F5ok% = � : � allow zero null entries
P� �(date$) >0 �
Z� �(date$) <>8 �
d ok% = �
n�
x day% = �(�date$,2))
� month% = �(�date$,4,2))
� year% = �(�date$,7,2))
� � year% � 4 = 0 �
� days_in_feb% = 29
� �
� days_in_feb% = 28
� �
�* � (day% > 31) � (day% < 1) � ok% = �
�- � (month% >12) � (month% < 1) � ok% = �
� Ȏ month% �
�* � 4,6,9,11 : � day% > 30 � ok% = �
�4 � 2 : � day% > days_in_feb% � ok% = �
� �
�
�
=ok%
"
,
6� �start_drag
@ � wex%,wey%
J !block% = newfile_window%
T% È™"Wimp_GetWindowState",,block%
^! wex% = block%!4 - block%!20
h" wey% = block%!16 - block%!24
r0 block%!4 = 2 : � icon handle for drag icon
|# È™"Wimp_GetIconState",,block%
� !block% = newfile_window%
� block%!4 = 5
� block%!8 = block%!8 +wex%
�! block%!12 = block%!12 +wey%
�! block%!16 = block%!16 +wex%
�! block%!20 = block%!20 +wey%
� block%!24 = 0
� block%!28 = 0
� block%!32 = &7FFFFFFF
� block%!36 = &7FFFFFFF
� ș"Wimp_DragBox",,block%
��
�
� �new_save
�extract_field_description
&number_of_fields% = 0
0� rec% = 0 � max_fields
: � �(f$(rec%,0)) > 0 �
D number_of_fields% +=1
N �
X�
b� number_of_fields% = 0 �
lA �error_message("There must be at least one field defined")
v�
�#ș"Wimp_GetPointerInfo",,block%
�block%!20 = 64
�block%!32 = 0
�block%!36 = 1
�block%!40 = block%!12
�block%!44 = block%!16
�block%!48 = !block%
�block%!52 = block%!4
�*block%!56 = 10000 : � size of the file
�/block%!60 = &778 : � file type of the file
�$(block%+64) = $filename%
�"?(block%+65+�($filename%)) = 0
�9ș"Wimp_SendMessage",17,block%+20,block%!12,block%!16
!�
!�
!
! � �get_name(P%)
!* A$=""
!4ȕ ?P%<>0 � ?P%<> 13
!> A$ = A$+�?P%:P%+=1
!H�
!R=A$
!\
!f
!p� �leaf(path$)
!zȕ �path$,".")
!�path$=�path$,�path$,".")+1)
!��
!�
=path$
!�
!�
!�� �datasave(b)
!�� loaded% �
!�� i% = 0 � 96 � 4
!� message_block%!i% = b!i%
!��
!�9� copy the message block since wimp poll currupts it!
!�1�produce_output(�get_name(message_block%+44))
!�6� �get_name(message_block%+44) <> "<Wimp$Scrap>" �
"6 $text_file_name% = �get_name(message_block%+44)
"�
"&message_block%!12=message_block%!8
"$message_block%!16=3
".!message_block% = 64
"8NÈ™"Wimp_SendMessage",17,message_block%,message_block%!20,message_block%!24
"B
"L�
"V�saveit(�get_name(b+44))
"` $pathname% = �get_name(b+44)
"j"$filename% = �leaf($pathname%)
"tb!12=b!8
"~
b!16=3
"�!b = 64
"�'ș"Wimp_SendMessage",17,b,b!20,b!24
"��
"��
"�
"�
"�
"�� �saveit(name$)
"�&� This saves a file the first time
"�� rec%
"�file% = �(name$)
"�-� a% = field_des% � field_des% + 2196 � 4
# �#file%,!a%
#
�
#current_field_value$() = ""
#number_of_fields% = 0
#(number_of_records% = 1
#2record_size% = 0
#<� rec% = 0 � max_fields
#F/ record_size%=record_size%+�(f$(rec%,2))+2
#P � �(f$(rec%,0)) > 0 �
#Z number_of_fields% +=1
#d �
#n�
#x*record_size%=20+record_size%*over_size
#�� #file%,$password%
#�� #file%, $filename%
#� � #file%, number_of_records%
#�� #file%, record_size%
#�� #file%, number_of_fields%
#�!� #file%, 1 : � record number
#�
#�� rec% = 0 � max_fields
#�! � #file%, field_used%(rec%)
#��
#�
#�.� a% = output_list% � output_list%+496 � 4
#� � #file%,!a%
$�
$
$.� a% = search_list% � search_list%+196 � 4
$" � #file%,!a%
$,�
$6
$@,� a% = sort_field% � sort_field%+296 � 4
$J � #file%,!a%
$T�
$^
$h
$r
$|
$�
$��write_record(1)
$�� #file%
$�
file% = 0
$��("settype "+name$+" 778")
$�"�closeawindow(newfile_window%)
$�!�closeawindow(fields_window%)
$�loaded% = �
$��load(name$)
$��
$�
$�
$�
%� �load(name$)
%� loaded% �
%s �error_message("The file '"+$filename%+"' is still open and must be closed before a new file can be loaded")
%&�
%0$ �closeawindow(newfile_window%)
%:# �closeawindow(fields_window%)
%D current_file_name$ = name$
%N file% = �(name$)
%X/ � a% = field_des% � field_des% + 2196 � 4
%b �#file%,!a%
%l �
%v � #file%,$password%
%� � #file%, $filename%
%�" � #file%, number_of_records%
%� � #file%, record_size%
%�! � #file%, number_of_fields%
%� � #file%, current_rec%
%�
%� � rec% = 0 � max_fields
%�$ � #file%, field_used%(rec%)
%� �
%�
%�0 � a% = output_list% � output_list%+496 � 4
%� � #file%,!a%
%� �
&
&0 � a% = search_list% � search_list%+196 � 4
& � #file%,!a%
& �
&*
&4. � a% = sort_field% � sort_field%+296 � 4
&> � #file%,!a%
&H �
&R
&\ �read_record(current_rec%)
&f$ $rec_number% = �(current_rec%)
&p loaded% = �
&z �extract_field_description
&� �create_display_icons
&� �password_check
&�0 � � inhibit% �open_window(display_window%)
&��
&��
&�
&�
&�� �create_display_icons
&�;� change validation string to match the type definition
&�� d%, f%,l%,w%
&�#� f% = 0 � number_of_fields% -1
&�wdisplay_icon%(f%+number_of_fields%)=�icon(display_window%,50,-300-f%*60,300,48,&7000511,"",field_des%+100*f%,-1,20)
&�Dl% = �(f$(f%,2)) : � set length of box to a suitable value
'w% = l%*16 +48
'� w%>400 � w%=400
'ldisplay_icon%(f%) = �icon(display_window%,400,-300-f%*60,w%,48,&700F535,"",display_data%+300*f%,-1,l%+1)
'$�
'.�
'8
'B� �destroy_display_icons
'L*� f% = 2*number_of_fields% -1 � 0 � -1
'V � display_icon%(f%) > 0 �
'`! !block% = display_window%
'j$ block%!4 = display_icon%(f%)
't# È™"Wimp_DeleteIcon",,block%
'~ �
'��
'��
'�
'�
'�
'�� �environment
'�ș "OS_GetEnv" � c$
'�c$=�c$,�c$-20)
'�ȕ �c$,1) <>" " � �c$ <>0
'� c$=�c$,�c$-1)
'��
'�� c$ = " " � c$ =""
( �
(
(� DEF PROCenvironment
(ș "OS_GetEnv" � c$
((p = �c$,"""",�c$,"""")+1)
(2c$=�c$,p+1)
(<ȕ �c$,1)=" "
(F c$=�c$,2)
(P�
(Z
(d�
(n
(x
(�
(�
(�
(�
(�
(�� �ackload(b)
(�b!12=b!8
(�b!16 = 4
(�!b = 64
(�!ș"Wimp_SendMessage",17,b,b!4
(��
(�
(�� �dataload(b)
)� b!40 = &778 �
) �load(�get_name(b+44))
) �ackload(b)
)"�
),�
)6
)@
)J
)T
)^
)h
)r� �extract_record_data
)|D� This takes the data from the icons and puts them into an array
)�� f%
)�"� f% = 0 � number_of_fields%-1
)� p% =display_data%+f%*300
)�$ current_field_value$(f%) = $p%
)��
)��
)�
)�� �clear_record
)�� f%
)�"� f% = 0 � number_of_fields%-1
)� p% =display_data%+f%*300
)� $p% = ""
)��
*�
*
*
*&� �date(date$)
*09 =�(�date$,2))+100*�(�date$,4,2))+10000*�(�date$,2))
*:
*D
*N
*X#� �valid_min(value$,type$,min$)
*b � ok%
*lok% = �
*v � � min$ >0 � � value$ > 0 �
*�Ȏ type$ �
*�+ � "t","T" : � value$ < min$ � ok% = �
*�1 � "N","n" : � �(value$) < �(min$) � ok% = �
*�9 � "D","d" : � �date(value$) < �date(min$) � ok% = �
*��
*��
*�=ok%
*�
*�#� �valid_max(value$,type$,max$)
*� � ok%
*�ok% = �
*� � � max$ >0 � � value$ > 0 �
*�Ȏ type$ �
++ � "t","T" : � value$ > max$ � ok% = �
+1 � "N","n" : � �(value$) > �(max$) � ok% = �
+9 � "D","d" : � �date(value$) > �date(max$) � ok% = �
+ �
+*�
+4=ok%
+>
+H%� �valid_list(value$,type$,list$)
+R � ok%
+\ok% = �
+f� � list$ >0 �
+p$ � �list$,value$) = 0 � ok% = �
+z�
+�=ok%
+�
+�
+�� �valid_record
+�ok% = �
+�f% = -1
+�ȕ ok% � f% < max_fields
+� f%+=1
+� � field_used%(f%) �
+�W � (f$(f%,1) = "d" � f$(f%,1) ="D") � � �valid_date(current_field_value$(f%)) �
+� ok% = �
+�? �error_message("'"+f$(f%,0)+"' has an invalid date")
+�
�
,E � � �valid_min(current_field_value$(f%),f$(f%,1),f$(f%,4)) �
, ok%=�
,I �error_message("'"+f$(f%,0)+"' has a value which is too low" )
,$
�
,.E � � �valid_max(current_field_value$(f%),f$(f%,1),f$(f%,5)) �
,8 ok%=�
,BJ �error_message("'"+f$(f%,0)+"' has a value which is too high" )
,L
�
,VF � � �valid_list(current_field_value$(f%),f$(f%,1),f$(f%,6)) �
,` ok%=�
,jN �error_message("'"+f$(f%,0)+"' has a value which is not in the list")
,t
�
,~> � f$(f%,1) = "N" � f$(f%,1)="n" � �(f$(f%,3)) > 0 �
,� A% = @%
,�/ @% =&0102000A + �(f$(f%,3))*&100
,�/ � �current_field_value$(f%) >0 �
,�J current_field_value$(f%) = �(�(current_field_value$(f%)))
,� �
,� @%=A%
,�4 � �current_field_value$(f%),1) ="." �
,�E current_field_value$(f%)= �current_field_value$(f%))
,� �
,�
�
,� �
,�
�
- �
-
�
-
�
-�
-(=ok%
-2
-<� �record_space
-F� total%
-Ptotal% = 0
-Z� f% = 0 � max_fields
-d1 total% = total% + �current_field_value$(f%)
-n�
-x=total%
-�
-�
-�� �next_record
-��extract_record_data
-�� �valid_record �
-�D � �(�record_space = 0 � �($rec_number%) = number_of_records%) �
-�$ �write_record(�($rec_number%))
-�) $rec_number% = �(�($rec_number%)+1)
-�. � �($rec_number%) > number_of_records% �
-� number_of_records%+=1
-� �clear_record
-� �
-�& �read_record(�($rec_number%))
. �
. �
.�
."�update_display
.,�
.6
.@� �previous_record
.J�extract_record_data
.T� �valid_record �
.^$ �write_record(�($rec_number%))
.h � �($rec_number%) > 1 �
.r) $rec_number% = �(�($rec_number%)-1)
.|# �read_record(�($rec_number%))
.� �
.�
�7
.� �
.��
.��update_display
.��
.�
.�� �start
.��extract_record_data
.�� �valid_record �
.�$ �write_record(�($rec_number%))
.� � �($rec_number%) > 1 �
.� $rec_number% = �(1)
/# �read_record(�($rec_number%))
/ �
/
�7
/& �
/0�
/:�update_display
/D�
/N
/X
/b
/l
/v� �end_of_file
/��extract_record_data
/�� �valid_record �
/�$ �write_record(�($rec_number%))
/�/ � �($rec_number%) < number_of_records% �
/�+ $rec_number% = �( number_of_records%)
/�# �read_record(�($rec_number%))
/� �
/�
�7
/� �
/��
/��update_display
/��
/�
0� �update_display
0: È™"Wimp_ForceRedraw",display_window%,0,-1000,1000,0
0( È™"Wimp_GetCaretPosition",,caret%
0 window% = caret%!0
0* icon% = caret%!4
04 new_pos% = icon%
0> �set_caret
0H�
0R
0\
0f
0p� �read_record(position%)
0z� p%, pointer%, f%
0�current_field_value$() = ""
0�*pointer% = 5000+position%*record_size%
0��#file% = pointer%
0�bad_field% = �
0�� �
0�
f% = 0
0�0ȕ f% <(number_of_fields% ) � � bad_field%
0� � � � bad_field% = �
0� � � bad_field% �
0�* � #file%, current_field_value$(f%)
0� p% =display_data%+f%*300
0�% $p% =current_field_value$(f%)
0� f% +=1
1 �
1�
1� �
1$�
1.
18
1B� �write_record(position%)
1L� p%, pointer%
1V*pointer% = 5000+position%*record_size%
1`�#file% = pointer%
1j"� f% = 0 � number_of_fields%-1
1t' � #file%, current_field_value$(f%)
1~�
1��
1�
1�
1�� �close_down_file
1�� file% <> 0 �
1� �#file% = 0
1� number_of_fields% = 0
1� � rec% = 0 � max_fields
1� � �(f$(rec%,0)) > 0 �
1� number_of_fields% +=1
1� �
1� �
2 � �field_length_ok �
2
1 � a% = field_des% � field_des% + 2196 � 4
2 �#file%,!a%
2 �
2( � #file%,$password%
22 � #file%, $filename%
2<$ � #file%, number_of_records%
2F � #file%, record_size%
2P# � #file%, number_of_fields%
2Z! � #file%, �($rec_number%)
2d � rec% = 0 � max_fields
2n% � #file%, field_used%(rec%)
2x �
2�
2�2 � a% = output_list% � output_list%+496 � 4
2� � #file%,!a%
2� �
2�
2�2 � a% = search_list% � search_list%+196 � 4
2� � #file%,!a%
2� �
2�
2�0 � a% = sort_field% � sort_field%+296 � 4
2� � #file%,!a%
2� �
2� �extract_record_data
3& �write_record(�($rec_number%))
3 � #file%
3 file% = 0
3" loaded% = �
3, inhibit% = �
36& �closeawindow(display_window%)
3@# �closeawindow(sort_window%)
3J% �closeawindow(output_window%)
3T% �closeawindow(fields_window%)
3^' �closeawindow(password_window%)
3h% �closeawindow(screen_window%)
3r# �closeawindow(save_window%)
3|
3� �destroy_display_icons
3� �
3�� �error_message("The field descriptor has been changed and is now too long. Either reduce the number of fields or reduce their length")
3� quit% = �
3� �
3��
3��
3�
3�� �field_length_ok
3��extract_field_description
3�total% = 0
3�control% = 0
3�� f% = 0 � max_fields
4$ total% = total% + �(f$(f%,2))
4& � �(f$(f%,0)) > 0 � control%+=2
4�
4&(� total% > record_size% - control% �
40=�
4:�
4D=�
4N
4X
4b� �password_check
4l � $password% <> "" �
4v $in_password% = ""
4�& �open_window(password_window%)
4� inhibit% = �
4� �
4��
4�
4�
4�
4�� �password
4�% �closeawindow(password_window%)
4�, � �$password%,4) = �$in_password%,4) �
4� inhibit% = �
4�% �open_window(display_window%)
4� �
5: �error_message("Incorrect password. File closing")
5 �close_down_file
5 �
5 �
5*
54
5>� �upper(text$)
5H� result$,i%,c$
5Rresult$=""
5\� i% = 1 � �text$
5f c$=�text$,i%,1)
5p* � c$>="a" � c$<="z" � c$=�(�(c$)�&DF)
5z result$=result$+c$
5��
5�=result$
5�
5�#� �replace(object$,target$,by$)
5�� start%, position%
5�start% = �object$,target$)
5�
È• start%
5�.position% = �(object$)-�(target$)-start%+1
5�8object$ = �object$,start%-1)+by$+�object$,position%)
5�,start% = �object$,target$,start%+�(by$))
5��
5�=object$
5�
6� �output_upper(text$)
6� result$,i%,c$
6quote% = �
6$result$=""
6.� i% = 1 � �text$
68 c$=�text$,i%,1)
6B# � c$ = �34 � quote% = � quote%
6L � c$="," � c$ = "+"
6V= � c$=";" � i% < �text$ � i% > 1 � c$="+"+�34+" "+�34+"+"
6` � � quote% �
6j- � c$>="a" � c$<="z" � c$=�(�(c$)�&DF)
6t �
6~ result$=result$+c$
6��
6�=result$
6�
6�
6�� �extract_output_list
6�� list% = 0 � 5
6�* pointer% = output_list% + list% * 70
6�% output_list$(list%) = $pointer%
6�> output_list$(list%) = �output_upper(output_list$(list%))
6��
6�� f% = 0 � max_fields
6� � �(f$(f%,0)) >0 �
7 � list% = 0 � 5
7
$ � � output_list$(list%) > 0 �
7o output_list$(list%) = �replace(output_list$(list%),�upper(f$(f%,0)),"current_field_value$("+�(f%)+")")
7 �
7( �
72 �
7<�
7F� list% = 0 � 5
7P� �output_list$(list%)>0 �
7Z
� �
7d% � � � : � � :�output_error : �
7n& � PRINTEVAL(output_list$(list%)
7x
� �
7��
7��
7��
7�
7�
7�
7�� �output_error
7� Ȏ � �
7�T � 9 : �error_message("Output line "+�(list%+1)+" contains an unmatched quote")
7�b � 26 : �error_message("Output line "+�(list%+1)+" contains a reference to an unknown field")
7�@ : �error_message("Looks like some other error at "+�(�))
7� �
7��
8
8�
8
8"
8,
86� �create_search_string
8@$ search_string$ = $search_list%
8J � case_sens% �
8T6 search_string$ =�output_upper(search_string$)
8^ �
8h/ search_string$ =�upper(search_string$)
8r �
8|� f% = 0 � max_fields
8� � �(f$(f%,0)) >0 �
8� Ȏ f$(f%,1) �
8�p � "t","T" : search_string$= �replace(search_string$,�upper(f$(f%,0)),"current_field_value$("+�(f%)+")")
8�s � "n","N" : search_string$= �replace(search_string$,�upper(f$(f%,0)),"VALcurrent_field_value$("+�(f%)+")")
8�! � "D","d" : �insert_date
8�
�
8� �
8��
8�� PRINT search_string$
8� � PRINT EVAL(search_string$)
8��
8�
8�� �insert_date
9� l$,r$,position%
91position% = �search_string$,�upper(f$(f%,0)))
9È• position% > 0
9&( position% = position% + � f$(f%,0)
90n ȕ (�search_string$,position%,1) <"0" � �search_string$,position%,1) >"1") � position% < �search_string$
9:! position% = position% +1
9D �
9N� search_string$ = �search_string$,position%-1)+"FNdate("+�34+�search_string$,position%,8)+�34+")"+�search_string$,�search_string$-position%-8)
9X#l$ = �search_string$,position%)
9b5r$ = �search_string$,�(search_string$)-position%)
9lOl$= �replace(l$,�upper(f$(f%,0)),"FNdate(current_field_value$("+�(f%)+"))")
9vsearch_string$ = l$ + r$
9�1position% = �search_string$,�upper(f$(f%,0)))
9��
9��
9�
9�
9�
9�
9�
9�� �valid_search_criteria
9�� total%, ok%, list%, d
9�ok% = �
9�� � search_string$ = 0 �
9�U �error_message("A search string must be entered. Use ALL to list all records")
: ok%=�
:�
:total% = 0
: � list% = 0 � 5
:*2 total% = total% + � (output_list$(list%))
:4 �
:>� total% = 0 �
:H ok%=�
:RT �error_message("At least one of the output lines must contain a field name.")
:\�
:f� �
:pN� � � ok% = � :�error_message("The search string contains a syntax error")
:z� ok% � d=�(search_string$)
:�� �
:�=ok%
:�
:�
� �screen
:�error% = �
:��extract_record_data
:�� �valid_record �
:�? �write_record(�($rec_number%)) : � save the latest record
:� �extract_output_list
:� �create_search_string
:� � �valid_search_criteria �
:� � list% = 0 � 5
:�, pointer% = output_display%+list%*300
; $pointer% = ""
; �
;" �open_window(screen_window%)
;$ rec% = 1
;. match% = 0
;8 $output_rec% = �rec%
;B $matches% = �match%
;L7 È™"Wimp_ForceRedraw",screen_window%,0,-500,4000,0
;V escape% = �
;` �poll(0)
;j/ ȕ rec% <= number_of_records% � � escape%
;t �read_record(rec%)
;~- � � case_sens% � �convert_record_case
;� � �(search_string$) �
;�> �read_record(rec%) : � because the case may be changed
;� � tabulate% � �tabulate
;� match% +=1
;� $output_rec% = �rec%
;� $matches% = �match%
;� � list% = 0 � 5
;�0 pointer% = output_display%+list%*300
;�) � �(output_list$(list%)) >0 �
;� �do_list
;�
�
;� $pointer% = ""
<