1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
integer function ivcleof(y,x)
c******************************************************************************
c This routine clears to the end of the screen, beginning with the
c position row=y, column=x. The cursor is then placed at (y,x)
c******************************************************************************
include 'Pstuff.com'
character blank*79
integer y,x,ypos,xpos
write(blank,1001)
1001 format(79(' '))
istat = ivwrite(y,x,blank,79)
xpos = 1
ypos = y
do 11 ipos=ypos,maxline
istat = ivmove(ipos,xpos)
11 istat = ivcleol()
istat = ivmove(y,x)
c
ivcleof = 0
return
end
integer function ivwrite(y,x,arr,ccount)
c
c This routine writes out a string of characters from 'arr',
c with the first character beginning at row=y, column=x. The length
c of the string may be at most 79 characters, and this routine
c will not write on the 80th column or the 25th row of the screen.
c
include 'Pstuff.com'
integer y,x,count,ccount
character arr*(*),dummy*80,string(80)*1,esc*1
equivalence (dummy,string(1))
c
count = ccount
if (y > maxline .or. x > 79) then
ivwrite = -1
return
endif
c
esc = char(27)
dummy = arr
count = min0(80-x,count)
c
if (x < 10) then
if (y < 10) then
write (*,1007) esc,y,x,(string(i),i=1,count)
1007 format(1x,a1,'[',i1,';',i1,'H',80a1)
else
write (*,1006) esc,y,x,(string(i),i=1,count)
1006 format(1x,a1,'[',i2,';',i1,'H',80a1)
endif
else
if (y < 10) then
write (*,1005) esc,y,x,(string(i),i=1,count)
1005 format(1x,a1,'[',i1,';',i2,'H',80a1)
else
write (*,1004) esc,y,x,(string(i),i=1,count)
1004 format(1x,a1,'[',i2,';',i2,'H',80a1)
endif
endif
c
ivwrite = 0
return
end
integer function ivmove(y,x)
c
c This routine moves the cursor to position row=y, column=x.
c It checks to be sure that y does not exceed 'maxline', and x does not
c exceed 79 (the screen limits).
c
include 'Pstuff.com'
integer y,x
character esc*1
c
if (y > maxline .or. x > 79) then
ivmove = -1
return
endif
c
esc = char(27)
c
if (x < 10) then
if (y < 10) then
write (*,1007) esc,y,x
1007 format(1x,a1,'[',i1,';',i1,'H')
else
write (*,1006) esc,y,x
1006 format(1x,a1,'[',i2,';',i1,'H')
endif
else
if (y < 10) then
write (*,1005) esc,y,x
1005 format(1x,a1,'[',i1,';',i2,'H')
else
write (*,1004) esc,y,x
1004 format(1x,a1,'[',i2,';',i2,'H')
endif
endif
c
ivmove = 0
return
end
integer function ivcleol()
c This routine clears to the end of a line, beginning with the current
c cursor position.
c
character*1 esc
c
esc = char(27)
write(*,1001) esc
1001 format(1x,a1,'[K')
c
ivcleol = 0
return
end
integer function ivbold(on)
c
c This routine either turns on the bold-face lettering, if on=1,
c or turns it off, if on=0
c
integer on
character*1 esc
c
esc = char(27)
if(on==1) then
write(*,'(1x,a1,a)') esc,'[1m'
else
write(*,'(1x,a1,a)') esc,'[0m'
endif
c
ivbold = 0
return
end
integer function ivundl(on)
c
c This routine either turns on the underlining of text, if on=1,
c or turns it off.
c
integer on
character*1 esc
c
esc = char(27)
if(on==1) then
write(*,'(1x,a1,a)') esc,'[4m'
else
write(*,'(1x,a1,a)') esc,'[0m'
endif
c
ivundl = 0
return
end
|
