From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import

---
 app/baisy/2.2.1-schulis/src/longrow | 38 +++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)
 create mode 100644 app/baisy/2.2.1-schulis/src/longrow

(limited to 'app/baisy/2.2.1-schulis/src/longrow')

diff --git a/app/baisy/2.2.1-schulis/src/longrow b/app/baisy/2.2.1-schulis/src/longrow
new file mode 100644
index 0000000..482cb8a
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/longrow
@@ -0,0 +1,38 @@
+PACKET longrowDEFINES LONGROW ,:=,newrow,insert,replace,delete,CAT ,length,
+pos,binsearch,_:TYPE LONGROW =TEXT ;LET nil13bytes="�������������",nil4bytes=
+"����",nilbyte="�",niltext="";TEXT VAR teil2,platzhalter:="��";OP :=(LONGROW 
+VAR r,LONGROW CONST s):CONCR (r):=CONCR (s)END OP :=;LONGROW PROC newrow:
+LONGROW VAR r;CONCR (r):=niltext;rEND PROC newrow;PROC insert(LONGROW VAR row
+,INT CONST wo,was):IF wo>0THEN replace(platzhalter,1,was);INT VAR trennpos:=2
+*wo-1;teil2:=subtext(CONCR (row),trennpos);CONCR (row):=subtext(CONCR (row),1
+,trennpos-1);CONCR (row)CAT platzhalter;CONCR (row)CAT teil2FI END PROC 
+insert;PROC replace(LONGROW VAR row,INT CONST wo,INT CONST was):IF length(row
+)<woTHEN stretch(row,2*wo)FI ;replace(CONCR (row),wo,was)END PROC replace;
+PROC replace(LONGROW VAR row,INT CONST wo,LONGROW CONST was):INT CONST rowl:=
+length(row);INT CONST wasl:=length(was);INT CONST elementpos:=2*wo-1;INT 
+CONST benoetigtelaenge:=wo+wasl-1;IF rowl<benoetigtelaengeTHEN stretch(row,
+benoetigtelaenge+benoetigtelaenge)FI ;replace(CONCR (row),elementpos,CONCR (
+was))END PROC replace;PROC delete(LONGROW VAR row,INT CONST wo):IF wo>0THEN 
+INT VAR trennpos:=2*wo+1;teil2:=subtext(CONCR (row),trennpos);CONCR (row):=
+subtext(CONCR (row),1,trennpos-3);CONCR (row)CAT teil2FI END PROC delete;OP 
+CAT (LONGROW VAR row,INT CONST was):replace(platzhalter,1,was);CONCR (row)
+CAT platzhalterEND OP CAT ;INT OP _(LONGROW CONST row,INT CONST i):CONCR (row
+)ISUB iEND OP _;INT PROC pos(LONGROW CONST row,INT CONST wert):INT VAR start
+:=0;replace(platzhalter,1,wert);REP start:=pos(CONCR (row),platzhalter,start+
+1)UNTIL gefundenCOR stringendePER ;(start+1)DIV 2.gefunden:((startMOD 2)=1).
+stringende:start=0.END PROC pos;INT PROC length(LONGROW CONST row):length(
+CONCR (row))DIV 2END PROC length;PROC binsearch(LONGROW CONST ordnung,TEXT 
+CONST muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner,INT VAR indord):
+starteindenvorgegebenengrenzen;setzeaufdiemitte;WHILE nichtgefundenREP IF 
+NOT kleineralsvergleichselementTHEN untererhinterdiemitteELSE 
+obereristdiemitteFI ;IF nichtgefundenTHEN setzeaufdiemitteELSE 
+setzeaufunterenFI PER ;gibordnungsindex.starteindenvorgegebenengrenzen:INT 
+VAR m,u:=1,o:=length(ordnung)+1.setzeaufdiemitte:m:=(u+o)DIV 2.nichtgefunden:
+o>u.untererhinterdiemitte:u:=m+1.obereristdiemitte:o:=m.setzeaufunteren:m:=u.
+kleineralsvergleichselement:kleiner(muster,vergleichselement).
+vergleichselement:(ordnung_m).gibordnungsindex:indord:=m.END PROC binsearch;
+PROC stretch(LONGROW VAR row,INT CONST laenge):WHILE LENGTH CONCR (row)<=
+laenge-13REP CONCR (row)CAT nil13bytesPER ;WHILE LENGTH CONCR (row)<=laenge-4
+REP CONCR (row)CAT nil4bytesPER ;WHILE LENGTH CONCR (row)<laengeREP CONCR (
+row)CAT nilbytePER END PROC stretch;END PACKET longrow;
+
-- 
cgit v1.2.3