segment editor ; { *** Header file with type declarations and common variables *** } {$I typedefs.pas} procedure readfromfile(var filename : string20) ; external ; procedure readcopyfile(var filename : string20) ; external ; procedure cls ; external ; procedure underscoreon ; external ; procedure poscur(x,y : integer) ; external ; procedure hlighton ; external ; procedure hlightoff ; external ; procedure flashon ; external ; procedure flashoff ; external ; function kbstat : boolean ; external ; procedure kbread(var ch : char) ; external ; procedure syscall(intnumber:byte; var regs : intregspec) ; external ; procedure sendtofile ; external ; procedure wait(hundred:integer) ; external; procedure editterm(currrec : ptr) ; type recstring = packed array [1..11] of char ; portbaud = packed array [1..9] of char ; lfstring = packed array [1..28] of char ; xyarray = array [1..26,1..4] of integer ; receivemodestr = packed array [1..4] of recstring ; portspeedstring = packed array [1..15] of portbaud ; linefeedstring = packed array [1..6] of lfstring ; var rds : intregspec ; xypos : xyarray ; incomingcall : receivemodestr ; insert : linefeedstring ; pbstr : portspeedstring ; charnum , dummy , loop , count , curredit : integer ; chcksum : integer ; zerochar , endofinput , first : boolean ; anti_pad , nameok : boolean ; b_up1, b_up2, b_up3 : integer ; b_str1 : packed array [1..32] of char ; b_str2 : packed array [1..20] of char ; b_str3 : packed array [1..24] of char ; function keystatus(var zerochar : boolean ; var cheat : integer) : boolean ; begin rds.ah := 6 ; rds.dl := 255; syscall(33,rds) ; if (not rds.zf) then begin if rds.al = 0 then begin syscall(33,rds) ; zerochar := true end else zerochar := false ; cheat := rds.al end ; if cheat > 127 then keystatus := false else keystatus := not rds.zf end ; function bitset(bit_num : integer ; data : byte) : boolean ; var num , divide_num : integer ; begin num := data ; divide_num := bit_num ; while divide_num <> 0 do begin num := num div 2 ; divide_num := divide_num - 1 ; end ; if (num mod 2) = 1 then bitset := true else bitset := false ; end ; procedure setbit(bit_num : integer ; var data : byte) ; var num : 0..255 ; mult_num : integer ; begin if not bitset(bit_num,data) then begin num := 1 ; mult_num := bit_num ; while mult_num <> 0 do begin num := num * 2 ; mult_num := mult_num - 1 ; end ; data := data + num ; end end ; procedure resetbit(bit_num : integer ; var data : byte) ; var num : 0..255 ; mult_num : integer ; begin if bitset(bit_num,data) then begin num := 1 ; mult_num := bit_num ; while mult_num <> 0 do begin num := num * 2 ; mult_num := mult_num - 1 ; end ; data := data - num ; end end ; procedure initialise(var xy : xyarray ; var nn : receivemodestr ; var ss : portspeedstring ; var ff : linefeedstring ) ; var loop : integer ; begin { The xy array encodes the position to display the information for each parameter. [n,1] = y, [n,2] = x } xy[1,1] := 2 ; xy[1,2] := 36 ; xy[2,1] := 2 ; xy[2,2] := 49 ; xy[3,1] := 5 ; xy[3,2] := 9 ; xy[4,1] := 7 ; xy[4,2] := 9 ; xy[5,1] := 9 ; xy[5,2] := 9 ; xy[6,1] := 5 ; xy[6,2] := 41 ; xy[7,1] := 7 ; xy[7,2] := 48 ; xy[8,1] := 9 ; xy[8,2] := 48 ; xy[9,1] := 13 ; xy[9,2] := 14 ; xy[10,1] := 15 ; xy[10,2] := 15 ; xy[11,1] := 17 ; xy[11,2] := 14 ; xy[12,1] := 19 ; xy[12,2] := 12 ; xy[13,1] := 13 ; xy[13,2] := 39 ; xy[14,1] := 15 ; xy[14,2] := 39 ; xy[15,1] := 17 ; xy[15,2] := 37 ; xy[16,1] := 19 ; xy[16,2] := 38 ; xy[17,1] := 13 ; xy[17,2] := 61 ; xy[18,1] := 14 ; xy[18,2] := 61 ; xy[19,1] := 15 ; xy[19,2] := 61 ; xy[20,1] := 16 ; xy[20,2] := 61 ; xy[21,1] := 13 ; xy[21,2] := 44 ; xy[22,1] := 17 ; xy[22,2] := 61 ; xy[23,1] := 18 ; xy[23,2] := 61 ; xy[24,1] := 19 ; xy[24,2] := 61 ; xy[25,1] := 15 ; xy[25,2] := 20 ; xy[26,1] := 14 ; xy[26,2] := 17 ; { length of variable } xy[1,3] := 2 ; xy[2,3] := 12 ; xy[3,3] := 29 ; xy[4,3] := 20 ; xy[5,3] := 24 ; xy[6,3] := 28 ; xy[7,3] := 1 ; xy[8,3] := 11 ; xy[9,3] := 3 ; xy[10,3] := 4 ; xy[11,3] := 8 ; xy[12,3] := 9 ; xy[13,3] := 3 ; xy[14,3] := 3 ; xy[15,3] := 4 ; xy[16,3] := 3 ; xy[17,3] := 5 ; xy[18,3] := 9 ; xy[19,3] := 3 ; xy[20,3] := 3 ; xy[21,3] := 3 ; { following sets type of variable, types are: 0 = string 1 = boolean 2 = special! 3 = never } xy[1,4] := 3 ; xy[2,4] := 0 ; xy[3,4] := 0 ; xy[4,4] := 0 ; xy[5,4] := 0 ; xy[6,4] := 1 ; xy[7,4] := 3 ; xy[8,4] := 1 ; xy[9,4] := 1 ; xy[10,4] := 2 ; xy[11,4] := 1 ; xy[12,4] := 1 ; xy[13,4] := 2 ; xy[14,4] := 1 ; xy[15,4] := 2 ; xy[16,4] := 2 ; xy[17,4] := 1 ; xy[18,4] := 1 ; xy[19,4] := 1 ; xy[20,4] := 1 ; xy[21,4] := 2 ; xy[22,4] := 2 ; xy[23,4] := 2 ; xy[24,4] := 2 ; xy[25,4] := 2 ; xy[26,4] := 2 ; nn[1] := 'REJECT ' ; nn[2] := 'CONDITIONAL' ; nn[3] := 'ACCEPT ' ; nn[4] := 'AUTOMATIC ' ; ss[1] := ' 300 baud' ; ss[2] := '1200 baud' ; ss[3] := ' 600 baud' ; ss[4] := '1275 baud' ; ss[5] := '2400 baud' ; ss[6] := '4800 baud' ; ss[7] := '9600 baud' ; ss[8] := '19K2 baud' ; ss[9] := 'Auto baud' ; ss[10] := ' Mdm baud' ; ss[11] := 'Twin baud' ;ss[14] := '7512 baud'; ff[1] := 'Transparent LF '; ff[2] := 'CR/LF shown when CR received'; ff[3] := 'CR/LF sent when CR typed '; ff[4] := 'LF added to displayed CRs '; ff[5] := 'CR/LF echoed when CR typed '; ff[6] := 'CR displayed as CR/LF '; end ; procedure setupscreen(currrec : ptr) ; var flag : integer ; begin cls ; writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»') ; writeln('º State of terminal Called º') ; writeln('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹') ; writeln('º º º') ; b_up1 := 1 ; b_up2 := 1 ; b_up3 := 1 ; b_str1[1] := ' ' ; b_str2[1] := ' ' ; b_str3[1] := ' ' ; if bitset(1,currrec^.flags1) then begin anti_pad := true ; writeln('º PVC: º º') ; writeln('º º º') ; writeln('º Ostr: º State: º') ; writeln('º º º') ; writeln('º Dstr: º Answer: º') ; end else begin anti_pad := false ; writeln('º User: º º') ; writeln('º º º') ; writeln('º Room: º State: º') ; writeln('º º º') ; writeln('º Tel: º Answer: º') ; end ; writeln('º º º') ; writeln('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹') ; writeln('º º º º') ; writeln('º Port type: º Height/width: / º Data: º') ; writeln('º Break action: º º Rate: º') ; writeln('º T.out/Forw.: / º DLE : º Echo: º') ; writeln('º º º Edit: º') ; writeln('º Flow type: º LF padding: º Delc: º') ; writeln('º º º Dell: º') ; writeln('º Carrier: º Auto repeat: º Disl: º') ; writeln('º º º º') ; writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ') ; poscur(25,1); hlighton; write('ALT+X to exit'); hlightoff; end ; procedure swap_st(currrec : ptr); forward ; procedure set_draw(loop : integer ; currrec : ptr ) ; var count , len : integer ; begin with currrec^ do case loop of 1 : write(termnumber:2) ; 2 : for count := 1 to 12 do if count > tnnum then write(' ') else write(tname[count]) ; 3 : for count := 1 to 29 do if count > unnum then write(' ') else write(uname[count]) ; 4 : if bitset(1,flags1) then begin len := 0 ; for count := 1 to ulnum do if (ord(uloc[count]) < 28) then begin write('^',chr(ord(uloc[count])+64)) ; len := len + 2 end else begin write(uloc[count]) ; len := len + 1 end ; for count := len+1 to 20 do write(' ') end else for count := 1 to 20 do if count > ulnum then write(' ') else write(uloc[count]) ; 5 : if bitset(1,flags1) then begin len := 0 ; for count := 1 to uphnum do if (ord(uphon[count]) < 28) then begin write('^',chr(ord(uphon[count])+64)) ; len := len + 2 end else begin write(uphon[count]) ; len := len + 1 end ; for count := len+1 to 24 do write(' ') end else for count := 1 to 24 do if count > uphnum then write(' ') else write(uphon[count]) ; 6 : case x29pars[13] of 0 : write(insert[1]) ; 1 : write(insert[2]) ; 4 : write(insert[4]) ; 5 : write(insert[3]) ; 6 : write(insert[5]) ; 7 : write(insert[6]) ; end ; 7 : write(' ') ; 8 : write(incomingcall[odds[1]+1]) ; 9 : if bitset(0,flags1) then if bitset(7,handshake) then write('GRN LPAD') else write('XXX LPAD') else if bitset(1,flags1) then begin write('APD ') ; if anti_pad = FALSE then begin hlightoff ; poscur(5,3) ; write('PVC: ') ; poscur(7,3) ; write('Ostr:') ; poscur(9,3) ; write('Dstr:') ; swap_st(currrec) ; anti_pad := true ; end ; end else if bitset(7,handshake) then begin write('GRN CPAD') ; if anti_pad = TRUE then begin hlightoff ; poscur(5,3) ; write('User:') ; poscur(7,3) ; write('Room:') ; poscur(9,3) ; write('Tel: ') ; swap_st(currrec) ; anti_pad := false ; end ; end else write('XXX CPAD') ; 10 : begin if not(bitset(1,flags2)) then x29pars[4] := 0 ; write(x29pars[4]:3) ; end ; 11 : if bitset(5,handshake) then write('Hardware') else write('Software') ; 12 : if bitset(2,handshake) then if bitset(1,handshake) then write('Online ') else write('Always on') else if bitset(1,handshake) then write('Nrmly off') else write('Nrmly on ') ; 13 : if odds[4]=0 then write('---') else write(odds[4]:3) ; 14 : if x29pars[1] = 0 then write('OFF') else write('ON ') ; 15 : if x29pars[14] = 0 then write('none') else write(x29pars[14]:3,' ') ; 16 : if odds[3] = 0 then write('none') else write(odds[3]:3,' ') ; 17 : if odds[2] = 127 then write('7 BIT') else write('8 BIT') ; 18 : if x29pars[11] < 11 then write(pbstr[x29pars[11]-1]) else if x29pars[11] < 20 then write(pbstr[x29pars[11]-7]) else write(pbstr[x29pars[11]-11]) ; 19 : if x29pars[2] = 0 then write('OFF') else write('ON ') ; 20 : if x29pars[15] = 0 then write('OFF') else write('ON ') ; 21 : if x29pars[10] < 10 then write(' 0',x29pars[10]:1) else if x29pars[10] < 100 then write(' ',x29pars[10]:2) else write(x29pars[10]:3) ; 22 : write(x29pars[16]:3); 23 : write(x29pars[17]:3); 24 : write(x29pars[18]:3); 25 : write(x29pars[3]:3); 26 : write(x29pars[7]:3); end ; end ; procedure swap_st ; var loop, t_i : integer ; t_str : char ; t_str1 : packed array [1..32] of char ; t_str2 : packed array [1..20] of char ; t_str3 : packed array [1..24] of char ; begin with currrec^ do begin t_i := unnum ; unnum := b_up1 ; b_up1 := t_i ; t_i := ulnum ; ulnum := b_up2 ; b_up2 := t_i ; t_i := uphnum ; uphnum := b_up3 ; b_up3 := t_i ; t_str1 := uname; uname := b_str1 ; b_str1 := t_str1 ; t_str2 := uloc ; uloc := b_str2 ; b_str2 := t_str2 ; t_str3 := uphon ; uphon := b_str3 ; b_str3 := t_str3 ; poscur(5,9) ; set_draw(3,currrec) ; poscur(7,9) ; set_draw(4,currrec) ; poscur(9,9) ; set_draw(5,currrec) ; end ; end ; procedure upone(var curredit: integer) ; begin case curredit of 4, 5, 11, 12, 14, 15, 16, 18, 19, 20, 23, 24 : curredit := curredit - 1 ; 10 : curredit := 26 ; 8 : curredit := 6 ; 3 , 6 : curredit := 2 ; 2 : curredit := 24 ; 9 , 13 : curredit := 5 ; 17 : curredit := 8 ; 21 : curredit := 5; 22 : curredit := 20 ; 25 : curredit := 26 ; 26 : curredit := 9 ; end ; end ; procedure downone(var curredit : integer) ; begin case curredit of 2, 3, 4, 10, 11, 13, 14, 15, 17, 18, 19, 22, 23 : curredit := curredit + 1 ; 6 : curredit := 8 ; 5 : curredit := 9 ; 8 : curredit := 13 ; 9 : curredit := 26 ; 12, 16, 24 : curredit := 2 ; 20 : curredit := 22 ; 21 : curredit := 13 ; 25 : curredit := 11; 26 : curredit := 10; end ; end ; procedure rightone(var curredit : integer) ; begin case curredit of 9 , 11 , 12 : curredit := curredit + 4 ; 14 : curredit := 19 ; 15 : curredit := 22 ; 16 : curredit := 24 ; 21 : curredit := 17 ; 13 : curredit := 21 ; 23,24 : curredit := 12 ; 17 , 18 : curredit := curredit - 7 ; 19 : curredit := 10 ; 20, 22 : curredit := 11 ; 3 , 5 : curredit := curredit + 3 ; 6 : curredit := curredit - 2 ; 2 , 4 , 8 : curredit := curredit + 1 ; 10 : curredit := 25; 25,26 : curredit := 14; end ; end ; procedure leftone(var curredit : integer) ; begin case curredit of 13 , 15, 18 : curredit := curredit - 4 ; 16, 20 : curredit := 15; 19 : curredit := 14; 22,23,24 : curredit := 16 ; 21 : curredit := 13 ; 14 : curredit := 25; 25 : curredit := 10; 17 : curredit := 21 ; 10 , 11 , 12 : curredit := curredit + 7 ; 26 : curredit := 17 ; 9 : curredit := 8 ; 6 , 8 : curredit := curredit - 3 ; 4 : curredit := curredit + 2 ; 5 : curredit := 4 ; 3 : curredit := 2 ; 2 : curredit := 24 ; end ; end ; function class(ch: char) : charclass ; begin if ch in ['a'..'z'] then class := lower else if ch in ['A'..'Z'] then class := upper else if ch = ' ' then class := blank else if ch in ['.','!',':',',','(',')','"','-','+','{','}','*','/','\'] then class := punctuation else if ch in ['0'..'9'] then class := digit else if ch = chr(13) then class := enter else class := other end ; procedure stringinput(curredit , maxlen , charnum : integer ; var currrec : ptr ; var next : integer) ; var num , count : integer ; ch : char ; begin ch := chr(charnum) ; num := 0 ; if (ch = '^') and (anti_pad) and (curredit in [4,5]) then begin count := 0 ; repeat repeat until kbstat ; kbread(ch) ; charnum := ord(ch) ; if ch in ['a'..'z','A'..'Z'] then begin write('^',ch) ; num := num + 2 ; count := count + 1 ; if ch in ['a'..'z'] then ch := chr(ord(ch)-96) else ch := chr(ord(ch)-64) ; case curredit of 2 : currrec^.tname[count] := ch ; 3 : currrec^.uname[count] := ch ; 4 : currrec^.uloc[count] := ch ; 5 : currrec^.uphon[count] := ch ; end ; end ; until (charnum in [0,13]) or (num > 30) ; end else if not (class(ch) = other) then begin write(ch) ; num := 1 ; case curredit of 2 : currrec^.tname[num] := ch ; 3 : currrec^.uname[num] := ch ; 4 : currrec^.uloc[num] := ch ; 5 : currrec^.uphon[num] := ch ; end ; while (num < maxlen) and not (charnum in [13,0]) do begin repeat until kbstat ; kbread(ch) ; charnum := ord(ch) ; if (charnum = 8) and (num > 0) then begin write(ch,' ',ch) ; num := num - 1 end ; if (class(ch) <> other) and (class(ch) <> enter) then begin num := num + 1 ; write(ch) ; case curredit of 2 : currrec^.tname[num] := ch ; 3 : currrec^.uname[num] := ch ; 4 : currrec^.uloc[num] := ch ; 5 : currrec^.uphon[num] := ch ; end ; end end ; end ; if charnum = 0 then begin repeat until kbstat ; kbread(ch) ; charnum := ord(ch) ; case charnum of 72 : next := 1 ; 80 : next := 2 ; 75 : next := 3 ; 77 : next := 4 ; otherwise next := 2 ; end end else next := 2 ; if num <> 0 then case curredit of 2 : currrec^.tnnum := num ; 3 : currrec^.unnum := num ; 4 : currrec^.ulnum := num ; 5 : currrec^.uphnum := num end end ; procedure toggle(curredit : integer ; var currrec : ptr) ; var temp , temp1 : byte ; begin case curredit of 6 : begin currrec^.x29pars[13] := currrec^.x29pars[13] + 1 ; if currrec^.x29pars[13] = 8 then currrec^.x29pars[13] := 0 else if currrec^.x29pars[13] = 2 then currrec^.x29pars[13] := 4 ; end ; 8 : begin currrec^.odds[1] := currrec^.odds[1] + 1 ; if currrec^.odds[1] = 4 then currrec^.odds[1] := 0 ; end ; 9 : begin temp := currrec^.flags1 ; temp1 := currrec^.handshake ; if bitset(0,temp) then if bitset(7,temp1) then resetbit(7,temp1) else begin resetbit(0,temp) ; setbit(1,temp) ; end else if bitset(1,temp) then begin resetbit(1,temp) ; setbit(7,temp1) ; end else if bitset(7,temp1) then resetbit(7,temp1) else begin setbit(7,temp1) ; setbit(0,temp) ; end ; currrec^.handshake := temp1 ; currrec^.flags1 := temp ; end ; 11 : begin temp := currrec^.handshake ; if bitset(5,temp) then resetbit(5,temp) else setbit(5,temp) ; currrec^.handshake := temp ; end ; 12 : begin temp := currrec^.handshake ; if bitset(2,temp) then if bitset(1,temp) then begin resetbit(1,temp) ; resetbit(2,temp) end else setbit(1,temp) else if bitset(1,temp) then begin setbit(2,temp) ; resetbit(1,temp) end else setbit(1,temp) ; currrec^.handshake := temp end ; 14 : if currrec^.x29pars[1] = 0 then currrec^.x29pars[1] := 1 else currrec^.x29pars[1] := 0 ; 17 : if currrec^.odds[2] = 127 then currrec^.odds[2] := 255 else currrec^.odds[2] := 127 ; 18 : begin currrec^.x29pars[11] := currrec^.x29pars[11] + 1 ; if currrec^.x29pars[11] = 16 then currrec^.x29pars[11] := 20 else if currrec^.x29pars[11] = 5 then currrec^.x29pars[11] := 11 else if currrec^.x29pars[11] = 23 then currrec^.x29pars[11] := 25 else if currrec^.x29pars[11] = 26 then currrec^.x29pars[11] := 2 end ; 19 : if currrec^.x29pars[2] = 0 then currrec^.x29pars[2] := 1 else currrec^.x29pars[2] := 0 ; 20 : if currrec^.x29pars[15] = 0 then currrec^.x29pars[15] := 1 else currrec^.x29pars[15] := 0 ; end ; set_draw(curredit,currrec) ; end ; procedure promptfornum(str : string ; var value : integer) ; var charnum : integer ; ch : char ; begin repeat hlighton ; poscur(22,1) ; write(str) ; value := 0 ; repeat repeat until kbstat ; kbread(ch) ; charnum := ord(ch) ; if charnum in [48..57] then begin write(ch) ; value := value*10 + (charnum - 48) ; end ; until (charnum in [0,13]) or (value > 256) ; hlightoff ; poscur(22,1) ; write(' ') ; hlighton until value in [0..255] end ; procedure findsecnum(str : string ; passedto : integer ; var value : integer) ; var ch : char ; begin hlighton ; poscur(22,1) ; write(str,chr(passedto)) ; value := charnum-48 ; repeat repeat repeat until kbstat ; kbread(ch) ; charnum := ord(ch) until charnum in [0,13,48..57] ; write(ch) ; if ch in ['0'..'9'] then value := value*10 + (ord(ch) - 48) until (charnum = 13) or (value > 256) ; hlightoff ; poscur(22,1) ; write(' ') ; hlighton ; if not (value in [0..255]) then promptfornum(str,value) end ; procedure toggleinput(charnum , curredit : integer ; var currrec : ptr) ; var ch : char ; value : integer ; temp : byte ; begin case curredit of 10 : begin promptfornum('Enter timeout period : ',value) ; currrec^.x29pars[4] := value ; temp := currrec^.flags2 ; if value = 0 then resetbit(1,temp) else setbit(1,temp) ; currrec^.flags2 := temp ; end ; 25 : begin promptfornum('Enter 1 for EOLN , 2 for special chars : ',value) ; if value = 1 then currrec^.x29pars[3] := 2 else begin promptfornum('Enter special chars code : ',value) ; currrec^.x29pars[3] := value end end ; 26: begin promptfornum('Enter break action required: ',value) ; if value in [0,1,2,5,8,21] then currrec^.x29pars[7] := value ; end; 22: begin promptfornum('Enter delete character code: ',value) ; currrec^.x29pars[16] := value end; 23: begin promptfornum('Enter delete line code: ',value) ; currrec^.x29pars[17] := value end; 24: begin promptfornum('Enter display line code: ',value) ; currrec^.x29pars[18] := value end; 13: if charnum = 32 then if currrec^.odds[4] = 0 then begin promptfornum('Enter lines per page: ',value) ; currrec^.odds[4] := value end else currrec^.odds[4] := 0 else if charnum in [48..57] then begin findsecnum('Enter lines per page: ',charnum,value) ; currrec^.odds[4] := value end ; 15: if charnum = 32 then if currrec^.x29pars[14] = 0 then begin promptfornum('Enter number of padding characters : ',value) ; currrec^.x29pars[14] := value end else currrec^.x29pars[14] := 0 else if charnum in [48..57] then begin findsecnum('Enter number of padding characters : ',charnum,value) ; currrec^.x29pars[14] := value end ; 16: if charnum = 32 then if currrec^.odds[3] = 0 then begin promptfornum('Enter repeat time (1/10 sec) : ',value) ; currrec^.odds[3] := value end else currrec^.odds[3] := 0 else if charnum in [48..57] then begin findsecnum('Enter repeat time (1/10 sec) : ',charnum,value) ; currrec^.odds[3] := value end ; 21: if charnum = 32 then if currrec^.x29pars[10] = 0 then begin promptfornum('Enter width of page : ',value) ; currrec^.x29pars[10] := value end else currrec^.x29pars[10] := 0 else if charnum in [48..57] then begin findsecnum('Enter width of page : ',charnum,value) ; currrec^.x29pars[10] := value end ; end ; end ; function checkname(var currrec : ptr) : boolean ; var runthrough : ptr ; loop : integer ; currname , nextname : string ; notvalid : boolean ; begin if currrec^.tnnum = 0 then checkname := false else begin runthrough := list_header ; currname := '' ; notvalid := false ; for loop := 1 to currrec^.tnnum do begin if currrec^.tname[loop] in ['a'..'z'] then currrec^.tname[loop] := chr(ord(currrec^.tname[loop]) - 32) else if currrec^.tname[loop] in [' ',',','.','+','/','\'] then notvalid := true ; currname := concat(currname,currrec^.tname[loop]) ; end ; if (not (currname[1] in ['A'..'Z'])) or notvalid then checkname := false else begin runthrough := list_header ; while runthrough <> nil do if runthrough = currrec then runthrough := runthrough^.next else begin nextname := '' ; for loop := 1 to runthrough^.tnnum do nextname := concat(nextname,runthrough^.tname[loop]) ; if (pos(nextname,currname) <> 0) or (pos(currname,nextname) <> 0) then notvalid := true ; runthrough := runthrough^.next end ; checkname := not notvalid end end ; if notvalid then begin poscur(22,1) ; writeln('Invalid name, please re-enter.') ; for loop := 1 to 100000 do ; hlightoff ; poscur(22,1) ; writeln(' ') ; hlighton end ; end ; begin initialise(xypos,incomingcall,pbstr,insert) ; setupscreen(currrec) ; with currrec^ do begin for loop := 1 to 26 do begin poscur(xypos[loop,1],xypos[loop,2]) ; set_draw(loop,currrec) ; end ; curredit := 2 ; endofinput := false ; repeat hlighton ; poscur(xypos[curredit,1],xypos[curredit,2]) ; set_draw(curredit,currrec) ; repeat until keystatus(zerochar,charnum) ; if zerochar then begin hlightoff ; poscur(xypos[curredit,1],xypos[curredit,2]) ; set_draw(curredit,currrec) ; case charnum of 45 : begin endofinput := true ; hlightoff ; end ; 72 : upone(curredit) ; 80 : downone(curredit) ; 77 : rightone(curredit) ; 75 : leftone(curredit) ; otherwise dummy := 1 ; end ; end else if charnum = 27 then begin endofinput := true; hlightoff; end else if charnum = 13 then begin hlightoff ; poscur(xypos[curredit,1],xypos[curredit,2]) ; set_draw(curredit,currrec) ; if curredit = 6 then curredit := 8 else curredit := curredit + 1 ; if curredit > 21 then curredit := 2 ; end else begin poscur(xypos[curredit,1],xypos[curredit,2]) ; case xypos[curredit,4] of 0 : begin first := false ; nameok := false ; while not nameok do begin poscur(xypos[curredit,1],xypos[curredit,2]) ; for loop := 1 to xypos[curredit,3] do write(' ') ; poscur(xypos[curredit,1],xypos[curredit,2]) ; if first then begin repeat repeat until keystatus(zerochar,charnum) ; until (not zerochar) and (charnum in [65..90,97..122]) ; end ; first := false ; stringinput(curredit,xypos[curredit,3],charnum,currrec,dummy) ; if curredit = 2 then nameok := checkname(currrec) else nameok := true end ; hlightoff ; poscur(xypos[curredit,1],xypos[curredit,2]) ; set_draw(curredit,currrec) ; case dummy of 1 : upone(curredit) ; 2 : downone(curredit) ; 3 : leftone(curredit) ; 4 : rightone(curredit) end end ; 1 : if charnum = 32 then toggle(curredit,currrec) ; 2 : toggleinput(charnum,curredit,currrec) ; end ; end ; until endofinput ; chcksum := con + numitems ; for loop := 2 to 212 do chcksum := chcksum + code[loop] ; chcksum := chcksum mod 256 ; if chcksum =0 then chck := 0 else chck := 256 - chcksum end ; end ; procedure erasecopym(portcnt:integer); var j : integer; begin poscur(20,16); write(' '); poscur(20,36); write(' '); poscur(22,1); write(' '); for j:= portcnt+1 downto 0 do begin poscur(j+2,11); write(' ') ; end; j:=1; end; function pickcopy(list_header:ptr): integer ; var runthrough : ptr ; i,portcnt,j,charn,loop : integer ; nextname : string ; names:array[1..16] of string; finished:boolean; ch:char; begin runthrough := list_header ; portcnt:=0; while runthrough <> nil do begin nextname:=''; for loop := 1 to runthrough^.tnnum do nextname:= concat(nextname,runthrough^.tname[loop]) ; runthrough := runthrough^.next; portcnt:=portcnt+1; names[portcnt]:=nextname; end ; poscur(2,11); write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»') ; for j:= 1 to portcnt do begin poscur(j+2,11); write('º º') ; poscur(j+2,13); write(names[j]); end; poscur(portcnt+3,11); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍͼ') ; j:=1; finished:=false; poscur(20,16); write('Source'); poscur(20,36); write('Target'); poscur(22,1); hlighton; write('Move to SOURCE terminal required and press ENTER (Esc to abort).'); hlightoff; repeat poscur(j+2,13); hlighton; write(names[j]); hlightoff; repeat until kbstat; kbread(ch); poscur(j+2,13); write(names[j]); charn:=ord(ch); if (charn=72) then if j>1 then j:=j-1 else j:=portcnt; if (charn=80) then if j0 then write(pmenu[j]); if (charn=72) then if j>1 then j:=j-1 else j:=3; if (charn=80) then if j<3 then j:=j+1 else j:=1 ; if (charn=27) then begin finished:=true; pickexit:=false; end; if (charn=75) then begin finished:=true; pickexit:=false; end; if (charn=13) then begin finished:=true; if j=1 then pickexit:=true; if j=2 then begin pickexit:=true; alldone := list_header ; assign(fp,cfgfile) ; rewrite(fp) ; while alldone <> nil do begin write(fp,alldone^) ; alldone := alldone^.next end; close(fp); end; if j=3 then pickexit:=false; end; until finished; erasepickex; end; procedure copyconfig(i,j:integer;list_header,copy_header:ptr;name:string); var tempptr,sourcrec,destrec : ptr; loop : integer; begin sourcrec := copy_header ; for loop:=1 to i-1 do sourcrec:= sourcrec^.next; destrec := list_header ; for loop:=1 to j-1 do destrec:= destrec^.next; tempptr:=destrec^.next; destrec^:=sourcrec^; destrec^.next:=tempptr; for loop:=1 to 12 do destrec^.tname[loop]:=' '; for loop:=1 to length(name) do destrec^.tname[loop]:=name[loop]; destrec^.tnnum:=length(name); destrec^.termnumber:=j-1; end; function pickname(list_header:ptr;copy_header:ptr;copyp:boolean;cfgf:string20): integer ; var runthrough : ptr ; copyport,i,portcnt,j,charn,loop : integer ; nextname : string ; names:array[1..16] of string; finished:boolean; ch:char; begin runthrough := list_header ; portcnt:=0; copyport:=0; while runthrough <> nil do begin nextname:=''; for loop := 1 to runthrough^.tnnum do nextname:= concat(nextname,runthrough^.tname[loop]) ; runthrough := runthrough^.next; portcnt:=portcnt+1; names[portcnt]:=nextname; end ; poscur(2,31); write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»') ; for j:= 1 to portcnt do begin poscur(j+2,31); write('º º') ; poscur(j+2,33); write(names[j]); end; poscur(portcnt+3,31); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍͼ') ; j:=1; finished:=false; repeat poscur(j+2,33); hlighton; write(names[j]); hlightoff; repeat until kbstat; kbread(ch); poscur(j+2,33); write(names[j]); charn:=ord(ch); if (charn=75) and (copyp) then begin copyport:=pickcopy(copy_header); if copyport<>0 then begin poscur(1,32); hlighton; write('COPY'); hlightoff; end; end; if charn=77 then if pickexit(list_header,cfgf) then begin finished:=true; pickname:=0; end; if (charn=72) then if j>1 then j:=j-1 else j:=portcnt; if (charn=80) then if j0 then begin copyconfig(copyport,j,list_header,copy_header,names[j]); copyport:=0; poscur(1,32); hlighton; write('edit'); hlightoff; poscur(21,36); flashon; write('COPYING'); flashoff; erasecopym(16); wait(50); poscur(21,36); write(' '); end else begin finished:=true; pickname:=j; end; end; until finished; end; procedure editdata(cfgfile:string20;copyfile:string20) ; var ch1 , ch2 : char ; value, loop : integer ; finished,copyp,all : boolean ; xiname : string4 ; filename : string20 ; currrec , alldone : ptr ; begin if fstat(copyfile) then begin readcopyfile(copyfile); copyp:=true; end else copyp:=false; if fstat(cfgfile) then begin readfromfile(cfgfile) ; finished:=false; repeat cls; hlighton; write('Move to port and press to edit. Cursor right to exit.') ; hlightoff; if copyp then begin poscur(1,36); hlighton; write(', cursor left to copy, c'); hlightoff; end; value:=pickname(list_header,copy_header,copyp,cfgfile); if value<>0 then begin currrec := list_header ; for loop:=1 to value-1 do currrec:= currrec^.next; cls; editterm(currrec) end else finished:=true; until finished; end; end ; begin end.