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
|
subroutine cvstr(n,line,str,job)
c ------------------------------------------------
c converts from ascii to Scilab internal coding
c call cvstr(n,line,str,job)
c n: integer, length of the string to be converted entier
c line: integer array (where Scilab coded string are stored )
c string: string
c job: integer flag
c 1: code-->ascii
c 0: ascii-->code
c Copyright INRIA/ENPC
c ------------------------------------------------
integer line(*)
character str*(*)
if(job.eq.0) then
call asciitocode(n,line,str,1)
else
call codetoascii(n,line,str)
endif
return
end
subroutine cvstr1(n,line,str,job)
c ------------------------------------------------
c very similar to cvstr but the conversion
c ascii->code is performed from end to the begining
c ------------------------------------------------
integer line(*)
character str*(*)
if(job.eq.0) then
call asciitocode(n,line,str,-1)
else
call codetoascii(n,line,str)
endif
return
end
subroutine codetoascii(n,line,str)
c ---------------------------------------------
c converts from Scilab internal coding to ascii
c Copyright INRIA/ENPC
c ---------------------------------------------
include '../stack.h'
integer eol
c
integer line(*)
character str*(*),mc*1
data eol/99/
c conversion code ->ascii
do 30 j=1,n
m=line(j)
if(m.eq.eol) then
goto 10
elseif(abs(m).gt.csiz) then
if(m.gt.eol) then
str(j:j)=char(m-(eol+1))
else
str(j:j)='!'
endif
elseif(m.lt.0) then
str(j:j)=alfb(abs(m)+1)
else
str(j:j)=alfa(m+1)
endif
goto 30
10 str(j:j)='!'
30 continue
return
end
subroutine asciitocode(n,line,str,flag)
c ---------------------------------------------
c converts from ascii to Scilab internal coding
c flag can be 1 or -1 and this is used when the
c conversion is made with line and str stored at overlapping
c memory zone
c Copyright INRIA/ENPC
c ---------------------------------------------
include '../stack.h'
integer getcode
integer flag
integer line(*)
character str*(*)
if ( flag.eq.1) then
do 50 j=1,n
line(j)= getcode(str(j:j))
50 continue
else
do 51 j=n,1,-1
line(j)= getcode(str(j:j))
51 continue
endif
return
end
integer function getcode(mc)
c ---------------------------------------------
c converts one ascii to Scilab internal code
c Copyright INRIA/ENPC
c ---------------------------------------------
include '../stack.h'
integer eol,k,blank
character mc*1
data eol/99/,blank/40/
do 45 k=1,csiz
if(mc.eq.alfa(k)) then
getcode = k-1
return
elseif(mc.eq.alfb(k)) then
getcode =-(k-1)
return
endif
45 continue
c special characters
c -----------------
if(ichar(mc).eq.0) then
c 0-> eol
getcode=eol
elseif(ichar(mc).eq.9) then
c \t -> ' '
getcode=blank+1
elseif(ichar(mc).eq.10) then
c \n remplace par un eol
getcode=eol
else
getcode=ichar(mc)+eol+1
endif
return
end
|
