Initial import

1 files changed, 61 insertions, 0 deletions

diff --git a/app/baisy/2.2.1-schulis/src/save b/app/baisy/2.2.1-schulis/src/save
new file mode 100644
index 0000000..e634acd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/save
@@ -0,0 +1,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;
+