Pro Pascal Compiler - Version zz 2.1 Compilation of: LPEXTS.PAS Options: LNIAP 1 0000 segment externals; 2 0000 3 0000 {External routines for Database package} 4 0000 5 0000 {Brian Gilmore August 1987} 6 0000 7 0000 8 0000 9 0000 TYPE 10 0000 {$I lptype.ins} 11 0000 adulta = ARRAY[1..10] OF integer; 12 0000 fsa = ARRAY[1..4] OF integer; 13 0000 fparty = ARRAY[0..8] OF string[3]; 14 0000 fattrn = ARRAY[0..15] OF string[15]; 15 0000 fsname = PACKED ARRAY[1..19] OF char; 16 0000 ffname = PACKED ARRAY[1..25] OF char; 17 0000 fhname = PACKED ARRAY[1..5] OF char; 18 0000 fstne = PACKED ARRAY[1..34] OF char; 19 0000 fpcode = PACKED ARRAY[1..8] OF char; 20 0000 s_integer = 0..60000; 21 0000 byte = 0..255; 22 0000 {xattr = (sa, sb, sc, sd, se, sf, sg, sh, si, sj, sk, sl, sm, sn, so, sp);} 23 0000 xattr = 1..15; 24 0000 sattr = SET OF xattr; 25 0000 26 0000 vf = RECORD 27 0000 sname: fsname; 28 0000 fname: ffname; 29 0000 hname: fhname; 30 0000 street: s_integer; 31 0000 r_no: s_integer; 32 0000 cvote: byte; 33 0000 pvote: byte; 34 0000 attr: sattr; 35 0000 spare1, spare2: byte; 36 0000 END; 37 0000 38 0000 vfp = ^vf; 39 0000 ntfile = FILE of vf; 40 0000 41 0000 rf = RECORD 42 0000 street: fstne; 43 0000 postcode: fpcode; 44 0000 END; 45 0000 46 0000 rfp = ^rf; 47 0000 rffile = FILE of rf; 48 0000 49 0000 COMMON 50 0000 final: integer; 51 0000 nat: text; 52 0000 party, sparty: fparty; 53 0000 attrn: fattrn; 54 0000 55 0000 56 0000 57 0000 VAR 58 0000 out, source, temp, outfile: text; {source file} 59 0000 outf, reg, filename, ofn, rfn, name: string[14]; 60 0000 s, line, sname, add, this_add, 61 0000 old_street, last_line, house: string[120]; 62 0000 target, count, p1, p2, lno,vkey,row,col,spt,i,flag,dstart,rlen,lflag: integer; 63 0000 x_now, p3, labels, addno, last_address: integer; 64 0000 key: char; 65 0000 66 0000 PROCEDURE cursor(y,x: integer); 67 0000 BEGIN 68 0000 write(chr(1bh), 'Y', chr(y+20h), chr(x+20h)); 69 0053 END; 70 0059 71 0059 PROCEDURE clearscreen; 72 0059 BEGIN 73 0059 write(chr(1bH)); write('E'); cursor(0, 1); 74 0097 END; 75 009D 76 009D PROCEDURE Clear_from_Line(n: integer); 77 009D BEGIN 78 009D cursor(n, 0); write(chr(1bh), 'J'); 79 00D3 END; 80 00D9 81 00D9 PROCEDURE Clearline(n: integer); 82 00D9 BEGIN 83 00D9 cursor(n,0); write(chr(1bH),'K'); 84 010F END; 85 0115 86 0115 PROCEDURE set_viewport(n: integer); 87 0115 BEGIN 88 0115 write(chr(1bH),'X',chr(n+33),chr(32),chr(28+32),chr(90-1+32)); 89 016C {set 1,0,29,90 - protects top row} 90 016C END; 91 0172 92 0172 PROCEDURE reset_viewport; 93 0172 BEGIN 94 0172 write(chr(1bH),'X ',chr(30+32),chr(90+32)); 95 01B0 END; 96 01B6 97 01B6 FUNCTION get: char; 98 01B6 VAR Key: char; 99 01B6 x: real; 100 01B6 BEGIN 101 01B6 REPEAT 102 01C3 if eoln(nat) then begin 103 01D2 key := chr(13); readln(nat); {clear eol flag} 104 01E8 END ELSE read(nat, key); 105 0209 UNTIL ord(key) > 0; 106 0210 if ord(key) = 3 then x := sqrt(-1); {force an error} 107 022B write(key); 108 0240 get := key; 109 024E END; 110 0254 111 0254 FUNCTION readint: integer; 112 0254 VAR i, j, n, q: integer; 113 0254 BEGIN 114 0254 n := 0; final := -1; q := 0; 115 0280 REPEAT 116 0285 i := ord(get); j := i-ord('0'); 117 02A5 if (j>=0) and (j<=9) then begin 118 02C8 n := n*10+j; q := 1; 119 02F3 end else final := i; 120 0303 UNTIL final > 0; 121 0316 if q = 0 then n := -1; 122 032F readint := n; 123 033C END; 124 0342 125 0342 FUNCTION getchar: integer; 126 0342 VAR i: integer; 127 0342 BEGIN 128 0342 i := ord(get); 129 035B getchar := i; 130 0364 END; 131 036A 132 036A FUNCTION getint(x, y:integer): integer; 133 036A VAR i,j,n,fl: integer; 134 036A BEGIN 135 036A fl := 0; 136 0381 REPEAT 137 0386 write(' '); cursor(x, y); 138 03B8 n := readint; 139 03C4 if (final<>32) and (final<>27) and (final<>13) then begin 140 040E cursor(x+1,0); write('Not a number, please retype'); 141 0455 cursor(x, y); write(' '); cursor(x, y); 142 049B end else fl := 1; 143 04AC UNTIL fl <> 0; 144 04B7 getint := n; 145 04C4 END; 146 04CA 147 04CA PROCEDURE show_attributes; 148 04CA VAR i, j: integer; 149 04CA BEGIN 150 04CA for i := 1 to 10 do begin 151 04E6 cursor(12+i, 60); write(i:3,' ',attrn[i]); 152 054C end; 153 055A END; 154 0560 155 0560 156 0560 PROCEDURE set_party; 157 0560 VAR i: integer; 158 0560 BEGIN 159 0560 party[0] := '???'; sparty[0] := '?'; 160 0585 party[1] := 'Lab'; sparty[1] := 'L'; 161 05A2 party[2] := 'Con'; sparty[2] := 'C'; 162 05BF party[3] := 'All'; sparty[3] := 'A'; 163 05DC party[4] := 'SNP'; sparty[4] := 'S'; 164 05F9 party[5] := 'Gre'; sparty[5] := 'G'; 165 0616 party[6] := 'Agt'; sparty[6] := 'A'; 166 0633 party[7] := 'Pos'; sparty[7] := 'P'; 167 0650 party[8] := 'D/K'; sparty[8] := 'D'; 168 066D 169 066D attrn[1] := 'Moved/Dead '; attrn[2] := 'Postal Vote '; 170 06AE attrn[3] := 'New Voter '; attrn[4] := 'Window Poster '; 171 06EF attrn[5] := 'Member '; attrn[6] := 'Car Wanted '; 172 0730 attrn[7] := 'Council Tenant '; attrn[8] := 'Student '; 173 0771 attrn[9] := 'Pensioner '; attrn[10]:= 'In Master File '; 174 07B2 END; 175 07B8 176 07B8 BEGIN 177 07B8 END.