SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00011 TEXT EDITING ROUTINES 1 05-28-9314:08ALL SWAG SUPPORT TEAM CENTER1.PAS IMPORT 5 F╔╧x {π>Anyways, does anyone here have a quick and easy Procedure orπ>Function For centering Text?π}ππProgram CenterIt_Demo;ππUsesπ Crt;ππ{ Display a String centered on the screen. }πProcedure DisplayCenter(st_Temp : String; by_Yaxis : Byte);πbeginπ GotoXY(((Succ(Lo(WindMax)) - Length(st_Temp)) div 2), by_Yaxis);π Writeln(st_Temp);πend; {DisplayCenter. }ππVarπ by_OldAttr : Byte;ππbeginπ ClrScr;π DisplayCenter('The Spirit of Elvis says... Hi!', 10);π ReadKey;πend.π 2 05-28-9314:08ALL SWAG SUPPORT TEAM CENTER2.PAS IMPORT 3 F╔╠V { Center Text }ππUses Crt;πVarπ s : String;π i : Integer;πbeginπ Write('String? ');π readln(s);π i := (succ(lo(windmax)) - length(s)) shr 1;π gotoXY(i,10);π Write(s);πend.π 3 05-28-9314:08ALL SWAG SUPPORT TEAM FORMAT1.PAS IMPORT 14 F╔8ë {π> - How can I get TP to make what ever the user enters in to CAPS or │π> NONCAPS? Example: │π> Enter Name -> ChRiS BrAtEnE │π> Your name is Chris Bratene? (Y/n)? │πππI just wrote a routine that does this on the fly, so to speak, Forπanother user, and I haven't erased it yet, so here it is (slightlyπmodified, so that it Forces lowerCase, too):π}ππUsesπ Crt;ππProcedure Backspace;πbeginπ Write(#8' '#8)πend;ππFunction LoCase(ch : Char) : Char;πbeginπ if ch in ['A'..'Z'] thenπ LoCase := Char(ord(ch)+32)π elseπ LoCase := ch;πend;ππProcedure Dibble(Var st : String);π{ Forces upperCase For first letter in each Word,π lowerCase For other letters. }πVarπ len : Byte Absolute st;π ch : Char;ππ Function ForceCap : Boolean;π beginπ ForceCap := (len = 0) or (st[len] = ' ');π end;ππbeginπ st := '';π Repeatπ ch := ReadKey;π if ForceCap thenπ ch := upCase(ch)π elseπ ch := LoCase(ch);π Case ch ofπ #8 : if len > 0 thenπ beginπ Backspace;π dec(len);π end;π #27 : While len > 0 doπ beginπ BackSpace;π dec(len);π end;π #0 : ch := ReadKey;ππ elseπ beginπ Write(ch);π st := st + ch;π end;ππ end;π Until ch in [#13,#27];ππ Writeln;ππend;πππVarπ st : String;ππbegin { test }π Writeln;π Write('Enter String: ');π Dibble(st);π Writeln(st);πend.π 4 05-28-9314:08ALL SEAN L. PALMER GHOSTED.PAS IMPORT 77 F╔¬ TR>Can anyone (please, it's important) , post here an example of a source codeπTR>that will show a text file , and let me scroll it (Up , Down ) ?πTR>Also I need an example of a simple editor.ππTry this for an example. Turbo Pascal 6.0+ source.πCompiles to a 7K text editor. Neat?ππ{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}π{$M $C00,0,0}πprogram ghostEd; {Ghost Editor v0.4 (C) 1993 Sean L. Palmer}πconstπ version='0.4';π maxF=$3FFF; {only handles small files!}π txtColor=$B;π vSeg:word=$B800;πvarπ nLines:byte;π halfPage:byte;π txt:array[0..maxF]of char;π crs,endF,pgBase,lnBase:integer;π x,y:word;π update:boolean;π theFile:file;π ticks:word absolute $40:$6C; {ticks happen 18.2 times/second}ππprocedure syncTick;var i:word;begin i:=ticks;repeat until i<>ticks;end;ππfunction readKey:char;assembler;asm mov ah,$07; int $21; end;ππfunction keyPressed:boolean;assembler;asm mov ah,$B; int $21; and al,$FE;πend; ππprocedure moveScrUp(s,d,n:word);assembler;asmπ mov cx,n;π push ds;π mov ax,vSeg; mov es,ax; mov ds,ax;π mov si,s; shl si,1;π mov di,d; shl di,1;π cld; repz movsw; {attr too!}π pop ds; @X:π end;ππprocedure moveScrDn(s,d,n:word);assembler;asmπ mov cx,n;π push ds;π mov ax,vSeg; mov es,ax; mov ds,ax;π mov si,s; add si,cx; shl si,1;π mov di,d; add di,cx; shl di,1;π std; repz movsw; {attr too!}π pop ds; @X:π end;ππprocedure moveScr(var s;d,n:word);assembler;asmπ mov cx,n; jcxz @X;π push ds;π mov ax,vSeg; mov es,ax;π mov di,d; shl di,1;π lds si,s;π cld;π@L: movsb; inc di; loop @L;π pop ds; @X:π end;ππprocedure fillScr(d,n:word;c:char);assembler;asmπ mov cx,n; jcxz @X;π mov ax,vSeg; mov es,ax;π mov di,d; shl di,1;π mov al,c; cld;π@L: stosb; inc di; loop @L;π@X:π end;ππprocedure fillAttr(d,n:word;c:byte);assembler;asmπ mov cx,n; jcxz @X;π mov ax,vSeg; mov es,ax;π mov di,d; shl di,1;π mov al,c; cld;π@L: inc di; stosb; loop @L;π@X:π end;ππprocedure cls;beginπ fillAttr(80,pred(nLines)*80,txtColor);π fillScr(80,pred(nLines)*80,' ');π end;ππprocedure scrollUp;beginπ moveScrUp(320,160,pred(nLines)*160);π fillScr(pred(nLines)*160,80,' ');π end;πprocedure scrollDn;beginπ moveScrDn(160,320,pred(nLines)*320);π fillScr(160,80,' ');π end;ππ{put cursor after preceding CR or at 0}πfunction scanCrUp(i:integer):integer;assembler;asmπ mov di,i; mov cx,di; add di,offset txtπ mov ax,ds; mov es,ax;π std; mov al,$D;π dec di;π repnz scasb;π jnz @S; inc di; @S:π inc di;π sub di,offset txt;π mov ax,di;π end;ππ{put cursor on next CR or endF}πfunction scanCrDn(i:integer):integer;assembler;asmπ mov di,i; mov cx,endF;π sub cx,di; inc cx; add di,offset txt;π mov ax,ds; mov es,ax;π cld; mov al,$D;π repnz scasb;π dec di;π sub di,offset txt;π mov ax,di;π end;ππprocedure findxy;beginπ lnBase:=scanCrUp(crs);x:=crs-lnBase;π y:=1;pgBase:=lnBase;π while(pgBase>0)and(y<halfPage) do beginπ pgBase:=scanCrUp(pred(pgBase)); inc(y);π end;π end;ππprocedure display;var i,j,k,oldY:integer;beginπ findXY;π if update then beginπ update:=false;π j:=pgBase;i:=1;π while (j<=endf) and (i<pred(nLines)) do beginπ k:=scanCrDn(j);π moveScr(txt[j],i*80,k-j);π fillScr(i*80+k-j,80-k+j,' ');π fillAttr(i*80,80,txtColor);π j:=succ(k); inc(i);π end;π if i<pred(nLines) then beginπ fillScr(i*80,80*pred(nLines-i),'X');π fillAttr(i*80,80*pred(nLines-i),1);π end;π endπ else beginπ>>> Continued to next messageππ * OLX 2.2 * "Could you continue your petty bickering? I find it most ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)ππ>>> Continued from previous messageπ i:=scanCrDn(lnBase)-lnBase;π moveScr(txt[lnBase],y*80,i);π fillScr(y*80+i,80-i,' ');π end;π end;ππconst menuStr:string='Ghost Editor v'+version+'-(C) Sean Palmer 1993';πprocedure title;beginπ fillAttr(0,80,$70);fillScr(0,80,' ');π MoveScr(MenuStr[1],1,length(MenuStr));π end;ππprocedure error(s:string);beginπ fillattr(0,80,$CE);fillScr(0,80,' ');π moveScr(s[1],1,length(s));π write(^G);readkey;π title;π end;ππprocedure tooBigErr;begin error('File too big');end;ππprocedure insChar(c:char);forward;πprocedure delChar;forward;πprocedure backChar;forward;ππprocedure trimLine;var i,t,b:integer;beginπ i:=crs;π b:=scanCrDn(crs); t:=scanCrUp(crs);π crs:=b;π while txt[crs]=' ' do beginπ delchar;π if i>crs then dec(i);π if crs>0 then dec(crs);π end;π crs:=i;π end;ππprocedure checkWrap(c:integer);var i,t,b:integer;beginπ b:=scanCrDn(c); t:=scanCrUp(c);π i:=b;π if i-t>=79 then beginπ i:=t+79;π repeat dec(i); until (txt[i]=' ')or(i=t);π if i=t then backChar {just disallow lines that long with no spaces}π else beginπ txt[i]:=^M; {change sp into cr, to wrap}π update:=true;π if (b<endF)and(txt[b]=^M)and(txt[succ(b)]<>^M) then beginπ txt[b]:=' '; {change cr into sp, to append wrapped part to next line}π checkWrap(b); {recursively check next line since it got stuff added}π end;π end;π end;π end;ππprocedure changeLines;beginπ trimLine; update:=true; {signal to display to redraw}π end;ππprocedure insChar(c:char);beginπ if endf=maxF then begin tooBigErr;exit;end;π move(txt[crs],txt[succ(crs)],endf-crs);π txt[crs]:=c;inc(crs);inc(endf);π if c=^M then changeLines;π checkWrap(crs);π end;πprocedure delChar;beginπ if crs=endf then exit;π if txt[crs]=^M then changeLines;π move(txt[succ(crs)],txt[crs],endf-crs);π dec(endf);π checkWrap(crs);π end;ππprocedure addLF;var i:integer;beginπ for crs:=endF downto 1 do if txt[pred(crs)]=^M then beginπ insChar(^J); dec(crs);π end;π end;ππprocedure stripLF;var i:integer;beginπ for crs:=endF downto 0 do if txt[crs]=^J then delChar;π end;ππprocedure writeErr;begin error('Write Error');end;ππprocedure saveFile;beginπ addLF;π rewrite(theFile,1);π if ioresult<>0 then writeErrπ else beginπ blockwrite(theFile,txt,endf);π if ioresult<>0 then writeErr;π close(theFile);π end;π end;ππprocedure newFile;begin crs:=0;endF:=0;update:=true;end;ππprocedure readErr;begin error('Read Error');end;ππprocedure loadFile;var i,n:integer;beginπ reset(theFile,1);π if ioresult<>0 then newFileπ else beginπ n:=filesize(theFile);if n>maxF then begin tooBigErr;n:=maxF;end;π blockread(theFile,txt,n,i);if i<n then readErr;π close(theFile);π crs:=0;endf:=i;update:=true;π stripLF;π end;π end;ππprocedure signOff;var f:file;i,n:integer;beginπ assign(f,'signoff.txt');π reset(f,1);π if ioresult<>0 then error('No SIGNOFF.TXT defined') {no macro defined}π else beginπ n:=filesize(f);π blockread(f,txt[endF],n,i);if i<n then readErr;π close(f);π inc(endf,i);update:=true;π i:=crs; stripLF; crs:=i; {stripLF messes with crs}π end;π end;ππprocedure goLf;beginπ if crs>0 then dec(crs);π if txt[crs]=^M then changeLines;π end;πprocedure goRt;beginπ if txt[crs]=^M then changeLines;π if crs<endf then inc(crs);π end;πprocedure goCtrlLf;var c:char;beginπ repeat goLf;c:=txt[crs];until (c<=' ')or(crs=0);π end;πprocedure goCtrlRt;var c:char;beginπ repeat goRt;c:=txt[crs];until (c<=' ')or(crs>=endF);π end;πprocedure goUp;var i:integer;beginπ if lnBase>0 then beginπ changeLines;π lnBase:=scanCrUp(pred(lnBase));crs:=lnBase;π i:=scanCrDn(crs)-crs;π>>> Continued to next messageππ * OLX 2.2 * "Could you continue your petty bickering? I find it most ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π π π >>> Continued from previous messageπ if i>=x then inc(crs,x) else inc(crs,i);π end;π end;πprocedure goDn;var i:integer;beginπ changeLines;π crs:=scanCrDn(crs);if crs>=endF then exit;π inc(crs);lnBase:=crs;π i:=scanCrDn(crs)-crs;π if i>=x then inc(crs,x) else inc(crs,i);π end;πprocedure goPgUp;var i:byte;begin for i:=halfPage downto 0 do goUp; end;πprocedure goPgDn;var i:byte;begin for i:=halfPage downto 0 do goDn; end;πprocedure goHome;begin crs:=scanCrUp(crs); end;πprocedure goEnd;begin crs:=scanCrDn(crs); end;ππprocedure backChar;beginπ if (crs>0) then begin goLf; delChar; end;π end;ππprocedure deleteLine;var i:integer;beginπ i:=scanCrDn(crs);crs:=scanCrUp(crs);π if i<endF then begin move(txt[succ(i)],txt[crs],endf-i); dec(endF);end;π dec(endf,i-crs); changeLines;π end;ππprocedure flipCursor;var j,k,l:word;beginπ j:=succ((y*80+x)shl 1);π l:=mem[vSeg:j]; {save attr under cursor}π mem[vSeg:j]:=$7B; if not keypressed then syncTick;π mem[vSeg:j]:=l; if not keypressed then syncTick;π end;ππprocedure edit;var c:char;beginπ repeatπ display;π repeat flipcursor;until keypressed;π c:=readkey;π if c=#0 then case readkey ofπ #59:signOff;π #75:goLf;π #77:goRt;π #115:goCtrlLf;π #116:goCtrlRt;π #72:goUp;π #80:goDn;π #83:delChar;π #73:goPgUp;π #81:goPgDn;π #71:goHome;π #79:goEnd;π endπ else case c ofπ ^[:saveFile;π ^H:backChar;π ^C:{abortFile};π ^Y:deleteLine;π else insChar(c);π end;π until (c=^[)or(c=^C);π end;ππfunction getRows:byte;assembler;asmπ mov ax,$1130; xor dx,dx; int $10;π or dx,dx; jnz @S; mov dx,24; @S: {cga/mda don't have this fn}π inc dx; mov al,dl;π end;ππvar oldMode:byte;πbeginπ asm mov ah,$F; int $10; mov oldMode,al; end; {save old Gr mode}π if oldMode=7 then vSeg:=$B000; {check for Mono}π nLines:=getRows;π halfPage:=pred(nLines shr 1);π cls; title;π if paramCount=0 then error('Need filename as parameter')π else beginπ asm mov bh,0; mov dl,0; mov dh,nLines; mov ah,2; int $10; end; {put cursorπof assign(theFile,paramStr(1));π loadFile;π edit;π end;π end.ππ * OLX 2.2 * "Could you continue your petty bickering? I find it most ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π π π 5 05-28-9314:08ALL SWAG SUPPORT TEAM WORDWRP1.PAS IMPORT 12 F╔á {This was a Programming contest Program- BTW, this is to VanπSlingerhead, not to Mike...π}πProgram Wordwrap; πUses Crt,Printer; πConstπ max = 10; πVarπ ch : Char;π arr : Array[1..800] of Char;π small,π s : String;π w,π len,π counter : Integer; πbeginπ w := 1;π Writeln; Writeln;π Repeatπ arr[w] := ReadKey;π inc(w);π if arr[w-1] = #8 thenπ beginπ Write(#8' '#8);π if w > 2 thenπ dec(w,2)π elseπ w:= 1;π end { if }π elseπ Write(arr[w-1]);π Until arr[w-1] = #13;π arr[w-1] := ' ';ππ dec(w);π Writeln; Writeln;π For counter := 1 to w doπ Write(arr[counter]);ππ small := '';π len := 0;π Writeln(lst);π Writeln(lst,'123456789012345678901234567890123456789012345');π Writeln(lst,' ^ ^ ^ ^ ^');π For counter := 1 to w doπ beginπ if arr[counter] <> ' ' thenπ beginπ small := small + arr[counter];π inc(len);π endπ elseπ if len <= 45 thenπ beginπ Write(lst,small,' ');π small := '';π inc(len);π endπ elseπ beginπ Writeln(lst);π Write(lst,small,' ');π len := length(small)+1;π small := '';π end; { else }π end; πend.ππ 6 05-28-9314:08ALL SWAG SUPPORT TEAM WORDWRP2.PAS IMPORT 18 F╔a╞ {π> P.S. A pre-made Unit to do a Word-wrap Function might also be nice.π}ππUnit WordWrap;ππInterfaceππUsesπ Crt;ππTypeπ Strn80 = String[80];ππConstπ MaxWordLineLength : Byte = 80;ππVarπ WordLine : Strn80;π Index1 : Byte;π Index2 : Byte;ππProcedure ResetWrapStrn;πProcedure WrapStrn (InputStrn: Strn80);ππImplementationππProcedure ResetWrapStrn;πbeginπ Index1 := 0;π Index2 := 0;π Wordline := '';πend;ππProcedure WrapStrn (InputStrn: Strn80);πVarπ Count : Byte;π InputChar : Char;πbeginπ For Count := 1 to Length (InputStrn) doπ beginπ InputChar := InputStrn[Count];π Case InputChar OFπ ^H: {Write destructive backspace & remove Char from WordLine}π beginπ Write(^H,' ',^H);π DELETE(WordLine,(LENGTH(WordLine) - 1),1)π end;π #0: {user pressed a Function key, so dismiss it}π beginπ InputChar := ReadKey; {Function keys send two-Char scan code!}π InputChar := ' 'π end;π #13: { it is an enter key.. reset everything and start on a new line}π beginπ Writeln;π Index1 := 0; Index2 := 0; Wordline := '';π end;π else {InputChar contains a valid Char, so deal With it}π beginπ Write(InputChar);π WordLine := (WordLine + InputChar);π if (LENGTH(WordLine) >= (MaxWordLineLength - 1)) thenπ {we have to do a Word-wrap}π beginπ Index1 := (MaxWordLineLength - 1);π While ((WordLine[Index1] <> ' ') and (WordLine[Index1] <> '-')π and (Index1 <> 0)) DOπ Index1 := (Index1 - 1);π if (Index1 = 0) then {whoah, no space was found to split line!}π Index1 := (MaxWordLineLength - 1); {forces split}π DELETE(WordLine,1,Index1);π For Index2 := 1 to LENGTH(WordLine) DOπ Write(^H,' ',^H);π Writeln;π Write(WordLine)π endπ endπ end; {CASE InputChar}π end;πend;ππbegin {WordWrap}π{Initialize the Program.}πWordLine := '';πIndex1 := 0;πIndex2 := 0;πend.π 7 05-28-9314:08ALL SWAG SUPPORT TEAM WORDWRP3.PAS IMPORT 28 F╔╠₧ Varπ S : String;ππFunction Wrap(Var st: String; maxlen: Byte; justify: Boolean): String;π { returns a String of no more than maxlen Characters With the last }π { Character being the last space beFore maxlen. On return st now has }π { the remaining Characters left after the wrapping. }π Constπ space = #32;π Varπ len : Byte Absolute st;π x,π oldlen,π newlen : Byte;ππ Function JustifiedStr(s: String; max: Byte): String;ππ { Justifies String s left and right to length max. if there is more }π { than one trailing space, only the right most space is deleted. The}π { remaining spaces are considered "hard". #255 is used as the Char }π { used For padding purposes. This will enable easy removal in any }π { editor routine. }ππ Constπ softSpace = #255;π Varπ jstr : String;π len : Byte Absolute jstr;π beginπ jstr := s;π While (jstr[1] = space) and (len > 0) do { delete all leading spaces }π delete(jstr,1,1);π if jstr[len] = space thenπ dec(len); { Get rid of trailing space }π if not ((len = max) or (len = 0)) then beginπ x := pos('.',jstr); { Attempt to start padding at sentence break }π if (x = 0) or (x =len) then { no period or period is at length }π x := 1; { so start at beginning }π if pos(space,jstr) <> 0 then Repeat { ensure at least 1 space }π if jstr[x] = space then { so add a soft space }π insert(softSpace,jstr,x+1);π x := succ(x mod len); { if eoln is reached return and do it again }π Until len = max; { Until the wanted String length is achieved }π end; { if not ... }π JustifiedStr := jstr;π end; { JustifiedStr }πππ begin { Wrap }π if len <= maxlen then begin { no wrapping required }π Wrap := st;π len := 0;π end else beginπ oldlen := len; { save the length of the original String }π len := succ(maxlen); { set length to maximum }π Repeat { find last space in st beFore or at maxlen }π dec(len);π Until (st[len] = space) or (len = 0);π if len = 0 then { no spaces in st, so chop at maxlen }π len := maxlen;π if justify thenπ Wrap := JustifiedStr(st,maxlen)π elseπ Wrap := st;π newlen := len; { save the length of the newly wrapped String }π len := oldlen; { and restore it to original length beFore }π Delete(st,1,newlen); { getting rid of the wrapped portion }π end;π end; { Wrap }ππbeginπ S :=π'By Far the easiest way to manage a database is to create an '+π'index File. An index File can take many Forms and its size will depend '+π'upon how many Records you want in the db. The routines that follow '+π'assume no more than 32760 Records.';ππWhile length(S) <> 0 doπ Writeln(Wrap(S,60,True));πend.ππWhilst this is tested and known to work on the example String, no furtherπtesting than that has been done. I suggest you test it a great deal moreπbeFore being satisfied that it is OK.ππ 8 08-17-9308:51ALL SWAG SUPPORT TEAM Text Wrapping and JustifyIMPORT 28 F╔ Uses CRT;πvarπ S : string;ππfunction Wrap(var st: string; maxlen: byte; justify: boolean): string;π { returns a string of no more than maxlen characters with the last }π { character being the last space before maxlen. On return st now has }π { the remaining characters left after the wrapping. }π constπ space = #32;π varπ len : byte absolute st;π x,π oldlen,π newlen : byte;ππ function JustifiedStr(s: string; max: byte): string;ππ { Justifies string s left and right to length max. If there is more }π { than one trailing space, only the right most space is deleted. The}π { remaining spaces are considered "hard". #255 is used as the char }π { used for padding purposes. This will enable easy removal in any }π { editor routine. }ππ constπ softSpace = #255;π varπ jstr : string;π len : byte absolute jstr;π beginπ jstr := s;π while (jstr[1] = space) and (len > 0) do { delete all leading spaces }π delete(jstr,1,1);π if jstr[len] = space thenπ dec(len); { Get rid of trailing space }π if not ((len = max) or (len = 0)) then beginπ x := pos('.',jstr); { Attempt to start padding at sentence break }π if (x = 0) or (x =len) then { no period or period is at length }π x := 1; { so start at beginning }π if pos(space,jstr) <> 0 then repeat { ensure at least 1 space }π if jstr[x] = space then { so add a soft space }π insert(softSpace,jstr,x+1);π x := succ(x mod len); { if eoln is reached return and do it again }π until len = max; { until the wanted string length is achieved }π end; { if not ... }π JustifiedStr := jstr;π end; { JustifiedStr }πππ begin { Wrap }π if len <= maxlen then begin { no wrapping required }π Wrap := st;π len := 0;π end else beginπ oldlen := len; { save the length of the original string }π len := succ(maxlen); { set length to maximum }π repeat { find last space in st before or at maxlen }π dec(len);π until (st[len] = space) or (len = 0);π if len = 0 then { no spaces in st, so chop at maxlen }π len := maxlen;π if justify thenπ Wrap := JustifiedStr(st,maxlen)π elseπ Wrap := st;π newlen := len; { save the length of the newly wrapped string }π len := oldlen; { and restore it to original length before }π Delete(st,1,newlen); { getting rid of the wrapped portion }π end;π end; { Wrap }ππbeginπ S :=π'By far the easiest way to manage a database is to create an '+π'index file. An index file can take many forms and its size will depend '+π'upon how many records you want in the db. The routines that follow '+π'assume no more than 32760 records.';ππwhile length(S) <> 0 doπ writeln(Wrap(S,75,true));πReadkey;πend.ππWhilst this is tested and known to work on the example string, no furtherπtesting than that has been done. I suggest you test it a great deal moreπbefore being satisfied that it is OK.ππ 9 08-27-9322:12ALL BRIAN PAPE Write String in ASM IMPORT 9 F╔ {πBRIAN PAPEππOk, I was writing a little program that I was trying to make as small asπpossible, so I wrote this little WriteString function. Since I'm not anπassembly language mogul by any stretch of the imagination, could one ofπyou assembly wizards out there tell me if this is Ok. I mean, it worksπfine (and saves almost 1k over linking in the writeln code), but I wantπto make sure that I'm not trashing a register or something that needs toπbe preserved. Thanks... BTW, anybody, go ahead and use it if itπdoesn't crash!π}ππprocedure WriteString(s : string); assembler;πasmπ push dsπ mov ah, 40h { DOS fcn call 40h write string to file handle }ππ mov dx, seg sπ mov ds, dxπ mov bx, offset sππ mov dx, bx { now put the offset into dx for the fcn call }π inc dx { plus 1, to avoid the length byte }π mov cl, [bx] { cl is length to write }π xor ch, chππ mov bx, 1 { file handle to write to }π int 21hπ pop dsπend;ππ 10 02-03-9407:05ALL MIKE COPELAND Text Word Wrap SWAG9402 25 F╔ π{π Here's some code I found in this echo a number of years ago - I don'tπrecall who should get credit for it. I put it into my own program,πwhich uses some other Units, and I hope I've sanitized it enough to makeπit generic...ππUses a FASTWRITE routine that can be found in SWAG G.D. 02/01/94 }πππprogram WordWrap;πuses CRT;πconstπ FKeyCode = #00;π Space = ' ';π Hyphen = '-';π BackSpace = #08;π C_R = #13;π MaxWordLineLength = 60;π MAXLINES = 6; { Maximum # of lines in "box" }πvarπ WordLine : string[MaxWordLineLength];π Index1 : byte;π Index2 : byte;π InputChar : char;π LINE : byte; { current output line }π LC : byte; { Line Count }π I : Word;π S1 : string;π LA : array[1..MAXLINES] of string[MaxWordLineLength];πbeginπ WordLine := ''; Index1 := 0; Index2 := 0; InputChar := Space;π ClrScr; Write ('Enter text (',MAXLINES:0,' line maximum): ');π for I := 1 to MAXLINES do { clear storage array }π LA[I] := '';π InputChar := ReadKey;π LC := 1; LINE := 6; gotoXY (1,20); { work area }π while LC <= MAXLINES doπ beginπ case InputChar ofπ #13 : begin { C/R - terminate line }π S1 := WordLine;π Writeln (S1); LA[LC] := S1; Inc(LC);π gotoXY (1,20); ClrEol; WordLine := ''π end;π BackSpace:π beginπ Write(BackSpace,Space,BackSpace);π if Length(WordLine) > 0 then Dec(WordLine[0])π end;π FKeyCode: { flush function key }π beginπ InputChar := ReadKey; InputChar := Spaceπ endπ else { valid char }π beginπ Write(InputChar); WordLine := WordLine+InputChar;π if (Length(WordLine) >= (MaxWordLineLength - 1)) thenπ begin { have to do a word-wrap }π Index1 := MaxWordLineLength-1;π while ((WordLine[Index1] <> Space) andπ (WordLine[Index1] <> Hyphen) andπ (Index1 <> 0))π do Dec(Index1);π if (Index1 = 0) then {no space was found to split!}π Index1 := (MaxWordLineLength-1); {forces split}π S1 := Copy(WordLine,1,Index1);π Delete(WordLine,1,Index1);π for Index2 := 1 TO LENGTH(WordLine) doπ Write(BackSpace,Space,BackSpace);π FastWrite (1,LINE,LONORM,S1); Inc(LINE);π LA[LC] := S1; Inc(LC);π gotoXY (1,20) ClrEol; Write(WordLine)π endπ endπ end; {case InputChar}π InputChar := ReadKey {Get next key from user}π end; {while (InputChar <> CarriageReturn)}πend.π 11 02-03-9416:07ALL SWAG SUPPORT TEAM Justification Routine SWAG9402 23 F╔ UNIT JUSTIFY;ππINTERFACEππPROCEDURE JustifyLine (VAR LINE : STRING; Printwidth : BYTE);ππIMPLEMENTATIONππPROCEDURE JustifyLine (VAR LINE : STRING; Printwidth : BYTE);π{ justify line to a length of printwidth by putting extra blanks betweenπ words, from right to left. The line currently has one blank between words.}ππVARπ blanks, {# of blanks to be inserted}π gaps, {# of gaps between words}π n, {amount to expand 1 gap}π dest, {new place for moved char}π source : INTEGER; {source column of that char}π len : BYTE ABSOLUTE Line;ππBEGIN {justify}ππ IF (LINE > '') AND (len < printwidth) THENπ BEGINπ {set hard spaces for indents}π source := 1;π WHILE (LINE [source] = ' ') AND (source < len) DOπ BEGINπ LINE [source] := #0;π INC(source);π END;ππ {count # of gaps between words}π gaps := 0;π FOR source := 1 TO len DOπ IF LINE [source] = ' ' THEN gaps := SUCC (gaps);ππ {find # of blanks needed to stretch the line}π blanks := printwidth - len;π {shift characters to the right, distributing extra blanks}π {between the words (in the gaps)}π dest := printwidth;π source := len;π WHILE gaps > 0 DOπ BEGIN {expand line}π IF LINE [source] <> ' ' THENπ BEGIN {shift char}π LINE [dest] := LINE [source]; {move char, leave blank}π LINE [source] := ' ';π ENDπ ELSEπ BEGIN {leave blanks}π {find # of blanks for this gap, skip that many}π {(now blank) columns}π n := blanks DIV gaps;π dest := dest - n;π gaps := PRED (gaps);π blanks := blanks - n;π END;π {step to next source and dest characters}π source := PRED (source);π dest := PRED (dest)π END; {expand line}ππ LINE[0] := CHR(printwidth);π FOR source := 1 TO len DOπ IF LINE [source] = #0 THEN LINE [source] := #32;π END;ππ END; {justify procedure}πEND.
