SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00016 SCREEN SCROLLING ROUTINES 1 05-28-9313:56ALL SWAG SUPPORT TEAM SCROLL1.PAS IMPORT 14 B╡=í {π>It's just a Fileviewer, I'm working on. I just want to be able toπ>scroll the File up, down, etc.π}ππProgram ScrollDemo;πUsesπ Crt;πTypeπ UpDown = (Up, Down);π { Scroll Text screen up or down. }ππProcedure Scroll({input } Direction : UpDown;π Lines2Scroll,π Rowtop,π RowBot,π ColStart,π ColStop,π FillAttr : Byte);πbeginπ if (Direction = Up) thenπ Asmπ mov ah, 06hπ mov al, Lines2Scrollπ mov bh, FillAttrπ mov ch, Rowtopπ mov cl, ColStartπ mov dh, RowBotπ mov dl, ColStopπ int 10hπ endπ elseπ Asmπ mov ah, 07hπ mov al, Lines2Scrollπ mov bh, FillAttrπ mov ch, Rowtopπ mov cl, ColStartπ mov dh, RowBotπ mov dl, ColStopπ int 10hπ endπend; { Scroll }ππ{ Pause For a key press. }πProcedure Pause;πVarπ chTemp : Char;πbeginπ While KeyPressed doπ chTemp := ReadKey;π Repeat Until(KeyPressed)πend; { Pause }ππVarπ Index : Byte;π stTemp : String[80];πbeginπ ClrScr;π { Display 24 lines of Text. }π For Index := 1 to 24 doπ beginπ stTemp[0] := #80;π fillChar(stTemp[1], length(stTemp), (Index + 64));π Write(stTemp)π end;π { Pause For a key press. }π Pause;π { Scroll Text down by 1 line. Use the Crt's Textattr }π { Variable as the Text color to fill with. }π Scroll(Down, 1, 0, 24, 0, 79, Textattr);π { Pause For a key press. }π Pause;π { Scroll Text up by 1 line. Use the Crt's Textattr }π { Variable as the Text color to fill with. }π Scroll(Up, 1, 0, 24, 0, 79, Textattr);π { Pause For a key press. }π Pauseπend.π 2 05-28-9313:56ALL SWAG SUPPORT TEAM SCROLL2.PAS IMPORT 53 B╡Y8 Program Scroll;πUsesπ Crt, Dos;πConstπ Null = #0;π UpArrow = #72;π LeftArrow = #75;π RightArrow = #77;π DownArrow = #80;π PageUp = #73;π PageDown = #81;π ESC = #27;ππTypeπ StrPtr = ^LineBuffer;ππ LineBuffer = Recordπ Line : String[255];π Next : StrPtr;π Prev : StrPtr;π Up23 : StrPtr;π Down23 : StrPtr;π end;πVarπ F : Text;π First,π Last,π Prev,π Current : StrPtr;π Line : Byte;π Row : Byte;ππFunction PadString( S : String ) : String;πVarπ X : Byte;πbeginπ if ord(S[0]) > 79 then S[0]:=Chr(80);π For X := (Length(S) + 1) to 79 Doπ S[X] := ' ';π S[0] := Chr(79);π PadString := S;πend;ππProcedure Normal;πbeginπ TextColor(15);π TextBackGround(0);πend;ππProcedure HighLite;πbeginπ TextColor(10);π TextBackGround(7);πend;ππProcedure AddString;πVarπ S : String;ππbeginπ if First = Nil thenπ beginπ Line := 1;π New(Current);π Current^.Prev := Nil;π Current^.Next := Nil;π Current^.Up23 := Nil;π Current^.Down23 := Nil;π ReadLn(F, S);π Current^.Line := S;π Last := Current;π First := Current;π endπ elseπ beginπ Prev := Current;π New(Current);π Current^.Prev:=Prev;π Current^.Next:=Nil;π ReadLn(F,Current^.Line);π if Line = 23 thenπ beginπ Current^.Up23 := First;π First^.Down23 := Current;π Current^.Down23:= Nil;π endπ elseπ beginπ if Line > 23 thenπ beginπ Current^.Up23 := Prev^.Up23^.Next;π Current^.Up23^.Down23 := Current;π Current^.Down23:=Nil;π endπ elseπ beginπ Current^.Up23:=Nil;π Current^.Down23:=Nil;π end;π end;π Prev^.Next:=Current;π Last:=Current;π if Line<=60 thenπ Line:=Line + 1;π end;πend;ππProcedure DrawScreen( This : StrPtr);πVarπ TRow : Byte;πbeginπ TRow:=1;π While TRow<=23 Doπ beginπ GotoXY(1,TRow);π Write(PadString(This^.Line));π This:=This^.Next;π TRow:=TRow + 1;π end;πend;ππProcedure Scrolling;πVarπ InKey : Char;πbeginπ While (MemAvail>272) and (not Eof(F)) Do AddString;π if not Eof(F) thenπ beginπ GotoXY(1,1);π TextColor(10);π Write('Entire File not Loaded');π end;π Current:=First;π Window(1,1,1,79);π ClrScr;π HighLite;π GotoXY(1,1);π Write(PadString(ParamStr(1)));π Window(2,1,24,80);π Normal;π DrawScreen(First);π Row:=1;π Window(2,1,25,80);π While InKey<>#27 Doπ beginπ InKey:=ReadKey;π Case InKey ofπ Null :π beginπ InKey:=ReadKey;π Case InKey ofπ UpArrow :π beginπ if Current^.Prev = Nil thenπ beginπ Sound(2000);π Delay(50);π NoSound;π endπ elseπ beginπ if Row = 1 thenπ beginπ GotoXY(1,1);π Normal;π Write(PadString(Current^.Line));π GotoXY(1,1);π InsLine;π Current:=Current^.Prev;π HighLite;π Write(PadString(Current^.Line));π endπ elseπ beginπ GotoXY(1,Row);π Normal;π Write(PadString(Current^.Line));π Row:=Row - 1;π GotoXY(1,Row);π HighLite;π Current:=Current^.Prev;π Write(PadString(Current^.Line));π end;π end;π end;ππ DownArrow :π beginπ if Current^.Next = Nil thenπ beginπ Sound(2000);π Delay(50);π NoSound;π endπ elseπ beginπ if Row = 23 thenπ beginπ GotoXY(1,23);π Normal;π Write(PadString(Current^.Line));π GotoXY(1,1);π DelLine;π GotoXY(1,23);π Current:=Current^.Next;π HighLite;π Write(PadString(Current^.Line));π endπ elseπ beginπ GotoXY(1,Row);π Normal;π Write(PadString(Current^.Line));π Row:=Row + 1;π GotoXY(1,Row);π HighLite;π Current:=Current^.Next;π Write(PadString(Current^.Line));π end;π end;π end;ππ PageDown :π beginπ if (Row = 23) and (Current = Last) thenπ beginπ Sound(2000);π Delay(50);π NoSound;π endπ elseπ beginπ Normal;π if Current^.Down23 = Nil thenπ beginπ Current:=Last;π DrawScreen(Last^.Up23);π Row:=23;π GotoXY(1,Row);π HighLite;π Write(PadString(Current^.Line));π endπ elseπ beginπ Current:=Current^.Down23^.Next;π DrawScreen(Current^.Up23);π Row:=23;π GotoXY(1,Row);π HighLite;π Write(PadString(Current^.Line));π end;π end;π end;ππ PageUp :π beginπ if (Row = 23) and (Current^.Up23 = Last) thenπ beginπ Sound(2000);π Delay(50);π NoSound;π endπ elseπ beginπ Normal;π if Current^.Up23 = Nil thenπ beginπ Current:=First;π DrawScreen(First);π Row:=1;π GotoXY(1,Row);π HighLite;π Write(PadString(First^.Line));π endπ elseπ beginπ Current:=Current^.Up23^.Prev;π DrawScreen(Current);π Row:=1;π GotoXY(1,Row);π HighLite;π Write(PadString(Current^.Line));π end;π end;π end;π elseπ beginπ Sound(2000);π Delay(50);π NoSound;π end;ππ end;π end;ππ elseπ beginπ Sound(2000);π Delay(50);π NoSound;π end;ππ end;π end;πend;ππbeginπ if ParamCount < 1 thenπ beginπ WriteLn('Invalid Number of Parameters!!!');π Halt(1);π end;π Assign(F, Paramstr(1));π Reset(F);π Current:=Nil;π First:=Nil;π Scrolling;π GotoXY(1, 23);π WriteLn;π WriteLn;πend.ππ 3 05-28-9313:56ALL SWAG SUPPORT TEAM SCROLL3.PAS IMPORT 33 B╡l⌠ {π Here is some demo code showing how to use Smooth.Obj. It offersπ vertical and horizontal smooth scrolling in Text or Graphics modes.ππ NOTE: Requires Smooth.Obj (see below) EGA & VGA ONLY !!!!ππ REQUIRES: Smooth.Obj Run the debug script through DEBUG to createπ Smooth.Obj. The NEXT message has the debug script.ππ ALSO: Until last week, I'd never seen a line of Pascal code.π So ForGIVE the rough edges of this code: bear in mindπ the Complete novice status of its author <!!G!!> }ππUses Crt;ππ{ NOTE: SmoothScroll is a MEDIUM MODEL Asm/OBJ For use inπ **either** Pascal or most flavors of modern BASIC.ππ It expects parameters to be passed by reference! We handleπ that here by not including Var, then passing Ofs(parameter).ππ Don't know if this is appropriate, but it works. Comments? }ππ{$F+} Procedure SmoothScroll(Row, Column: Integer); external; {$F-}π{$L Smooth.Obj}ππVarπ Row, Col, Speed, WhichWay : Integer;π Ch : Char;π s : String [60];ππbeginπ TextColor (14); TextBackground (0); ClrScr;ππ GotoXY (25,4); Write ('Press <Escape> to move on.');ππ ch := 'A';π For Row := 10 to 24 doπ beginπ FillChar (s, Sizeof(s), ch);π s[0] := #60; Inc (ch);π GotoXY (10, Row); Write (s);π end;ππ Speed := 1; { Change Speed! See notes. }ππ {The higher the Speed, the faster the scroll.π Use Speed = 1 For subtle scrolling.π Try Speed = 5 (10 in Graphics) For very fast scrolling.π Try Speed = 10+ (25 in gfx) to see some **Real shaking**.ππ Even in Text mode here, Row and Column use GraphICS MODEπ pixel coordinates (ie., begin w/ 0,0). }ππ {================================= demo vertical smooth scrolling}π Row := 0; Col := 0;π WhichWay := Speed; { start by going up }ππ Repeat { press any key to end demo }π GotoXY (2,10); Write (Row, ' ');π SmoothScroll(ofs(Row), ofs(Col));π Row := Row + WhichWay;ππ if (Row > 150) or (Row < 2) then { try 400 here }π WhichWay := WhichWay * -1; { reverse direction }ππ if Row < 1 then Row := 1;ππ Until KeyPressed;ππ ch := ReadKey; Row := 0; Col := 0;π SmoothScroll ( ofs(Row), ofs(Col) ); { return to normal (sort of) }ππ {================================= demo horizontal smooth scrolling}π Row := 0; Col := 0;π WhichWay := Speed; { start by going left }ππ Repeat { press any key to end demo }π GotoXY (38,3); Write (Col, ' ');π SmoothScroll(ofs(Row), ofs(Col));π Col := Col + WhichWay;ππ if (Col > 65) or (Col < 0) then { try 300 here }π WhichWay := WhichWay * -1; { reverse direction }π if Col < 0 then Col := 0;π Until KeyPressed;ππ Row := 0; Col := 0; SmoothScroll(ofs(Row), ofs(Col));πend.ππ{ Capture the following to a File (eg. S.Scr).π then: DEBUG < S.SCR.ππ Debug will create SMOOTH.OBJ.ππ N SMOOTH.OBJπ E 0100 80 0E 00 0C 73 6D 74 68 73 63 72 6C 2E 61 73 6Dπ E 0110 87 96 27 00 00 06 44 47 52 4F 55 50 0D 53 4D 54π E 0120 48 53 43 52 4C 5F 54 45 58 54 04 44 41 54 41 04π E 0130 43 4F 44 45 05 5F 44 41 54 41 90 98 07 00 48 89π E 0140 00 03 05 01 87 98 07 00 48 00 00 06 04 01 0E 9Aπ E 0150 04 00 02 FF 02 5F 90 13 00 00 01 0C 53 4D 4F 4Fπ E 0160 54 48 53 43 52 4F 4C 4C 00 00 00 A7 88 04 00 00π E 0170 A2 01 D1 A0 8D 00 01 00 00 55 8B EC 06 56 33 C0π E 0180 8E C0 8B 76 08 8B 04 33 D2 26 8B 1E 85 04 F7 F3π E 0190 8B D8 8B CA 26 A1 4A 04 D0 E4 F7 E3 8B 76 06 8Bπ E 01A0 1C D1 EB D1 EB D1 EB 03 D8 26 8B 16 63 04 83 C2π E 01B0 06 EC EB 00 A8 08 74 F9 EC EB 00 A8 08 75 F9 26π E 01C0 8B 16 63 04 B0 0D EE 42 8A C3 EE 4A B0 0C EE 42π E 01D0 8A C7 EE 4A 83 C2 06 EC EB 00 A8 08 74 F9 83 EAπ E 01E0 06 B0 08 EE 8A C1 42 EE 83 C2 05 EC BA C0 03 B0π E 01F0 33 EE 8B 76 06 8B 04 24 07 EE 5E 07 8B E5 5D CAπ E 0200 04 00 F5 8A 02 00 00 74π RCXπ 0108π Wπ Qππ'======== end of Debug Script ========π}ππ 4 05-28-9313:56ALL SWAG SUPPORT TEAM SCROLL4.PAS IMPORT 12 B╡≈h {> I need to be able to scroll the Text display in my File viewer,π> both left and right, to allowing reading of lines that extend pastπ> column 80.ππUnFortunately there's no way to scroll horizontally by BIOS or by anotherπservice Function. You have to implement it on your own. Here are two Proceduresπthat I use in my Programs (in Case they must scroll left or right ;-)):π}ππ{$ifNDEF VER70}πConstπ Seg0040 = $0040;π SegB000 = $B000;π SegB800 = $B800;π{$endif}ππTypeπ PageType = Array [1..50,1..80] of Word;ππVarπ Screen : ^PageType;π VideoMode : ^Byte;ππProcedure ScrollRight(X1,Y1,X2,Y2,Attr : Byte);πVarπ Y : Byte;π Attrib : Word;πbeginπ Attrib := Word(Attr SHL 8);π Y := Y1-1;π Repeatπ Inc(Y);π Move(Screen^[Y,X1],Screen^[Y,X1+1],(X2-X1)*2);π Screen^[Y,X1] := Attrib+32;π Until Y=Y2;πend;ππProcedure ScrollLeft(X1,Y1,X2,Y2,Attr : Byte);πVarπ Y : Byte;π Attrib : Word;πbeginπ Attrib := Word(Attr SHL 8);π Y := Y1-1;π Repeatπ Inc(Y);π Move(Screen^[Y,X1+1],Screen^[Y,X1],(X2-X1)*2);π Screen^[Y,X2] := Attrib+32;π Until Y=Y2;πend;ππbeginπ VideoMode := Ptr(Seg0040,$0049);π if VideoMode^=7 thenπ Screen := Ptr(SegB000,$0000)π elseπ Screen := Ptr(SegB800,$0000);πend.ππ{πX1, Y1, X2 and Y2 are the coordinates of the Windows to be scrolled. Attr isπthe color of the vertical line that occurs after scrolling. ;-)π}π 5 06-08-9308:17ALL LOU DUCHEZ Write w/ Scroll Control IMPORT 33 B╡àÜ (*π===========================================================================π BBS: Canada Remote SystemsπDate: 06-01-93 (06:21) Number: 24456πFrom: LOU DUCHEZ Refer#: NONEπ To: MICHAEL DEAKINS Recvd: NO πSubj: ANSI, BATCH FILE EXEC'ING Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πMD>I have two questions. First, How can I display ANSI files from a PascalπMD>program by using the CON driver (read: ANSI.SYS) instead of going to theπMD>trouble of writing a terminal emulator, and still remainπMD>window-relative? I used TP5.5's WRITE procedure to write to a fileπMD>assigned to the CON device instead of the CRT unit's standard OutPut,πMD>but this obliterated my status line at the bottom of the screen when theπMD>ANSI file scrolled. Is there an easy way to write to the CON deviceπMD>while remaining window-relative without having to modify ANSI.SYS orπMD>write a terminal emulation procedure?πMD> My second question: How can I call a batch file from within a PascalπMD>program and pass %1-%9 parameters to it? I'm aware of the EXECπMD>procedure, but doesn't that only work on executables?ππSecond question first: you're right about EXEC calling only executables.πSo try calling "COMMAND.COM" as your program, and give it parameters ofπ"/C " plus the batch file name plus whatever arguments you intend to pass.π(That tells the system to run a single command out of DOS.) Look upπParamCount and ParamStr() to see how Pascal uses command-line parameters.ππFirst question second: you know, I addressed this problem just yesterdayπtrying to write a program. I concluded that, if you're going to bypassπCRT, you need to do a lot of "manual" work yourself to keep a windowπgoing. Let me show you the tools I devised:π*)πππ{---PROCEDURE ATSCROLL: SCROLLS A SCREEN REGION UP OR DOWN (negative orπ positive number in LINESDOWN, respectively) }ππprocedure atscroll(x1, y1, x2, y2: byte; linesdown: integer);πvar tmpbyte, intbyte, clearattrib: byte;πbeginπ if linesdown <> 0 then beginπ clearattrib := foxfore + foxback shl 4;π x1 := x1 - 1;π y1 := y1 - 1;π x2 := x2 - 1;π y2 := y2 - 1;π if linesdown > 0 then intbyte := $07 else intbyte := $06;π tmpbyte := abs(linesdown);π asmπ mov ah, intbyteπ mov al, tmpbyteπ mov bh, clearattribπ mov ch, y1π mov cl, x1π mov dh, y2π mov dl, x2π int 10hπ end;π end;π end;ππππ{---FUNCTION YPOS: Returns the line the cursor is on. I wrote it becauseπ I don't always trust WHEREY (or WHEREX): they report, for example, theπ cursor position relative to a text window. So I had it lying around,π and I opted to use it in my routines. }ππfunction ypos: byte;πvar tmpbyt: byte;πbeginπ asmπ mov ah, 03hπ mov bh, 0π int 10hπ mov tmpbyt, dhπ end;π ypos := tmpbyt + 1;π end;ππππ{--- PROCEDURE WRITEANDFIXOVERHANG: I use it in place of WRITELN in myπ program: before writing a line of text, it checks if there's roomπ at the bottom of the screen. If not, it scrolls the screen upπ before writing. Keep in mind that this program is bent on preservingπ the top three or four screen lines, not the bottom lines. }ππprocedure writeandfixoverhang(strin: string);πconst scrollat: byte = 24;πvar overhang: byte;πbeginπ if ypos >= scrollat then beginπ overhang := ypos - scrollat + 1;π atscroll(0, 4 + overhang, 0, 80, 25, -overhang);π movecursor(1, ypos - overhang);π end;π writeln(strin);π end;ππ{πSo assuming your text lines don't get too long (line longer than 160 chars),πthese routines will keep the top of your screen from getting eaten. If youπwant to preserve space at the bottom of the screen instead (or both top andπbottom), change WRITEANDFIXOVERHANG.ππBTW, if there are any compiling problems, let me know. I took out all theπstuff that applied specifically to my application -- I might have stupidlyπchanged something you need ... }π 6 11-02-9306:14ALL BERNIE PALLEK Quick Scroller IMPORT 17 B╡ {πBERNIE PALLEKππ>Would anyone happen to know how I can use the ASCII Charactersπ>while in Video mode $13 (320x200x256)? Or better yet, make a messageπ>scroll across the screen like in them neat intros and demos..ππThe easiest way to do it is to set DirectVideo to False (if you are usingπthe Crt Unit). This disables direct Writes to the screen, meaning thatπthe BIOS does screen writing, and the BIOS works in just about everyπscreen mode. Then, you can just use Write and WriteLn to display TextπCharacters (I think GotoXY will even work). As For scrolling...πSince mode 13h ($13) has linearly addressed video memory (just a runπof 64,000 contiguous Bytes), do something like this:ππthis is untested, but it might actually work :')π}ππUsesπ Crt;πConstπ msgRow = 23;π waitTime = 1; { adjust suit your CPU speed }π myMessage : String = 'This is a test message. It should be more ' +π 'than 40 Characters long so the scrolling can be demonstrated.';πVarπ sx, xpos : Byte;ππProcedure MoveCharsLeft;πVarπ curLine : Word;πbeginπ { shift the row left 1 pixel }π For curLine := (msgRow * 8) to (msgRow * 8) + 7 DOπ Move(Mem[$A000 : curLine * 320 + 1], Mem[$A000 : curLine * 320], 319);π { clear the trailing pixels }π For curLine := (msgRow * 8) to (msgRow * 8) + 7 DOπ Mem[$A000 : curLine * 320 + 319] := 0;πend;ππbeginπ Asmπ MOV AX, $13π INT $10π end;π DirectVideo := False;π GotoXY(1, msgRow + 1);π Write(Copy(myMessage, 1, 40));π { 'myMessage' must be a String With a Length > 40 }π For xpos := 41 to Length(myMessage) doπ beginπ For sx := 0 to 7 doπ beginπ MoveCharsLeft;π Delay(waitTime);π end;π GotoXY(40, msgRow + 1);π Write(myMessage[xpos]);π end;π Asmπ MOV AX, $3π INT $10π end;πend.ππ{πThis may not be very efficiently coded. As well, it could benefit fromπan Assembler version. But it should at least demonstrate a techniqueπyou can learn from. }ππ 7 11-02-9306:14ALL DANIEL JOHN LEE PARNELL Scrolling Demo IMPORT 71 B╡ {πS921878@MINYOS.XX.RMIT.OZ.AU, Daniel John Lee Parnellππ I have received several requests for the source code to theπscrolly demo I posted to this group. Sorry about posting a binary. Iπdidn't know it was not allowed on this group. Anyway the following is theπsource code to the scrolly. It is not a unit. It uses one 286πinstruction so it wont work on an XT :(π}ππ{$G+}πprogram ColorBars;ππusesπ DOS, CRT;ππconstπ maxBars = 7;π maxStars = 100;π maxLines = 7;π m : array [1..maxLines] of string =π ('Welcome to my first scrolly demo on the PC. It was written using ',π 'Turbo Pascal 6.0 on the 7th of October 1993. This program took me ',π 'about 2 hours to write and I had a lot of fun writing it! ',π 'I suppose I''d better put in some greets I guess...............',π 'Greetings go to Robyn Adam Rowan Mandy ',π ' Weng Speed Shane Iceberg Inc. And anybody ',π 'else out there whom I have forgotten about...... ');ππvarπ colors : array [0..768] of byte;π rMsk,π gMsk,π bMsk : array [0..255] of byte;π y, dy, s : array [1..maxBars] of integer;π sx, sy,π sdx : array [1..maxStars] of integer;π tx, ty : array [0..640] of integer;π dot : integer;π ticks : word;π scrly : array [0..360] of integer;π mpos,π mlen : integer;ππprocedure SetMode(m : integer); { Set video mode }πvarπ regs : registers;πbeginπ regs.ax := m;π intr($10, regs);πend;ππprocedure WaitRetrace; { Wait for vertical retrace }πbeginπ repeat { Nothing } until (Port[$03da] and 8) <> 0;πend;ππprocedure WaitNotRetrace; { Wait for not vertical retrace }πbeginπ repeat { Nothing } until (Port[$03da] and 8) <> 8;πend;ππprocedure InitScreen; { Sets up the colored bars }πvarπ i, j : integer;πbeginπ for i := 0 to 199 doπ for j := 0 to 319 doπ mem[$a000 : i * 320 + j] := i;πend;ππprocedure InitColors; { Zeros the first 200 colors }πvarπ i : integer;πbeginπ for i := 0 to 199 * 3 doπ colors[i] := 0;πend;ππprocedure SetColors; assembler; { Loads the colors into the regs }πasmπ @ntrace: { Wait for not retrace }π mov dx, $03daπ in al, dxπ test al, 8π jnz @vtraceππ @vtrace: { Now wait for retrace }π mov dx, $03daπ in al, dxπ test al, 8π jz @vtraceππ mov dx, $03c8 { Start changeing colors from color # 1 }π mov al, 1π out dx, alππ inc dx { Make DX point to the color register }π mov cx, 199*3 { The number of bytes to put into the color register }π mov si, offset colors { Load the address of the color array }π rep outsb { Now change the colors }πend;ππprocedure CalcBars; { Calculate the color bars }πvarπ i, j, k : integer;πbeginπ for i := 0 to 199 * 3 do { Zero all the colors }π colors[i] := 0;ππ for i := 1 to maxBars do { Now process each bar in turn }π beginπ y[i] := y[i] + dy[i]; { Move the bar }π if (y[i] < 4) or (y[i] > 190) then { Has it hit the top or the bottom? }π beginπ dy[i] := -dy[i]; { Yes, so make it bounce }π y[i] := y[i] + dy[i];π end;ππ for j := (y[i] - s[i]) to (y[i] + s[i]) do { Now update the color array }π beginπ if j < y[i] then { Calculate the intensity }π k := 63 - (y[i] - j) * 4π elseπ k := 63 - (j - y[i]) * 4;ππ if j > 0 then { If it is a valid color change it }π beginπ colors[j * 3] := (colors[j * 3] + (k and rMsk[i])); { Do red }π colors[j * 3 + 1] := (colors[j * 3 + 1] + (k and gMsk[i])); { Do green }π colors[j * 3 + 2] := (colors[j * 3 + 2] + (k and bMsk[i])); { Do blue }π end;π end;π end;πend;ππprocedure InitBars; { Set up the bars randomly }πvarπ i : integer;πbeginπ for i := 1 to MaxBars doπ beginπ y[i] := random(150)+4; { Starting pos }π s[i] := random(6)+4; { Size }ππ rMsk[i] := random(2)*255; { Red mask }π gMsk[i] := random(2)*255; { Green mask }π bMsk[i] := random(2)*255; { Blue mask }ππ repeat { Calc direction }π dy[i] := random(6) - 3;π until dy[i] <> 0;π end;πend;ππprocedure InitStars; { Set up the stars }πvarπ i : integer;πbeginπ port[$03c8] := $f8; { Change the colors for stars }π for i := 7 downto 0 doπ beginπ port[$03c9] := 63 - (i shl 2);π port[$03c9] := 63 - (i shl 2);π port[$03c9] := 63 - (i shl 2);π end;ππ for i := 1 to maxStars doπ beginπ sx[i] := random(320); { Choose X pos }π sy[i] := random(200); { Y pos }π sdx[i] := 1 shl random(3); { Speed }π end;πend;ππprocedure InitScroll; { Initialize the scrolly }πconstπ k = 3.141 / 180;πvarπ i : integer;πbeginπ mlen := 0; { Calc length of scroll text }π for i := 1 to maxLines doπ mlen := mlen + length(m[i]);ππ for i := 0 to 640 do { Zero all the star positions }π tx[i] := -1;ππ for i := 0 to 360 do { Calculate the scroll path }π scrly[i] := round(100 + 50 * sin(i * k));πend;ππprocedure UpdateStars; { Draw the stars }πvarπ i, ad : integer;πbeginπ for i := 1 to maxStars doπ beginπ ad := sx[i] + sy[i] * 320; { Calc star address in video ram }π mem[$a000 : ad] := sy[i]; { Unplot old star pos }π sx[i] := sx[i] + sdx[i]; { Calc new star pos }ππ if sx[i] > 319 then { Is it past the end of the screen? }π beginπ sy[i] := random(200); { Yes, generate a new star }π sx[i] := 0;π sdx[i] := 1 shl random(3);π ad := sx[i] + sy[i] * 320;π end;π mem[$a000:ad + sdx[i]] := $f7 + (sdx[i]) * 2;π end;πend;ππfunction msg(var i : integer) : char; { Get a char from the scroll text }πvarπ j, t, p : integer;πbeginπ if i > mlen then { Is I longer then the text? }π i := 1;ππ j := 0; { Find which line it is in }π t := 0;π repeatπ inc(j);π t := t + length(m[j]);π until i<t;ππ p := i - t + length(m[j]); { Calculate position in line }ππ if p > 0 thenπ msg := m[j][p]π elseπ msg := chr(0);π inc(i); { Increment text position }πend;ππprocedure NextChar; { Create nex character in scroll text }πvarπ ad : word;π i, j,π q, c : integer;πbeginπ c := ord(msg(mpos)); { Get the char }ππ ad := $fa6e + (c * 8); { Calc address of character image in ROM }π for i := 0 to 7 doπ beginπ q := mem[$f000 : ad + i]; { Get a byte of the image }π for j := 0 to 7 doπ beginπ if odd(q) then { Is bit 0 set? }π beginπ tx[dot] := 320 + (7 - j) * 4; { If so add a dot to the list }π ty[dot] := i * 4;π inc(dot);π if dot > 640 thenπ dot := 0;π end;π q := q shr 1; { Shift the byte one pos to the right }π end;π end;πend;ππprocedure DisplayScroll; { Display scrolly and update dot positions }πvarπ i : integer;π ad : word;πbeginπ if (ticks mod 32) = 0 then { Is it time for the next char? }π NextChar;ππ for i := 0 to 640 doπ if tx[i] > 0 then { Is this dot being used? }π beginπ if tx[i] < 320 then { Is it on the screen? }π beginπ ad := tx[i] + (ty[i] + scrly[tx[i]]) * 320; { Calc old position }π mem[$a000:ad] := ty[i] + scrly[tx[i]]; { Clear old dot }π end;ππ dec(tx[i]); { Move dot to the left }π ad := tx[i] + (ty[i] + scrly[tx[i]]) * 320; { Calc new position }ππ if (tx[i] > 0) and (tx[i] < 320) then { Is it on the screen? }π mem[$a000:ad] := $ff - (ty[i] shr 2); { Plot new dot }ππ end;πend;ππbeginπ randseed := 4845267; { Set up the random seed }π SetMode($13); { Go to 320*200*256 mode }π InitColors; { Blank the color array }π SetColors; { Set the colors to black }π InitScreen; { Set up the colored bars }π InitBars; { Set up the bar positions }π InitStars; { Set up the stars }π InitScroll; { Set up the scrolly }π dot := 0; { Set the dot counter to 0 }π mpos := 1; { Set up the text pos }ππ repeatπ CalcBars; { Calculate the color bars }π DisplayScroll; { Display the scrolly text }π UpdateStars; { Update & display the stars }π SetColors; { Set the colors }π inc(ticks); { Update the tick counter }π until KeyPressed;ππ SetMode(3); { Return to text mode }πend.π 8 01-27-9412:15ALL BAS VAN GAALEN BIG Scroller - NEAT! IMPORT 11 B╡ {πI'm not sure if there're people who are still searching for a _big_ scrollπ(meaning bigger than just one line). If so, here's some source:ππ{ --- cut here --- }ππprogram Simple_Old_TextScroll;ππuses crt;πconst Sseg : word = $b800; Hi = 17; Txt : string = 'Hello world... ';πvar Fseg,Fofs : word; I,Cur,Idx,Line,BitPos : byte;ππprocedure Getfont; assembler; asmπ mov ax,1130h; mov bh,3; int 10h; mov Fseg,es; mov Fofs,bp; end;ππprocedure Retrace; assembler; asmπ mov dx,3dah;π @l1: in al,dx; test al,8; jnz @l1;π @l2: in al,dx; test al,8; jz @l2; end;ππbeginπ GetFont;π Idx := 1;π repeatπ Cur := ord(Txt[Idx]);π for BitPos := 0 to 7 do beginπ for Line := 0 to 7 do beginπ if ((mem[Fseg:Fofs+Cur*8+Line] shl BitPos) and 128) <> 0 thenπ mem[Sseg:158+(Line+Hi)*160] := 219π elseπ mem[Sseg:158+(Line+Hi)*160] := 32;π end;π Retrace;π for Line := 0 to 7 doπ for I := 0 to 78 doπ mem[Sseg:(Line+Hi)*160+I+I] := mem[Sseg:(Line+Hi)*160+I+I+2];ππ end;π Idx := 1+Idx mod length(Txt);π until keypressed;πend.ππ{ --- cut here --- }ππKeep in mind this thing expects a VGA card with the textmemory at $b800.ππ 9 01-27-9412:15ALL BAS VAN GAALEN Sinus Scroll IMPORT 20 B╡ {π> but you can use Pascal to do things like this:π}πprogram SinusScroll;πconstπ GSeg = $a000;π Sofs = 140; Samp = 40; Slen = 255;π Size = 2; Curve = 3;π Xmax = 279 div Size; Ymax = 7;π ScrSpd = -1;π ScrText : string =π ' Hai world... This looks a bit like the scroll of the second part'+π ' of Future Crew''s Unreal demo (part one)... It''s not filled'+π ' but it sure looks nicer (imho)... ';πtype SinArray = array[0..Slen] of word;πvar Stab : SinArray; Fseg,Fofs : word;ππprocedure CalcSinus; var I : word; beginπ for I := 0 to Slen do Stab[I] := round(sin(I*4*pi/Slen)*Samp)+Sofs; end;ππprocedure GetFont; assembler; asmπ mov ax,1130h; mov bh,1; int 10h; mov Fseg,es; mov Fofs,bp; end;ππprocedure SetGraphics(Mode : word); assembler; asmπ mov ax,Mode; int 10h end;ππfunction keypressed : boolean; assembler; asmπ mov ah,0bh; int 21h; and al,0feh; end;ππprocedure Scroll;πtypeπ ScrArray = array[0..Xmax,0..Ymax] of byte;π PosArray = array[0..Xmax,0..Ymax] of word;πvarπ PosTab : PosArray;π BitMap : ScrArray;π X,I,SinIdx : word;π Y,ScrIdx,CurChar : byte;πbeginπ fillchar(BitMap,sizeof(BitMap),0);π fillchar(PosTab,sizeof(PosTab),0);π ScrIdx := 1; SinIdx := 0;π repeatπ Curchar := ord(ScrText[ScrIdx]);π inc(ScrIdx); if ScrIdx = length(ScrText) then ScrIdx := 1;π for I := 0 to 7 do beginπ move(BitMap[1,0],BitMap[0,0],(Ymax+1)*Xmax);π for Y := 0 to Ymax doπ if ((mem[Fseg:Fofs+8*CurChar+Y] shl I) and 128) <> 0 thenπ BitMap[Xmax,Y] := ((ScrIdx+Y-I) mod 70)+32 else BitMap[Xmax,Y] := 0;π while (port[$3da] and 8) <> 0 do;π while (port[$3da] and 8) = 0 do;π for X := 0 to Xmax doπ for Y := 0 to Ymax do beginπ mem[GSeg:PosTab[X,Y]] := 0;π PosTab[X,Y] := (Size*Y+STab[(SinIdx+X+Curve*Y) modπ SLen])*320+Size*X+STab[(X+Y) mod SLen]-SOfs;π mem[GSeg:PosTab[X,Y]] := BitMap[X,Y];π end;π SinIdx := (SinIdx+ScrSpd) mod SLen;π end;π until keypressed;πend;ππbeginπ CalcSinus;π GetFont;π SetGraphics($13);π Scroll;π SetGraphics(3);πend.ππ{ --- and again --- }ππThe prior 'release' was a bit buggy indeed (as I expected). So here's aπbetter working version. It's smaller too. Not only thanx to theπvariable-size. Have fun!ππBtw: 'keypressed' was taken from Sean Palmers' GhostEd. The rest, of course,πby me! ;-)π 10 01-27-9412:21ALL ERIC MILLER Multi-Line Scroll IMPORT 12 B╡ {π> Last month this routine for scrolling text across the screen wasπ> posted in this echo. It's a great routine but would the author of theπ> routine please describe how to place the scrolling text on any of theπ> 25 vertical lines, how to change the background color...the foregroundπ> color I found. Also, can this routine place the text between twoπ> points on the screen without writing over the extreme left and rightπ> sides?ππThis should be what you're looking for. I sort exapnded on theπold code, but instead of using Mem for direct writes I set aπscreen structure over the text screen instead...makes it easierπto understand. }ππPROGRAM NewScroll;πUses Crt;ππTYPEπ TCell = RECORD C: Char; A: Byte; END;π TScreen = array[1..25, 1..80] of TCell;ππCONSTπ Row: byte = 15;π Col1: byte = 10;π Col2: byte = 70;π Attr: byte = $4F; { bwhite / red }π Txt: string = 'Hello world.... ';ππVARπ Scr: TScreen ABSOLUTE $B800:0;π I, J: Byte;πBEGINπ I := 1;π REPEATπ while (port[$3da] and 8) <> 0 do; { wait retrace }π while (port[$3da] and 8) = 0 do;π FOR J := Col1 TO (Col2-1) DOπ Scr[Row, J] := Scr[Row, J+1]; { shift cell left }π Scr[Row, Col2].C := Txt[I]; { add new cell }π Scr[Row, Col2].A := Attr;π I := 1 + (I MOD Length(Txt));π UNTIL Keypressed;ππEND.ππ 11 01-27-9412:21ALL THORSTEN BARTH Screen Info - Scrolling IMPORT 9 B╡ {π> I need help with a scroller for the textmode (25x80)...I ran into someπ> trouble..:(.. The major problem is that it has to quite fast, so my choiseπ> was to make the scroller using Mem [VidSeg....] and Move but I just don'tπ> seem to get it right... So if anybody out there has got a scroller for theπ> textmode please post it... Nevermind if it's not so fast, it might helpπ> anywayππI tested the single line scroller, and it worked. (Delayed 50 instead of 10)π(make the constant a string to compile it).ππNow a simple scroll command for the entire screen (up)π}πMove(Mem[Vidseg,160],Mem[Vidseg,0],3840); or just writelnπ{πentire screen(down)π}πMove(Mem[Vidseg,0],Mem[Vidseg,160],3840);π{πentire screen(left)π}πMove(Mem[Vidseg,2],Mem[Vidseg,0],3998);π{πthen write all characters that are new in the right columnππentire screen(right)π}πMove(Mem[VidSeg,0],Mem[VidSeg,2],3998);π{πthen write all characters in new left columnπ}π 12 01-27-9412:22ALL DAVID DAHL Smooth Text Scroll IMPORT 63 B╡ {π> Does anybody know if it is possible to accomplish a smooth-text scrollerπ> (like in the old c64 dayz) in text mode? If so, please let me know andππ> Well, it's impossible, you'll have to switch to a graphic mode.ππ No, it's possible in text mode... it's just a pain in theπarse. I know of two ways. The first is to use an alternateπcharacter set (the EGA can have 2 on screen at once, the VGA canπhave 4). You use one character set as normal text, and use theπother as a pseudo-graphics window. Put the text you need toπscroll in the window and move (copy) it a pixel at a time. Theπsecond way is to use the 8253 timer to time the scanline. Whenπthe scanline gets to the portion of the screen you want, turn offπv-retrace, set v-retrace on the next scan line, and set theπhorizontal pel pan to the value you need for your smooth pan.πWhen the card gets to the line that the v-retrace would occur, itπresets the pan but doesn't retrace because you turned it off.πAfter this, reset the registers you changed back to their defaultπvalues so the card builds the screen correctly. This is done onπEVERY screen build. Needless to say, the pseudo-graphics windowπversion is easier so that's the one I used to program the exampleπthat follows.π}ππProgram SmoothTextScrollExample1;ππ{==============================================ππ Smooth Scroll In Text Mode Exampleπ Programmed by David Dahlπ 12/21/93π This program and source are PUBLIC DOMAINππ ----------------------------------------------ππ This example uses a second font to scrollπ the text. The font definition is changedπ to make the text scroll. This programπ requires VGA.ππ ==============================================}ππUses CRT;ππType FontDefType = Array[0..255, 0..31] of Byte;ππVar ScrollText : String;ππ FontDef : FontDefType;ππProcedure SetCharWidthTo8; Assembler;πAsmπ { Change To 640 Horz Res }π MOV DX, $3CCπ IN AL, DXπ AND AL, Not(4 OR 8)π MOV DX, $3C2π OUT DX, ALππ { Turn Off Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 0π OUT DX, ALππ { Reset Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALππ { Switch To 8 Pixel Wide Fonts }π MOV DX, $3C4π MOV AL, 1π OUT DX, ALπ MOV DX, $3C5π IN AL, DXπ OR AL, 1π OUT DX, ALππ { Turn Off Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 0π OUT DX, ALππ { Reset Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALππ { Center Screen }π MOV DX, $3DAπ IN AL, DXπ MOV DX, $3C0π MOV AL, $13 OR 32π OUT DX, ALπ MOV AL, 0π OUT DX, ALπEnd;ππProcedure WriteScrollTextCharacters(Row : Byte);πVar Counter : Word;πBeginπ { Set Fonts 0 & 1 }π ASMπ MOV BL, 4π MOV AX, $1103π INT $10π END;ππ { Write Characters }π For Counter := 0 to 79 doπ Beginπ { Set Characters }ππ MEM[$B800:(80*2)*Row+(Counter*2)] := Counter;π { Set Attribute To Secondary Font }π MEM[$B800:(80*2)*Row+(Counter*2)+1] :=π MEM[$B800:(80*2)*Row+(Counter*2)+1] OR 8;ππ End;ππEnd;ππProcedure FlushKeyBoardBuffer;πVar Key : Char;πBeginπ While KeyPressed doπ Key := ReadKey;πEnd;ππProcedure SetAccessToFontMemory; Assembler;πASMπ { Turn Off Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 1π OUT DX, ALππ { Reset Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALππ { Change From Odd/Even Addressing to Linear }π MOV DX, $3C4π MOV AL, 4π OUT DX, ALπ MOV DX, $3C5π MOV AL, 7π OUT DX, ALππ { Switch Write Access To Plane 2 }π MOV DX, $3C4π MOV AL, 2π OUT DX, ALπ MOV DX, $3C5π MOV AL, 4π OUT DX, ALππ { Set Read Map Reg To Plane 2 }π MOV DX, $3CEπ MOV AL, 4π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 2π OUT DX, ALππ { Set Graphics Mode Reg }π MOV DX, $3CEπ MOV AL, 5π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 0π OUT DX, ALππ { Set Misc. Reg }π MOV DX, $3CEπ MOV AL, 6π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 12π OUT DX, ALπEnd;ππProcedure SetAccessToTextMemory; Assembler;πASMπ { Turn Off Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 1π OUT DX, ALππ { Reset Sequence Controller }π MOV DX, $3C4π MOV AL, 0π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALππ { Change To Odd/Even Addressing }π MOV DX, $3C4π MOV AL, 4π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3π OUT DX, ALππ { Switch Write Access }π MOV DX, $3C4π MOV AL, 2π OUT DX, ALπ MOV DX, $3C5π MOV AL, 3 {?}π OUT DX, ALππ { Set Read Map Reg }π MOV DX, $3CEπ MOV AL, 4π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 0π OUT DX, ALππ { Set Graphics Mode Reg }π MOV DX, $3CEπ MOV AL, 5π OUT DX, ALπ MOV DX, $3CFπ MOV AL, $10π OUT DX, ALππ { Set Misc. Reg }π MOV DX, $3CEπ MOV AL, 6π OUT DX, ALπ MOV DX, $3CFπ MOV AL, 14π OUT DX, ALπEnd;ππProcedure MakeFontDefTable;πVar CounterX,π CounterY : Word;πBeginπ SetAccessToFontMemory;ππ For CounterY := 0 to 255 doπ For CounterX := 0 to 31 doπ FontDef[CounterY, CounterX] :=π MEM[$B800:(CounterY * 32)+CounterX];ππ SetAccessToTextMemory;πEnd;ππProcedure ClearSecondFontMemory;πVar Counter : Word;πBeginπ SetAccessToFontMemory;ππ For Counter := 0 to 32 * 256 doπ MEM[$B800:$4000 + Counter] := 0;ππ SetAccessToTextMemory;πEnd;ππProcedure ScrollMessage;πConst CharCol : Integer = 8;π Counter : Byte = 1;π COUNTERY : Byte = 0;π PWRTbl : Array [0..7] of Byte = (1,2,4,8,16,32,64,128);πBeginπ SetAccessToFontMemory;ππ ASMπ { Wait For Retrace }π MOV DX, $3DAπ @RT:π IN AL, DXπ TEST AL, 8π JZ @RTππ { Scroll Text One Pixel To The Left }π MOV AX, $B800 + ($4000 / 16)π MOV ES, AXπ MOV CX, 32π @Row:π MOV DI, (79 * 32) - 1π ADD DI, CXπ SHL byte ptr ES:[DI], 1π PUSHFπ SUB DI, 32π POPFπ PUSH CXπ MOV CX, 79π @Chrs:π RCL byte ptr ES:[DI], 1π PUSHFπ SUB DI, 32π POPFπ Loop @Chrsπ POP CXπ Loop @Rowπ END;ππ If CharCol < 0π Thenππ Beginπ CharCol := 7;π Inc(Counter);π Endπ Elseπ Dec(CharCol);ππ If Counter > Length(ScrollText)π Thenπ Counter := 1;ππ { Write New Column Of Pixels }π For CounterY := 0 to 31 doπ MEM[$B800:$4000 + (79 * 32) + CounterY] :=π MEM[$B800:$4000 + (79 * 32) + CounterY] ORπ ((FontDef[Ord(ScrollText[Counter]), CounterY] AND PwrTbl[CharCol])π SHR CharCol);ππ SetAccessToTextMemory;πEnd;ππProcedure TurnCursorOff; Assembler;πASMπ MOV DX, $3D4π MOV AL, $0Aπ OUT DX, ALπ MOV DX, $3D5π IN AL, DXπ OR AL, 32π OUT DX, ALπEnd;ππProcedure TurnCursorOn; Assembler;πASMπ MOV DX, $3D4π MOV AL, $0Aπ OUT DX, ALπ MOV DX, $3D5π IN AL, DXπ AND AL, Not(32)π OUT DX, ALπEnd;ππBeginπ TextMode (C80);π TurnCursorOff;π SetCharWidthTo8;π MakeFontDefTable;π ClearSecondFontMemory;π TextColor(Red);π ClrScr;ππ ScrollText := 'This program is one example of how a smooth '+π 'scroll can be done in text mode. ';ππ WriteScrollTextCharacters(10);ππ TextColor(Blue);π GoToXY (26,10);π Write ('Text Mode Smooth Scroll Example');π GoToXY (34,11);π Write ('By David Dahl');ππ FlushKeyBoardBuffer;ππ Repeatπ ScrollMessage;π Until Keypressed;ππ FlushKeyboardBuffer;ππ TextMode (C80);π TurnCursorOn;πEnd.π 13 01-27-9412:22ALL JOHN BECK Smooth Scroll with Asm IMPORT 117 B╡ {π;π; Adapted from Programmer's Guide to PC & PS/2 Video Systems (1-55615-103-9)π;π; Routine written by Richard Wiltonπ;π;π; Name: ScreenOriginπ;π; Function: Set screen origin on EGA and VGA.π;π; Caller: Pascal:π;π; ScreenOrigin(x,y : integer);π;π; x,y (* pixel x,y coordinates *)π;ππ; Pascal calling conventionππARGx EQU word ptr [bp+8] ; stack frame addressingπARGy EQU word ptr [bp+6]ππ;π; C calling conventionπ;π; ARGx EQU word ptr [bp+4]π; ARGy EQU word ptr [bp+6]ππCRT_MODE EQU 49h ; addresses in video BIOS data areaπADDR_6845 EQU 63hπPOINTS EQU 85hπBIOS_FLAGS EQU 89hπππDGROUP GROUP _DATAπππ_TEXT SEGMENT byte public 'CODE'π ASSUME cs:_TEXT,ds:DGROUPππ PUBLIC ScreenOriginπScreenOrigin PROC farππ push bp ; preserve caller registersπ mov bp,spπ push siπ push diππ mov ax,40hπ mov es,ax ; ES -> video BIOS data areaπ mov cl,es:[CRT_MODE]ππ mov ax,ARGx ; AX := pixel x-coordinateπ mov bx,ARGy ; BX := pixel y-coordinateππ cmp cl,7π ja L01 ; jump if graphics modeππ je L02 ; jump if monochrome alphaπ test byte ptr es:[BIOS_FLAGS],1π jnz L02 ; jump if VGAπ jmp short L03ππ; setup for graphics modes (8 pixels per byte)ππL01:π mov cx,8 ; CL := 8 (displayed pixels per byte)π ; CH := 0π div cl ; AH := bit offset in byteπ ; AL := byte offset in pixel rowπ mov cl,ah ; CL := bit offset (for Horiz Pel Pan)π xor ah,ahπ xchg ax,bx ; AX := Yπ ; BX := byte offset in pixel rowππ mul word ptr BytesPerRowπ ; AX := byte offset of start of rowπ jmp short L05ππ; setup for VGA alphanumeric modes and EGA monochrome alphanumeric modeπ; (9 pixels per byte)ππL02: ; routine for alpha modesπ mov cx,9 ; CL := 9 (displayed pixels per byte)π ; CH := 0π div cl ; AH := bit offset in byteπ ; AL := byte offset in pixel rowπ dec ah ; AH := -1, 0-7π jns L04 ; jump if bit offset 0-7π mov ah,8 ; AH := 8π jmp short L04ππ; setup for EGA color alphanumeric modes (8 pixels per byte)ππL03:π mov cx,8 ; CL := 8 (displayed pixels per byte)π ; CH := 0π div cl ; AH := bit offset in byteπ ; AL := byte offset in pixel rowπL04:π mov cl,ah ; CL := value for Horiz Pel Pan regπ xor ah,ahπ xchg ax,bx ; AX := yπ ; BX := byte offset in rowπ div byte ptr es:[POINTS] ; AL := character rowπ ; AH := scan line in char matrixπ xchg ah,ch ; AX := character rowπ ; CH := scan line (value for Presetπ ; Row Scan register)π mul word ptr BytesPerRow ; AX := byte offset of char rowπ shr ax,1 ; AX := word offset of character rowπL05:π call SetOriginππ pop di ; restore registers and exitπ pop siπ mov sp,bpπ pop bpππ ret 4ππScreenOrigin ENDPππSetOrigin PROC near ; Caller: AX = offset of character rowπ ; BX = byte offset within rowπ ; CH = Preset Row Scan valueπ ; CL = Horizontal Pel Pan valueππ add bx,ax ; BX := buffer offsetππ mov dx,es:[ADDR_6845] ; CRTC I/O port (3B4h or 3D4h)π add dl,6 ; video status port (3BAh or 3DAh)ππ; update Start Address High and Low registersππL20:π in al,dx ; wait for start of vertical retraceπ test al,8π jz L20ππL21:π in al,dx ; wait for end of vertical retraceπ test al,8π jnz L21ππ cli ; disable interruptsπ sub dl,6 ; DX := 3B4h or 3D4hππ mov ah,bh ; AH := value for Start Address Highπ mov al,0Ch ; AL := Start Address High reg numberπ out dx,ax ; update this registerππ mov ah,bl ; AH := value for Start Address Lowπ inc al ; AL := Start Address Low reg numberπ out dx,ax ; update this registerπ sti ; enable interruptsππ add dl,6 ; DX := video status portπL22:π in al,dx ; wait for start of vertical retraceπ test al,8π jz L22ππ cli ; disable interruptsππ sub dl,6 ; DX := 3B4h or 3D4hπ mov ah,ch ; AH := value for Preset Row Scan regπ mov al,8 ; AL := Preset Row Scan reg numberπ out dx,ax ; update this registerππ mov dl,0C0h ; DX := 3C0h (Attribute Controllerπport)π mov al,13h OR 20h ; AL bit 0-4 := Horiz Pel Pan regπnumberπ ; AL bit 5 := 1π out dx,al ; write Attribute Controller Addressπregπ ; (The Attribute Controller addressπ ; flip-flop.)π mov al,cl ; AL := value for Horiz Pel Pan regπ out dx,al ; update this registerππ sti ; enable interruptsπ retππSetOrigin ENDPππ_TEXT ENDSπππ_DATA SEGMENT word public 'DATA'ππ EXTRN BytesPerRow : word ; bytes per pixel rowππ_DATA ENDSππ ENDππ}π{$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V+,X+,Y+}π{$M 65520,0,655360}ππ(****************************************************************************)π { }π { MODULE : SCROLL }π { }π { DESCRIPTION : Generic unit for perform smooth scrolling. }π { }π { AUTHOR : John M. Beck }π { }π { MODIFICATIONS: None }π { }π { HISTORY : 29-Dec-1993 Coded. }π { }π(****************************************************************************)ππunit scroll;ππinterfaceππconstπ charwidth = 8;π charheight = 14; { depends on adapter }ππvarπ screenseg : word;π bytesperrow : word;ππfunction getvideomode : byte;ππprocedure smoothscroll;ππprocedure gotoxy (x,y : byte);πprocedure wherexy(var x,y : byte);ππprocedure cursoroff;πprocedure setcursor(top,bot : byte);πprocedure getcursor(var top,bot : byte);ππprocedure clearline(line : word);πprocedure setvideomode(mode : byte);πprocedure panscreen(x0,y0,x1,y1 : integer);ππimplementationππ{$L SCRORG.OBJ}ππ{π;π; Name: ScreenOriginπ;π; Function: Set screen origin on EGA and VGA.π;π; Caller: Pascal:π;π; procedure ScreenOrigin(x,y : integer);π;π; x,y (* pixel x,y coordinates *)π;π}ππprocedure screenorigin(x,y : integer); external;ππfunction getvideomode : byte; assembler;π asmπ mov ax,0F00hπ int 10hπ end;ππprocedure cursoroff; assembler;π asmπ mov cx,2000hπ mov ah,1π int 10hπ end;ππprocedure gotoxy(x,y : byte); assembler;π asmπ mov ah,2π xor bx,bxπ mov dl,xπ dec dlπ mov dh,yπ dec dhπ int 10hπ end;ππprocedure wherexy(var x,y : byte); assembler;π asmπ mov ax,0300hπ xor bx,bxπ int 10hπ xchg dx,axπ les di,xπ stosbπ mov al,ahπ les di,yπ stosbπ end;ππprocedure setvideomode(mode : byte); assembler;π asmπ mov ah,00π mov al,modeπ int 10hπ end;ππprocedure setcursor(top,bot : byte); assembler;π asmπ mov ax,0100hπ mov ch,topπ mov cl,botπ int 10hπ end;ππprocedure getcursor(var top,bot : byte); assembler;π asmπ mov ax,0300hπ xor bx,bxπ int 10hπ xchg cx,axπ les di,botπ stosbπ mov al,ahπ les di,topπ stosbπ end;ππprocedure clearline(line : word); assembler;π asmπ mov ax,screenseg { ; AX := screen segment }π mov es,ax { ; ES := AX }ππ mov ax,bytesperrow { ; AX := # chars per row * 2 }π push ax { ; preserve this value }π mov cx,line { ; CX := Line }π dec cx { ; CX-- (zero based) }π mul cx { ; AX := bytesperrow * 25 }π mov di,ax { ; ES:DI -> 25th line }π pop cx { ; CX := bytesperrow }π shr cx,1 { ; CX := CX / 2 (word moves) }π mov ax,1824 { ; AH := 7 (white on black) }π { ; AL := 32 (space) }π rep stosw { ; clear line }π end;ππprocedure panscreen(x0,y0,x1,y1 : integer);π{π Routine originally in Microsoft C by Richard Wiltonπ}π varπ i,j : integer;π xinc,π yinc : integer;π beginπ i := x0; j := y0;ππ if (x0 < x1) thenπ xinc := 1π elseπ xinc := -1;ππ if (y0 < y1) thenπ yinc := 1π elseπ yinc := -1;ππ while (i <> x1) or (j <> y1) doπ beginπ if i <> x1 then inc(i,xinc);π if j <> y1 then inc(j,yinc);π screenorigin(i,j);π end;π end;ππprocedure smoothscroll;π{π Smooth scrolls one line up and puts cursor on bottom line.π}π varπ top,bot : byte;ππ beginπ clearline(26); { blank 26th line }π panscreen(0,0,0,charheight); { smooth scroll one line down }π screenorigin(0,0); { restore screen origin }ππ asmπ push ds { ; preserve data segment }ππ mov ax,screenseg { ; AX := 0B000h or 0B800 }ππ mov ds,ax { ; DS := screen segment }π mov si,160 { ; SI := offset of (0,1) }π { ; DS:SI -> (0,1) of video buffer }ππ mov es,ax { ; ES := screen segment }π xor di,di { ; DI := offset of (0,0) }ππ mov cx,1920 { ; CX := bytesperrow * 24 / 2 }ππ rep movsw { ; move screen one line up }ππ pop ds { ; restore data segment }π end;ππ getcursor(top,bot); { save cursor settings }π clearline(25); { blank new bottom line }π gotoxy(1,25); { goto last line }π end;ππbeginπ if getvideomode = 7 thenπ screenseg := $B000π elseπ screenseg := $B800;ππ bytesperrow := 80*2; { 80 bytes for text and attributes }πend.ππ{$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V+,X+,Y+}π{$M 65520,0,655360}ππ(****************************************************************************)π { }π { PROGRAM : PANTEST }π { }π { DESCRIPTION : Tests the scroll unit. }π { }π { AUTHOR : John M. Beck }π { }π { MODIFICATIONS: None }π { }π { HISTORY : 29-Dec-1993 Coded. }π { }π(****************************************************************************)ππprogram pantest;ππuses crt, scroll;ππvarπ count : byte;ππbeginπ clrscr;π gotoxy(1,1);π textattr := (black shl 4) or lightgray;π for count := 1 to 24 do writeln('Hello ',count);ππ write('Press any key to smooth scroll up one line ... ');π readkey;ππ smoothscroll;ππ write('Press any key to pan demonstration ... ');π readkey;ππ clrscr;π gotoxy(65,25);π textattr := (black shl 4) or lightgreen;π write('... Groovy ...');π panscreen(0,0,65 * charwidth,25 * charheight);π panscreen(65 * charwidth,25 * charheight,0,0);π gotoxy(1,25);π textattr := (black shl 4) or lightblue;π write('Any key to exit ... ');π readkey;πend.ππ 14 01-27-9412:24ALL ELAD NACHMAN Vertical Graphics ScrolliIMPORT 7 B╡ {π> I've got all kinds of routines by now, from fire to plasma, etc.π> But what I need is a screen in graphics mode 13h (or mode-x),π> where text scrolls from the bottom of the screen to the top ofπ> the screen.ππThe address is a000:0000 - now all you should do is:π}πx : array[1..320] of byte;πasmπmov ax,$a000πmov es,axπmov ds,axπcldπmov cx,160πxor si,siπmov di,offset x[1]πrep movswπmov si,320πxor di,diπmov cx,160*199πrep movswπmov si,offset x[1]πmov di,320*199πmov cx,160πrep movswπend;ππ{πThat should do it - A simple move operation.πNote: This will only scroll one line. I think it's fast enough - although Iπtested it on a 386-dx40. The drawback of it is that you get this nasty line onπthe screen.π} 15 01-27-9413:33ALL GREG ESTABROOKS EGA/VGA Slider IMPORT 11 B╡ Program VGASLIDE; {requirements TP6 or higher + register-compatible VGA}πππuses CRT,grstuff;ππvarπ t,slide:word;π ch:char;ππProcedure VgaBase(Xscroll,Yscroll:integer);π var dum:byte;π Beginπ Dec(SLIDE,(Xscroll+320*Yscroll)); { slide scrolling state }π Port[$03d4]:=13; { LO register of VGAMEM offset }π Port[$03d5]:=(SLIDE shr 2) and $FF; { use 8 bits: [9..2] }π Port[$03d4]:=12; { HI register of VGAMEM offset }π Port[$03d5]:= SLIDE shr 10; { use 6 bits [16..10] }π Dum:=Port[$03DA]; { reset to input by dummy read }π Port[$03C0]:=$20 or $13; { smooth pan = register $13 }π Port[$03C0]:=(SLIDE and 3) Shl 1; { use bits [1..0], make it 0-2-4-6π}π End;πππBEGIN {main}ππ setvidmode($13);π SLIDE:=0;ππ { draw a quick test pattern directly to video memory }π For T:= 0 to 63999 do MEM[$A000:T]:=(T mod (317 + T div 10000)) andπ255;ππ repeatπ Vgabase(-1,-1); { scroll smoothly in UPPER LEFT direction }π Delay(14);π until Keypressed;π ch:=Readkey;ππ repeatπ Vgabase( 1, 1); { scroll smoothly in LOWER RIGHT direction }π Delay(14);π until Keypressed;π ch:=Readkey;π setvidmode($3);ππEND.π 16 02-05-9407:57ALL BERNIE PALLEK Tweaked Text Scroll IMPORT 18 B╡ πprogram heavily_tweaked_textscroll;πuses crt;πconst sseg : word = $b800; hi = 16; grd = 3; wideness = 1;π grade : string = '.:|X#';π txt : string = 'This simple old text scroll is really getting tweaked!'π + ' In fact, it''s not so simple anymore... ';ππvar fseg, fofs : word; idx : word; i, cur, line, bitpos : byte;π jcol : byte; ch : char; widecount : byte;ππprocedure getfont; assembler; asmπ mov ax,1130h; mov bh,3; int 10h; mov fseg,es; mov fofs,bp; end;ππprocedure retrace; assembler; asmπ mov dx,3dah;π @l1: in al,dx; test al,8; jnz @l1;π @l2: in al,dx; test al,8; jz @l2; end;ππprocedure moverowleft(startingrow : word); assembler;πasm { sorry, I had to smush it a bit }π push ds; push es { do I really need to save es? }π mov ax,$b800; mov es,ax; mov ds,ax; mov cx,0003π @@MoveByte:π add cx,startingrow; mov di,cx; mov al,[es:di]π sub cx,startingrow; sub cx,2; add cx,startingrowπ mov si,cx; mov [ds:si],al; sub cx,startingrowπ add cx,4; cmp cx,160π jl @@MoveByteπ pop es; pop dsπend;πππbeginπ getfont; textattr := 15; clrscr;π fillchar(mem[$b800:0],4000,0);π for idx := hi to (hi+7) do for jcol := 0 to length(grade)-1 do beginπ for i := grd*jcol to 79-(grd*jcol) doπ mem[sseg:idx*160+i*2] := Ord(grade[jcol+1]);π end;π idx := 1; jcol := 15;π repeatπ cur := ord(txt[idx]);π inc(jcol); if (jcol > 15) then jcol := 1;π bitpos := 0;π repeatπ for widecount := 1 to wideness do beginπ for line := 0 to 7 do beginπ (* jcol := random(14) + 1; *)π if ((mem[fseg:fofs+cur*8+line] shl bitpos) and 128) <> 0 thenπ mem[sseg:158+(line+hi)*160+1] := jcolπ elseπ mem[sseg:158+(line+hi)*160+1] := 0;π end;π retrace;π for line := 0 to 7 do moverowleft((line+hi)*160);π end;π inc(bitpos);π until (bitpos > 7) or keypressed;π if not keypressed then idx := 1 + idx mod length(txt);π until keypressed;π while keypressed do ch := readkey;π textattr := 7; clrscr;πend.ππ
