Pro Pascal Compiler - Version zz 2.1 Compilation of: M:LPVOT.PAS Options: LNIAP 1 0000 program LPVOT(input,output); 2 0000 3 0000 { Program to examine and modify a file in Database format} 4 0000 5 0000 {Brian Gilmore May 1987} 6 0000 7 0000 8 0000 TYPE 9 0000 {$I lptype.ins} 10 0000 adulta = ARRAY[1..10] OF integer; 11 0000 fsa = ARRAY[1..4] OF integer; 12 0000 fparty = ARRAY[0..8] OF string[3]; 13 0000 fattrn = ARRAY[0..15] OF string[15]; 14 0000 fsname = PACKED ARRAY[1..19] OF char; 15 0000 ffname = PACKED ARRAY[1..25] OF char; 16 0000 fhname = PACKED ARRAY[1..5] OF char; 17 0000 fstne = PACKED ARRAY[1..34] OF char; 18 0000 fpcode = PACKED ARRAY[1..8] OF char; 19 0000 s_integer = 0..60000; 20 0000 byte = 0..255; 21 0000 {xattr = (sa, sb, sc, sd, se, sf, sg, sh, si, sj, sk, sl, sm, sn, so, sp);} 22 0000 xattr = 1..15; 23 0000 sattr = SET OF xattr; 24 0000 25 0000 vf = RECORD 26 0000 sname: fsname; 27 0000 fname: ffname; 28 0000 hname: fhname; 29 0000 street: s_integer; 30 0000 r_no: s_integer; 31 0000 cvote: byte; 32 0000 pvote: byte; 33 0000 attr: sattr; 34 0000 spare1, spare2: byte; 35 0000 END; 36 0000 37 0000 vfp = ^vf; 38 0000 ntfile = FILE of vf; 39 0000 40 0000 rf = RECORD 41 0000 street: fstne; 42 0000 postcode: fpcode; 43 0000 END; 44 0000 45 0000 rfp = ^rf; 46 0000 rffile = FILE of rf; 47 0000 48 0000 COMMON 49 0000 final: integer; 50 0000 nat: text; 51 0000 party, sparty: fparty; 52 0000 attrn: fattrn; 53 0000 54 0000 55 0000 56 0000 VAR 57 0000 vv: vfp; 58 0000 dbfile: ntfile; 59 0000 rv: rfp; 60 0000 rdfile: rffile; 61 0000 source, temp, outfile: text; {source file} 62 0000 reg, filename, ofn, rfn, name: string[14]; 63 0000 line,last_line, house: string[120]; 64 0000 target, count, p1, p2, lno,vkey,row,col,spt,i,flag,dstart,rlen,lflag: integer; 65 0000 x_now, x_party, p3, labels, addno, last_address: integer; 66 0000 adult: adulta; 67 0000 field_size, field_max: fsa; 68 0000 key: char; 69 0000 chng: boolean; 70 0000 71 0000 PROCEDURE cursor(y,x: integer); EXTERNAL; 72 0000 PROCEDURE clearscreen; EXTERNAL; 73 0000 PROCEDURE Clear_from_Line(n: integer); EXTERNAL; 74 0000 PROCEDURE Clearline(n: integer); EXTERNAL; 75 0000 PROCEDURE set_viewport(n: integer); EXTERNAL; 76 0000 PROCEDURE reset_viewport; EXTERNAL; 77 0000 FUNCTION get: char; EXTERNAL; 78 0000 FUNCTION readint: integer; EXTERNAL; 79 0000 FUNCTION getchar: integer; EXTERNAL; 80 0000 FUNCTION getint(x, y:integer): integer; EXTERNAL; 81 0000 PROCEDURE set_party; EXTERNAL; 82 0000 83 0000 PROCEDURE get_address(n: integer); 84 0000 BEGIN 85 0000 if last_address <> n then seek(rdfile, n); 86 002A last_address := n; 87 0038 END; 88 003E 89 003E PROCEDURE show_attributes; EXTERNAL; 90 003E 91 003E PROCEDURE print_attributes(q: integer); FORWARD; 92 003E 93 003E PROCEDURE set_attributes; 94 003E VAR i,j, n: integer; 95 003E BEGIN 96 003E show_attributes; 97 004E REPEAT 98 0053 cursor(22, 0); write('Attribute no (return for none)?'); 99 009D n := getint(22, 31); 100 00B9 if (n=-1) and (final=13) then n := 0; 101 00F0 if n>15 then begin 102 0107 cursor(24,0); write('Attributes between 1 and 15 please!'); 103 0155 end else begin 104 015C if n > 0 then begin 105 0173 dbfile^.attr := dbfile^.attr + [n]; 106 01AF chng := true; 107 01B9 end; 108 01B9 end; 109 01B9 clearline(24); 110 01C9 if chng then print_attributes(13); 111 01DF UNTIL n <= 0; 112 01F1 END; 113 01F7 114 01F7 PROCEDURE print_attributes; 115 01F7 VAR i, j, k: integer; 116 01F7 BEGIN 117 01F7 cursor(q, 0); writeln(' '); 118 024C writeln(' '); 119 0288 write (' '); 120 02C4 if dbfile^.attr = [] then begin 121 02E1 cursor(q,15); write('[None]'); 122 0310 end else begin 123 0318 j := 1; cursor(q, 10); 124 0338 for i := 1 to 10 do begin 125 034C k := 0; 126 035B if [i] * dbfile^.attr <> [] then begin 127 038E write(attrn[i]); 128 03BD j := j+1; 129 03CD if j = 4 then begin 130 03E0 q := q+1; cursor(q,10); j := 1; 131 0407 end; 132 0407 end; 133 0407 end; 134 0415 end; 135 0415 END; 136 041B 137 041B PROCEDURE display_entry; 138 041B VAR 139 041B pos: integer; 140 041B BEGIN 141 041B pos := 3; 142 0432 cursor(pos, 1); writeln('Register no. ',dbfile^.r_no); 143 047E cursor(pos+1, 1); writeln('Surname ',dbfile^.sname); 144 04CF cursor(pos+2, 1); writeln('First name ',dbfile^.fname); 145 052C cursor(pos+3, 1); writeln('House no. ',dbfile^.hname); 146 0589 get_address(dbfile^.street); 147 05A5 cursor(pos+4, 1); writeln('Street: ', 148 05EA rdfile^.street,', ',rdfile^.postcode); 149 0622 cursor(pos+6,1); writeln('Voting intention ',party[dbfile^.cvote]); 150 0690 cursor(pos+7,1); writeln('Previous ',party[dbfile^.pvote]); 151 06FE cursor(pos+9,1); writeln('Further Information:'); 152 0746 print_attributes(pos+10); 153 075F END; 154 0765 155 0765 PROCEDURE Print_Party_options; 156 0765 VAR i,j: integer; 157 0765 BEGIN 158 0765 cursor(0,70); 159 0785 if x_now = 0 then write('Setting Current Vote') else write('Setting previous Vote'); 160 07E6 FOR i := 0 to 8 do begin 161 07FA cursor(13+i,60); write(i:3,' ',party[i]); 162 085D END; 163 086B END; 164 0871 165 0871 PROCEDURE Get_Party; 166 0871 VAR i,j,n: integer; 167 0871 BEGIN 168 0871 REPEAT 169 087E print_party_options; 170 0886 clearline(22); 171 0896 cursor(22,0); write('Which Party (0-8)?'); {i := getchar-ord('0');} 172 08D3 i := getint(22,18); 173 08EF if i > 8 then begin 174 0902 cursor(24,0); writeln('Party between 0 and 8 only !'); 175 0949 end; 176 0949 UNTIL i<9; {return gives -1 -> take no action} 177 095B x_party := i; 178 0969 clearline(23); 179 0979 END; 180 097F 181 097F PROCEDURE Set_General(entry_type: integer); 182 097F LABEL 1; 183 097F VAR i,j,n, prev: integer; 184 097F BEGIN 185 097F n := 0; 186 0996 cursor(0,0); writeln('Add Canvas Returns'); 187 09D3 cursor(0,40); write('Press EXIT to finish'); 188 0A12 REPEAT 189 0A17 clear_from_line(1); prev := n; 190 0A2F cursor(22,0); write('First Voter Number (EXIT to finish)?'); n := getint(22,36); 191 0A95 clear_from_line(1); 192 0AA5 if (n = -1) and (final=13) then n := 1; 193 0AE0 if final = 27 then n := 0; 194 0B01 if n = 0 then goto 1; 195 0B13 REPEAT 196 0B18 count := n; 197 0B26 seek(dbfile,n); 198 0B38 display_entry; chng := false; 199 0B45 if entry_type <= 0 then begin 200 0B5C get_party; 201 0B64 if final = 27 then goto 1; 202 0B7E if x_party >= 0 then begin 203 0B8D if x_now = 0 then begin 204 0B9D dbfile^.cvote := x_party; cursor(9, 21); write(party[x_party]); 205 0BF6 end else begin 206 0BFD dbfile^.pvote := x_party; cursor(10,21); write(party[x_party]); 207 0C56 end; 208 0C56 chng := true; 209 0C60 end; 210 0C60 end; 211 0C60 if entry_type >= 0 then begin 212 0C6E set_attributes; 213 0C76 if final = 27 then goto 1; 214 0C8F end; 215 0C8F if chng then put(dbfile); 216 0CA1 n := n+1; 217 0CB1 UNTIL n = 0; 218 0CB8 1:; 219 0CB8 UNTIL n = 0; 220 0CC3 clearscreen; 221 0CCB END; 222 0CD1 223 0CD1 PROCEDURE Set_Specific_Vote; 224 0CD1 VAR i,j,n, prev: integer; 225 0CD1 BEGIN 226 0CD1 cursor(0,0); writeln('Set Specific Party'); 227 0D16 clear_from_line(1); 228 0D26 get_party; n := 0; 229 0D38 cursor(0, 40); write('Party:', party[x_party]); 230 0D8A 231 0D8A REPEAT 232 0D8F clearline(22); prev := n; 233 0DA7 cursor(22,0); write('Give Voter Number (0 to finish)?'); n := getint(22,32); 234 0E09 if (n=-1) and (final=13) then n := prev+1; 235 0E41 if n > 0 then begin 236 0E58 count := n; 237 0E66 seek(dbfile, n); 238 0E78 if x_now = 0 then dbfile^.cvote := x_party else 239 0EA4 dbfile^.pvote := x_party; 240 0EC3 display_entry; 241 0ECB put(dbfile); 242 0ED7 end; 243 0ED7 UNTIL n = 0; 244 0EE2 clearscreen; 245 0EEA END; 246 0EF0 247 0EF0 PROCEDURE this_or_previous; 248 0EF0 VAR i,j: integer; 249 0EF0 BEGIN 250 0EF0 clearscreen; 251 0F00 REPEAT 252 0F05 clearline(22); 253 0F15 cursor(3,0); writeln(' 1 - Set Current voting intentions'); 254 0F62 cursor(5,0); writeln(' 2 - Set Previous voting intentions'); 255 0FB0 cursor(22,0); write('Option (1-2)?'); i := getint(22,13); 256 0FFF if (i<1) or (i>2) then begin 257 102B cursor(24,0); write('Option between 1 and 2!'); 258 106D end else begin 259 1074 x_now := i-1; 260 1085 end; 261 1085 UNTIL (i=1) or (i=2); 262 10B1 END; 263 10B7 264 10B7 PROCEDURE Add_Canvas; 265 10B7 VAR i,j : integer; 266 10B7 BEGIN 267 10B7 clearscreen; 268 10C7 REPEAT 269 10CC clearline(22); 270 10DC cursor(3,0); writeln(' 0 - Return to Main Menu'); 271 111F cursor(5,0); writeln(' 1 - Set Voter intention & attributes'); 272 116F cursor(7,0); writeln(' 2 - Set Voter intention'); 273 11B2 cursor(9,0); writeln(' 3 - Set Attributes only'); 274 11F5 cursor(11,0); writeln(' 4 - Set a series of one party only'); 275 1243 276 1243 cursor(22,0); write('Option (0-4)?'); {i := getchar-ord('0');} 277 127B i := getint(22,13); 278 1297 if (i < 0) or (i > 4) then begin 279 12BA cursor(24,0); writeln('Option between 0 and 4 !'); 280 12FD end else begin 281 1304 CASE i of 282 1310 0: ; 283 1312 1: begin; this_or_previous; Set_General(0); end; 284 1327 2: begin; this_or_previous; Set_General(-1); end; 285 133C 3: Set_General(1); 286 134E 4: begin; this_or_previous; Set_Specific_Vote; end; 287 135B END; 288 1372 end; 289 1372 UNTIL i = 0; 290 137D set_viewport(1); clearscreen; 291 1390 END; 292 1396 293 1396 PROCEDURE Disp_Voter; 294 1396 VAR i, prev: integer; 295 1396 BEGIN 296 1396 clearscreen; i := 0; 297 13B0 repeat 298 13B5 clearline(22); prev := i; 299 13CD cursor(22,0); write('Voter number (0 to finish):'); 300 1413 i := getint(22, 27); 301 142F if (i=-1) and (final=13) then i:=prev+1; 302 1467 if final = 27 then i:=0; 303 1488 count := i; clearline(23); 304 14A1 seek(dbfile, i); 305 14B3 if i <> 0 then display_entry; 306 14C5 until i = 0; 307 14D0 END; 308 14D6 309 14D6 PROCEDURE Main_menu; 310 14D6 VAR i,j: integer; 311 14D6 BEGIN 312 14D6 set_viewport(1); 313 14EE REPEAT 314 14F3 cursor(2,0); writeln('Main Menu'); 315 1527 cursor(4,0); writeln(' 0 - Exit Program'); 316 156C cursor(6,0); writeln(' 1 - Display Voter details'); 317 15BA cursor(8,0); writeln(' 2 - Add Canvas Returns'); 318 1605 319 1605 cursor(22,0); write('Action (0-2)?'); {j := getchar-ord('0');} 320 163D j := getint(22, 13); 321 1659 clearline(24); 322 1669 323 1669 if j = 1 then begin 324 167F Disp_Voter; 325 1687 clearscreen; 326 168F end else begin 327 1697 if j = 2 then begin 328 16AD Add_Canvas; clearscreen; 329 16B8 end else begin 330 16BF if j <> 0 then begin 331 16CE cursor(24,0); writeln('Input MUST be between 0 and 2'); 332 1716 end; 333 1716 end; 334 1716 end; 335 1716 UNTIL j = 0; 336 1721 END; 337 1727 338 1727 BEGIN 339 1727 set_party; 340 1738 writeln; writeln; 341 1749 write('Register Name?'); readln(ofn); 342 177F rfn := concat('B:',ofn,'.STR'); 343 17AC ofn := concat('B:',ofn,'.DAT'); 344 17D9 clearscreen; 345 17E1 346 17E1 cursor(0,1); lno := 1; row := 1; col := 1; vkey:=0; dstart:=0; 347 1830 assign(nat, 'KBD:'); reset(nat); {get at keyboard directly} 348 1856 assign(dbfile, ofn); update(dbfile); 349 1877 assign(rdfile, rfn); update(rdfile); 350 1898 flag := 0; count := 1; labels := 0; 351 18BE 352 18BE cursor(0,1); writeln('Database File:', ofn); 353 1903 354 1903 main_menu; 355 190B 356 190B reset_viewport; clearscreen; 357 1916 END.