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
|
PACKET saveDEFINES save:LET ascii=1,asciigerman=2,transparent=3,rowtext=5,ds=
6,atarist=10,ibm=11,ff="�",ctrlz="�",crlf="
",rowtextmodelength=4000;TEXT
VAR buffer;BOUND STRUCT (INT size,ROW rowtextmodelengthTEXT clusterrow)VAR
clusterstruct;PROC save(TEXT CONST filename,DATASPACE CONST fileds,INT CONST
mode):SELECT modeOF CASE ascii,asciigerman,atarist,ibm,transparent:
savefilemode(fileds,filename,mode)CASE rowtext:saverowtextmode(fileds,
filename)CASE ds:savedsmode(fileds,filename)OTHERWISE errorstop(
"Unzulässige Betriebsart")END SELECT .END PROC save;PROC savefilemode(
DATASPACE CONST filespace,TEXT CONST name,INT CONST codetype):enablestop;
opensavedosfile(name);FILE VAR file:=sequentialfile(modify,filespace);buffer
:="";INT VAR lineno;FOR linenoFROM 1UPTO lines(file)REP toline(file,lineno);
buffercatfileline;WHILE length(buffer)>=clustersizeREP
writenextsavedoscluster(subtext(buffer,1,clustersize));buffer:=subtext(buffer
,clustersize+1)PER PER ;IF asciicodeTHEN bufferCAT ctrlzFI ;writerest;
closesavedosfile;buffer:="".buffercatfileline:exec(PROC (TEXT CONST ,INT
CONST )catadaptedline,file,codetype).asciicode:(codetype=ascii)OR (codetype=
asciigerman).writerest:WHILE buffer<>""REP writenextsavedoscluster(subtext(
buffer,1,clustersize));buffer:=subtext(buffer,clustersize+1)PER .END PROC
savefilemode;PROC catadaptedline(TEXT VAR line,INT CONST codetype):IF
codetype=transparentTHEN bufferCAT lineELSE changeescsequences;
changeeumelprintchars;SELECT codetypeOF CASE ascii:asciichangeCASE
asciigerman:asciigermanchangeCASE atarist:ataristchangeCASE ibm:ibmchangeEND
SELECT ;bufferCAT line;IF (lineSUB length(line))<>ffTHEN bufferCAT crlfFI FI
.changeescsequences:changeall(line,"#page#",ff);INT VAR p:=pos(line,"#");
WHILE p>0REP IF isescsequenceTHEN change(line,p,p+4,codedchar)FI ;p:=pos(line
,"#",p+1)PER .isescsequence:LET digits="0123456789";(lineSUB (p+4))="#"CAND
pos(digits,lineSUB p+1)>0CAND pos(digits,lineSUB p+2)>0CAND pos(digits,line
SUB p+3)>0.codedchar:code(int(subtext(line,p+1,p+3))).changeeumelprintchars:p
:=pos(line,"k"," ",1);WHILE p>0REP replace(line,p,stdchar);p:=pos(line,"k",
" ",p+1)PER .stdchar:"k-# "SUB (code(lineSUB p)-219).asciichange:changeall(
line,"ß","#251#");p:=pos(line,"Ä","ü",1);WHILE p>0REP change(line,p,p,
ersatzdarstellung(lineSUB p));p:=pos(line,"Ä","ü",p+1)PER .asciigermanchange:
changeall(line,"[","#091#");changeall(line,"\","#092#");changeall(line,"]",
"#093#");changeall(line,"{","#123#");changeall(line,"|","#124#");changeall(
line,"}","#125#");changeall(line,"~","#126#");changeall(line,"ß","~");p:=pos(
line,"Ä","ü",1);WHILE p>0REP replace(line,p,umlautinasciigerman);p:=pos(line,
"Ä","ü",p+1)PER .umlautinasciigerman:"[\]{|}"SUB (code(lineSUB p)-213).
ibmchange:changeall(line,"ß","�");p:=pos(line,"Ä","ü",1);WHILE p>0REP replace
(line,p,umlautinibm);p:=pos(line,"Ä","ü",p+1)PER .ataristchange:changeall(
line,"ß","�");p:=pos(line,"Ä","ü",1);WHILE p>0REP replace(line,p,umlautinibm)
;p:=pos(line,"Ä","ü",p+1)PER .umlautinibm:"Ξ��ΔΥΑ"SUB (code(lineSUB p)-213).
END PROC catadaptedline;TEXT PROC ersatzdarstellung(TEXT CONST char):TEXT
CONST t:=text(code(charSUB 1));"#"+(3-length(t))*"0"+t+"#"END PROC
ersatzdarstellung;PROC saverowtextmode(DATASPACE CONST space,TEXT CONST name)
:enablestop;opensavedosfile(name);initsaverowtextmode;WHILE lineno<
clusterstruct.sizeREP fillbuffer;writenextsavedoscluster(subtext(buffer,1,
clustersize));rememberrestPER ;writerest;closesavedosfile;buffer:="".
initsaverowtextmode:clusterstruct:=space;buffer:="";INT VAR lineno:=0.
fillbuffer:WHILE lineno<clusterstruct.sizeAND NOT bufferfullREP linenoINCR 1;
bufferCAT clusterstruct.clusterrow[lineno]PER .bufferfull:LENGTH buffer>=
clustersize.rememberrest:buffer:=subtext(buffer,clustersize+1).writerest:
WHILE buffer<>""REP writenextsavedoscluster(subtext(buffer,1,clustersize));
rememberrestPER .END PROC saverowtextmode;PROC savedsmode(DATASPACE CONST
outds,TEXT CONST name):enablestop;opensavedosfile(name);INT VAR pageno:=
firstnondummydspage;getlastallocateddspage;WHILE pageno<=lastallocateddspage
REP writenextsavedoscluster(outds,pageno);PER ;closesavedosfile.
getlastallocateddspage:INT VAR lastallocateddspage:=-1,i;FOR iFROM 1UPTO
dspages(outds)REP lastallocateddspage:=nextdspage(outds,lastallocateddspage)
PER .END PROC savedsmode;END PACKET save;
|
