DP Tool Club 16

home *** CD-ROM | disk | FTP | other *** search

/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / maj / swag / egavga.swg < prev next >

Wrap

Text File | 1994-08-29 | 443KB | 2 lines

SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00131 EGA/VGA ROUTINES 1 05-28-9313:39ALL REYNIR STEFANSSON Proportional Fade IMPORT 12 Üd.p {πREYNIR STEFANSSONππ Here is yet another fade-in routine. This one does a proportional fadeπof all colours.π}ππProgram FadeDemo;ππUsesπ Crt;ππConstπ PelAddrRgR = $3C7;π PelAddrRgW = $3C8;π PelDataReg = $3C9;ππTypeπ rgb = Recordπ r, g, b : Byte;π end;ππVarπ i : Integer;π ch : Char;π col : Array[0..63] of rgb;ππProcedure GetCol(C : Byte; Var R, G, B : Byte);πbeginπ Port[PelAddrRgR] := C;π R := Port[PelDataReg];π G := Port[PelDataReg];π B := Port[PelDataReg];πend;ππProcedure SetCol(C, R, G, B : Byte);πbeginπ Port[PelAddrRgW] := C;π Port[PelDataReg] := R;π Port[PelDataReg] := G;π Port[PelDataReg] := B;πend;ππProcedure SetInten(b : Byte);πVarπ i : Integer;π fr,π fg,π fb : Byte;πbeginπ For i := 0 to 63 DOπ beginπ fr := col[i].r * b div 63;π fg := col[i].g * b div 63;π fb := col[i].b * b div 63;π SetCol(i, fr, fg, fb);π end;πend;ππbeginπ TextMode(LastMode);π For i := 0 to 63 DOπ GetCol(i, col[i].r, col[i].g, col[i].b);π For i := 1 to 15 DOπ beginπ TextAttr := i;π WriteLn('Foreground colour = ', i : 2);π end;π ch := ReadKey;π For i := 63 DOWNTO 0 DOπ beginπ SetInten(i);π Delay(20);π end;π GotoXY(1, 1);π For i := 15 DOWNTO 1 DOπ beginπ TextAttr := i;π WriteLn('Foreground colour = ', i : 2);π end;ππ For i := 0 to 63 DOπ beginπ SetInten(i);π Delay(20);π end;π ch := ReadKey;π TextMode(LastMode);πend.π 2 05-28-9313:39ALL SWAG SUPPORT TEAM Convert BGI to EXE IMPORT 7 Üd±ƒ {π>How do I compile a Graphic Program With the Graph included.ππI think what you'd like to be included in your EXE File are the BGI drivers ;πhere is a sample code to include the EGAVGA.BGI driver in your EXE :π}ππUnit EgaVga;ππInterfaceππUsesπ Graph;ππImplementationππ{$L EgaVga}πProcedure DriverEgaVga; External;ππbeginπ If RegisterBGIDriver(@DriverEgaVga)<0 Thenπ Halt(1);πend.ππ{πWhat you need to do is just include the Unit in your 'Uses' statement.πWell, prior to do this, you'll need to enter the following command atπthe Dos prompt :ππBinObj EGAVGA.BGI EGAVGA.Obj DriverEgaVgaππYou cand do the same For the other .BGI Files, and even For the .CHR (font)πFiles -just replacing RegisterBGIDriver With RegisterBGIFont, I think.π} 3 05-28-9313:39ALL SWAG SUPPORT TEAM EGA/VGA Bitmap FONTS IMPORT 130 Üd@j {π>I need to Write some Pascal code For a PC that will allow Text modeπ>fonts to be changed (at least on PC's With VGA adapters).ππ>Prof. Salmi's FAQ lists a book by Porter and Floyd, "Stretchingπ>Turbo Pascal", as having the relevant information, but my localπ>bookstore claims this is out of print.ππYou could try borrowing the book from the library. For instance oursπwill search For books; I rarely buy books. STP:v5.5 was an exception.πHere is code (substantially based on Porter and Floyds' code) writtenπfor version 5.x . Actually, aside from this stuff, the book wasn't asπgood as I thought it would be. I believe Ken Porter died and parts ofπthe book seem missing. This code, For instance, isn't well documentedπin the book (althought I think its clear how to use it from theseπPrograms).ππYou know, after playing With this code I thought I knew it all :DπIt turns out that there is a lot more you can do. For instance, theπintensity bit can be used as an extra Character bit to allowπ512-Character fonts. I have an aging PC Magazine article (that Iπhaven't gotten around to playing with) that has some Asm code For theπEGA. (I'm hoping the same code will work For the VGA).π}π{--[rounded.pas]--}ππProgramπ Rounded;πUsesπ Crt, BitFonts;ππTypeπ matrix = Array[0..15] of Byte;ππConstπ URC : matrix = ($00,$00,$00,$00,$00,$00,$00,$C0,$70,$30,$18,$18,$18,$18,$18,$18);π LLC : matrix = ($18,$18,$18,$18,$0C,$0E,$03,$00,$00,$00,$00,$00,$00,$00,$00,$00);π LRC : matrix = ($18,$18,$18,$18,$30,$70,$C0,$00,$00,$00,$00,$00,$00,$00,$00,$00);π ULC : matrix = ($00,$00,$00,$00,$00,$00,$00,$03,$0E,$0C,$18,$18,$18,$18,$18,$18);π{ ULC : matrix = ($00,$00,$00,$00,$00,$03,$0E,$19,$33,$36,$36,$36,$36,$36,$36,$36);}πVarπ index,b : Word;π package : fontPackagePtr;π FontFile : File of FontPackage;π EntryFont : ROMfont;ππ Procedure TextBox( left, top, right, bottom, style : Integer );π Constπ bord : Array[1..2,0..5] of Char = ( ( #196,#179,#218,#191,#217,#192 ),π ( #205,#186,#201,#187,#188,#200 ));π Var P:Integer;ππ beginπ if Style = 0 then Exit; { what the fuck is this For ? }ππ { verify coordinates are in ( NW,SE ) corner }π if left > right thenπ beginπ p := left; left := right; right := p;π end;π if bottom < top thenπ beginπ p := top; top := bottom; bottom := p;π end;ππ { draw top }π GotoXY( left,top );π Write( bord[style,2] );π For p := left+1 to right-1 doπ Write( bord[style,0]);π Write( bord[style,3] );ππ { draw bottomm }π GotoXY( left,bottom );π Write( bord[style,5]);π For p := left+1 to right-1 doπ Write( bord[style,0]);π Write( bord[style,4]);ππ { draw sides }π For p := top+1 to bottom-1 doπ beginπ GotoXY( left,p );π Write( bord[style,1] );π GotoXY( right,p );π Write( bord[style,1] );π end;π end; { Procedure TextBox }ππ Procedure replace( ASCII:Word; newChar:matrix );π Var offset,b:Word;π beginπ offset := ASCII * VDA.points;π For b := 0 to VDA.points-1 doπ package^.ch[offset+b] := newChar[b];π end;ππbeginπ if not isEGA thenπ beginπ Writeln( 'You can only run this Program on EGA or VGA systems' );π halt( 1 );π end;π {- fetch copy of entry font -}π EntryFont := CurrentFont;π Package := FetchHardwareFont( CurrentFont );ππ {- replace the corner Characters -}π replace( 191,URC );π replace( 192,LLC );π replace( 217,LRC );π replace( 218,ULC );ππ {- load and active user-modified font -}π Sound( 1000 );π LoadUserFont( package );π NoSound;ππ {- Draw a Text box -}π ClrScr;π{ CursorOff; }π TextBox( 20,5,60,20,1 );π GotoXY( 33,12 ); Write( 'rounded corners' );π{ WaitForKey;}π readln;ππ {- save user-modified font to File -}π assign( FontFile, 'HELLO' );π reWrite( FontFile );π Write( FontFile,Package^ );π close( FontFile );ππ {- clear and quit -}π SetHardWareFont( EntryFont );π ClrScr;π{ CursorOn;}ππend.ππ{--[editfnt2.pas]--}ππProgram EditFont;ππUses Crt, Dos, BitFonts;ππConstπ Block = #220;π Esc = #27;πVarπ c,π Choice : Char;π EditDone,π Done,π Valid : Boolean;π Font : ROMfont;π package : FontPackagePtr;π fout : File of FontPackage;π foutfil : String;ππFunction UpperCase( s:String ): String;π Var i:Byte;π beginπ For i := 1 to length( s ) doπ s[i] := UpCase( s[i] );π UpperCase := s;π end;πππFunction HexByte( b:Byte ):String;π Const DIGIT : Array[0..15] of Char = '0123456789ABCDEF';π beginπ HexByte := Digit[b SHR 4] + Digit[b and $0F];π end;πππFunction ByteBin( Var bs:String ):Byte;π Const DIGIT : Array[0..15] of Char = '0123456789ABCDEF';π Var i,b:Byte;π beginπ b := 0;π For i := 2 to length( bs ) doπ if bs[i] = '1' thenπ b := b + 2 SHL (i-1);π if bs[1] = '1' thenπ b := b + 1;π ByteBin := b;π end;πππProcedure Browse( Font:ROMfont );ππ{π arrow keys to manueverπ Esc to acceptπ Enter or space to toggle bitπ C or c to clear a rowπ alt-C or ctl-C to clear whole Charππ}π Constπ MapRow = ' - - - - - - - - ';π MapTop = 7;ππ Varπ ASCII,π row,π col,π index,π bit : Word;π f : Char_table;π s : String;π error : Integer;ππ Procedure putChar( value:Word );π Var reg:Registers;π beginπ reg.AH := $0A;π reg.AL := Byte( value );π reg.BH := 0;π reg.BL := LightGray;π reg.CX := 1;π intr( $10,reg );π GotoXY( WhereX+1, WhereY );π end; { proc putChar }ππ beginπ GetMem( Package, SizeOf( Package^ ));π ClrScr;π Package := FetchHardwareFont( Font );π Repeatπ GotoXY( 1,1 );π Write( 'FONT: ' );π Case Font ofπ ROM8x8 : Writeln( '8 x 8' );π ROM8x14 : Writeln( '8 x 14' );π ROM8x16 : Writeln( '8 x 16' );π end;π Writeln;π clreol;π Write( 'ASCII value to examine? (or QUIT to quit) ' );π readln( s );π Val( s,ASCII,error );π if error <> 0 thenπ if UpperCase( s ) = 'QUIT' thenπ Done := Trueπ elseπ ASCII := Byte( s[1] );ππ { show the Character image }π clreol;π Write( '(Image For ASCII ',ASCII,' is ' );π putChar( ASCII );π Writeln( ')' );ππ { display blank bitmap }π GotoXY( 1,MapTop );π For row := 1 to Package^.FontInfo.points doπ Writeln( maprow );ππ { explode the image bitmap }π index := Package^.FontInfo.points * ASCII;π For row := 0 to Package^.FontInfo.points-1 doπ beginπ For bit := 0 to 7 doπ if (( Package^.Ch[index] SHR bit ) and 1 ) = 1 thenπ beginπ col := ( 8 - bit ) * 2;π GotoXY( col,row+MapTop );π Write( block );π end;π GotoXY( 20,row+MapTop );π Write( hexByte( Package^.Ch[index] )+ 'h' );π inc( index );π end;πππ { edit font }π col := 2;π row := MapTop;π EditDone := False;π index := Package^.FontInfo.points * ASCII;ππ While ( not Done ) and ( not EditDone ) doπ beginπ GotoXY( col,row );π c := ReadKey;π if c = #0 thenπ c := ReadKey;ππ Case c ofππ #03, { wipe entire letter }π #46 : beginπ index := Package^.FontInfo.points * ASCII;π For row := MapTop to MapTop+Package^.FontInfo.points-1 doπ beginπ Package^.Ch[index] := 0;π col := 2;π GotoXY( col,row );π Write( '- - - - - - -' );π GotoXY( 20,row );π Write( hexByte( Package^.Ch[index] )+ 'h' );π GotoXY( col,row );π inc( index );π end;π end;ππ 'C', { wipe row }π 'c' : beginπ Package^.Ch[index] := 0;π col := 2;π GotoXY( col,row );π Write( '- - - - - - -' );π GotoXY( 20,row );π Write( hexByte( Package^.Ch[index] )+ 'h' );π GotoXY( col,row );π end;πππ #27 : EditDone := True; { esc }ππ #72 : begin { up }π if row > MapTop thenπ beginπ dec( row );π dec( index );π end;π end;ππ #80 : begin { down }π if row < ( MapTop + Package^.FontInfo.points - 1 ) thenπ beginπ inc( row );π inc( index );π end;π end;ππ #77 : begin { right }π if col < 16 thenπ inc( col,2 );π end;ππ #75 : begin { left }π if col > 3 thenπ dec( col,2 );π end;ππ #13,π #10,π ' ' : beginπ bit := 8 - ( col div 2 );π if (( Package^.Ch[index] SHR bit ) and 1 ) = 1 thenπ beginπ Package^.Ch[index] := ( Package^.Ch[index] ) ANDπ ($FF xor ( 1 SHL bit ));π Write( '-' )π endπ elseπ beginπ Package^.Ch[index] := Package^.Ch[index] XORπ ( 1 SHL bit );π Write( block );π end;ππ GotoXY( 20,row );π Write( hexByte( Package^.Ch[index] )+ 'h' );π GotoXY( col,row );π end;ππ end; { Case }ππ LoadUserFont( Package );ππ end; { While }ππ Until Done;ππ GotoXY( 40,7 );π Write( 'Save to disk? (Y/n) ');π Repeatπ c := UpCase( ReadKey );π Until c in ['Y','N',#13];π if c = #13 thenπ c := 'Y';π Write( c );ππ if c = 'Y' thenπ beginπ GotoXY( 40,9 );π ClrEol;π Write( 'Save as: ');π readln( foutfil );ππ(* if fexist( foutfil ) thenπ beginπ GotoXY( 40,7 );π Write( 'OverWrite File ''',foutfil,''' (y/N) ');π Repeatπ c := UpCase( ReadKey );π Until c in ['Y','N',#13];π if c = #13 thenπ c := 'N';π Write( c );π end;π*)π {$I-}π assign( fout,foutfil ); reWrite( fout );π Write( fout,Package^ );π close( fout );π {$I+}π GotoXY( 40,11 );π if ioResult <> 0 thenπ Writeln( 'Write failed!' )π elseπ Writeln( 'Wrote font to File ''',foutfil,'''.' );π end;πππ end; { proc Browse }πππbeginππ Done := False;π { get font to view }π Repeatπ Valid := False;π Repeatπ ClrScr;π Writeln( 'Fonts available For examination: ' );π Writeln( ' 1. 8 x 8' );π if isEGA thenππ Writeln( ' 2. 8 x 14' );π if isVGA thenπ Writeln( ' 3. 8 x 16' );π Writeln;π Write( ' Select by number (or Esc to quit) ' );π choice := ReadKey;π if Choice = Esc thenπ beginπ ClrScr;π Exit;π end;π if Choice = '1' then Valid := True;π if ( choice = '2' ) and isEGA then Valid := True;π if ( Choice = '3' ) and isVGA then Valid := True;π Until Valid;ππ { fetch and display selected font }π Case choice ofπ '1' : Font := ROM8x8;π '2' : Font := ROM8x14;π '3' : Font := ROM8x16;π end;π Browse( font );π Until Done;π GotoXY( 80,25 );π Writeln;π Writeln( 'Thanks you For using EditFont which is based on code from' );π Writeln( '_Stretching Turbo Pascal_ by Kent Porter and Mike Floyd.' );π Writeln;π Writeln( 'This Program was developed 12 Apr 92 by Alan D. Mead.' );πend.ππ{--[bitfonts.pas]--}πππUnit BitFonts;π { support For bit-mapped Text fonts on EGA/VGA }ππInterfaceππTypeπ { enumeration of ROM hardware fonts }π ROMfont = ( ROM8x14, ROM8x8, ROM8x16 );ππ { Characetr definition table }π CharDefTable = Array[0..4095] of Byte;π CharDefPtr = ^CharDefTable;ππ { For geting Text Character generators }π Char_table = Recordπ points : Byte; { Char matrix height }π def : CharDefPtr; { address of table }π end;ππ { font format }π FontPackage = Recordπ FontInfo : Char_Table;π ch : CharDefTable;π end;π FontPackagePtr = ^FontPackage;ππ { table maintained by video ROM BIOS at 40h : 84h }π VideoDataArea = Recordπ rows : Byte; { Text rows on screem - 1 }π points : Word; { height of Char matrix }π info, { EGA/VGA status info }π info_3, { EGA/VGA configuration }π flags : Word; { misc flags }π end; { remainder of table ignored }ππ { globally visible }πVarπ VDA : VideoDataArea Absolute $40:$84; { equipment flags }π isEGA,π isVGA,π isColor : Boolean;π CurrentFont : ROMfont; { default hardware font }ππProcedure GetCharGenInfo( font:ROMfont; Var table:Char_table );πProcedure SetHardWareFont( font:ROMfont );πFunction FetchHardwareFont( font:ROMfont ):FontPackagePtr;πProcedure LoadUserFont( pkg:FontPackagePtr );ππ{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }ππImplementationππUses Dos, Crt {, TextScrn} ;ππVar reg:Registers;ππProcedure GetCharGenInfo( font:ROMfont; Var table:Char_table );π beginπ if isEGA thenπ beginπ reg.AH := $11;π reg.AL := $30;π Case font ofπ ROM8x8 : reg.BH := 3;π ROM8x14 : reg.BH := 2;π ROM8x16 : reg.BH := 6;π end;π intr( $10,reg );π table.def := ptr( reg.ES,reg.BP ); { address of definition table }π Case font ofπ ROM8x8 : table.points := 8;π ROM8x14 : table.points := 14;π ROM8x16 : table.points := 16;π end;π end;π end; { proc GetCharGenInfo }πππProcedure SetHardWareFont( font:ROMfont );π beginπ if isEGA thenπ beginπ Case Font ofπ ROM8x14 : reg.AL := $11;π ROM8x8 : reg.AL := $12;π ROM8X16 : if isVGA thenπ reg.AL := $14π elseπ beginπ reg.AL := $12;π font := ROM8x14;π end;π end;π reg.BL := 0;π intr( $10,reg );π CurrentFont := font;π end;π end; { proc SetHardwareFont }πππFunction FetchHardwareFont( font:ROMfont ):FontPackagePtr;π { Get a hardware font and place it on heap For user modification }π Var pkg : FontPackagePtr;π beginπ new( pkg );π GetCharGenInfo( font,pkg^.fontinfo );π pkg^.ch := pkg^.fontinfo.def^;π FetchHardwareFont := pkg;π end; { func FetchHardwareFont }πππProcedure LoadUserFont( pkg:FontPackagePtr );π beginπ reg.AH := $11;π Reg.AL := $10;π reg.ES := seg( pkg^.ch );π reg.BP := ofs( pkg^.ch );π reg.BH := pkg^.FontInfo.points;π reg.BL := 0;π reg.CX := 256;π reg.DX := 0;π intr( $10,reg );π end; { proc LoadUserFont }πππbegin { initialize }ππ { determine adapter Type }π isEGA := False;π isVGA := False;π if VDA.info <> 0 thenπ beginπ isEGA := True;π if ( VDA.flags and 1 ) = 1 thenπ isVGA := True;π end;ππ { determine monitor Type }π if isEGA thenπ beginπ reg.AH := $12;π reg.BL := $10;π intr( $10,reg );π if reg.BH = 0 thenπ isCOLOR := Trueπ elseπ isCOLOR := False;π { ADM: this seems Really shaky! }π { determine current font }π if isVGA and ( VDA.rows = 24 ) thenπ CurrentFont := ROM8x16π elseπ if isEGA and ( VDA.rows = 24 ) thenπ CurrentFont := ROM8x14π elseπ CurrentFont := ROM8x8;π endπend.π 4 05-28-9313:39ALL EDWIN CALIMBO Detection of EGA/VGA CardIMPORT 18 ÜdR╦ {πEDWIN CALIMBOππ│Can anyone supply me With a routine to determine a Graphics card? I wantπ│the Procedure to return a Variable if the user has a Graphics card lessπ│than an EGA. Anyone have anything quick?ππThe Function below will detect most Graphics (mono/color) card. It'sπa bit long, but is has all the info on how to detect certain card.π}ππUsesπ Dos;ππTypeπ CardType = (none,mda,cga,egamono,egacolor,π vgamono,vgacolor,mcgamono,mcgacolor);ππFunction VideoCard: CardType;πVarπ code : Byte;π Regs : Registers;πbeginπ Regs.AH := $1A; (* call VGA Identify Adapter Function *)π Regs.AL := $00; (* clear AL to 0...*)π Intr($10, Regs); (* call BIOS *)π If Regs.AL = $1A thenπ beginπ Case Regs.BL ofπ $00 : VideoCard := NONE; (* no Graphic card *)π $01 : VideoCard := MDA; (* monochrome *)π $02 : VideoCard := CGA; (* cga *)π $04 : VideoCard := EGAColor; (* ega color *)π $05 : VideoCard := EGAMono; (* ega mono*)π $07 : VideoCard := VGAMono; (* vga mono *)π $08 : VideoCard := VGAColor; (* vga color *)π $0A,π $0C : VideoCard := MCGAColor; (* mcga color *)π $0B : VideoCard := MCGAMono; (* mcga mono *)π Elseπ VideoCard := CGAπ endπ endπ Elseπ beginπ Regs.AH := $12; (* use another Function service *)π Regs.BX := $10; (* BL = $10 means return EGA info *)π Intr($10, Regs); (* call BIOS video Function *)π If Regs.bx <> $10 Then (* bx unchanged means EGA is not present *)π beginπ Regs.AH := $12;π Regs.BL := $10;π Intr($10, Regs);π If Regs.BH = 0 Thenπ VideoCard := EGAColorπ Elseπ VideoCard := EGAMonoπ endπ Elseπ beginπ Intr($11, Regs); (* eguipment determination service *)π code := (Regs.AL and $30) shr 4;π If (code = 3) Thenπ VideoCard := MDAπ Elseπ VideoCard := CGAπ endπ endπend; (* VideoCard *)ππ(*============================= cut here ==================================*)ππbeginπ Case VideoCard ofπ VGAColor : Writeln('VGA Color');π end;πend. 5 05-28-9313:39ALL SWAG SUPPORT TEAM Drawing a Circle IMPORT 19 Üd ¬ { SC> I had some free time the other day so I decided to play aroundπ SC> With some Graphics. I am using TRIG Functions to draw aπ SC> circle. But it's not too fast. I understand that usingπ SC> Shift operators to multiply and divide will be faster. Butπ SC> am not sure how to do numbers which are not powers of 2.π SC> Here is the code; how else can we make it faster?ππUsing shifts to multiply things is one way to speed it up but that's difficultπFor generic multiplies and only applies to Integer multiplies. There's an evenπfaster way to draw a circle if you are interested. <YES he says> OK, first itπis called the "Bresenham Circle Algorithm" and Uses symmetry about the eightπoctants to plot the circle and Uses only Integer arithmetic throughout. Hereπis the code.π}πUsesπ Graph, KASUtils;ππVarπ Gd, Gm : Integer;ππProcedure DrawCircle(X, Y, Radius:Word; Color:Byte);πVarπ Xs, Ys : Integer;π Da, Db, S : Integer;πbeginπ if (Radius = 0) thenπ Exit;ππ if (Radius = 1) thenπ beginπ PutPixel(X, Y, Color);π Exit;π end;ππ Xs := 0;π Ys := Radius;ππ Repeatπ Da := Sqr(Xs+1) + Sqr(Ys) - Sqr(Radius);π Db := Sqr(Xs+1) + Sqr(Ys - 1) - Sqr(Radius);π S := Da + Db;ππ Xs := Xs+1;π if (S > 0) thenπ Ys := Ys - 1;ππ PutPixel(X+Xs-1, Y-Ys+1, Color);π PutPixel(X-Xs+1, Y-Ys+1, Color);π PutPixel(X+Ys-1, Y-Xs+1, Color);π PutPixel(X-Ys+1, Y-Xs+1, Color);π PutPixel(X+Xs-1, Y+Ys-1, Color);π PutPixel(X-Xs+1, Y+Ys-1, Color);π PutPixel(X+Ys-1, Y+Xs-1, Color);π PutPixel(X-Ys+1, Y+Xs-1, Color);π Until (Xs >= Ys);πend;ππ{It Uses Sqr at the moment, but you could code it to use X * X instead of Sqr(X)πif you like since it will probably speed it up. I haven't had time to optimiseπit yet since it will ultimately be in Assembler.ππHope this comes in handy For what you're doing. :-) Oh BTW it assumes you haveπa PlotDot routine which takes the obvious parameters.π}ππbeginπ EGAVGA_Exe;π gd := detect;π InitGraph(gd,gm,'');π clearviewport;ππ drawcircle(100,100,150,yellow);π readln;πend. 6 05-28-9313:39ALL SWAG SUPPORT TEAM Another Fader Program IMPORT 24 Üdÿá {πWould anyone have a Procedure of Function to do a fadein orπfadeout CLXXof a bitmapped image. if I understand correctly, theseπCLXXfadeins are perFormed by changing the DAC Registers of the CLXXVGAπCards. Can anyone enlighten me on this as I have CLXXsearched manyπbooks on how to do this and have not found CLXXit. I know that there isπa utility out there called CLXXFastGraph by Teg Gruber which can doπthis, but short of CLXXbuying it For $200.00 Would one of you good folksπhave a CLXXroutint in Asm or BAsm to do this. CLXXI thank you all inπadvance For your assistance. CLXXChristian Laferriere.π}ππProcedure Pageswitch(X: Byte);πbeginπ Asmπ mov ah,5π mov al,xπ int 10hπ end;πend; { Pageswitch }ππ{********************************************}πProcedure FadeIn;ππVarπ oldp,π oldp2,π oldp3 : Byte;π Palette : Array[1..255 * 4] of Byte;π FAKEPalette : Array[1..255 * 4] of Byte;π I, J : Integer;ππbeginπ For I := 1 to 255 doπ beginπ Port[$3C7] := I;π Palette[(I - 1) * 4 + 1] := I;π Palette[(I - 1) * 4 + 2] := Port[$3C9];π Palette[(I - 1) * 4 + 3] := Port[$3C9];π Palette[(I - 1) * 4 + 4] := Port[$3C9];π end;π For I := 1 to 255 doπ beginπ Port[$3C8] := I;π Port[$3C9] := 0;π Port[$3C9] := 0;π Port[$3C9] := 0;π end;ππ Pageswitch(0);ππ For J := 0 to 63 doπ beginππ For I := 1 to 255 doπ beginπ Port[$3C7] := I;π oldp := Port[$3C9];π oldp2 := Port[$3C9];π oldp3 := Port[$3C9];π Port[$3C8] :=I;π if oldp + 1 <= Palette[(I - 1) * 4 + 2] thenπ Port[$3C9] := oldp+1π elseπ Port[$3C9] := Oldp;π if oldp2 + 1 <= Palette[(I - 1) * 4 + 3] thenπ Port[$3C9] := oldp2+1π elseπ Port[$3C9] := Oldp2;π if oldp3 + 1 <= Palette[(I - 1) * 4 + 4] thenπ Port[$3C9] := oldp3+1π elseπ Port[$3C9] := Oldp3;π end;ππ For I := 1 to 30000 doπ beginπ end;ππ end;πend; {end of FadeIn}πππProcedure FadeOut;ππVarπ uoldp,π uoldp2,π uoldp3 : Byte;π I, J : Integer;πbeginπ Pageswitch(0);ππ For J := 0 to 63 doπ beginππ For I := 1 to 255 doπ beginπ Port[$3C7] := I;π uoldp := Port[$3C9];π uoldp2 := Port[$3C9];π uoldp3 := Port[$3C9];π Port[$3C8] := I;π if uoldp - 1 >= 0 thenπ Port[$3C9] := uoldp - 1π elseπ Port[$3C9] := uOldp;π if uoldp2 - 1 >= 0 thenπ Port[$3C9] := uoldp2 - 1π elseπ Port[$3C9] := uOldp2;π if uoldp3 - 1 >= 0 thenπ Port[$3C9] := uoldp3 - 1π elseπ Port[$3C9] := uOldp3;π end;ππ For I := 1 to 30000 doπ beginπ end;ππ end;πend; {end of FadeOut}ππ{πThat Procedure can FadIn and FadeOut any Text screen or anyπGraphics in Mode $13 With no problems.. Just make sure that youπswitch the video pages at the right time between fadeIns andπFadeouts.. Hope that helped.. LATERπ}ππbeginπ FadeOut;π FadeIn;πend. 7 05-28-9313:39ALL SEAN PALMER Text fading on a VGA IMPORT 7 Üd¡¬ {π Here is some code to try For Text fading on a vga...π by Sean Palmerπ}ππConstπ tableReadIndex = $3C7;π tableWriteIndex = $3C8;π tableDataRegister = $3C9;ππProcedure setColor(color, r, g, b : Byte); Assembler;πAsm {set DAC color}π mov dx, tableWriteIndex;π mov al, color;π out dx, al;π inc dx;π mov al, r;π out dx, al;π mov al, g;π out dx, al;π mov al, b;π out dx, al;πend; {Write index now points to next color}ππFunction getColor(color : Byte) : LongInt; Assembler;πAsm {get DAC color}π mov dx, tableReadIndex;π mov al, color;π out dx, al;π add dx, 2;π cld;π xor bh, bh;π in al, dx;π mov bl, al;π in al, dx;π mov ah, al;π in al, dx;π mov dx, bx;πend; {read index now points to next color}ππ 8 05-28-9313:39ALL SWAG SUPPORT TEAM Dealing with EGA Palet IMPORT 6 Üd8≥ {π> I once saw a Procedure that set the palette With RGB inputs, like theπ> 256- colour palette setter (RGBSetPalette). It used some SHLsπ> and SHRs to reduce the inputted values For red, green, andπ> blue to 2-bit values (or somewhere around there).π}ππProcedure EGAPalette(c_index, red, green, blue : Byte);πVarπ i : Integer;π regs : Registers;πbeginπ red := red SHR 6;π green := green SHR 6;π blue := blue SHR 6;π i := (red SHL 4) + (green SHL 2) + blue;π regs.AH := $10;π regs.AL := 0;π regs.BH := i;π regs.BL := c_index; { the colour index to change }π Intr($10, regs);πend;ππ 9 05-28-9313:39ALL SWAG SUPPORT TEAM Another Good Fader IMPORT 15 ÜdδΓ Program GoodFade;πUsesπ Crt;ππConstπ I1II111 = 75;π IIIIII = 60;ππVarπ Count, Count2 : Byte;π Pal1, Pal2 : Array [0..255, 0..2] of Byte;ππProcedure I1I1;πbeginπ For Count := 0 to 255 DOπ beginπ PORT [$03C7] := Count;π Pal1 [Count, 0] := PORT [$03C9];π Pal1 [Count, 1] := PORT [$03C9];π Pal1 [Count, 2] := PORT [$03C9];π end;π Pal2 := Pal1;πend;ππProcedure IIIIIII;πbeginπ For Count := 0 to 255 DOπ beginπ PORT [$03C8] := Count;π PORT [$03C9] := Pal1 [Count, 0];π PORT [$03C9] := Pal1 [Count, 1];π PORT [$03C9] :=π Pal1 [Count, 2];π end;πend;ππProcedure FadeOut;πbeginπ For Count := 1 to I1II111 DOπ beginπ For Count2 := 0 to 255 DOπ beginπ if Pal2 [Count2, 0] > 0 thenπ DEC (Pal2 [Count2, 0]);π if Pal2 [Count2, 1] > 0 thenπ DEC (Pal2 [Count2, 1]);π if Pal2 [Count2, 2] > 0 thenπ DEC (Pal2 [Count2, 2]);π PORT [$03C8] := Count2;π PORT [$03C9] := Pal2 [Count2, 0];π PORT [$03C9] := Pal2 [Count2, 1];π PORT [$03C9] := Pal2 [Count2, 2];π end;π Delay (IIIIII);π end;πend;ππProcedure FadeIn;πbeginπ For Count := 1 to I1II111 DOπ beginπ For Count2 := 0 to 255 DOπ beginπ if Pal2 [Count2, 0] < Pal1 [Count2, 0] thenπ INC (Pal2 [Count2, 0]);π if Pal2 [Count2, 1] < Pal1 [Count2, 1] thenπ INC (Pal2 [Count2, 1]);π if Pal2 [Count2, 2] < Pal1 [Count2, 2] thenπ INC (Pal2 [Count2, 2]);π PORT [$03C8] := Count2;π PORT [$03C9] := Pal2 [Count2, 0];π PORT [$03C9] := Pal2 [Count2, 1];π PORT [$03C9] := Pal2 [Count2, 2];π end;π Delay (IIIIII);π end;πend;ππbeginπ I1I1;π FadeOut;π FadeIn;π IIIIIII;πend.ππ 10 05-28-9313:39ALL EIRIK MILCH PEDERESEN Yet another Fader IMPORT 61 Üd∩ {πEirik Milch Pedersenππ> I too, would appreciate the source for fading colours in 16 colour textπ> mode on a VGA, i've tried my hand at it but can't work out a decentπ> algoritm, i've been using int 10h to set a block of colour regs for speedπ> but can't seem to work out how to fade the colours!ππI replyed to the author of the first fade-question, but I might as well postπmy code to the public. This is a little demo I made in TP60 for fading form aπpalette to another. So techincal you can fade from anything to anything. :-)πThe routine should be fast enough for most computers, but if you start toπsee 'snow' on the screen try to reduce the number of colors that are faded.π}ππ{$G+}πusesπ crt;ππtypeπ ColorType = array[0..255] of recordπ R, G, B : byte;π end;ππvarπ Colors,π White,π Black : ColorType;ππprocedure SetMode(Mode : word); assembler;πasmπ mov ax, Modeπ int 010hπend;ππprocedure MakeColors(ColorArray : pointer); assembler;πlabelπ RLoop, GLoop, BLoop;πasmπ les di, ColorArrayππ mov cx, 85π xor al, alπ RLoop:π mov byte ptr es:[di+0], alπ mov byte ptr es:[di+1], 0π mov byte ptr es:[di+2], 0π add di, 3π inc alπ and al, 03Fhπ loop Rloopππ mov cx, 85π xor al, alπ GLoop:π mov byte ptr es:[di+0], 0π mov byte ptr es:[di+1], alπ mov byte ptr es:[di+2], 0π add di, 3π inc alπ and al, 03Fhπ loop Gloopππ mov cx, 86π xor al, alπ BLoop:π mov byte ptr es:[di+0], 0π mov byte ptr es:[di+1], 0π mov byte ptr es:[di+2], alπ add di, 3π inc alπ and al, 03Fhπ loop Bloopπend;ππprocedure DrawBars; assembler;πlabelπ LineLoop, PixelLoop;πasmπ mov ax, 0A000hπ mov es, axπ xor di, diππ mov cx, 200π LineLoop:π xor al, alπ push cxπ mov cx, 320π PixelLoop:π stosbπ inc alπ loop PixelLoopππ pop cxπ loop LineLoopπend;ππprocedure UpdateColorsSlow(ColorBuffer : pointer); assembler;πlabelπ ColorLoop;πasmπ push dsππ lds si, ColorBufferπ mov cx, 3*256ππ mov dx, 03C8hπ xor al, alπ out dx, alπ inc dxπ ColorLoop: { here is the substitute that }π lodsb { goes round the problem. }π out dx, alπ loop ColorLoopππ pop dsπend;ππprocedure UpdateColorsFast(ColorBuffer : pointer); assembler;πasmπ push dsππ lds si, ColorBufferπ mov cx, 3*256ππ mov dx, 03C8hπ xor al, alπ out dx, alπ inc dxππ rep outsb { here is the cause of the problem. }ππ pop dsπend;πππprocedure FadeColors(FromColors, ToColors : Pointer;π StartCol, NoColors, NoSteps : byte); assembler;πlabelπ Start, DummyPalette, NoColorsX3,π DummySub, StepLoop, ColorLoop,π SubLoop, RetrLoop1, RetrLoop2, Over1, Over2;πasmπ jmp Startπ DummyPalette:π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π DummySub:π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0π NoColorsX3 :π dw 0π Start:π push dsππ lds si, ToColorsπ les di, FromColorsπ xor ch, chπ mov cl, NoColorsπ shl cx, 1π add cl, NoColorsπ adc ch, 0π mov word ptr cs:[NoColorsX3], cxπ mov bx, 0π push diπ SubLoop:π lodsbπ sub al, byte ptr es:diπ mov byte ptr cs:[DummySub+bx], alπ inc diπ inc bxπ loop SubLoopπ pop diππ push csπ pop dsπ mov dh, 0π mov dl, NoStepsπ StepLoop:π push diπ mov cx, word ptr cs:[NoColorsX3]π mov bx, 0π ColorLoop:π xor ah, ahπ mov al, byte ptr cs:[DummySub+bx]π or al, alπ jns over1π neg alπ over1:π mul dhπ div dlπ cmp byte ptr cs:[DummySub+bx], 0π jge over2π neg alπ over2:π mov ah, byte ptr es:[di]π add ah, alπ mov byte ptr cs:[DummyPalette+bx], ahπ inc bxπ inc diπ loop ColorLoopππ push dxπ mov si, offset DummyPaletteπ mov cx, word ptr cs:[NoColorsX3]ππ mov dx, 03DAhπ retrloop1:π in al, dxπ test al, 8π jnz retrloop1π retrloop2:π in al, dxπ test al, 8π jz retrloop2ππ mov dx, 03C8hπ mov al, StartColπ out dx, alπ inc dxπ rep outsbππ pop dxππ pop diπ inc dhπ cmp dh, dlπ jbe StepLoopππ pop dsπend;ππππbeginπ ClrScr;π MakeColors(@Colors);π FillChar(Black, 256 * 3, 0);π FillChar(White, 256 * 3, 63);ππ SetMode($13);π UpdateColorsSlow(@Black);π DrawBars;ππ REPEATπ FadeColors(@Black, @Colors, 0, 255, 100);π FadeColors(@Colors, @White, 0, 255, 100);π FadeColors(@White, @Colors, 0, 255, 100);π FadeColors(@Colors, @Black, 0, 255, 100);π UNTIL keyPressed;ππ SetMode($3);πEND.π 11 05-28-9313:39ALL GRADY WERNER FAST RGB on EGA/VGA IMPORT 6 Üdí {πGRADY WERNERπPut these in your code For GREAT, FAST RGB Palette Changing...π}πProcedure ASetRGBPalette(Color, Red, Green, Blue : Byte);πbeginπ Port[$3C8]:=Color;π Port[$3C9]:=Red;π Port[$3C9]:=Green;π Port[$3C9]:=Blue;πend;ππ{πThis Procedure Changes palette colors about 400% faster than theπbuilt-in routines. Also, a problem With flicker may have been encounteredπwith Turbo's Putimage Functions. Call this Procedure RIGHT BEFORE theπputimage is called... Viola... NO Flicker!π}πProcedure WaitScreen;πbeginπ Repeat Until (Port[$3DA] and $08) = 0;π Repeat Until (Port[$3DA] and $08) <> 0;πend;π 12 05-28-9313:39ALL SWAG SUPPORT TEAM Get current Videomode IMPORT 6 Üdïò {πHere's a quick proc. to return the current video mode:π}ππUsesπ Dos;ππFunction CurVidMode : Byte;ππVarπ Regs : Registers;ππbegin;ππ Regs.Ah :=$f;π Intr($10, Regs);π CurVidMode := Regs.Al;ππend;ππbeginπ Writeln(CurVidMode);πend.πππ{πYou can use that same color Procedure For the VGA 16 color mode becauseπalthough it can only do 16 colors, it can still change each of the 16πcolors to 64*64*64 (262,144) colors, like the 256 color mode.ππAbout the EGA palette - I'll have to get back to ya, that's moreπcomplex.π}ππ 13 05-28-9313:39ALL SWAG SUPPORT TEAM Another text fader IMPORT 12 ÜdJi {π>I have a copy of the fade Unit and am having problems getting it to workπ>correctly. I want to fade my Programs screen on Exit, clear it, and showπ>the Dos screen.ππHere's a little fade source, there're some change to made if you're using it inπGraphic or Text mode.π}ππUsesπ Crt;πππVarπ count1, count2 : Integer;π pal1,pal2 : Array[0..255,0..2] of Byte;πππbeginππ For count1 := 0 to 255 do {Get the current palette}π beginπ Port[$03C7] := count1;π pal1[count1,0] := Port[$03C9];π pal1[count1,1] := Port[$03C9];π pal1[count1,2] := Port[$03C9];π end;ππ Pal2:=Pal1;ππ For Count1 := 1 to 255 do {this will fade the entire palette}π begin {20 must be enough in Text mode}π For Count2 := 0 to 255 doπ beginπ If Pal2[Count2,0] > 0 thenπ Dec(Pal2[Count2,0]);π If Pal2[Count2,1] > 0 thenπ Dec(Pal2[Count2,1]);π If Pal2[Count2,2] > 0 thenπ Dec(Pal2[Count2,2]);π Port[$03C8] := Count2;π Port[$03C9] := Pal2[Count2,0];π Port[$03C9] := Pal2[Count2,1];π Port[$03C9] := Pal2[Count2,2];π end;π Delay(40); {Change the Delay For a quicker or slower fade}π end;ππ For Count1 := 0 to 255 do {Restore Original palette}π beginπ Port[$03C8] := Count1;π Port[$03C9] := Pal1[Count1,0];π Port[$03C9] := Pal1[Count1,1];π Port[$03C9] := Pal1[Count1,2];π end;ππend.ππ 14 05-28-9313:39ALL JOHN WONG GREAT text Fader IMPORT 17 Üd_ {πJohn Wongππ>Does anyone out there have any fade-in routines??? Also can anyoneπ>recomend some good books on VGA Programming and Animation???ππThis might be a fade out routine, but you could modify it to fade in.π}π{$G+}πProgram fades;ππUsesπ Crt, Dos;π { TPC /$G+ To Compile }πVarπ All_RGB : Array[1..256 * 3] Of Byte;π x,color : Integer;πππProcedure FadeOut2; { This is Hard Cores Fade Out }πbeginπ {for using Textmode use color 7, or For Graphics}π x := 1;π Color := 7;π Repeat;π port[$3c8] := color;π port[$3c9] := 60 - x;π port[$3c9] := 60 - x;π port[$3c9] := 60 - x;π inc(x);π Delay(75);π Until x = 60;ππ { Get The Screen Back ( Change This ) }π Color := 7;π port[$3c8] := color;π port[$3c9] := 60 + x;π port[$3c9] := 60 + x;π port[$3c9] := 60 + x;π inc(x);π Delay(25);πend;ππProcedure FadeOut;πLabelπ OneCycle,π ReadLoop,π DecLoop,π Continue,π Retr,π Wait,π Retr2,π Wait2;πbegin { FadeOut }π Asmπ MOV CX,64π OneCycle:ππ MOV DX,3DAhπ Wait: in AL,DXπ TEST AL,08hπ JZ Waitπ Retr: in AL,DXπ TEST AL,08hπ JNZ Retrππ MOV DX,03C7hπ xor AL,ALπ OUT DX,ALπ INC DXπ INC DXπ xor BX,BXπ ReadLoop:π in AL,DXπ MOV Byte Ptr All_RGB[BX],ALπ INC BXπ CMP BX,256*3π JL ReadLoopππ xor BX,BXπ DecLoop:π CMP Byte Ptr All_RGB[BX],0π JE Continueπ DEC Byte Ptr All_RGB[BX]ππ Continue:π INC BXπ CMP BX,256*3π JL DecLoopππ MOV DX,3DAhπ Wait2: in AL,DXπ TEST AL,08hπ JZ Wait2π Retr2: in AL,DXπ TEST AL,08hπ JNZ Retr2ππ MOV DX,03C8hπ MOV AL,0π OUT DX,ALπ INC DXπ MOV SI,OFFSET All_RGBπ CLDπ PUSH CXπ MOV CX,256*3π REP OUTSBπ POP CXππ LOOP OneCycleππ end;πend; { FadeOut }πππbeginπ fadeout;π NormVideo;π Fadeout2;πend.π 15 05-28-9313:39ALL SWAG SUPPORT TEAM Initialize BGI Interface IMPORT 18 Üd∞M {πThe following Unit contains one Function. This Function will initialize theπBorland BGI Interface in a Turbo Pascal Program. I wrote this Unit in TPπ5.5, but it should work For all versions of TP after 4.0.ππThe Function performs two actions which I think can help Graphics Programsπimmensely. The first is to obtain the path For the BGI (and CHR) driversπfrom an environmental Variable BGIDIR. The second action is to edit theπdriver and mode passed to the initialization Unit against what is detectedπby TP. The Function returns a Boolean to say if it was able to successfullyπinitialize the driver.ππI hope this helps someone.π}ππUnit GrphInit;ππInterfaceππUsesπ Dos,π Graph;ππFunction Init_Graphics (Var GraphDriver, GraphMode : Integer) : Boolean;π{ This Function will initialize the Turbo Graphics For the requestedπ Graphics mode if and only if the requested mode is valid For theπ machine the Function is run in. Another feature of this Function isπ that it will look For an environmental Variable named 'BGIDIR'. Ifπ this Variable is found, it will attempt to initialize the Graphicsπ mode looking For the BGI driver using the String associated With BGIDIRπ as the path. If the correct BGI driver is not available, or if there isπ not BGIDIR Variable in the environment, it will attempt to initializeπ using the current directory. }πππImplementationππFunction Init_Graphics (Var GraphDriver, GraphMode : Integer) : Boolean;πConstπ ENV_BGI_PATH = 'BGIDIR';πVarπ BGI_Path : String;πbeginπ { Default to not work }π Init_Graphics := False;π BGI_Path := GetEnv(ENV_BGI_PATH);π InitGraph(GraphDriver,GraphMode,BGI_Path);π if GraphResult = grOk thenπ Init_Graphics := Trueπ Elseπ begin { Try current Directory }π InitGraph(GraphDriver,GraphMode,'');π if GraphResult = grOk thenπ Init_Graphics := True;π end; { Try current Directory }πend; { Function Init_Graphics }ππend.πππ{π Example File :ππUsesπ Graph, GrphInit;ππConstπ Gd : Integer = 0;π Gm : Integer = 0;πbeginπ Init_Graphics(Gd, Gm);π Line(10,10,40,40);π Readln;πend.π} 16 05-28-9313:39ALL SWAG SUPPORT TEAM Get/Put Image functions IMPORT 25 Üdl╜ {Here is a small Program that illustrates the features of GetImage/PutImage thatπyou would like to use:π}π {$A+,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S+,V-,X+}π {$M 16384,0,655360}π Uses Graph;π (* Turbo Pascal, Width= 20 Height= 23 Colors= 16 *)π Constπ Pac: Array[1..282] of Byte = (π $13,$00,$16,$00,$00,$FE,$00,$00,$FE,$00,π $00,$FE,$00,$FF,$01,$FF,$03,$FF,$80,$03,π $FF,$80,$03,$FF,$80,$FC,$00,$7F,$07,$8F,π $C0,$07,$8F,$C0,$07,$8F,$C0,$F8,$00,$3F,π $1F,$77,$F0,$1F,$17,$F0,$1F,$17,$E0,$E0,π $70,$0F,$1F,$77,$E0,$1F,$37,$E0,$1F,$37,π $C0,$E0,$70,$1F,$3F,$77,$C0,$3F,$17,$C0,π $3F,$17,$80,$C0,$70,$3F,$7F,$8F,$80,$7F,π $8F,$80,$7F,$8F,$00,$80,$00,$7F,$7F,$FF,π $00,$7F,$FF,$00,$7F,$FE,$00,$80,$00,$FF,π $FF,$FE,$00,$FF,$FE,$00,$FF,$FC,$00,$00,π $01,$FF,$FF,$FC,$00,$FF,$FC,$00,$FF,$F8,π $00,$00,$03,$FF,$FF,$F8,$00,$FF,$F8,$00,π $FF,$F0,$00,$00,$07,$FF,$FF,$F0,$00,$FF,π $F0,$00,$FF,$E0,$00,$00,$0F,$FF,$FF,$F8,π $00,$FF,$F8,$00,$FF,$F0,$00,$00,$07,$FF,π $FF,$FC,$00,$FF,$FC,$00,$FF,$F8,$00,$00,π $03,$FF,$FF,$FE,$00,$FF,$FE,$00,$FF,$FC,π $00,$00,$01,$FF,$7F,$FF,$00,$7F,$FF,$00,π $7F,$FE,$00,$80,$00,$FF,$7F,$FF,$80,$7F,π $FF,$80,$7F,$FF,$00,$80,$00,$7F,$3F,$FF,π $C0,$3F,$FF,$C0,$3F,$FF,$80,$C0,$00,$3F,π $1F,$FF,$E0,$1F,$FF,$E0,$1F,$FF,$C0,$E0,π $00,$1F,$1F,$FF,$F0,$1F,$FF,$F0,$1F,$FF,π $E0,$E0,$00,$0F,$07,$FF,$C0,$07,$FF,$C0,π $07,$FF,$C0,$F8,$00,$3F,$03,$FF,$80,$03,π $FF,$80,$03,$FF,$80,$FC,$00,$7F,$00,$FE,π $00,$00,$FE,$00,$00,$FE,$00,$FF,$01,$FF,π $00,$00);π Var Size,Result: Word;π Gd, Gm: Integer;π P: Pointer;π F: File;π beginπ { Find correct display/card-Type and initiallize stuff }π Gd := Detect;π InitGraph(Gd, Gm, 'd:\bp\bgi');π if GraphResult <> grOk then Halt(1); { Error initialize }π ClearDevice;ππ SetFillStyle(SolidFill,Blue);π Bar(0,0,639,479);π P := @Pac; (* Pass the address of the *)π (* Pac Constant to a Pointer *)π PutImage(1,1,P^,NormalPut); (* Display image *)ππ Size := ImageSize(1,1,20,23) { Get size of your picture };π GetMem(P, Size); { Get memory from heap }π GetImage(1,1,20,23,P^) { Capture picture itself in P^ };ππ ClearDevice;ππ Assign(F,'IMAGE');π reWrite(F,1);π BlockWrite(F,P^,Size,Result) { Put picture (from P^) in File F };π if Ioresult <> 0 then Halt(2) { Error during BlockWrite I/O };π if Result <> Size then Halt(3) { not enough data written to F };π close(F);π if Ioresult <> 0 then Halt(4) { Error during Close of F };ππ PutImage(1,1,P^,NormalPut);π FreeMem(P,Size) { Free memory. This is GPP. };π ReadLn { Hit any key to continue };π ClearDevice;π CloseGraph;π end.π 17 05-28-9313:39ALL SWAG SUPPORT TEAM Optimized line drawing IMPORT 19 Üd» {1) An efficient/optimised line-drawing routine (in Pascalπor Asm) based on (or better than) the Bres. Line algorithm.π}ππ{$R-,S-}ππUsesπ Crt, Dos;ππProcedure PutPixel(X, Y : Word; Color : Byte);πbeginπ Mem[$A000:Y*320+X] := Colorπend;ππProcedure Switch(Var First, Second : Integer);π{ Exchange the values of First and second }πVarπ Temp : Integer;πbeginπ Temp := First;π First := Second;π Second := Temp;πend; { Switch }ππProcedure Line(X1, Y1, X2, Y2, Color : Integer);π{ Uses Bressenham's algorithm For drawing a line }πVarπ LgDelta, ShDelta, LgStep, ShStep, Cycle, PointAddr : Integer;ππbeginπ LgDelta := X2 - X1;π ShDelta := Y2 - Y1;π if LgDelta < 0 thenπ beginπ LgDelta := -LgDelta;π LgStep := -1;π endπ elseπ LgStep := 1;π if ShDelta < 0 thenπ beginπ ShDelta := -ShDelta;π ShStep := -1;π endπ elseπ ShStep := 1;π if LgDelta > ShDelta thenπ beginπ Cycle := LgDelta shr 1; { LgDelta / 2 }π While X1 <> X2 doπ beginπ Mem[$A000:Y1*320+X1] := Color; { PutPixel(X1, Y1, Color); }π Inc(X1, LgStep);π Inc(Cycle, ShDelta);π if Cycle > LgDelta thenπ beginπ Inc(Y1, ShStep);π Dec(Cycle, LgDelta);π end;π end;π endπ elseπ beginπ Cycle := ShDelta shr 1; { ShDelta / 2 }π Switch(LgDelta, ShDelta);π Switch(LgStep, ShStep);π While Y1 <> Y2 doπ beginπ Mem[$A000:Y1*320+X1] := Color; { PutPixel(X1, Y1, Color); }π Inc(Y1, LgStep);π Inc(Cycle, ShDelta);π if Cycle > LgDelta thenπ beginπ Inc(X1, ShStep);π Dec(Cycle, LgDelta);π end;π end;π end;πend; { Line }ππProcedure SetMode(Mode : Byte);π{ Interrupt $10, sub-Function 0 - Set video mode }πVarπ Regs : Registers;πbeginπ With Regs doπ beginπ AH := 0;π AL := Mode;π end;π Intr($10, Regs);πend; { SetMode }ππVarπ x,y,d:Word;π r:Real;ππbegin { example }π SetMode($13); { 320x200 256 color mode For VGA and MCGA cards }π For d := 0 to 360 * 10 doπ beginπ r := (d * PI) * 0.1 / 180;π x := round(sin(r * 5) * 90) + 160;π y := round(cos(r) * 90) + 100;π line(160,100,x,y,x div 4);π end;π Repeat Until port[$60] = 1; { hit esc to end }ππ SetMode($03) { Text mode }πend.π 18 05-28-9313:39ALL MICHAEL MROSOWSKI MODEXY for VGA IMPORT 25 Üd⌠■ {πFor people who do not find any xsharp Near them, and who would like to test itπanyway i translated some Assembler-Code (not by me) back to to TP6.πI tested it on a 486/33 With multisynch and a 386/40 With an old bw/vga monitorπboth worked well. Anyway i cannot guarantee that it works With every pc and isπhealthy For every monitor, so be careful.πThis Listing changes to 360x480x256 modex and displays some pixels.πHave fun With it !π}π(*Source: VGAKIT Version 3.4π Copyright 1988,89,90 John Bridgesπ Translated to Pascal (why?) by Michael Mrosowski *)ππProgram ModexTest;ππUses Crt,Dos;ππVarπ maxx,maxy : Word;ππ(*Set Modex 360x480x256 *)ππProcedure SetModex;πConstπ VptLen=17;π Vpt : Array[1..VptLen] of Word =π ($6b00 , (* horz total *)π $5901 , (* horz displayed *)π $5a02 , (* start horz blanking *)π $8e03 , (* end horz blanking *)π $5e04 , (* start h sync *)π $8a05 , (* end h sync *)π $0d06 , (* vertical total *)π $3e07 , (* overflow *)π $4009 , (* cell height *)π $ea10 , (* v sync start *)π $ac11 , (* v sync end and protect cr0-cr7 *)π $df12 , (* vertical displayed *)π $2d13 , (* offset *)π $0014 , (* turn off dWord mode *)π $e715 , (* v blank start *)π $0616 , (* v blank end *)π $e317); (* turn on Byte mode *)πVarπ regs:Registers;π i:Integer;π cr11:Byte;πbeginπ maxx:=360;π maxy:=480;π regs.ax:=$13; (*start With standardmode 13h*)π Intr($10,regs); (*hi bios!*)ππ PortW[$3c4]:=$0604; (*alter sequencer Registers: disable chain 4*)π PortW[$3c4]:=$0F02; (* set Write plane mask to all bit planes*)π FillChar(Mem[$a000:0],43200,0); (* Clearscreen *)π (* ((XSIZE*YSIZE)/(4 planes)) *)ππ PortW[$3c4]:=$0100; (*synchronous reset*)π Port [$3c2]:=$E7; (*misc output : use 28 Mhz dot clock*)π PortW[$3c4]:=$0300; (*sequencer : restart*)ππ Port [$3d4]:=$11; (*select Crtc register cr11*)π cr11:=Port[$3d5];π Port [$3d5]:=cr11 and $7F; (*Write protect*)ππ For i:=1 to vptlen do (*Write Crtc-Registers*)π PortW[$3d4]:=Vpt[i];πend;πππ(*Put pixel in 360x480 (no check)*)ππProcedure PutPixel(x,y:Word;c:Byte);πbeginπ PortW[$3c4]:=($100 shl (x and 3))+2; (*set EGA bit plane mask register*)π Mem[$a000:y*(maxx shr 2) + (x shr 2)]:=c;πend;ππVar c:Char;π i,j:Integer;ππbeginπ SetModex;π For j:=0 to 479 do (* Nearly SVGA With your good old 256k VGA*)π For i:=0 to 359 doπ PutPixel(i,j,(i+j) and $FF);π c:=ReadKey;π TextMode(LastMode);πend. 19 05-28-9313:39ALL KAI ROHRBACHER More MODEXY for VGA IMPORT 47 Üd0 {πKai Rohrbacherππ>> Basically, Mode Y works like this: use the BIOS to switchπ>> into normal 320x200x256 mode, then reprogram the sequencer toπ>> unchain the 4 bitplanes. This results in a bitplaned VRAM layoutπ>> very similiar to the EGA/VGA's 16 color modes:π>π> By saying 4 bitplanes, are you referering to the pages? I know thatπ> you can specify 4 pages in mode X/Y.ππNo, it just means that with each VRAM address, 4 physically different RAM cellsπcan be addressed: you may think of a "3-dimensional" architecture of your VGA'sπVRAM (ASCII sucks, I know...)π ____________π |* plane3 |π ___|_________ |π |* plane2 |__|π ___|__________ |π |* plane1 |__|π ___|___________ |π|* plane0 |__|π| |π|_______________|ππThe upper left corner of each bitplane (marked by a "*") is referenced with theπaddress $A000:0, but refers to 4 pixels! It is quite simple: instead ofπcounting "$A000:0 is the first pixel, $A000:1 is the 2nd, $A000:2 is the 3rd,π$A000:3 is the 4th, $A000:4 is the 5th" (as you would do in the normal BIOSπmode 320x200x256), the pixels now are distributed this way: "$A000:0/plane 0 isπthe 1st, $A000:0/plane 1 is the 2nd, $A000:0/plane 2 is the 3rd, $A000:0/planeπ3 is the 4th, $A000:1/plane 0 is the 5th" and so on.πSo obviously, w/o doing some "bitplane switching", you are always restricted toπwork on one bitplane at a time --the one actually being activated. If this isπplane0, you may only change pixels which (x mod 4) remainder is 0, the otherπones with (x mod 4)=1|2|3 aren't accessible, you have to "switch to the plane"πfirst. Thus the name "bitplane"!ππDT> And what exactly does "unchain" mean, as opposed to "chained". I have theπDT> feeling that they refer to each page(bitplane) being on its own.πHuhh, that would go pretty much into details; a bit simplified, "chained" meansπthat the bitplanes mentioned above are "glued" together for the simple BIOSπmode, so that bitplane switching isn't necessary anymore (that is equivalent inπsaying that one VRAM address refers to one RAM cell). As there are only 65536πaddresses in the $A000 segment and we need 320x200=64000 for a full page, youπonly have 65536/64000=1.024 pages therefore. "Unchaining" means to make eachπbitplane accessible explicitely.ππ> Now here is another problem I don't understand. I am familiar with VGA'sπ> mode 13h which has one byte specifying each pixel on the screen,π> therefore 1 byte = 1 pixel. But this takes up 64k.ππSmall note on this: not 64K, but only 64000 bytes!ππ> But how do you have one address represent 4 pixels, which only occupiesπ> 16000 address bytes, and still be able to specify 256 colours. Won't 4π> bitplanes at 320x200 each take up 64000x4 bytes of space?ππWe have 320x200=64000 pixels=64000 bytes. As each 4 pixels share one address,π16000 address bytes per page suffice. The $A000 segment has 64K address bytes,πthus 4*64K=256K VRAM can be addressed. 64K address bytes = 65536 address bytes;π65536/16000 = 4.096 pages.ππ> How would you go about adjusting the vertical retraces, and memoryπ> location you mentioned.ππAssuming that the DX-register has been set to 3DAh or 3BAh for color/monochromeπdisplay, respectively, you can trace the status of the electronic beam likeπthis:ππ @WaitNotVSyncLoop:π in al, dxπ and al, 8π jnz @WaitNotVSyncLoopπ @WaitVSyncLoop:π in al, dxπ and al, 8π jz @WaitVSyncLoopπ {now change the starting address}π{π(If you use "1" instead of "8" and exchange "jz" <-> "jnz" and vice vs., thenπyou sync on the shorter horizontal retrace (better: horizontal _enable_)πsignal).πThe alteration of the starting address is done by the code I already posted inπmy first mail! (Its done by addressing the registers $C and $D of theπCRT-controller).πNote that reprogramming the starting address isn't restricted to mode X/Y, youπcan have it in normal mode 13h, too: there are 65536 addresses available, butπonly 64000 needed, thus giving a scroll range of 4.8 lines! And to complicateπthings even further, for start addressing purposes, even the BIOS mode isπplaned (that is, a row consists of 320/4 bytes only). Just for the case youπdon't believe...π}πPROGRAM Scroll;πVARπ CRTAddress,π StatusReg : WORD;π a : ARRAY[0..199, 0..319] OF BYTE ABSOLUTE $A000 : 0000;π i, j : WORD;ππPROCEDURE SetAddress(ad : WORD); ASSEMBLER;πASMπ MOV BX, adππ MOV DX, StatusRegπ @WaitNotVSyncLoop:π in al, dxπ and al, 8π jnz @WaitNotVSyncLoopπ @WaitVSyncLoop:π in al, dxπ and al, 8π jz @WaitVSyncLoopππ MOV DX, CRTAddressπ MOV AL, $0Dπ CLIπ OUT DX, ALπ INC DXπ MOV AL, BLπ OUT DX, ALπ DEC DXπ MOV AL, $0Cπ OUT DX, ALπ INC DXπ MOV AL, BHπ OUT DX, ALπ STIπEND;ππBEGINπ IF ODD(port[$3CC]) THENπ CRTAddress := $3D4π ELSEπ CRTAddress := $3B4;ππ StatusReg := CRTAddress + 6;π ASMπ MOV AX,13hπ INT 10hπ END;ππ FOR i := 1 TO 1000 DOπ a[Random(200), Random(320)] := Random(256);ππ {scroll horizontally by 4 pixels}π FOR i := 1 TO 383 DOπ SetAddress(i);π FOR i := 382 DOWNTO 0 DOπ SetAddress(i);ππ {scroll vertically by 1 row}π FOR j := 1 TO 20 DOπ BEGINπ FOR i := 1 TO 4 DOπ SetAddress(i * 80);π FOR i := 3 DOWNTO 0 DOπ SetAddress(i * 80)π END;ππ ASM {back to 80x25}π MOV AX,3π INT 10hπ END;ππEND.π{π> Your said you could specify how the memory can be layed out by the user,π> but I am in need of what each PORT does. I know you have to sendπ> different values to the port to program it, but I have no idea what eachπ> port reads.ππThere are incredibly much registers to program! For a good overview of most ofπthem, try to get your hands on a copy of VGADOC*.* by Finn Thoegersenπ(jesperf@daimi.aau.dk) which covers programming a lot of SVGA's chipsets, too.ππ 20 05-28-9313:39ALL CHRIS BEISEL Another NICE fader IMPORT 14 ÜdXf {πCHRIS BEISELππHey Terje, here's some stuff to get you started on some ideas For theπgroup. I threw it together it 3 minutes, so it's not much, but theπassembley code isn't bad... here it is:π}ππProgram palette;ππUsesπ Crt;ππConstπ vga_segment = $0A000;π fade_Delay = 20;ππVarπ lcv : Integer;π temp : Char;ππProcedure video_mode (mode : Byte); Assembler;πAsmπ mov AH,00π mov AL,modeπ int 10hπend;ππProcedure set_color (color, red, green, blue : Byte);πbeginπ port[$3C8] := color;π port[$3C9] := red;π port[$3C9] := green;π port[$3C9] := blue;πend;ππProcedure wait_4_refresh; Assembler;πLabelπ wait, retr;πAsmπ mov DX,3DAhπ wait: in AL,DXπ test AL,08hπ jz waitπ retr: in AL,DXπ test AL,08hπ jnz retrπend;ππbeginπ ClrScr;π Writeln('Hey Terje, this is pretty cheezy, but it does show how to wait');π Writeln('for the vertical screen refresh in assembley, as well as how to');π Writeln('change colors, too... this isn''t the palette scrolling, but some');π Writeln('fade Type routines that may come in handy. The video mode routine');π Writeln('was also written in assembley (obviously)... well, next I''m going');π Writeln('to work on zooming (It could be a cool effect). C''ya L8r. ');π Writeln(' Press a key...');π temp := ReadKey;π video_mode($13);π lcv := 0;π Repeatπ While lcv < 63 doπ beginπ wait_4_refresh;π set_color(0, lcv, lcv, lcv);π lcv := lcv + 1;π Delay(fade_Delay);π end;π While lcv > 0 doπ beginπ wait_4_refresh;π set_color(0, lcv, lcv, lcv);π lcv := lcv - 1;π Delay(fade_Delay);π end;π Until KeyPressed;π video_mode(3);πend.ππ 21 05-28-9313:39ALL SWAG SUPPORT TEAM PALETTE tricks IMPORT 54 ÜdÇ1 { FD> Hey Greg, do you think you could tell me how to accessπ FD> Mode-X, preferably the source, if it's no trouble.... :)ππnot a problem.... Mostly I do Graphics and stuff With C, but when it all comesπdown to it, whether you use Pascal or C For the outer shell the main Graphicsπroutines are in Assembler (For speed) or use direct hardware port accessπ(again, For speed).πThe following is a demo of using palette scrolling techniques in Mode 13h (X)πto produce a flashy "bouncing bars" effect often seen in demos:π}ππProgram PaletteTricks;π{ Speccy demo in mode 13h (320x200x256) }ππUses Crt;ππConst CGA_CharSet_Seg = $0F000; { Location of BIOS CGA Character set }π CGA_CharSet_ofs = $0FA6E;π CharLength = 8; { Each Char is 8x8 bits, }π NumChars = 256; { and there are 256 Chars }π VGA_Segment = $0A000; { Start of VGA memory }π NumCycles = 200; { Cycles/lines per screen }π Radius = 80;ππ DispStr : String = ' ...THIS IS A LITTLE '+π 'SCROLLY, DESIGNED to TEST SOME GROOVY PASCAL ROUTinES...'+π ' ';ππ { Colours For moving bars... Each bar is 15 pixels thick }π { Three colours are palette entries For RGB values... }π Colours : Array [1..15*3] of Byte =π ( 7, 7, 63,π 15, 15, 63,π 23, 23, 63,π 31, 31, 63,π 39, 39, 63,π 47, 47, 63,π 55, 55, 63,π 63, 63, 63,π 55, 55, 63,π 47, 47, 63,π 39, 39, 63,π 31, 31, 63,π 23, 23, 63,π 15, 15, 63,π 7, 7, 63 );πππType OneChar = Array [1..CharLength] of Byte;ππVar CharSet: Array [1..NumChars] of OneChar;π Locs: Array [1..NumCycles] of Integer;π BarLocs: Array [1..4] of Integer; { Location of each bar }π CurrVert,π Count: Integer;π Key: Char;π MemPos: Word;ππProcedure GetChars;π{ Read/copy BIOS Character set into Array }π Var NumCounter,π ByteCounter,π MemCounter: Integer;π beginπ MemCounter:=0;π For NumCounter:=1 to NumChars doπ For ByteCounter:=1 to CharLength doπ beginππCharSet[NumCounter][ByteCounter]:=Mem[CGA_CharSet_Seg:CGA_CharSet_ofs+MemCounter];π inC(MemCounter);π end;π end;πππProcedure VideoMode ( Mode : Byte );π{ Set the video display mode }π beginπ Asmπ MOV AH,00π MOV AL,Modeπ inT 10hπ end;π end;πππProcedure SetColor ( Color, Red, Green, Blue : Byte );π{ Update the colour palette, to define a new colour }π beginπ Port[$3C8] := Color; { Colour number to redefine }π Port[$3C9] := Red; { Red value of new colour }π Port[$3C9] := Green; { Green " " " " }π Port[$3C9] := Blue; { Blue " " " " }π end;πππProcedure DispVert ( Var CurrLine : Integer );π { Display next vertical 'chunk' of the Character onscreen }π Var Letter: OneChar;π VertLine,π Count: Integer;π beginπ { Calculate pixel position of start of letter: }π Letter := CharSet[ord(DispStr[(CurrLine div 8)+1])+1];π VertLine := (CurrLine-1) Mod 8;ππ { Push the Character, pixel-by-pixel, to the screen: }π For Count := 1 to 8 doπ if Letter[Count] and ($80 Shr VertLine) = 0π then Mem[VGA_Segment:185*320+(Count-1)*320+319] := 0π else Mem[VGa_Segment:185*320+(Count-1)*320+319] := 181;π end;ππProcedure CalcLocs;π{ Calculate the location of the top of bars, based on sine curve }π Var Count: Integer;π beginπ For Count := 1 to NumCycles doπ Locs[Count] := Round(Radius*Sin((2*Pi/NumCycles)*Count))+Radius+1;π end;πππProcedure DoCycle;π{ Display the bars on screen, by updating the palette entries toπ reflect the values from the COLOUR Array, or black For blank lines }ππ Label Wait,Retr,BarLoop,PrevIsLast,Continue1,Continue2,Rep1,Rep2;ππ beginπ Asmπ { First, wait For start of vertical retrace: }π MOV DX,3DAhπWait: in AL,DXπ TEST AL,08hπ JZ WaitπRetr: in AL,DXπ TEST AL,08hπ JNZ Retrππ { then do bars: }π MOV BX,0πBarLoop:π PUSH BXπ MOV AX,Word PTR BarLocs[BX]π MOV BX,AXπ DEC BXπ SHL BX,1π MOV AX,Word PTR Locs[BX]π PUSH AXπ CMP BX,0π JE PrevIsLastπ DEC BXπ DEC BXπ MOV AX,Word PTR Locs[BX]π JMP Continue1ππPrevIsLast:π MOV AX,Word PTR Locs[(NumCycles-1)*2]ππContinue1:π MOV DX,03C8hπ OUT DX,ALπ inC DXπ MOV CX,15*3π MOV AL,0πRep1:π OUT DX,ALπ LOOP Rep1ππ DEC DXπ POP AXπ OUT DX,ALπ inC DXπ MOV CX,15*3π xor BX,BXπRep2:π MOV AL,Byte Ptr Colours[BX]π OUT DX,ALπ inC BXπ LOOP Rep2ππ POP BXπ inC Word PTR BarLocs[BX]π CMP Word PTR BarLocs[BX],NumCyclesπ JNG Continue2ππ MOV Word PTR BarLocs[BX],1πContinue2:π inC BXπ inC BXπ CMP BX,8π JNE BarLoopππ end;π end;πππbeginππ VideoMode($13); { Set video mode 320x200x256 }π Port[$3C8] := 1; { Write palette table entry }π For Count := 1 to 180 do { Black out the first 180 colours, }π SetColor(Count,0,0,0); { one colour will be used per line }ππ { Now colour each scan line using the given palette colour: }π MemPos := 0;π For Count := 1 to 180 doπ beginπ FillChar(Mem[VGA_Segment:MemPos],320,Chr(Count));π MemPos := MemPos + 320;π end;ππ SetColor(181,63,63,0);π CalcLocs;π For Count := 1 to 4 doπ BarLocs[Count] := Count*10;ππ GetChars;π CurrVert := 1;π Repeatπ DoCycle;π For Count := 1 to 8 doπ Move(Mem[VGA_Segment:185*320+(Count-1)*320+1],π Mem[VGA_Segment:185*320+(Count-1)*320],319);π DispVert(CurrVert);π inC(CurrVert);π if CurrVert > Length(DispStr) * 8π then CurrVert := 1;ππ Until KeyPressed; { Repeat Until a key is pressed... }ππ Key := ReadKey; { Absorb the key pressed }π VideoMode(3); { Reset video mode back to Textmode } end.πend.π 22 05-28-9313:39ALL MICHAEL NICOLAI PUTPIXEL in Graphics IMPORT 4 Üdî6 {πMICHAEL NICOLAIππRe: Plotting a pixel.πIn 320x200x256 mode it's very simple:πx : 0 to 319, y : 0 to 199π}ππProcedure Plot(x,y Word; color : Byte);πbeginπ mem[$A000 : (y * 200 + x)] := color;πend;ππ{You mean mem[$A000:y*320+x]:=color; don't you? ????? ($UNTESTED)}π 23 05-28-9313:39ALL ERIC MILLER READLNXY IMPORT 20 Üd┘∞ {πERIC MILLERππ> My question is this: In TP, the outtextxy is supposed to change theπ> CP (current pointer) to the location given in x,y. When you execute aπ> readln after a outtextxy or even and outtext, the program alwaysπ> starts at 0,0.. Is there a way to set the CP where the readln willπ> recognize it?ππ Here's a demo of a procedure called ReadlnXY; it readsπ a string in graphics mode using BGI support.π}ππPROGRAM Graphics_Readln;ππUsesπ Crt, Graph;ππPROCEDURE ReadlnXY(X, Y: Integer; VAR S: String);πVARπ Ch : Char; { key from keyboard }π Done : boolean; { our flag for quiting }π CurColor : word; { color to write text in }π OldX : Integer; { old x }ππBEGINπ S := '';π CurColor := GetColor;π MoveTo(X, Y);π Done := False;π WHILE NOT Done DOπ BEGINπ Ch := Readkey; { get a single key }ππ CASE Ch ofπ #0 : { extra key - two chars - let's ignore them }π Ch := Readkey;ππ #13 : { return key }π Done := true; { we got our string, let's go }ππ #32..#126: { ASCII 32 (space) through 126 (tilde) }π BEGINπ OutText(Ch);π S := Concat(S, Ch);π END;ππ #8 : IF Length(S) > 0 THENπ BEGINπ { move back to last character }π OldX := GetX - TextHeight(S[Length(S)]);π MoveTo(OldX, GetY);π { over write last character }π SetColor(0);π OutText(S[Length(S)]);π SetColor(CurColor);π MoveTo(OldX, GetY);π { remove last character from the string }π Delete(S, Length(S), 1);π END;ππ END;π END;πEND; { ReadlnXY }ππππVARπ GraphMode, GraphDriver: Integer;π Name, PathToDriver: String;ππBEGINππ GraphDriver := VGA; { VGA }π GraphMode := VGAHi; { 640x480x16 }π PathToDriver := 'D:\BP\BGI'; { path to EGAVGA.BGI }π { you can make this program work with EGA 640x350x16 -π it requires 640 wide and 16 colors to work for thisπ example, but ReadlnXY should work in any graphics mode }π InitGraph(GraphDriver, GraphMode, PathToDriver); { set graphics mode }ππ SetTextStyle(DefaultFont, HorizDir, 2);ππ SetColor(12);ππ OutTextXY(63, 63, 'Please enter your name: ');π SetColor(13);π ReadlnXY(63 ,95, Name);π CloseGraph;π Write('The name you entered was: ');π Writeln(Name);πEND.π 24 05-28-9313:39ALL SWAG SUPPORT TEAM redefine Chars in EGA/VGAIMPORT 26 Üdn╠ {πAfter several tricks to redefine Characters in EGA and VGA in this echo,πhere is one you can use in CGA mode 4,5,6. You will find an Unit, and aπtest Program.π}ππUnit graftabl;ππ{πreleased into the public domainπauthor : Emmanuel ROUSSINπFIDO : 2:320/200.21πEmail : roussin@frmug.fr.mugnet.orgππfor using redefined Characters (128 to 255)πin CGA mode 4,5 and 6 Without using GRAFTABL.EXEπ}ππInterfaceππTypeπ Tcaractere8 = Array [1..8] of Byte;π Tgraftabl = Array [128..255] of Tcaractere8;ππ{πif you want to use only one font, define it in this Unit, For example :ππConstπ the_only_font : Tgraftabl = (π (x,x,x,x,x,x,x,x),π .π .π (x,x,x,x,x,x,x,x),π (x,x,x,x,x,x,x,x)π );ππOr you can in your main Program :ππVarπ my_font : Tgraftabl;ππand define it afterπ}ππVarπ seg_graftabl,π ofs_graftabl : Word;ππ{internal Procedures}ππProcedure get_graftabl(Var segment, offset : Word);πProcedure put_graftabl(segment, offset : Word);ππ{Procedures to use in your Programs}ππProcedure init_graftabl;πProcedure use_graftabl(Var aray : Tgraftabl);πProcedure end_graftabl;ππImplementationππProcedure get_graftabl(Var segment, offset : Word);πbeginπ segment := memw[0 : $1F * 4 + 2];π offset := memw[0 : $1f * 4];πend;ππProcedure put_graftabl(segment, offset : Word);πbeginπ memw[0 : $1f * 4 + 2] := segment;π memw[0 : $1f * 4] := offsetπend;ππProcedure init_graftabl;π{ interrupt 1F is a Pointer to bitmaps For high 128 Chars (8 Bytes perπ Character) defined by GRAFTABL.EXE we save this initial Pointer }πbeginπ get_graftabl(seg_graftabl, ofs_graftabl);πend;ππProcedure use_graftabl(Var aray : Tgraftabl);π{ we define a new Pointer : the address of an Array }πbeginπ put_graftabl(seg(aray),ofs(aray));πend;ππProcedure end_graftabl;π{ we restore the original Pointer }πbeginπ put_graftabl(seg_graftabl,ofs_graftabl);πend;ππend.ππProgram test;ππUsesπ Graph3, Crt, graftabl;πππVarπ font : Tgraftabl;π i,j,tmp : Byte;π rid : Char;ππbeginπ hires;π init_graftabl;π fillChar(font,sizeof(font),0);π use_graftabl(font);ππ {$F000:$FA6E is the ROM address where the Characters 0 to 127 are defined}ππ For i := 1 to 26 doπ For j := 0 to 7 doπ beginπ tmp := mem[$F000 : $FA6E + 97 * 8 + (i - 1) * 8 + j] xor $FF;π tmp := tmp xor $FF;π tmp := tmp or (tmp div 2);π font[i + 127, j + 1] := tmp;π { Char 128 to 153 are redefined }π end;ππ For i := 1 to 26 doπ For j := 0 to 7 doπ beginπ tmp := mem[$F000 : $FA6E + 97 * 8 + (i - 1) * 8 + j] or $55;π font[i + 153, j + 1 ] := tmp;π { Char 154 to 181 are redefined }π end;ππ Writeln('the normal Characters ($61 to $7A) :');π Writeln;π For i := $61 to $7A doπ Write(chr(i));π Writeln; Writeln;π Writeln('now, these same Characters, but thick :');π Writeln;π For i := 128 to 153 doπ Write(chr(i));π Writeln; Writeln;π Writeln('the same Characters, but greyed :');π Writeln;π For i := 154 to 181 doπ Write(chr(i));π rid := ReadKey;π end_graftabl;π Textmode(co80);πend.ππ 25 05-28-9313:39ALL SWAG SUPPORT TEAM Setting Graphics Mode IMPORT 6 Üd╩q {πWell, there are two basic ways of using Graphics mode.π1) Use the BIOS routines to enter this mode.π2) Use the BGI (Borland Graphics Interface) used With the Graph Unitπ and the appropriate BGI File (as mentioned by you).ππSince you intend to display PCX Files, I guess you have no businessπwith the Graph Unit and the BGI, so I suggest the first way.ππExample:π}ππProgram Enter256;ππUsesπ Dos;ππVarπ Regs : Registers;ππbeginπ Regs.Ah := 0;π Regs.Al := $13;π Intr($10, Regs);ππ Readln;πend.ππ{π At the end of this Program you will be in 320x200 256 color mode.π} 26 05-28-9313:39ALL SWAG SUPPORT TEAM Another Set Graphics ModeIMPORT 26 Üdèá {RV│ok i would like some info on how to remove a tsr added to memory by aπ │i'd like some info on ext. VGA screens. For examplw i know that inπ │320x200x256 that one Byte is equal to one pixel. i need this Type ofπ │info For =< 640x480ππMode $10 (ie 640x350x16)π-------------------------ππIn this mode, the 256K display memory is divided into 4 bit planes ofπ64K each. Each pixel is produced by 4 bits, one from each bit plane, whichπare combined into a 4-bit value that determines which of the 16 colors willπappear on the screen For that pixel.ππThere is a one-to-one correspondense between the bits in each bit plane andπthe pixel on the screen. For example, bit 7 of the first Byte in each bitπplane correspond to the pixel in the upper left-hand corner of the screen.ππThe display memory For the 640x350 Graphics mode is mapped into memory asπa 64K block starting at A000h, With each 64K bit plane occupying the sameπaddress space (ie: in parallel).ππBecause of the one-to-one relationship of bits in bit planes With the pixelsπon the screen, it's straightForward to calculate the address needed toπaccess a particular pixel. There are 640 bits = 80 Bytes per line on theπscreen. Thus the Byte address corresponding to a particular X,Y coordinateπis given by 80*Y + X/8. A desired pixel can then be picked out of the Byteπusing the bit mask register.π}ππProcedure PutPixel(X,Y:Integer; Color:Byte);πVarπ Byte_address : Word;π wanted_pixel : Byte;πbeginπ Port[$3CE] := 5; (* mode register *)π Port[$3CF] := 2; (* select Write mode 2 *)π Port[$3CE] := 8; (* bit mask register *)π (* calculate pixel's Byte address *)π Byte_address := (80 * Y) + (X div 8);π (* set the bit we want *)π wanted_pixel := (1 SHL (7 - (X MOD 8)));π (* mask pixel we want *)π Port[$3CF] := $FF and wanted_pixel;π (* turn the pixel we want on *)π Mem[$A000:Byte_address] := Mem[$A000:Byte_address] or Colorπend; (* PutPixel *)ππFunction ActiveMode : Byte;π (* Returns the current display mode *)πVarπ Regs : Registers; (* Registers from Dos Unit *)πbeginπ Regs.AH := $0F; (* get current video mode service *)π Intr($10,Regs); (* call bios *)π ActiveMode := Reg.AL (* current display mode returns in AL *)πend;ππ{πSome video numbers:ππ CGA04 = $04; (* CGA 320x200x4 *)π CGA06 = $06; (* CGA 640x200x2 *)ππ EGA0D = $0D; (* 320x200x16,EGA,2 pages (64K), A0000*)π EGA0E = $0E; (* 640x200x16,EGA,4 pages(64K) " *)π EGA0F = $0F; (* 640x350 B&W,EGA,2 " " " *)π EGA10 = $10; (* 640x350x16 EGA,2 " (128K) " *)ππ VGA11 = $11; (* 640x480x2 B&W VGA, 4 pages (256K) " *)π VGA12 = $12; (* 640x480x16 VGA 1 page (256K) " *)π VGA13 = $13; (* 320x200x256 VGA 4 pages (256K) " *)ππExample:ππ ...π if (ActiveMode = VGA13) thenπ beginπ ....π ShowPCX256π ....π endπ ...π}π 27 05-28-9313:39ALL SWAG SUPPORT TEAM Yet Another Set Graph IMPORT 19 Üde {PK>SetVisualPage are Procedures I spent a lot of time investigating withπPK>Really weird results. In fact I locked up Computer several times andππI hate it when that happens <g>.ππPK>then I got frustrated and posted the message hoping there would be someπPK>other way how to go about it. tom Swan's book Mastering Turbo Pascal 6.0ππThere is: Don't use Graph.TPU and Write all your own routines. In theπfollowing Program, 3 routines SetVidMode, SetPage, and PutPixπillustrate a Graph.TPU-less example of your original requirement.π}ππProgram test0124;πUses Dos;ππConstπ VidMode = $10; {..640x350x16 - Supported By VGA and Most EGA }πVarπ x,y : Integer;π reg : Registers;ππProcedure SetVidMode(VidMode :Integer);π beginπ reg.ah := $00;π reg.al := VidMode;π intr($10,reg);π end;ππProcedure SetPage(Page :Integer);π beginπ reg.ah := $05;π reg.al := page;π intr($10,reg);π end;ππProcedure PutPix(Color,Page,x,y : Integer);π beginπ reg.ah := $0C;π reg.al := Color;π reg.bh := Page;π reg.cx := x;π reg.dx := y;π intr($10,reg);π end;ππbeginπSetVidMode(VidMode);πSetPage(0); {..set active display page }πFor x := 200 to 440 do {..use custom PutPix to }π For y := 100 to 250 do PutPix(3,1,x,y); { draw to different page }πWrite(^g);πReadLn; {..press enter to switch }πSetPage(1); { active display page }πReadLn;πend.ππ{πThere are only a few dozen more routines that you need to have theπFunctionality of Graph.TPU - simple stuff like manipulating palettes,πline/circle/polygon algorithms, fill routines, etc., etc....have fun.ππPK>list all video modes and number of pages it is capable of working withπPK>and VGA in 640x480 (that's the mode I have) is supposed to handle onlyπPK>one page. That's is probably the reason why it doesn't work. What isππThat would do it. From my reference, Advanced MS Dos Programming - RayπDuncan, The best resolution you can get With multiple page support isπ640x350 (Mode $10).ππAbout the ClearViewPort conflict, I experienced similar problems - Iπwent as Far as pixelling out portions of the display to avoid usingπClearViewPort <Sheesh!> - that Graph Unit doesn't make anything easy.π} 28 05-28-9313:39ALL SWAG SUPPORT TEAM Still Another Set Graph IMPORT 14 Üd╝ There are basically three ways you can do it, all of them usingπInterrupt 10h (video interrupt). First, set up something in your Varπlike this:ππ Varπ Regs : Registers;ππFunction 0 sets the mode, which will also clear the screen. This isπuseful if you want to set mode and clear screen at the same time.πIt would look like this;ππ REGS.AH := 0;π REGS.AL := x; { where x is the mode you want (get a good Dosπ reference manual For these) }π inTR($10,REGS);ππThe other two options are Really inverses of each other...scrollπWindow up and scroll Window down. The advantage of these is that itπdoesn't clear the border color (set mode does). The disadvantage isπthere are a lot more parameters to set. For these, AH = 6 For scroll upπand 7 For scroll down. AL = 0 (this Forces a clear screen), CH = theπupper row, CL = the left column, DH = the lower row, DL = the rightπcolumn, and BH = the color attribute (Foreground and background). As Iπsaid, it's a bit more Complicated, but you can set the screen color atπthe same time if you want to (if not, you'll need to get the currentπattribute first and store it in BH). You'll also have to know theπcurrent screen mode (40 or 80 columns, 25, 35, 43, or 50 lines).ππAs you can see, clearing the screen without using Crt is a bit moreπComplicated, but you can set a lot of options at the same time as well.πIt's up to you.ππJust as an after-note, I'm currently working on a way to useπpage-switching in Crt mode, writing directly to the video memory. I'mπsick of not being to switch pages without loading Graph (waste of spaceπand memory, just to switch pages).π 29 05-28-9313:39ALL SWAG SUPPORT TEAM SETMODE5.PAS IMPORT 19 ÜdΣ▓ {CD> Can someone tell me how to get 320x200x256 screen mode in TurboπCD>Pascal 5.5.ππYes.π}πProgram DemoMode13;πUses Dos,Crt;πVarπ LM : Word;π CD : Word;ππ{π; Enable 320*200*256, return True if successful, otherwise Falseπ;π; Reasons For False return : Already in mode 13, mode 13 unsupported.π}πFunction Enable13:Boolean;π Varπ Regs : Registers;π beginπ LM:=LastMode;π Regs.AH:=$0F;π intr($10,Regs);π if Regs.AL<>$13 then beginπ Regs.AH:=$03;π intr($10,Regs);π CD:=Regs.CX;π Regs.AX:=$0013;π intr($10,Regs);π if (Regs.Flags and 1)=0 then beginπ Enable13:=True;π end else beginπ Enable13:=False;π end;π end else beginπ Enable13:=False;π end;π end;ππ{π; Exit 310*200*256 mode, True if successful, False if notπ;π; Reasons For False return : not in mode 13.π}πFunction Release13:Boolean;π Varπ Regs : Registers;π beginπ Regs.AH:=$0F;π intr($10,Regs);π if Regs.AL=$13 then beginπ TextMode(LM);π Regs.AH:=$01;π Regs.CX:=CD;π intr($10,Regs);π Release13:=True;π end else beginπ Release13:=False;π end;π end;ππ{π; Plot a pixel in 320*200*256 mode.π;π; This may appear quite obvious at first, but take a closer look if you thinkπ; it is Really simple. if you read your Turbo Pascal book, though, you areπ; required to only ponder the usage of `Absolute' For a moment.π}πProcedure DrawPixel(X,Y:Word;Colour:Byte);π Varπ Screen : Array [0..319,0..199] of Byte Absolute $A000:$0000;π beginπ Screen[Y,X]:=Colour;π end;ππ{π; Main Program. Draws points in four corners in random colours, reads a likeπ; of Text (odd, but it displays it!) then returns to Text mode and quits.π}πbeginπ Writeln;π CheckBreak:=False;π CheckSnow:=False;π DirectVideo:=False;π if Enable13 then beginπ Randomize;π DrawPixel(0,0,Random(255));π DrawPixel(319,0,Random(255));π DrawPixel(0,199,Random(255));π DrawPixel(319,199,Random(255));π GotoXY(1,2);π Writeln('Type something then press [Enter]');π readln;π if (not enable13) then beginπ ClrScr;π end else beginπ Writeln;π Writeln('Error Exiting mode 13.');π Writeln('Enter MODE CO80 or MODE MONO to');π Writeln('restore your screen to Text mode.');π end;π end else beginπ Writeln('Error invoking mode 13');π end;π Writeln;πend.π 30 05-28-9313:39ALL SWAG SUPPORT TEAM Set Graphics Mode #6 IMPORT 9 Üd<~ {πGreat Thanks Chris. Now For another question, This Function would returnπ0..63 For the 256 color palette right? Can I also use this For the 16πcolor VGA & EGA palettes With the exception of it returning a value betweenπ0 and 3? and if you wouldn't mind I could also use another Function thatπwould tell me what video mode I am in. I am examining a Program that can useπvideo modes of CGA4 ($04), CGA2 ($06), EGA ($10), VGA ($12) and MCGA ($13)πand it Uses this Procedure to set the video mode:π}ππProcedure VideoMode (n: Integer);πbeginπ Reg.ah := $00;π Reg.al := n;π intr ($10, Reg);πend;ππ{πWith the N being the hex numbers from the above video modes.ππNow i know next to nothing about interrupts, and your code looks very similarπto what was done to set each color. Is the way to find out the value of al toπcall the interrupt in the same manner as above without specifying a value Forπal? Would it return the current al value...... or am I in left field on thisπone :)π} 31 05-28-9313:39ALL SWAG SUPPORT TEAM Set Graphics Mode #7 IMPORT 11 Üd╙ I heard (read?) that you wanted to find out how to do 256-colour Graphics.πHere are some Procedures For you.ππUses Dos; { if your Program doesn't already :) }ππProcedure SetGrMode(grMode : Byte); { enters a given Graphics mode }π{ does *not* check For presence of VGA -- use With caution!! }πVarπ r : Registers;πbeginπ r.AX := grMode;π Intr($10, R);πend;ππProcedure PutPixel256(p_x, p_y : Integer; p_c : Byte);πbeginπ Mem[$A000 : p_y * 320 + p_x] := p_c;πend;ππOK, With the SetGrMode Procedure, to enter 256-colour mode, call the Programπwith a value of $13. So: SetGrMode($13);πAnd to return to Text mode, call: SetGrMode($03);πThe second Procedure is self-explanatory, With a few bits of info required.πThe valid co-ords are 0..319 (horizontal) x 0..199 (vertical), so you can't useπGetMaxX or GetMaxY, unless you define them as Constants in the beginning ofπyour Program. The colour is in the range 0..255.ππ*WARNING* These Procedure will not work together With a BGI driver or theπGraph Unit. If you enter Graphics mode With my Procedure, you will not be ableπto output Text, boxes, circles, etc. unless you Write your own Procedures forπthe above.π 32 05-28-9313:39ALL SWAG SUPPORT TEAM Set Graphics Page IMPORT 14 ÜdÑi {π Hi.. I am trying to do animation by flipping the two images betweenπ the video pages, but I keep getting lines at the bottom of my screen,π and my screen color changes.. What's up here?π Did you synchronize to the {vertical|horizontal retrace beForeπ flipping? I don't know how to do this, so any helpfull code from you willπ be appreciated. I took this out of my ANIVGA-Unit:ππAt the very beginning of your Program, detect the address of the proper portπ(StatusReg is a global Word Variable):π}ππ Asm {check whether we are running on a monochrome or color monitor}π MOV DX,3CCh {ask Output-register:}π in AL,DXπ TEST AL,1 {is it a color monitor?}π MOV DX,3D4hπ JNZ @L1 {yes}π MOV DX,3B4h {no }π @L1: {DX=3B4h/3D4h = CrtAddress-register For monochrome/color}π{ MOV CrtAddress,DX not needed For this purpose}π ADD DX,6 {DX=3BAh/3DAh = Status-register For monochrome/color}π MOV StatusReg,DXπ end; {of Asm}ππ{πLater on, when you want to switch pages:ππ CLI {time critical routine: do not disturb!}π mov dx,StatusRegπ @WaitnotVSyncLoop:π in al,dxπ and al,8π jnz @WaitnotVSyncLoopπ @WaitVSyncLoop:π in al,dxπ and al,8π jz @WaitVSyncLoopπ{π HERE! SWITCH PAGES NOW!!! IMMEDIATELY! do not USE BIOS-inTS or OTHERπ TIME-WASTERS!π}π STIπ{πWell, that's all there is... if you replace the 2 "and al,8" against "and al,1"πand exchange jnz<->jz, you are syncronizing at the horizontal retrace. But thisπsignal is extremely short (at least Compared With the vertical retr.).π}π 33 05-28-9313:39ALL BERNIE PALLEK STARS1.PAS IMPORT 20 Üd*≡ {πBERNIE PALLEKππ> Hmm.. does anyone have an example of a starfield routine in Turbo Pascal..ππOK, here's a sample (I don't know what kind of starfield you're looking for):ππ{EGA/VGA parallax stars}ππUsesπ Crt, Graph, KasUtils;ππConstπ starCol : Array[0..2] of Byte = (8, 7, 15);ππTypeπ StarRec = Recordπ x : Integer;π y : Integer;π d : Integer; { depth }π end;ππVarπ stars : Array[0..31] of StarRec;π xinc,π yinc : Integer;π ch : Char;πππProcedure OpenGraph;πVarπ gd, gm : Integer;πbeginπ EgaVga_Exe;π Gd := Detect;π { this doesn't care if you don't have correct video card or not }π InitGraph(gd, gm, ''); { put the path to your BGI }πend;ππProcedure InitStars;πVarπ i : Integer;πbeginπ For i := 0 to 31 doπ With stars[i] doπ beginπ x := Random(GetMaxX);π y := Random(GetMaxY);π d := Random(3);π end;πend;ππProcedure MoveStars;πVarπ i : Integer;πbeginπ For i := 0 to 31 doπ With stars[i] doπ beginπ PutPixel(x, y, 0);π x := x + xinc * (d + 1);π if (x < 0) thenπ x := x + GetMaxX;π if (x > GetMaxX) thenπ x := x - GetMaxX;π y := y + yinc * (d + 1);π if (y < 0) thenπ y := y + GetMaxY;π if (y > GetMaxY) thenπ y := y - GetMaxY;π PutPixel(x, y, starCol[d]);π end;πend;ππbeginπ OpenGraph; (* enter Graphics mode *)π InitStars;π xinc := 1;π yinc := 0;π Repeatπ MoveStars;π Delay(10);π (* Delay here For faster computers *)π Until KeyPressed;π ch := ReadKey;π if (ch = #0) thenπ ch := ReadKey; (* get rid of extended keycodes *)π CloseGraph;πend.ππ{πWhew! There you have it! Untested, of course, so you may have to iron out aπfew bugs.ππ**** BIG HINT: You should probably use Real numbers instead of Integer numbersπfor x and y positions and increments, and Round them when PutPixel-ing! Thisπwill allow you to make smoother transitions, as well as bouncing effects, andπother neat stuff. ****ππYou'll notice (if the thing works) that the stars move horizontally only, andπthe dimmer ones move slower than the bright ones (parallax/multi-layered). Youπcan add extra layers, but remember to change the StarCol Constant so you haveπthe right number of colours For the stars.ππSorry, I was too lazy to comment it thoroughly; I'm expecting that you'll beπable to figure it out Without too much trouble. Sorry if you can't; Write meπfor an explanation. TTYL.π}π 34 05-28-9313:39ALL DANIEL SCHLENZIG STARS2.PAS IMPORT 11 Üdτm { DANIEL SCHLENZIG }ππProgram stars;ππConstπ maxstars = 200;ππVarπ star : Array[0..maxstars] of Word;π speed : Array[0..maxstars] of Byte;π i : Word;ππProcedure create;πbeginπ For i := 0 to maxstars doπ beginπ star[i] := random(320) + random(200) * 320;π speed[i] := random(3) + 1;π if mem[$a000 : star[i]] = 0 thenπ mem[$a000 : star[i]] := 100;π end;πend;ππProcedure moveit; Assembler;πAsmπ xor bp,bpπ mov ax,0a000hπ mov es,axπ lea bx,starπ lea si,speedπ mov cx,320ππ @l1:π mov di,[bx]π mov al,es:[di]π cmp al,100π jne @j1π xor al,alπ stosbπ @j1:π mov al,[si]π xor ah,ahπ add [bx],axπ mov ax,bxπ xor dx,dxπ div cxπ mul cxπ mov dx,bxπ sub dx,axπ cmp dx,319π jle @j3π sub [bx],cxπ @j3:π mov di,[bx]π mov al,es:[di]π or al,alπ jnz @j2π mov al,100π stosbπ @j2:π add bx,2π inc siπ inc bpπ cmp bp,maxstarsπ jle @l1π end;ππbeginπ Asmπ mov ax,13hπ int 10hπ call createππ @l1:π mov dx,3dahπ @r1:π in al,dxπ test al,8π je @r1ππ call moveitπ in al,60hπ cmp al,1π jne @l1;π end;πend.π 35 05-28-9313:39ALL SWAG SUPPORT TEAM Another Text Fader IMPORT 34 Üd±⌡ {πI attempted to Write a Unit For Text FADING, but I don't have it all downπright... If any one wants to play With the Unit and perfect it I would notπmind! My problem is that I do not know the correct values to change in theπcolor register For the affect of a fade. Once all the values are 0 the screenπis black, but on the way there the screen gets some strange colors... Also, ifπyou know how to change the colors, you can implement your own custom colors forπText mode. I think 256 different colors, but only 16 at a time. (I am onlyπguessing at that last part). The FADEOUT and FADEIN does work here, but itπgoes through some strange colors on the way!ππRobertπ}ππUnit TextFade; {attempt For implementing Text fading}π{ only works For VGA or SVGA as Far as I know! }ππInterfaceππUses Dos, Crt;ππTypeπ ColorRegister =π Recordπ Red : Byte;π Green : Byte;π Blue : Byte;π end;ππ ColorRegisterArray = Array[0..255] of ColorRegister;π ColorRegisterArrayPtr = ^ColorRegisterArray;ππVarπ SaveCRAp : ColorRegisterArrayPtr;ππProcedure SaveColorRegister(Var CRAp : ColorRegisterArrayPtr);π{ given a color register Array ptr, this will save the current }π{ values so you can restore from them later... }ππProcedure SetColorRegister(Var CRAp : ColorRegisterArrayPtr);π{ when you adjust the values of a color register set, this }π{ Procedure will make put the new values into memory }ππProcedure FadeOut(MS_Delay : Integer);π{ using the global Variable 'SaveCRAp', this will fade the Text}π{ screen out till all the values in the color register Array }π{ ptr are 0 }ππProcedure FadeIn(MS_Delay : Integer);π{ once again using the global Variable 'SaveCRAp', this will }π{ fade the screen back in till all values of the current color }π{ register Array ptr are equal to 'SaveCRAp' }ππImplementationππProcedure Abort(Msg : String);πbeginπ Writeln(Msg);π Halt(1);πend;ππProcedure SaveColorRegister(Var CRAp : ColorRegisterArrayPtr);πVarπ R : Registers;πbeginπ With R Doπ beginπ ah := $10;π al := $17;π bx := $00;π cx := 256;π es := Seg(crap^);π dx := Ofs(crap^);π end;π Intr($10,r);πend;ππProcedure SetColorRegister(Var CRAp : ColorREgisterArrayPtr);πVarπ R : Registers;πbeginπ With R Doπ beginπ ah := $10;π al := $12;π bx := $00;π cx := 256;π es := Seg(crap^);π dx := Ofs(crap^);π end;π Intr($10,r);πend;ππProcedure FadeOut(MS_Delay : Integer);πVarπ NewCRAp : ColorRegisterArrayPtr;π W : Word;π T : Word;πbeginπ New(NewCRAp);π If NewCRAp = NIL Thenπ Abort('Not Enough Memory');π NewCrap^ := SaveCrap^;π For T := 1 to 63 Doπ beginπ For W := 0 to 255 Doπ With NewCRAp^[w] Doπ If Red + Green + Blue > 0 Thenπ beginπ Dec(Red);π Dec(Green);π Dec(Blue);π end;π SetColorRegister(NewCRAp);π Delay(MS_Delay);π end;πend;ππProcedure FadeIn(MS_Delay : Integer);πVarπ NewCRAp : ColorRegisterArrayPtr;π W : Word;π T : Word;πbeginπ New(NewCRAp);π If NewCRAp = Nil Thenπ Abort('Not Enough Memory');π FillChar(NewCRAp^,SizeOf(NewCRAp^),0);π For T := 1 to 63 Doπ { The values in the color register are not higher than 63 }π beginπ For W := 0 to 255 Doπ If SaveCRAp^[w].Red + SaveCRAp^[w].Green + SaveCRAp^[w].Red > 0 Thenπ beginπ If NewCRAp^[w].Red < SaveCRAp^[w].Red Thenπ Inc(NewCRAp^[w].Red);π If NewCRAp^[w].Green < SaveCRAp^[w].Green Thenπ Inc(NewCRAp^[w].Green);π If NewCRAp^[w].Blue < SaveCRAp^[w].Blue Thenπ Inc(NewCRAp^[w].Blue);π end;π SetColorRegister(NewCRAp);π Delay(MS_Delay);π end;πend;πππbeginπ New(SaveCRAp);π {get memory For the Pointer}π If SaveCRAp = Nil Then Abort('Not Enough Memory');π {make sure it actually got some memory}π SaveColorRegister(SaveCRAp);π {save the current values into SaveCRAp}πend.ππ---------------8<-----cut here------>8---------ππHere is a demo of how to use it...πππUses TextFADE;ππbeginπ FADEOUT(10);π WriteLN(' HOW DOES THIS LOOK');π FADEIN(10);π Dispose(SaveCRAp);π {I just Realized I never got rid of this Pointer before!}πend.π 36 05-28-9313:39ALL SWAG SUPPORT TEAM VGA Tricks IMPORT 19 Üdyy {πSorry it took so long - anyway here's a new batch of VGA TRICKS :πFirst there's your basic equipment - synchronizing withπthe vertical Crt retrace.π( You can use this For hardware VGA scrolling synchronisation too, justπsubstitute the Delay(14) in my old routine For a call to thisπProcedure.)π}ππProcedure VRET;Assembler; {works For CGA,EGA and VGA cards}πAsmπ MOV DX, $03DAπ MOV AH, 8π@Wau: in AL, DXπ TEST AL, AHπ JNZ @Wau { wait Until out of retrace }π@Wai: in AL, DXπ TEST AL, AHπ JZ @Wai { wait Until inside retrace }πendππ{πThe following is Really new, as Far as I know: breaking the colorπbarrier by displaying more than 64 different colors on a Text modeπscreen. (But it will work For Text and Graphics color modes.)πIt displays the effect For approximately SEC seconds, affectingπthe black background and any black Characters. note that ifπyou have the border set to black too, the bars will expand into it.π}ππProcedure ColorBars(Sec:Byte);Assembler;πAsmπ MOV AL,Secπ MOV AH,70 { assume a 70 Hz mode (= 400 lines like mode 3 or $13)}π MUL AHπ MOV CX,AXπ MOV DX,$03DAπ in AL,DXπ MOV DX,$03C0 { assume color nr 0 = default Text background.. }π MOV AL,$20+0 { set color nr 0 .. }π OUT DX,ALπ MOV AL,0 { .. to DAC color 0 }π OUT DX,ALπ@Doscreen:π xor SI,SIπ CLIπ MOV DX,$03DAπ MOV AH,8π@Wau: in AL,DXπ TEST AL,AHπ JNZ @Wau { wait Until out of retrace }π@Wai: in AL,DXπ TEST AL,AHπ JZ @Wai { wait Until inside retrace }π@Doline:π STIπ MOV DX,$03C8 { point to DAC[0] }π MOV AL,0π OUT DX,ALπ inC SI { line counter }π MOV BX,SIπ ADD BX,CX { prepare For color effect }π MOV DI,$03C9π CLIπ MOV DX,$03DAπ@Whu: in AL,DXπ RCR AL,1π JC @Whu { wait Until out of horizontal retrace }π@Whi: in AL,DXπ RCR AL,1π JNC @Whi { wait Until inside retrace }π MOV DX,DIπ XCHG BX,AX { tinker With these to change the chromatic effect}π OUT DX,AL { dynamic Red }π ADD AL,ALπ OUT DX,AL { dynamic Green }π XCHG SI,AXπ OUT DX,AL { static Blue }π XCHG SI,AXπ CMP SI,200 { paint 200 lines }π JBE @dolineπ DEC DX { last line }π MOV AL,0 { reset to black For remainder of screen }π OUT DX,ALπ inC DXπ OUT DX,ALπ OUT DX,ALπ OUT DX,ALπ STIπLoop @Doscreenπend;ππ 37 05-28-9313:39ALL SWAG SUPPORT TEAM TWEAKED.PAS IMPORT 32 ÜdÑi {π Hi, would anyone like to tell me how to get the tweaked videoπ mode With 4 pages to work With because I'm tired of the 16 colorπ 2 page demos I'm making.ππSure, here's an adaptation of some code from Dr. Dobbs magazine on Mode-X.πI've only posted the routine to set the VGA to 360x240x256 With 3 pages ofπGraphics. Only 3 pages since the increase in resolution Uses more RAM.π}ππProcedure InitVGA360x240;ππConstπ GC_inDEX = $03CE; { VGA Graphics Controller }π SC_inDEX = $03C4; { VGA Sequence controller }π CrtC_inDEX = $03D4; { VGA Crt Controller }π MISC_OUTPUT = $03C2; { VGA Misc Register }π MAP_MASK = $02; { Map Register # }π READ_MAP = $04; { Read Map Register # }ππ VMODE_DATA : Array[1..17] of Word =π ($6B00, { Horizontal total }π $5901, { Horizontal displayed }π $5A02, { Start horizontal blanking }π $8E03, { end horizontal blanking }π $5E04, { Start H sync. }π $8A05, { end H sync. }π $0D06, { Vertical total }π $3E07, { Overflow }π $4109, { Cell height }π $EA10, { V sync. start }π $AC11, { V sync. end/Prot CR0 CR7 }π $DF12, { Vertical displayed }π $2D13, { offset }π $0014, { DWord mode off }π $E715, { V Blank start }π $0616, { V Blank end }π $E317); { Turn on Byte mode }ππbeginπ Asmπ mov ax, $13π int $10ππ mov dx, SC_inDEX { Sequencer Register }π mov ax, $0604 { Disable Chain 4 Mode }π out dx, axππ mov ax, $0100 { (A)synchronous Reset }π out dx, axππ mov dx, MISC_OUTPUT { VGA Misc Register }π mov al, $E7 { Use 28Mhz Clock & 60Hz }π out dx, alππ mov dx, SC_inDEX { Sequencer Register }π mov ax, $0300 { Restart Sequencer }π out dx, axππ {π Diasable Write protect For CrtC Registers 0-7, since we areπ about to change the horizontal & vertical timing settings.π }π mov dx, CrtC_inDEX { VGA CrtC Registers }π mov al, $11 { CrtC register 11h }π out dx, al { Load current value }π inc dx { Point to data }π in al, dx { Get CrtC register 11h }π and al, $7F { Mask out Write protect }π out dx, al { and send it back }ππ { Send CrtC data in VMODE_DATA Array to the CrtC. }π mov dx, CrtC_inDEX { VGA CrtC Registers }π cld { Forward block load }π mov si, offset VMODE_DATA { Get parameter data }π mov cx, 17 { Number of entries in block }ππ @@1:π mov ax, ds:[si] { Get next parameter value }π inc si { Advance to next Word }π inc siπ out dx, ax { Output next value }π loop @@1 { Process next value }ππ { Clear all VGA memory to black. }π mov dx, SC_inDEX { Select all planes }π mov ax, $0F02π out dx, axππ mov ax, VGA_SEG { Point to VGA memory }π mov es, axπ mov di, 0ππ xor ax, ax { clear 256K }π mov cx, $8000 { 32K * 2 * 4 planes }π rep stoswπ end;πend;π{πThat's about it. The video memory in this mode is organised a bit differentlyπthan CGA/HERC. It is a lot like the 16 color modes you're probably used to, inπthat you must go through the EGA/VGA Registers to access the memory, by settingπMAP MASK & PLANE SELECT, etc.π}π 38 05-28-9313:39ALL RON CZARNIK Text Fader IMPORT 13 Üd√└ { RON CZARNIK }ππUnit TXTFADE;ππInterfaceππProcedure TextFadeIn(Speed : Integer);πProcedure TextFadeOut(Speed : Integer);ππImplementationπUsesπ Dos, Crt;ππTypeπ DacType = Array[1..256,1..3] of Byte;ππVarπ dac1,π dac2 : DacType;π x, y,π i, erg,π gesamt : Word;πππProcedure Read_DACs(Var Dac : DacType);πVarπ r : Registers;πbeginπ r.ax := $1017;π r.bx := 0;π r.cx := 256;π r.es := SEG(Dac);π r.dx := Ofs(Dac);π Intr($10, r);πend;ππProcedure Write_DACs(Dac : DacType);πVarπ r : Registers;πbeginπ r.ax := $1012;π r.bx := 0;π r.cx := 256;π r.es := seg(Dac);π r.dx := Ofs(Dac);π Intr($10, r);πend;ππ{ fade....}πProcedure TextFadeOut(Speed : Integer);πbegin;π Repeatπ erg := 0;π For x := 1 to 256 doπ For y := 1 to 3 doπ beginπ if dac2[x, y] > 0 thenπ DEC(dac2[x, y]);π erg := erg + dac2[x, y];π end;π Write_Dacs(dac2);π Delay(Speed);π Until erg = 0;πend;ππ{ restore....fades also}πProcedure TextFadeIn(Speed : Integer);πbegin;π Repeatπ erg := 0;π For x := 1 to 256 doπ For y := 1 to 3 doπ beginπ if dac2[x, y] < dac1[x, y] thenπ INC(dac2[x,y]);π erg := erg + dac2[x, y];π end;π Write_Dacs(dac2);π Delay(Speed);π Until (erg = gesamt) or (KeyPressed);π Write_Dacs(dac1);πend;ππbeginπ Read_Dacs(dac1);π dac2 := dac1;π gesamt := 0;π For x := 1 to 256 doπ For y := 1 to 3 doπ gesamt := gesamt + dac1[x, y];ππend.π 39 05-28-9313:39ALL SWAG SUPPORT TEAM VGA-PTR.PAS IMPORT 19 Üd!┬ { Make a Pointer, make a Type of the data Type you are dealing with, make asπmany Pointers as you will need data segments (or as commonly practiced amongstπthe Programming elite, make an linked list of the data items), and call theπGETMEM Procedure using the Pointer in the Array... Here is an example I use toπcopy VGA (320x200x256) screens...π}ππTypeπ ScreenSaveType = Array[0..TheSize] of Byte;πVarπ TheScreen : ScreenSaveType Absolute $A000:0000;π Screen : Array[1..100] of ^ScreenSaveType;ππbeginπ InitGraphics;π Count := 0;ππ Repeatπ Count := Count + 1;π GetMem(Screen[Count],Sizeof(ScreenSaveType));π WriteLn('Memory at Screen ',Count,' : ',MemAvail); {THIS MAKESπ THE PAGES}π Until MemAvail < 70000;π For X := 1 to Count doπ For A := 1 to TheSize do {THE MAKES A SCREEN}π Screen[X]^[A] := Random(255);π E := C;π X := 0;π GetTime(A,B,C,D);π C2 := 0;ππ Repeatπ X := X + 1;π GetTime(A,B,C,D);π if C <> E thenπ beginπ C2 := C2 + 1;π testresults[C2] := X;π X := 1;π E := C;π end;π TheScreen := Screen[X mod Count + 1]^;π Move(Scroll2,Scroll1,Sizeof(Scroll2));π Until KeyPressed;π WriteLn(Test,'Number of Screens :',Count);π For X := 1 to C2 doπ WriteLn(Test,'Number of flips, second #',X,':',testresults[x]);π Close(Test);πend.ππ{ I didn't try and Compile that, I also edited out the ProcedureπinitGraphics because you aren't Really interested in that end. However whereπit says "THIS MAKES THE PAGES" is what you want to do.. In this particularπversion I made 4 Graphics pages under pascal and 5 outside of pascal, I couldπhave fit more but I have too many TSRS. Using Extended memory I can fit aboutπ20 Graphics pages (I got about 2 megs ram), but you can extend that as Far asπram may go. The MOVE command isn't a bad command either to know. I got whenπrunning a Text mode, 213 Text pages per second. I was even impressed (PSπGraphics people, I got 16 Graphics pages per second in 320x200x256 mode!)...π}π 40 05-28-9313:39ALL ERIC MILLER VGA BGI & Detect IMPORT 10 ÜdÅ≤ (*πERIC MILLERππ> Let's suppose that I used VGA256.BGI. I change it to VGA256.OBJ. And inπ> my program, I type the following: {$L VGA256.OBJ}ππWell, you can't lin VGA256.BGI into the program that way; for someπreason, if it wasn't included in TP6 it won't register. You haveπto use the InstallUserDriver function instead of RegisterBGIDriver.πHere is a program that get's into VGA256 mode that way - but ofπcourse you must already know how to do it.π*)ππPROGRAM Vg;ππUsesπ Graph;ππFUNCTION vgaPresent : boolean; assembler;πasmπ mov ah,$Fπ int $10π mov ax,$1A00π int $10 {check for VGA/MCGA}π cmp al,$1Aπ jne @ERR {no VGA Bios}π cmp bl,7π jb @ERR {is VGA or better?}π cmp bl,$FFπ jnz @OKπ @ERR:π xor al,alπ jmp @EXITπ @OK:π mov al,1π @EXIT:πend;ππ{$F+}πFUNCTION DetectVGA256: Integer;πBEGINπ IF vgaPresent THENπ DetectVGA256 := 0π ELSEπ DetectVGA256 := grError;πEND;π{$F-}πππVARπ VGA256: Integer;π B: Integer;ππBEGINπ VGA256 := InstallUserDriver('VGA256', @DetectVGA256);π B := 0;π InitGraph(VGA256, B, '');π OutText('In 320x200x256 - press enter');π Readln;π CloseGraph;πEND.π 41 05-28-9313:39ALL SEAN PALMBER VGA Detect #1 IMPORT 7 Üd░ {πSEAN PALMERππWell, here are routines to detect a VGA and an EGA adapter...π}πUsesπ Crt;ππVarπ OldMode : Byte;ππfunction EGAInstalled : boolean; assembler;πasmπ mov ax, $1200π mov bx, $10π mov cx, $FFFFπ int $10π inc cxπ mov al, clπ or al, chπend;ππfunction VgaPresent : boolean; assembler;πasmπ mov ah, $Fπ int $10π mov oldMode, al {save old Gr mode}π mov ax, $1A00π int $10 {check for VGA/MCGA}π cmp al, $1Aπ jne @ERR {no VGA Bios}π cmp bl, 7π jb @ERR {is VGA or better?}π cmp bl, $FFπ jnz @OKπ @ERR:π xor al, alπ jmp @EXITπ @OK:π mov al, 1π @EXIT:πend;ππbeginπ OldMode := LastMode;π Writeln(EGAInstalled);π Writeln(VGAPresent);πend. 42 05-28-9313:39ALL MICHAEL NICOLAI VGA Detect #2 IMPORT 8 ÜdîQ {π> I know how to determine the current mode of a card, but how do a lot ofπ> Programs determine if a VGA is present in the first place? I'd ReallyππMICHAEL NICOLAIπIt's very easy to check if a VGA card is present, 'cause there are someπFunctions which are only supported on VGAs. The best one is this:π}ππUsesπ Dos;ππFunction Is_VGA_present : Boolean;πVarπ regs : Registers;πbeginπ Is_VGA_present := True;π regs.ax := $1A00;π intr($10, regs);π if (regs.al <> $1A) thenπ Is_VGA_present := False;πend;πππ{ KELD R. HANSEN }ππFunction VGA : Boolean; Assembler;πAsmπ MOV AH,1Ahπ INT 10hπ CMP AL,1Ahπ MOV AL,Trueπ JE @OUTπ DEC AXπ @OUT:πend;ππ{ will return True if a VGA card is installed. }πbeginπ Writeln(Is_VGA_present);π Writeln(VGA);πend. 43 05-28-9313:39ALL SEAN PALMER VGA Fonts from file IMPORT 21 Üdò≤ {π Sean Palmerππ> Does anyone know of any way to display a single screen of Graphics onπ> EGA 640x350 mode *quickly*. It can be VGA as well; I'm just trying toπ> display the screen *fast* from a disk File. I know, I could have usedπ> the GIF or PCX format (or any other format), but I want to make aπ> proprietary format to deter hacking of the picture. So, what I want toπ> know is how to read the data from disk directly to screen. I'veπ> figured out that BlockRead (if I can get it to work) is the best methodπ> of reading the data from the disk, but I don't know of any fast, and Iπ> mean *fast*, methods of writing the data to the screen. Would it beπ> feasible to use an Array the size of the screen and Move the Array toπ> the screen (I'd need memory locations For that, if possible)? Anyπ> response (ideas, solutions, code fragments) would be appreciated.ππYou could set up the screen as an Absolute Variable.πThen read in each plane as an Array DIRECTLY from the disk File.πBefore reading each plane, set up Write mode 0 (should be already in mode 0)πand make sure that the enable set/reset register is set to 0 so that the cpuπWrites go directly to the planes. Set the sequencer map mask register forπeach plane so you only Write to them one at a time. and enable the entire BitπMask register ($0F). Then after telling it which plane, read directly fromπthe File. No I haven't tested the following code and most of it's gonna beπfrom memory but give it a try:ππthe File:π Plane 0π Plane 1π Plane 2π Plane 3ππeach Plane:π 350 rows of 80 Bytes (each bit belongs to a different pixel)π}ππTypeπ scrRec = Array[0..640 * 350 div 8 - 1] of Byte;πVarπ screen : scrRec Absolute $A000 : 0000;π dFile : File of scrRec;ππConstπ gcPort = $3CE; {EGA/VGA Graphics controller port}π seqPort = $3C4; {EGA/VGA sequencer port}ππProcedure readFileToMode10h(s:String);πVarπ dFile : File of scrRec;π i : Byte;πbeginπ Asmπ mov ax, $10;π int $10;π end; {set up video mode}π assign (dFile,s);π reset(s); {no error checking 8) }π portw[gcPort] := $0001; {clear enable set/reset reg}π portw[gcPort] := $FF08; {set entire bit mask (this is the default?)}π For i := 0 to 3 doπ beginπ {set map mask reg to correct plane}π portw[seqPort] := (1 shl (i + 8)) + $02;π read(dFile, screen); {load that plane in}π end;π portw[seqPort] := $0F02; {restore stuff to normal}π portw[gcPort] := $0F01;π close(dFile);πend;π 44 05-28-9313:39ALL SWAG SUPPORT TEAM VGA User Fonts IMPORT 22 Üd╨¿ {π>so it appears nothing happened). I have seen some Programs that areπ>able to save the Dos font into a buffer in the Program and then justπ>set the video card back to that font when the Program quits. The problemπ>is, I have not seen any documented Dos interrupt that will allow me toπ>do this.π> I'm wondering if anyone knows of such an interrupt that I can use toπ> get the current VGA font and save it to a buffer.π> Any help would be greatly appreciated!ππ Interrupt $10 is what you're looking For. Function $11,π subFunction $30 gets the Character generator info.π Function $11, subFunction $10 loads user fonts. Function $11 canπ also be used to Reset to one of the hardware fonts (subFunctionπ $11 Resets to ROM 8x14, $12 Resets to ROM 8x8, $14 Resets to VGAπ ROM 8x16)ππ The structure Types are as follows:π}πTypeππ { enumerated font Type }π ROMfont = (ROM8x14, ROM8x8, ROM8x16);ππ { Character definition table }π CharDefTable = Array[0..4096] of Byte;π CharDefPtr = ^CharDefTable;ππ { Text Character generator table }π Char_Table = Recordπ Points :Byte;π Def :CharDefPtr;π end;ππ { font Format }π FontPackage = Recordπ FontInfo :Char_Table;π Ch :CharDefTable;π end;π FontPkgPtr = ^FontPackage;ππ{ Here are some handy Procedures to use those Types: }ππProcedure GetCharGenInfo(font: ROMfont; Var Table:Char_Table);πbeginπ if is_EGA thenπ beginπ Reg.AH := $11;π Reg.AL := $30;π Case font ofπ ROM8x8 : Reg.BH := 3;π ROM8x14: Reg.BH := 2;π ROM8x16: Reg.BH := 6;π end;π Intr($10, Reg);π Table.Def := Ptr(Reg.ES, Reg.BP);π Case font ofπ ROM8x8 : Table.Points := 8;π ROM8x14: Table.Points := 14;π ROM8x16: Table.Points := 16;π end;π end;πend;ππProcedure SetHardwareFont(Var font :ROMfont);πbeginπ if is_EGA thenπ beginπ Reg,AH := $11;π Case font ofπ ROM8x14 : Reg.AL := $11;π ROM8x8 : Reg.AL := $12;π ROM8x16 :π if is_VGA thenπ Reg.AL := $14 { 8x16 on VGA only }π elseπ beginπ Reg.AL := $12;π font := ROM8x14;π end;π end;π Reg.BL := 0;π Intr($10, Reg);π end;πend;ππFunction FetchHardwareFont(font :ROMfont):FontPkgPtr;πVarπ pkg :FontPkgPtr;πbeginπ New(pkg);π GetCharGenInfo(font, Pkg^.FontInfo);π Pkg^.Ch := Pkg^.FontInfo.Def^;π FetchHardwareFont := Pkg;πend;ππProcedure LoadUserFont(pkg :FontPkgPtr);πbeginπ Reg.AH := $11;π Reg.AL := $10;π Reg.ES := Seg(pkg^.ch);π Reg.BP := Ofs(pkg^.ch);π Reg.BH := Pkg^.FontInfo.Points;π Reg.BL := 0;π Reg.CX := 256;π Reg.DX := 0;π Intr($10, Reg);πend;ππ 45 05-28-9313:39ALL SWAG SUPPORT TEAM VGA ClrScr #1 IMPORT 20 Üdδ {π Anivga is the best set of Graphics routines i've seen For the PC sinceπ i stopped using my old 4,7 Mhz MSX (which had smooth sprites &π scrolling) and the one With the most extra's.ππWell, here is >ONE< solution For you. It is one I have used in aπstreetfighter Type game a friend and I have been working on (the friendπis an artist who has been doing the pics While I'm doing the software).πIt turns out, using an index-to-index copy during vertical retrace isπfast enough to get at least (and I mean at LEAST--I've been able to overπDouble this rate) 18.2 frames per second on a 16bit VGA card.ππThe code (in pascal, although the Program itself is written in C++, theπtheory works With TP6.0) would look something like this:π}ππTypeπ ScreenRec = Array[0..63999] of Byte;π ScreenPtr = ^ScreenRec;ππVarπ VGAScreen : ScreenRec Absolute $A000:$0000; {I think thats how you doπ it, been a While since Iπ had to do things this way}ππProcedure VS_PutPixel(x, y: Integer; c:Byte; VS: ScreenPtr);ππbeginπ VS^[(y*320)+x] := c; {Again, this may be off slightly--my originalπ pascal Implementation used a member Variable inπ an Object}πend;ππProcedure VS_Write(VS: ScreenPtr);ππVarπ X : Integer;π Y : Integer;ππbeginπ {Wait For a retrace--see a VGA manual For how to do this, it takesπ monitoring two ports. if you are already in a retrace, wait For it toπ end and another one to begin}π For Y := 0 to 199 doπ For X := 0 to 319 doπ VGAScreen[(Y*320)+X] := VS^[(Y*320)+X];πend;ππ{πWith this method, you even have time in the nexted For loops (!) to do aπComparison. One I typically use (For emulating multiple planes) is ifπVS^[(Y*320)+X] <> 0... That lets me copy multiple screens. to give youπan idea of how fast this is, on my 386/25, I can do this during a timerπinterrupt (18.2 times a second) without any problems, and still haveπtime to do full collision detection and multisprite animation withπscrolling backgrounds and Soundblaster Sound. During the retraceπperiod, you can move quite a bit of inFormation into the VGA card,πbecause memory accesses are MUCH faster (the screen is also not beingπupdated). This is CompLETELY flicker free using this technique (ifπsmaller sections are chaging, you MIGHT consider only copying parts ofπthe screen).ππ} 46 05-28-9313:39ALL SWAG SUPPORT TEAM VGA ClrScr #2 IMPORT 14 Üd7Å { The following Turbo Pascal Program displays HARDWARE SCROLLinGπ For 100% Compatible VGA cards,in mode $13.π I'd be grateful if anyone interestedπ could test this and report the results :π}ππProgram VGASLIDE; {requirements TP6 or higher + register-Compatible VGAπ}ππUses Crt;ππ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}ππ Asm {inITIALIZE vga mode $13 using BIOS}π MOV AX,00013hπ inT 010hπ end;ππ 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;ππ Asmπ MOV AX,00003h {reset to Textmode}π inT 010hπ end;ππend.π 47 05-28-9313:39ALL SWAG SUPPORT TEAM VGA ClrScr #3 IMPORT 23 Üd' {πI also wanted to put a picture bigger than the screen to scroll overπFor the intro. -- ANIVGA --π}ππProgram ScrollExample;π{Demonstrates how to use the VGA's hardware scroll to do some nice opening}π{sequence: the Program loads 3 Graphic pages With data and then scrolls }π{them by. note that this erases the contents of the background page and }π{thus shouldn't be used While animating sprites in parallel!}ππUsesπ ANIVGA, Crt;ππProcedure IntroScroll(n,wait:Word);π{ in: n = # rows to scroll up using hardware zoom}π{ wait = time (in ms) to wait after each row }π{rem: Scrolling *always* starts at page 0 (=$A000:0000) }π{ Thus, issuing "Screen(1-page)" afterwards is a must!}π{ if you put the routine into ANIVGA.PAS, you should delete all the}π{ Constants following this line}πConstπ StartIndex=0;π endIndex=StartIndex+3;π {offsetadressen der Grafikseiten (in Segment $A000):}π offset_Adr:Array[StartIndex..endIndex] of Word=($0000,$3E80,$7D00,$BB80);π CrtAddress=$3D4; {if monochrome: $3B4}π StatusReg =$3DA; {if monochrome: $3BA}πbeginπ Screen(0); {position at $A000:0000}π Asmπ xor SI,SI {use page address 0 }π and SI,3π SHL SI,1π ADD SI,ofFSET offset_Adr-StartIndex*2 {call this "defensive Programming"..}π LODSWπ MOV BX,AXπ MOV CX,nπ MOV SI,waitπ @oneline:π ADD BX,LinESIZEπ CLI {no inTs please!}π MOV DX,StatusRegπ @WaitnotHSyncLoop:π in al,dxπ and al,1π jz @WaitnotHSyncLoopπ @WaitHSyncLoop:π in al,dxπ and al,1π jz @WaitHSyncLoopπ MOV DX,CrtAddress {Crt-controller}π MOV AL,$0D {LB-startaddress-register}π OUT DX,ALπ inC DXππ MOV AL,BLπ OUT DX,AL {set new LB of starting address}π DEC DXπ MOV AL,$0Cπ OUT DX,ALπ inC DXπ MOV AL,BH {dto., HB}π OUT DX,ALπ STIππ PUSH BXπ PUSH CXπ PUSH SIπ PUSH SIπ CALL Crt.Delayπ POP SIπ POP CXπ POP BXπ LOOP @onelineπ end;πend;ππbeginπ InitGraph; {Program VGA into Graphic mode, clear all pages}ππ {--- Start of Intro ---}π Screen(0); {or SCROLLPAGE, just an aesthetic question...}π {Load 3 pages With pics, or draw them:}π LoadPage('1st.PIC',0);π LoadPage('2nd.PIC',1);π LoadPage('3rd.PIC',BackgndPage);π IntroScroll(3*200,20); {scroll up 3 pages, wait 20ms}π Delay(3000); {wait a few seconds}π Screen(1-page); {restore correct mode}π {--- end of Intro ---}ππ {now do your animations as usual}π {...}π CloseRoutines;πend.ππ{πif you adjust LoadPage() to allow loading into Graphic page 3 (=SCROLLPAGE),πtoo, you may easily do a 4 screen hardware scroll!π}π 48 05-28-9313:39ALL KAI ROHRBACHER MODE XY IMPORT 43 Üd║[ {πKAI ROHRBACHERππ> explain MODE X.ππWell, I don't care much about Mode X (which is 320x240x256), but use Mode Yπ(=320x200x256) --at least I think that this mode is called "Mode Y" (as farπas I know, the terms were introduced by a series of Michael Abrash in "Dr.πDobb's Journal" (?)). Nevertheless, things are identical With the exceptionπof initialising the VGA card! So here we go; note that the Asm code examplesπwere taken from my ANIVGA-toolkit: the PASCAL-equivalents when given are "onπthe fly" Asm->PASCAL translations For improved clarity (I hope...); inπdoubt, rely on the Asm part.ππMODE Y in a nutshellπ~~~~~~~~~~~~~~~~~~~~ππBasically, Mode Y works like this: use the BIOS to switch into normalπ320x200x256 mode, then reProgram the sequencer to unchain the 4 bitplanes.πThis results in a bitplaned VRAM layout very similiar to the EGA/VGA's 16πcolor modes:π}πProcedure InitGraph; Assembler;πAsmπ MOV AX,0013hπ INT 10hπ MOV DX,03C4hπ MOV AL,04π OUT DX,ALπ INC DXπ in AL,DXπ and AL,0F7hπ or AL,04π OUT DX,ALπ MOV DX,03C4hπ MOV AL,02π OUT DX,ALπ INC DXπ MOV AL,0Fhπ OUT DX,ALπ MOV AX,0A000hπ MOV ES,AXπ SUB DI,DIπ MOV AX,DIπ MOV CX,8000hπ CLDπ REP STOSWππ MOV DX,CrtAddressπ MOV AL,14hπ OUT DX,ALπ INC DXπ in AL,DXπ and AL,0BFhπ OUT DX,ALπ DEC DXπ MOV AL,17hπ OUT DX,ALπ INC DXπ in AL,DXπ or AL,40hπ OUT DX,ALπend;ππ{πCrtAddress and StatusReg are the port addresses For the VGA ports needed;πthey are 3B4h and 3BAh on a monochrome display and 3D4h and 3DAh on a colorπdisplay, but can be determined at run-time, too:π}ππAsmπ MOV DX,3CChπ in AL,DXπ TEST AL,1π MOV DX,3D4hπ JNZ @L1π MOV DX,3B4hπ @L1:π MOV CrtAddress,DXπ ADD DX,6π MOV StatusReg,DXπend;ππ{πThe VRAM layout is this: underneath each memory address in the rangeπ$A000:0000..$A000:$FFFF, there are 4 Bytes, each representing one pixel'sπcolor.πWhenever you Write to or read from such an address, an internal logic of theπVGA-card determines which one of those 4 pixels is accessed.πA line of 320 pixels (=320 Bytes) thus only takes 320/4=80 Bytes addressπspace, but to address a pixel, you need a) its VRAM address and b) whichπbitplane it's on.πThe pixels are arranged linearly: thus, the mapping from point coordinatesπto memory addresses is done by (x,y) <-> mem[$A000: y*80+ (x div 4)] and theπbitplane is determined by (x mod 4).π(Note coordinates start With 0 and that "div 4" can be computed very fast byπ"shr 2"; "mod 4" by "and 3").ππSo you computed the proper address and bitplane. If you want to _read_ theπpixel's color, you issue commands like this:π portw[$3CE]:=(bitplane SHL 8)+4; color:=mem[$A000:y*80+(x shr 2)]πOr For better speed & control, do it in Asm:ππ MOV AL,4π MOV AH,bitplaneπ MOV DX,3CEhπ CLIπ OUT DX,AXπ MOV AL,ES:[DI]π STIππ_Writing_ a pixel's color works similiar, but needs an additional step: theπmask is computed by 1 SHL bitplane (that is: 1/2/4/8 For mod4 values 0/1/2/3πrespectively):π portw[$3C4]:=(1 SHL bitplane+8)+2; mem[$A000:y*80+(x shr 2)]:=colorπOr using Asm again:ππ MOV CL,bitplaneπ MOV AH,1π SHL AH,CLπ MOV AL,2π MOV DX,3C4hπ CLIπ OUT DX,AXπ STOSBπ STIππAs stated above, one address represents 4 pixels, so 320x200 pixels occupyπ16000 address Bytes. We do have 65536 (=$A000:0..$A000:$FFFF) though,πtherefore a bit more than 4 pages are possible. It's up to you to defineπyour pages, 0..15999=page 0, 16000..31999=page 1, 32000..47999=page 2,π48000..63999=page 3, 64000..65535=unused is the most obvious layout.ππWhich part of the VRAM is actually displayed can be Programmed by writingπthe offset part of the starting address to the Crt-controller (the segmentπpart is implicitly set to $A000):ππAsmπ MOV DX,CrtAddressπ MOV AL,$0Dπ CLIπ OUT DX,ALπ INC DXπ MOV AL,low Byte of starting offsetπ OUT DX,ALπ DEC DXπ MOV AL,$0Cπ OUT DX,ALπ INC DXπ MOV AL,high Byte of starting offsetπ OUT DX,ALπ STIπend;ππN.B.: if you reProgram the display's starting address more often than "everyπnow and then", you better synchronize that to the vertical retrace orπhorizontal enable signal of your VGA card; otherwise, an annoying screenπflicker will become visible during switching!ππFor example, if you do a "FOR i:=1 to 100 do SetAddress(i*80)", this willπresult in a blinding fast hardware scroll: With each iteration of the loop,πthe display will start 80 address Bytes (=320 pixels = 1 row) later, givingπthe impression of the display scrolling upwards.ππNote that Mode X/Y do not differ in any other respect than their memoryπlayouts from all the other bitplaned VGA modes: palette handling is theπsame, as is usage of the VGA's Write modes! In (default) Write mode 0, youπcan access the VRAM by Bytes, Words or dWords. Write mode 1 is handy to copyπthe contents of one Graphic page to another: you are restricted to Byteπaccesses, but each one will transfer 4 Bytes at once.πFor example, a sequence like the following...πportw[$3C4]:=$0f02; portw[$3CE]:=$4105;πmove(mem[$a000:0000],mem[$a000:$3e80],16000);πportw[$3CE]:=$4005π...enables all 4 planes, switches to Write mode 1, copies the (64000 Bytes)πcontents of the 2nd Graphic page to the 1st one and then switches back toπWrite mode 0 again.π} 49 05-30-9308:57ALL SWAG SUPPORT TEAM Dispaly PIC,PCX,SCI,GIF IMPORT 64 Üdw> {π>Does anyone know of any way to display a single screen of Graphics on EGAπ>640x350 mode *quickly*. It can be VGA as well; I'm just trying to display tπ>screen *fast* from a disk File. I know, I could have used the GIF or PCXππThis would restore a .PIC format File, uncompressed, For 320x200x256πmode $13, With a prepended 256*3 Byte palette entry header. It shouldπwork- I just wrote this code yesterday to display some unknown .PICπFiles.π}ππProgram dispic;πConstπ maxpicsize = 320*200;πTypeπ pbuf = ^abuf;π abuf=Array[1..maxPICSIZE] of Byte;π palbuf = ^apalbuf;π apalbuf=Array[1..256*3] of Byte;π headerbuf=^aheaderbuf;π aheaderbuf=Array[1..32] of Byte;πVarπ f : File;π i : Byte;π buf : pbuf;π pal : palbuf;π header : headerbuf;π hsize,vsize,picsize,headersize,palettesize:Word;π _r,_g,_b,π cr : Byte;π nr,ctr : Word;π fs,overflow : LongInt;π Filename : String;πππProcedure setcolreg(p:Pointer;start,num:Word);πbeginπ Asmπ mov ah,10hπ mov al,12h { seg block of color Registers }π mov bx,startπ mov cx,numπ mov dx,Word ptr p+2 { get high Word of p (seg) }π mov es,dxπ mov dx,Word ptr p { get low Word of p (ofs) }π int $10π end;πend;ππProcedure stop(s:String);πbeginπ Writeln(s);π halt;πend;ππbeginπ Writeln('DISPIC v0.01ß (c)1993 Brian Pape/Jagaer Technologies'+#10#13);π Writeln(maxavail,' Bytes available.');π if paramcount < 1 thenπ stop('no .PIC File specified.');π Filename := paramstr(1);π assign(f,Filename);π {$I-} reset(f,1); {$I+}π if ioresult <> 0 thenπ beginπ Writeln('File '+Filename+' not found.');π halt;π end;π new(header);π Writeln(maxavail,' Bytes available after header allocate.');π palettesize := sizeof(pal^);π headersize := sizeof(header^);ππ if Filesize(f) < headersize+palettesize then stop('invalid .pic File.');ππ blockread(f,header^,headersize,nr);π if nr < sizeof(headersize) thenπ stop('insufficient header information.')π elseπ Writeln('header: ',nr,' Bytes read.');π hsize := (Word(header^[4]) shl 8) or header^[3];π vsize := (Word(header^[6]) shl 8) or header^[5];ππ picsize := (Word(header^[14]) shl 8) or header^[13];π Writeln('picsize: ',picsize,' Bytes.');π if picsize > maxpicsize thenπ beginπ picsize := maxpicsize;π Writeln('picture size read overflow. resetting to maxpicsize.');π end;ππ dispose(header);π new(pal);π Writeln(maxavail,' Bytes available after palette allocate.');ππ blockread(f,pal^,palettesize,nr);π if nr < palettesize thenπ stop('insufficient palette information.')π elseπ Writeln('palette: ',nr,' Bytes read.');ππ new(buf);π Writeln(maxavail,' Bytes available after buffer allocate.');π {$I-} blockread(f,buf^,sizeof(buf^),nr); {$I+}π if ioresult <> 0 then;π Writeln('picture: ',nr,' Bytes read.');π Writeln('hsize: ',hsize);π Writeln('vsize: ',vsize);π Writeln('press enter.');π readln;π close(f);π Asmπ mov ah,00π mov al,$13π int $10π end;π move(buf^,ptr($a000,0)^,nr);ππ setcolreg(pal,0,256);ππ dispose(buf);π dispose(pal);π readln;π Asmπ mov ah,00π mov al,03π int $10π end;πend.ππ{π> Hello is somebody there that knows how to use pictures that Iπ> made in Deluxe paint (.lbm)ππFirst, convert the LBM File to a SCI using For instance VPIC.πI assume you are using VGA/MCGA 320x200x256.. In Case you don't,πthis won't work...:π}πUsesπ Crt;πVarπ SCIFile : File;π r, g, b : Byte;π i : Integer;π VideoM : Byte Absolute $A000:0000;πbeginπ Asmπ mov ax,0013hπ int 10hπ end;ππ Assign(SCIFile, 'MYSCI.SCI'); { Put your own Filename there }π Reset(SCIFile, 1);ππ For i := 0 to 255 do beginπ Port[$3C8] := i;π BlockRead(SCIFile,r,1);π BlockRead(SCIFile,g,1);π BlockRead(SCIFile,b,1);π Port[$3C9] := r;π Port[$3C9] := g;π Port[$3C9] := b; { Set palette }π end;ππ BlockRead(SCIFile,VideoM,64000);π Repeat Until Port[$60] = 1; { Wait For ESC }ππ Asmπ mov ax,0003hπ int 10hπ end;πend.ππ{π> I am looking to create a simple utility to report the size, color, etcπ> of GIFs.π}ππProgram GI;πUsesπ Dos;ππProcedure ExtractGIFInfo (Name : String);ππConstπ ColorRez : Array[1..8] of Byte=(1,3,7,15,31,63,127,255);ππTypeπ GifSigRec = Array[1..6] of Char;ππ ScreenDiscRec = Recordπ Width,π Height:Word;π GenInfo:Byte;π end;ππVarπ F : File;π Sig : GIFSigRec;π Screen : ScreenDiscRec;π Result : Word;π Diver,π X : Byte;π Y : LongInt;π DirInfo : SearchRec;π Ratio : Byte;π Res : Word;π RReal : Real;ππbeginπ Assign(F, Name);π Reset(F, 1);π BlockRead(F, Sig, SizeOF(Sig), Result);π BlockRead(F, Screen, SizeOf(Screen), Result);π Close(F);ππ If (Sig[1] + Sig[2] + Sig[3] <> 'GIF') Thenπ beginπ WriteLn('Not a Valid .GIF File!');π Exit;π end;ππ For X := 1 to 6 doπ Write(Sig[X]);π Write(', ', Screen.Width, 'x', Screen.Height, 'x');π Screen.GenInfo := (Screen.GenInfo and 7) + 1;π Res := ColorRez[Screen.GenInfo] + 1;π WriteLn(Res);πend;ππVarπ Count : Byte;πbeginπ If ParamCount >= 1 thenπ For Count := 1 to ParamCount doπ ExtractGIFInfo (ParamStr(Count))π elseπ WriteLn(' Use a Filename geek!');πend.πHad the PCX info:ππZSoft .PCX File HEADER ForMATππByte Item Size Description/Commentsππ0 Manufacturer 1 Constant Flag, 10 = ZSoft .pcxππ1 Version 1 Version inFormationπ 0 = Version 2.5 of PC Paintbrushπ 2 = Version 2.8 w/palette inFormationπ 3 = Version 2.8 w/o palette inFormationπ 4 = PC Paintbrush For Windows(Plus For Windowsπ Uses Ver 5)π 5 = Version 3.0 and > of PC Paintbrush andπ PC Paintbrush +, includes Publisher's Paintbrushππ2 Encoding 1 1 = .PCX run length encodingππ3 BitsPerPixel 1 Number of bits to represent a pixel (perπ Plane)- 1, 2, 4, or 8ππ4 Window 8 Image Dimensions: Xmin,Ymin,Xmax,Ymaxππ12 HDpi 2 Horizontal Resolution of image in DPI*ππ14 VDpi 2 Vertical Resolution of image in DPI*ππ16 Colormap 48 Color palette setting, see Textππ64 Reserved 1 Should be set to 0.ππ65 NPlanes 1 Number of color planesππ66 BytesPerLine 2 Number of Bytes to allocate For a scanlineπ plane. MUST be an EVEN number. Do notπ calculate from Xmax-Xmin.ππ68 PaletteInfo 2 How to interpret palette- 1 = Color/BW, 2 =π Grayscale (ignored in PB IV/ IV +)ππ70 HscreenSize 2 Horizontal screen size in pixels.ππNew field found only in PB IV/IV Plusππ72 VscreenSize 2 Vertical screen size in pixels.ππNew field found only in PB IV/IV Plusππ74 Filler 54 Blank to fill out 128 Byte header. Set allπ Bytes to 0ππnotES:ππAll sizes are measured in ByteS.ππAll Variables of SIZE 2 are Integers.ππ*HDpi and VDpi represent the Horizontal and Vertical resolutionsπwhich the image was created (either Printer or scanner); i.e. anπimage which was scanned might have 300 and 300 in each of theseπfields.π{π> Does anyone have the format structure For PCX format? I had itπ> once but I lost it... It had a header (big surprise), and usedπ> run-length compression (HAHAHAHAHA!!!!), but it seems the easiest majorπ> format to code.ππ Here's the header, I haven't fooled much With coding/decoding PCXπbut if I remember right (At least For 256c images) the runπlength-Byte is up to 64 since the most-significant bits signify theπend of a line in the image. And in 256c images, the last 768 Bytesπshould be the palette.π}ππPCXHeader = Recordπ Signature : Char;π Version : Char;π Encoding : Char;π BitsPerPixel : Char;π XMin,YMin,π XMax,YMax : Integer;π HRes,VRes : Integer;π Palette : Array [0..47] of Byte;π Reserved : Char;π Planes : Char;π BytesPerLine : Integer;π PaletteType : Integer;π Filler : Array [0..57] of Byte;πend;ππ 50 05-31-9308:09ALL WILBER VAN LEIJEN 256 VGA Colors IMPORT 23 ÜdQc ==============================================================================π BBS: «« The Information and Technology Exchanπ To: DOUGLAS BAKER Date: 11-11─91 (20:18)πFrom: WILBERT VAN.LEIJEN Number: 2147 [101] PASCALπSubj: 256 TEXT COLORS? Status: Publicπ------------------------------------------------------------------------------πHi Doug,ππ > I was wondering if anyone knows if 256 text colors can be accessedπ > with a VGA adaptor. I figured that since such programs as VGADimmerπ > exist, (to change the brightness) I should be able to change theπ > intensity ofd each color to simulate the 256 colors. Any help and TPπ > 5.5 or 6.0 routines would be appreciated.ππYou can have no more than 16 colours in text mode. These colours can beπselected on the VGA from 255 registers and changed at will. Each register canπalso be programmed to hold a specific Red, Blue and Green value ranging fromπ0..63, giving 64*64*64 = 262,144 unique colours.πThe registers are referred to as the 'DAC registers'.ππProgram ShowDoug;ππ{$X+ }ππuses Crt;ππConstπ MinIntensity = 0;π MaxIntensity = 63;ππTypeπ ColourRange = MinIntensity..MaxIntensity;π RGBType = Recordπ r, g, b : ColourRange;π end;ππ{ Store colour information to DAC register }ππProcedure SetRegister(register : Byte; colour : ColourRange); Assembler;ππASMπ MOV BH, colourπ MOV BL, registerπ MOV AX, 1000hπ INT 10hπend; { SetRegister }ππ{ Store the Red, Green and Blue intensity into a DAC register }ππProcedure SetRGBValue(register : Byte; RGB : RGBType); Assembler;ππASMπ PUSH DSπ LDS SI, RGBπ XOR BX, BXπ MOV BL, registerπ LODSBπ MOV DH, ALπ LODSWπ XCHG CX, AXπ XCHG CH, CLπ MOV AX, 1010hπ INT 10hπ POP DSπend; { SetRGBValue }ππVarπ i, j, t : Integer;π RGB : RGBType;ππBeginπ ClrScr;π Randomize;π TextBackground(black);π For i := 1 to 25 Doπ Beginπ t := 0;π For j := 1 to 80 Doπ Beginπ TextColor(t);π If j mod 5 = 0 Thenπ Inc(t);π If not ((j = 80) and (i = 25)) Thenπ Write(#219);π end;π end;π Repeat { fiddle with the registers }π SetRegister(Random(16), Random(64));π Delay(200);π Until KeyPressed;π ReadKey;π Repeat { fiddle with the R, G, B values }π RGB.r := Random(255);π RGB.g := Random(255);π RGB.b := Random(255);π SetRGBValue(Random(64), RGB);π Until KeyPressed;πend.πππ--- Dutchie V2.91dπ * Origin: Point Wilbert | 'I think, therefore I ASM'. (2:500/12.10956)π 51 06-08-9308:27ALL SEAN PALMER Scale Bitmats IMPORT 13 ÜdΓ/ {π===========================================================================π BBS: Canada Remote SystemsπDate: 05-26-93 (00:24) Number: 24154πFrom: SEAN PALMER Refer#: NONEπ To: ALL Recvd: NOπSubj: SCALING BITMAPS Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πDon't know if anyone is interested, but here is some code to scaleπbitmaps. I JUST now wrote it, and it's tested, but it hasn't even begunπto be optimized yet (that's why it's still postable in the Pascal Echo,πno .ASM stuff yet) 8)ππworks with VGA mode $13. }ππtypeπ fixed=record case boolean ofπ true:(l:longint);π false:(f:word;i:integer);π end;ππprocedure scaleBitmap(var bitmap;x,y:word;x1,y1,x2,y2:word);πvarπ a,i:word;π sx,sy,cy,s:fixed;π map:array[0..65521]of byte absolute bitmap;πbeginπ sx.l:=(x*$10000)div succ(x2-x1); sy.l:=(y*$10000)div succ(y2-y1);π cy.i:=pred(y); cy.f:=$FFFF;π while cy.i>=0 do beginπ a:=y2*320+x1;π s.l:=(cy.i*x)*$10000;π for i:=x2-x1 downto 0 do beginπ mem[$A000:a]:=map[s.i];π inc(a);π inc(s.l,sx.l);π end;π dec(cy.l,sy.l); dec(y2);π end;π end;ππconstπ bmp:array[0..3,0..3]of byte=π ((0,1,2,3),π (1,2,3,4),π (2,3,4,5),π (3,4,5,6));πvar i:integer;ππbeginπ asm mov ax,$13; int $10; end;π for i:=1 to 99 doπ scaleBitMap(bmp,4,4,0,0,i*2,i*2);π asm mov ax,$3; int $10; end;π end.π 52 07-16-9306:06ALL SEAN PALMER Access Video Bios Fonts IMPORT 23 ÜdQc ===========================================================================π BBS: Canada Remote SystemsπDate: 07-02-93 (14:00) Number: 29054πFrom: SEAN PALMER Refer#: NONEπ To: FRANCIS BURIANEK Recvd: NO πSubj: DOS FONT Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πFB>Would You know, where the Video Bios Fonts are located at? (address),πFB>or a way to access using an interrupt?ππI pulled this off the echo a while back...ππTypeπ FontBlock = 0..7;π CharSetType = (INT1F, INT43, ROM8x14, ROM8x8lo, ROM8x8hi, ROM9x14,π ROM8x16, ROM9x16);ππ{ Get a pointer to one of the eight resident VGA fonts }ππFunction GetFontPtr(charset : CharSetType) : Pointer; Assembler;ASMπ MOV BH, charsetπ MOV AX,$1130π INT $10π MOV DX, ESπ XCHG AX, BPπend;ππ{ Get font block index of current (resident) and alternate character set.π Up to two fonts can be active at the same time }ππProcedure GetFontBlock(Var primary, secondary : FontBlock); Assembler;ASMπ { Get character map select register:π (VGA sequencer port 3C4h/3C5h index 3)ππ 7 6 5 4 3 2 1 0π | | | | | |π | | | | +--+-- Primary font (lower 2 bits)π | | +--+-------- Secondary font (lower 2 bits)π | +-------------- Primary font (high bit)π +----------------- Secondary font (high bit) }ππ MOV AL, 3π MOV DX,$3C4π OUT DX, ALπ INC DXπ IN AL, DXπ MOV BL, ALπ PUSH AXπ { Get secondary font number: add up bits 5, 3 and 2 }π SHR AL, 1π SHR AL, 1π AND AL, 3π TEST BL,$20π JZ @1π ADD AL, 4π@1: LES DI, secondaryπ STOSBπ { Get primary font number: add up bits 4, 1 and 0 }π POP AXπ AND AL, 3π TEST BL,$10π JZ @2π ADD AL, 4π@2: LES DI, primaryπ STOSBπend;ππ{ Store the font block index }ππProcedure SetFontBlock(primary, secondary : FontBlock); Assembler;πConstπ MapPrimTable : Array[0..7] of Byte = ($00, $01, $02, $03,$10, $11, $12, $13);π MapSecTable : Array[0..7] of Byte = ($00, $04, $08, $0C,$20, $24, $28, $2C);πASMπ MOV AL, primaryπ LEA BX, MapPrimTableπ XLATπ MOV AH, ALπ MOV AL, secondaryπ LEA BX, MapSecTableπ XLATπ ADD AL, AHπ MOV BL, ALπ{ Set block specifier }π MOV AX,$1103π INT $10πend;πππ * OLX 2.2 * If at first you succeed, hide your astonishment...ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π 53 07-16-9306:15ALL SEAN PALMER Detect Presents of VGA IMPORT 12 ÜdQc ===========================================================================π BBS: Canada Remote SystemsπDate: 06-30-93 (16:12) Number: 28771πFrom: SEAN PALMER Refer#: NONEπ To: JOHN DAILEY Recvd: NOπSubj: VGA INFO Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πJD>I'm looking for a quick-and-dirty way of checking to see ifπJD>a user has VGA capability in text mode. ie. 50 line mode.πJD> Any help is appreciated.ππfunction vgaPresent:boolean;assembler;asmπ mov ah,$F; int $10; mov oldMode,al; {save old Gr mode}π mov ax,$1A00; int $10; {check for VGA/MCGA}π cmp al,$1A; jne @ERR; {no VGA Bios}π cmp bl,7; jb @ERR; {is VGA or better?}π cmp bl,$FF; jnz @OK;π@ERR: xor al,al; jmp @EXIT;π@OK: mov al,1;π@EXIT:π end;ππotherwise you can check the BIOS save data area for number of rows onπscreen... the EGA and VGA keep this updated, older adapters don't (theyπset it to 0)ππyou can just leave the screen in the mode it was in already this way.ππvarπ lastRow:byte absolute $40:$84; {newer bios only:rows on screen-1}ππ * OLX 2.2 * Programming is like sex: one mistake and you support itππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π 54 08-18-9312:23ALL JOSE ALMEIDA Get the active font IMPORT 9 ÜdLô { Get the active font table in buffer #0.π Part of the Heartware Toolkit v2.00 (HTfont.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }πππtypeπ Font_Type = array[1..4096] of byte;ππPROCEDURE Font_Get(var Fnt : Font_Type);ππ{ DESCRIPTION:π Get the active font table in buffer #0.π SAMPLE CALL:π Font_Get(Font_Table);π RETURNS:π The font table.π NOTES:π Works in VGA only, and with 8x16 fonts }ππvarπ Regs : registers;ππBEGIN { Font_Get }π Regs.AH := $11;π Regs.AL := $30;π Regs.BH := 6; { VGA: 8 x 16 }π Intr($10,Regs);π Move(Mem[Regs.ES:Regs.BP],Fnt,4096);πEND; { Font_Get }π 55 08-18-9312:25ALL JOSE ALMEIDA Get one Char from Font IMPORT 9 Üdùσ { Get one char table from font buffer.π Part of the Heartware Toolkit v2.00 (HTfont.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππtypeπ Font_Type = array[1..4096] of byte;π Char_Type = array[1..16] of byte;ππPROCEDURE Font_Get_Char(Fnt : Font_Type;π Char_ : byte;π var Char_Buffer : Char_Type);ππ{ DESCRIPTION:π Get one char table from font buffer.π SAMPLE CALL:π Font_Get_Char(Font_Table,176,Char_Table);π RETURNS:π Char_Buffer : Specified char table.π NOTES:π Works in VGA only, and with 8x16 fonts }ππvarπ P : word;ππBEGIN { Font_Get_Char }π P := Succ(16 * Char_);π Move(Fnt[P],Char_Buffer,16);πEND; { Font_Get_Char }π 56 08-27-9320:52ALL GREG ESTABROOKS 43/50 Line Mode IMPORT 7 Üds¬ {π> HELP!!! I cannot figure out how to throw Borland's Turbo Pascalπ> v4.0 into VGA 50linesx80columns mode!ππYou just have to use the Textmode procedure that is in the CRTπunit. The following is an example of how to use it.π}ππPROGRAM TextMode_Demo; { June 14/93, Greg Estabrooks }πUSESπ CRT; { TextMode, LastMode }πVARπ SavedMode : BYTE; { Holds Initial Text mode }ππBEGINπ SavedMode := LastMode; { Save Current Mode for later }π TextMode(Font8x8 + Co80); { Set to Color 43/50 line mode }π Writeln('This is 43/50 line mode!');π Readln; { Wait for user to have a look }π TextMode(SavedMode); { Restore to original textmode }πEND.π 57 08-27-9321:51ALL SWAG SUPPORT TEAM VGA Wait for retrace IMPORT 5 Üd▐▓ {π> Does anybody know how to wait for the retrace before drawing a newπ> screen to eliminate flicker?ππHere's the procedure from a PD unit called SuperVGA (by Steve Madsen):ππWaits for a verticle retrace to complete before exiting. Usefulπfor reducing flicker in video intensive operations, like color cycling.π}ππPROCEDURE WaitRetrace;πbeginπ while ((Port[$3DA] AND 8) > 0) do;π while ((Port[$3DA] AND 8) = 0) do;πend;π 58 08-27-9322:09ALL PETER WOKKE VGA COLOR Unit IMPORT 9 Üd¬ {πPETER WOKKEππ> anyone know a way to set the DAC registers that's faster than int $10?π}ππPROGRAM vga_in_mode_13;ππ{ VGA in Mode $13 320 x 200 and 256 Colors for Turbo Pascal 6.0 }ππUSESπ Dos, Crt;ππProcedure Plot(x, y : Integer; color : Byte);πBeginπ Mem[$A000 : word(y * 320 + x)] := color;πEnd;ππProcedure set_rgb(reg, Red, Green, Blue : Byte);πBeginπ Port[$3C8] := reg;π Inline($FA);π Port[$3C9] := Red;π Port[$3C9] := Green;π Port[$3C9] := Blue;π Inline($FB);πEnd;ππVarπ x, y : Integer;π reg : Registers;π savemode : Byte;π n : Byte;πBeginπ reg.AX := $0F00;π Intr($10, reg);π savemode := reg.al;ππ reg.AX := $0013;π Intr($10, reg);ππ For n := 0 TO 63 Doπ set_rgb(n, n, 0, 0);π For n := 63 Downto 0 Doπ set_rgb(127 - n, n, 0, 0);π For n := 128 TO 191 Doπ set_rgb(n, 0, 0, n);ππ For y := 0 TO 191 Doπ For x := 0 TO 319 Doπ Plot(x, y, y);π Readln;ππ reg.AX := savemode;π Intr($10, reg);πEND.π 59 09-26-9308:44ALL MIGUEL MARTINEZ 80x30 Text Mode ProcedureIMPORT 16 ÜdPÆ (*πFrom: MIGUEL MARTINEZ Refer#: NONEπSubj: 80x30 Text-Mode Procedure Conf: (1617) L-Pascalπ---------------------------------------------------------------------------πHello to everyone!. A friend of mine who enjoys Assembler, has developed aπroutine, to provide "another" video mode to all those who develop text-basedπprograms.ππIt's a routine to set a 80x30 text mode, using the 16x8 font of the VGA.πI think is a better mode to work, than the standard 80x25 mode: Moreπinformation on screen, without loosing the pretty 16x8 chars.ππI have translated this routine to Pascal, and here is the result. It willπwork on any standard VGA card.π*)ππ{Procedure to set 80 columns per 30 rows video mode}π{Orignial Author: Ignacio García Pérez}πProcedure Set80x30Mode;πVar CrtcReg:Array[1..8] of Word;π Offset:Word;π i,Data:Byte;πBeginπ CrtcReg[1]:=$0c11; {Vertical Display End (unprotect regs. 0-7)}π CrtcReg[2]:=$0d06; {Vertical Total}π CrtcReg[3]:=$3e07; {Overflow}π CrtcReg[4]:=$ea10; {Vertical Retrace Start}π CrtcReg[5]:=$8c11; {Vertical Retrace End (& protect regs. 0-7)}π CrtcReg[6]:=$df12; {Vertical Display Enable End}π CrtcReg[7]:=$e715; {Start Vertical Blanking}π CrtcReg[8]:=$0616; {End Vertical Blanking}ππ MemW[$0040:$004c]:=8192; {Change page size in bytes}π Mem[$0040:$0084]:=29; {Change page length}π Offset:=MemW[$0040:$0063]; {Base of CRTRC}π Asmπ cli {Clear Interrupts}π End;ππ For i:=1 to 8 doπ PortW[Offset]:=CrtcReg[i]; {Load Registers}ππ Data:=Port[$03cc];π Data:=Data And $33;π Data:=Data Or $C4;π Port[$03c2]:=Data;π Asmπ sti {Set Interrupts}π mov ah,12h {Select alternate printing routine}π mov bl,20hπ int 10hπ End;πEnd; {Of Procedure}ππBEGINπSet80X30Mode;πEND.ππ 60 10-28-9311:40ALL WIM VAN DER VEGT VGA TEXT Support IMPORT 36 Üdâ {===========================================================================πDate: 10-09-93 (10:40)πFrom: WIM VAN DER VEGTπSubj: textmodes w/43/50 linesπ---------------------------------------------------------------------------πHere the uncodes sources of some routines I've written to replaceπturbo's internal textmode routines to enable 43 & 50 lines textmodes onπVGA. They use the BIOS and can be combined with normal read/writeπstatements. Just use the unit and call one of the Vgaxxlines routines.ππ{---------------------------------------------------------}π{ Project : Vga Textmode Support }π{ By : G.W. van der Vegt }π{---------------------------------------------------------}π{ Date .time Revision }π{ 931003.2200 Creatie. }π{---------------------------------------------------------}ππUnit Vts_01;ππInterfaceππFunction MaxX : Byte;ππFunction MaxY : Byte;ππFunction WhereX : Byte;ππFunction WhereY : Byte;ππProcedure GotoXY(x,y : Byte);ππFunction GetXY(x,y : Byte) : Char;ππProcedure vga50lines;ππProcedure vga43lines;ππProcedure vga25lines;ππ{---------------------------------------------------------}ππImplementationππUsesπ Dos;ππ{---------------------------------------------------------}ππFunction MaxX : Byte;ππ{----Return horizontal size of textmode in characters}ππVarπ r : Registers;ππBeginπ r.ah:=$0F;π Intr($10,r);π MaxX:=r.AH;πEnd; {of MaxX}ππ{---------------------------------------------------------}ππFunction MaxY : Byte;ππ{----Return vertical size of textmode in characters}ππVarπ r : Registers;π buf : Array[0..63] Of byte;ππBeginπ r.ah:=$1B;π r.bx:=$00;π r.es:=Seg(buf);π r.di:=Ofs(buf);π Intr($10,r);π MaxY:=buf[$22];πEnd; {of MaxY}ππ{---------------------------------------------------------}ππFunction WhereX : Byte;ππ{----WhereX, aware of textmodes larger than 80x25}ππVarπ r : registers;ππBeginπ r.ah:=$0f;π Intr($10,r);π r.ah:=$03;π Intr($10,r);π WhereX:=r.dl;πEnd; {of WhereX}ππ{---------------------------------------------------------}ππFunction WhereY : Byte;ππ{----WhereY, aware of textmodes larger than 80x25}πππVarπ r : registers;ππBeginπ r.ah:=$0f;π Intr($10,r);π r.ah:=$03;π Intr($10,r);π WhereY:=r.dh;πEnd; {of WhereY}ππ{---------------------------------------------------------}ππProcedure GotoXY(x,y : Byte);ππ{----GotoXY, aware of textmodes larger than 80x25}ππVarπ r : registers;ππBeginπ r.ah:=$0f;π Intr($10,r);π r.ah:=$02;π r.dh:=y;π r.dl:=x;π Intr($10,r);πEnd; {of GotoXY}ππ{---------------------------------------------------------}ππFunction GetXY(x,y : Byte) : Char;ππ{----GetXY, returns char at x,y and is aware of textmodes larger than 80x25}π{ leave cursor unchanged. }ππVarπ r : registers;π xs,ys : Byte;πBeginπ xs:=WhereX;π ys:=WhereY;π GotoXY(x,y);π r.ah:=$0f;π Intr($10,r);π r.ah:=$08;π Intr($10,r);π GetXY:=Chr(r.al);π GotoXY(xs,ys);πEnd; {of GotoXY}ππ{---------------------------------------------------------}ππProcedure vga50lines;ππ{----Put VGA display into 80x50 textmode}ππVarπ r : registers;π b : Byte;ππBeginπ{----50 line mode}π b:=Mem[$40:$87];π Mem[$40:$87]:=Mem[$40:$87] OR $01;π r.ah:=$11;π r.al:=$12; {----8x8 Character set}π r.bl:=$00;π Intr($10,r);π Mem[$40:$87]:=b;ππ{----400 scan lines neccesary}π r.ah:=$12;π r.al:=$02; {----400}π r.bl:=$30;π Intr($10,r);πEnd; {of Vga50lines}ππ{---------------------------------------------------------}ππProcedure vga43lines;ππ{----Put VGA display into 80x43 (EGA) textmode}ππVarπ r : registers;π b : Byte;ππBeginπ{----43 line mode}π b:=Mem[$40:$87];π Mem[$40:$87]:=Mem[$40:$87] OR $01;π r.ah:=$11;π r.al:=$12; {----8x8 Character set}π r.bl:=$00;π Intr($10,r);π Mem[$40:$87]:=b;ππ{----350 scan lines neccesary}π r.ah:=$12;π r.al:=$01; {----350}π r.bl:=$30;π Intr($10,r);πEnd; {of Vga43lines}ππ{---------------------------------------------------------}ππProcedure vga25lines;ππ{----Put VGA display into 80x25 textmode}ππVarπ r : registers;π b : Byte;ππBeginπ{----25 line mode}π b:=Mem[$40:$87];π Mem[$40:$87]:=Mem[$40:$87] OR $01;π r.ah:=$11;π r.al:=$11; {----8x14 Character set}π r.bl:=$00;π Intr($10,r);π Mem[$40:$87]:=b;ππ{----400 scan lines neccesary}π r.ah:=$12;π r.al:=$02; {----400}π r.bl:=$30;π Intr($10,r);πEnd; {of Vga25lines}ππEnd.π 61 11-02-9304:44ALL SEAN PALMER 50 Line mode IMPORT 5 Üd╢. {πSEAN PALMERππ> Yeah, I almost think I learned assembly just to reProgram the Crtπ> Unit! (except I can't seem to find out how to get to 50-line mode Withπ> assembly)π}ππProcedure set50LineMode; Assembler;πAsmπ mov ax, $1202π mov bl, $30π int $10 {set 400 scan lines}π mov ax, 3π int $10 {set Text mode}π mov ax, $1112π mov bl, 0π int $10 {load 8x8 font to page 0 block}πend;ππ 62 11-02-9305:26ALL WILLIAM MCBRINE Clear Screen in Mode $13 IMPORT 4 Üd∙ {πWILLIAM MCBRINEππ> I am looking For a Procedure to clear a screen in mode $13. Writingπ> black pixels to each position isn't quite fast enough!ππThis assumes that color 0 is black.π}ππProcedure clearmode13; Assembler;πAsmπ cldπ mov ax, $A000π mov es, axπ xor di, diπ xor ah, ahπ mov cx, 32000π rep stoswπend;ππ 63 11-02-9308:10ALL ANDREW WOOLFSON VGA Lines IMPORT 39 Üd╝w {πANDREW WOOLFSONππI recall certain people discussing ways of drawing LINES in Pascal.πUnfortunately I'v lost the thread of those messages - BUT thought I couldπadd my endevours to this same task.πI hope this helps someone.ππ}πProgram VGA_Line_Demo;π(***************************************************************************)π(* Designed, thought out and programmed by Andrew Woolfson {using TP v6.0} *)π(* *)π(* Because you have lost all those handy Borland Graphic Functions, I have *)π(* had to redesign the second elementary function in graphics : THE LINE *)π(* This proved very difficult, and so far this program is a example of the *)π(* best I have managed to do (using vector mathematics). *)π(* *)π(* This program also shows VGA direct screen addressing in 320x200x256 *)π(* mode. *)π(* *)π(* I have not documented this program, as I feel it it fairly explanatory. *)π(* If you Do not understand any routine, dont hesitate to ask. *)π(* Please share your experiments as I have. *)π(***************************************************************************)ππUsesπ Crt, Graph, DOS;ππVarπ x, y, Loop : Integer;π Key : Char;π Pixels : Array [0..199,0..319] OF BYTE ABSOLUTE $A000:0000;π { NOTE: Y & X Coord's have been swapped }ππProcedure InitializeVGA;πVarπ GraphDriver : Integer;π GraphMode : Integer;π PathtoDriver : String[8];π Regs : Registers;πBeginπ GraphDriver := VGA;π GraphMode := VGAHi;π InitGraph(GraphDriver, GraphMode, 'e:\bp\bgi');ππ Regs.AX := 19;π intr($10, Regs); { Interrupt 16 }πEnd;ππProcedure Plot(X, Y, Color : Integer);πBeginπ Pixels[Y,X] := Color;πEnd;ππProcedure Line(x1, y1, x2, y2, Color : Integer);πVarπ Loop,π tx, ty : Integer;π Gradiant : Real;πBeginπ If ((x1 < x2) AND (y1 < y2)) ORπ ((x1 = x2) AND (y1 < y2)) ORπ ((x1 < x2) AND (y1 = y2)) Thenπ Beginπ If (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1) <= 1 Thenπ Beginπ Gradiant := (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1);π For Loop := x1 To (x1 + ABS(x2 - x1)) Doπ Plot(Loop, (y1 + trunc((Loop - x1) * Gradiant)), Color);π Endπ elseπ Beginπ Gradiant := (ABS(x2 - x1) + 1) / (ABS(y2 - y1) + 1);π For Loop := y1 To (y1 + ABS(y2 - y1)) Doπ Plot((x1 + trunc((Loop - y1) * Gradiant)), Loop, Color);π End;π End;ππ If (x1 > x2) AND (y1 < y2) Thenπ Beginπ If (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1) <= 1 Thenπ Beginπ Gradiant := (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1);π For Loop := x2 To x1 Doπ Plot(Loop, (y1 + trunc((x1 - Loop) * Gradiant)), Color);π Endπ elseπ Beginπ Gradiant := (ABS(x2 - x1) + 1) / (ABS(y2 - y1) + 1);π For Loop := y1 To (y1 + ABS(y2 - y1)) Doπ Plot((x1 + trunc((y1 - Loop) * Gradiant)), Loop, Color);π End;π End;ππ If ((x1 < x2) AND (y1 > y2)) Thenπ Beginπ If (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1) <= 1 Thenπ Beginπ Gradiant := (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1);π For Loop := x1 To (x1 + ABS(x2 - x1)) Doπ Plot(Loop, y1 + trunc((x1 - Loop) * Gradiant), color);π Endπ elseπ Beginπ ty := y1;π y1 := y2;π y2 := ty;π Gradiant := (ABS(x2 - x1) + 1) / (ABS(y2 - y1) + 1);π For Loop := y1 To (y1 + ABS(y2 - y1)) Doπ Plot(x2 + trunc((y1 - Loop) * Gradiant), Loop, color);π End;π End;ππ If ((x1 > x2) AND (y1 > y2)) ORπ ((x1 = x2) AND (y1 > y2)) ORπ ((x1 > x2) AND (y1 = y2)) Thenπ Beginπ tx := x1;π ty := y1;π x1 := x2;π y1 := y2;π x2 := tx;π y2 := ty;π If (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1) <= 1 Thenπ Beginπ Gradiant := (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1);π For Loop := x1 To (x1 + ABS(x2 - x1)) Doπ Plot(Loop, y1 + trunc((Loop - x1) * Gradiant), color);π Endπ elseπ Beginπ Gradiant := (ABS(x2 - x1) + 1) / (ABS(y2 - y1) + 1);π For Loop := y1 To (y1 + ABS(y2 - y1)) Doπ Plot(x1 + trunc((Loop - y1) * Gradiant), Loop, color);π End;π End;ππEnd;ππBeginπ InitializeVGA;ππ SetRGBPalette(1,63, 0, 0); { RED }π SetRGBPalette(2, 0,63, 0); { GREEN }π SetRGBPalette(3, 0, 0,63); { BLUE }π SetRGBPalette(4,63,63,63); { WHITE }ππ For x := 50 To 250 Doπ Line(150, 100, x, 50, 1);π For y := 50 To 150 Doπ Line(150, 100, 250, y, 2);π For x := 250 Downto 50 Doπ Line(150, 100, x, 150, 3);π For y := 150 Downto 50 Doπ Line(150, 100, 50, y, 4);ππ Readln;πEnd.π 64 11-02-9310:25ALL JAMES SAITO Using ALL the memory IMPORT 19 ÜdMj {πJAMES SAITOππ> I wonder if I can allocate With GetMem more than 64K, though. You see, I'mπ> interested in creating games With my own code, and the most important partπ> of games is Graphics. You don't want to play some dumb monochrome Textπ> adventure With a little man (@). :) Do you have any tips For outputting aπ> screen of information such as a part of a dungeon? I'd sorta like to keepπ> the Character centered like in Nintendo games.ππWell. if you want to make a 320x200x256 game, I know the right stuff. if youπwould like to make the Character centered, and when you pressπup/down/left/right, the whole screen scrolls. Here is an example on a playingπfield that is umm. Let's say 1000x200 (200K).π}πVarπ Field : Array [0..199] of Pointer; {The Field}π P : Pointer; {I'll tell you what happens With this}π Count,π Count2 : Integer;ππbeginπ {Init The Graphics}π Asmπ MOV AH,00H {AH = 0}π MOV AL,13H {AL = 13H,which is the Graphics mode 320x200x256}π INT 10H {Call the Graphics bios services}π end;ππ if Mem[$40:$49] <> $13 Thenπ beginπ WriteLn('VGA Graphics Required For this game');π Halt(1);π end;ππ For Count := 0 to 199 doπ beginπ getmem(field[count],1000); {Find a chunk of memory For the field}π For count2 := 0 to 999 doπ mem[seg(field[count]^) : ofs(field[count]^)] := random(256);π {Create a random field}π end;π getmem(p, 64000);π For Count2 := 0 to 679 doπ beginπ For count := 0 to 199 doπ Move(mem[seg(field[count]^) : ofs(field[count]^) + Count2],π mem[seg(p^) : ofs(p^) + count * 320], 320);π {Now do put your player on, supposing it's a white block}π For count := 90 to 110 doπ FillChar(mem[seg(p^) : ofs(p^) + count * 320 + 150], 20, 15);π move (p^, mem[$A000 : 0], 64000);π {Now copy that workspace into the video memory}π end;ππ {Now time to close the Graphics}π Asmπ MOV AH,$00;π MOV AL,$03;π INT 10Hπ end;ππ {Free all blocks}π For Count := 0 to 199 doπ freemem(field[count], 320);π freemem(p, 64000);πend.π{π Well. That's it. It actually took me 20 minutes to Type this whole thingπright in the message base. I guess there's a bit of errors. - James Saitoπ}π 65 11-02-9310:32ALL SWAG SUPPORT TEAM PLASMA Fractal IMPORT 30 Üd' {π>Do you have Pascal code For generating this PLAsmA fractal? if so,π>then I'd like to snarf a copy of it, if'n you don't mind... Or (if it'sπ>not too large) could you post it as a message? Thanx in advance!π}ππProgram PlAsma;ππUsesπ Crt, Dos;ππConstπ f = 2.0;π EndProgram : Boolean = False;π DelayFactor : Byte = 20;ππTypeπ ColorValue = Recordπ Rvalue,π Gvalue,π Bvalue : Byte;π end;ππ PaletteType = Array [0..255] of ColorValue;ππVarπ ch : Char;π i : Integer;π image : File;π ok : Boolean;π p : paletteType;ππProcedure SetVGApalette(Var tp : PaletteType);πVarπ regs : Registers;πbeginπ With regs doπ beginπ AX := $1012;π BX := 0;π CX := 256;π ES := Seg(tp);π DX := Ofs(tp);π end;π Intr($10, regs);πend;ππProcedure PutPixel(x, y : Integer; c : Byte);πbeginπ mem[$a000 : Word(320 * y + x)] := c;πend;ππFunction GetPixel(x, y : Integer) : Byte;πbeginπ GetPixel := mem[$a000 : Word(320 * y + x)];πend;ππProcedure adjust(xa, ya, x, y, xb, yb : Integer);πVarπ d, v : Integer;πbeginπ if GetPixel(x, y) <> 0 thenπ Exit;π d := abs(xa - xb) + abs(ya - yb);π v := trunc((GetPixel(xa, ya) + GetPixel(xb, yb)) / 2 +π (random - 0.5) * d * F);π if v < 1 thenπ v := 1;π if v >= 193 thenπ v := 192;π putpixel(x, y, v);πend;ππProcedure subDivide(x1, y1, x2, y2 : Integer);πVarπ x, y : Integer;π v : Real;πbeginπ if KeyPressed thenπ Exit;π if (x2 - x1 < 2) and (y2 - y1 < 2) thenπ Exit;π x := (x1 + x2) div 2;π y := (y1 + y2) div 2;π adjust(x1, y1, x, y1, x2, y1);π adjust(x2, y1, x2, y, x2, y2);π adjust(x1, y2, x, y2, x2, y2);π adjust(x1, y1, x1, y, x1, y2);π if GetPixel(x, y) = 0 thenπ beginπ v := (GetPixel(x1, y1) + GetPixel(x2, y1) + GetPixel(x2, y2) +π getPixel(x1, y2)) / 4;π putpixel(x, y, Trunc(v));π end;ππ SubDivide(x1, y1, x, y);π subDivide(x, y1, x2, y);π subDivide(x, y, x2, y2);π subDivide(x1, y, x, y2);πend;ππProcedure rotatePalette(Var p : PaletteType; n1, n2, d : Integer);πVarπ q : PaletteType;πbeginπ q := p;π For i := n1 to n2 doπ p[i] :=q[n1 + (i + d) mod (n2 - n1 + 1)];π SetVGApalette(p);πend;ππbeginπ Inline($b8/$13/0/$cd/$10);π With P[0] doπ beginπ Rvalue := 32;π Gvalue := 32;π Bvalue := 32;π end;π For i := 0 to 63 doπ beginπ With p[i + 1] doπ beginπ Rvalue := 63-i; { 63 - i }π Gvalue := 63-i; { 63 - i }π Bvalue := i+63; { 0 }π end;π With p[i + 65] doπ beginπ Rvalue := 0; { 0 }π Gvalue := i+63; { i }π Bvalue := 63-i; { 0 }π end;π With p[i + 129] doπ beginπ Rvalue := i; { 0 }π Gvalue := i; { 0 }π Bvalue := 63 - i; { 63 - i }π end;π end;π Inline($b8/$13/0/$cd/$10);ππ SetVGApalette(p);π Assign(image, 'PLASMA.IMG');π {$i-}π Reset(image, 1);π {$I+}π ok := (ioResult = 0);π if not ok or (ParamCount <> 0) thenπ beginπ Randomize;π putpixel(0, 0, 1 + Random(192));π putpixel(319, 0, 1 + Random(192));π putpixel(319, 199, 1 + Random(192));π putpixel(0, 199, 1 + Random(192));π SubDivide(0, 0, 319, 199);π ReWrite(image, 1);π BlockWrite(image, mem[$a000:0], $FA00);π endπ elseπ BlockRead(image, mem[$a000:0], $FA00);ππ Close(image);π Repeatπ rotatePalette(p, 1, 192, + 1);π Delay(DelayFactor);π If KeyPressed thenπ Case ReadKey ofπ #0 : Case ReadKey ofπ #80 : If DelayFactor < 255 thenπ Inc(DelayFactor);π #72 : If DelayFactor > 0 thenπ Dec(DelayFactor);π end;π #113,#81 {Q,q} : EndProgram := True;π end;π Until EndProgram;ππ TextMode(lastmode);πend.π 66 11-02-9310:35ALL KAI ROHRBACHER VGA Text Mode Demo IMPORT 77 Üdφ╦ {πKAI ROHRBACHERππ>> VGA Text mode (which is just an all-points-not-addressable mode,π>> whereas the Graphics modes we're all familiar With are called all-π>> points-addressable. The point is that whether all the points areπ>> addressable or not is irrevelant, but rather the "points" areπ>> there period.)ππNo. The width of a normal 256 color Graphics mode counts twiceπcompared to the pixel frequency of a 16 color mode (Text or Graphic):πa 320 pixel resolution in 256 colors needs the same clock rate as aπ640 pixel resolution in 16 color mode.ππ>> Anyway, the VGA Text mode consists of 80 Characters wideπ>> each which are 9 points wide. Do you see where I'm going...the VGAπ>> ISSSSS capable of 720 pixels wide.π> I wouldn't doubt it since we've seen 640x480x16 on a regular VGA.π> 720 isn't far from 640.ππThat's why it is so easy to trick the VGA into 360x400x256 orπ360x480x256 modes: 80 Text columns * 9 pixels = 720 pixels. 720/2=360.πHere's a small Program, demonstrating some Graphics mode; it's takenπfrom a German computer magazine, I just ported it from "C" to TP.πNote that For the same reason, I doubt that the claimed resolutionπ640x400x256 will run on a standard VGA: it would require a dotπfrequency of 1280 pixels in a 16 color mode!π}ππProgram vgademo;ππUsesπ Dos, Crt;ππConstπ maxPar = 23;ππTypeπ parameter = Array [0..maxPar] of Byte;ππConstπ CrtRegVal320x240 : parameter { Static } =π (95,79,80,130,84,128,13,62,0,65,0,0,0,0,0,0,234,172,223,40,0,231,6,227);π CrtRegVal320x400 : parameter { Static } =π (95,79,80,130,84,128,191,31,0,64,0,0,0,0,0,0,156,142,143,40,0,150,185,227);π CrtRegVal360x480 : parameter { Static } =π (107,89,90,142,94,138,13,62,0,64,0,0,0,0,0,0,234,172,223,45,0,231,6,227);π CrtRegVal640x400 : parameter { Static } =π (95,79,80,130,84,128,191,31,0,64,0,0,0,0,0,0,156,142,143,40,0,150,185,163);ππ actualMode :Byte = 0;ππ R640x400 = 4;π R360x480 = 3;π R320x400 = 2;π R320x240 = 1; { die moeglichen Aufloesungen }πππVarπ ch : Char;π VideoRam,π zb4, {ein 1/4 der Bytes je Grafikzeile}π max_X,π max_Y : Word;π regs : Registers;ππFunction ReadMode : Byte;πbeginπ regs.ah := $f;π intr($10, regs);π ReadMode := regs.al;πend;πππProcedure OldMode(OldMod : Byte);πbeginπ regs.ah := 0;π regs.al := OldMod;π intr($10, regs);πend;πππProcedure Mode(Resolution : Word);πVarπ Read_1,π RegNumber : Word;πbeginπ regs.ax := $0012;π intr($10, regs);π regs.ax := $0013;π intr($10, regs);π portw[$3c4] := $0604;π port[$3d4] := $11;π Read_1 := port[$03d5] And $7f;π port[$03d5] := Read_1;ππ Case Resolution Ofπ R320x240 :π beginπ actualMode := R320x240;π portw[$03c4] := $0100;π port[$03c2] := $e3;π portw[$03c4] := $0300;π For RegNumber := 0 to maxPar DOπ portw[$03d4] := CrtRegVal320x240[RegNumber] SHL 8 + RegNumber;π zb4 := 80;π max_X := 319;π max_Y := 239;π end;ππ R320x400 :π beginπ actualMode := R320x400;π For RegNumber := 0 to maxPar DOπ portw[$03d4] := CrtRegVal320x400[RegNumber] SHL 8 + RegNumber;π zb4 := 80;π max_X := 319;π max_Y := 399;π end;ππ R360x480 :π beginπ actualMode := R360x480;π portw[$03c4] := $0100;π port[$03c2] := $e7;π portw[$03c4] := $0300;π For RegNumber := 0 to maxPar DOπ portw[$03d4] := CrtRegVal360x480[RegNumber] SHL 8 + RegNumber;π zb4 := 90;π max_X := 359;π max_Y := 479;π end;ππ R640x400 :π beginπ actualMode := R640x400;π {hier!}π portw[$03c4] := $0100;π port[$03c2] := $e7;π portw[$03c4] := $0300;π For RegNumber := 0 to maxPar DOπ portw[$03d4] := CrtRegVal640x400[RegNumber] SHL 8 + RegNumber;π zb4 := 160;π max_X := 639;π max_Y := 399;π endπ end;ππ VideoRam := $a000;πend;πππProcedure Paint(Resolution, Side : Word);πbeginπ Case Resolution Ofπ R320x240 : Case Side Ofπ 1 : VideoRam := $a000;π 2 : VideoRam := $a4b0;π 3 : VideoRam := $a960;π else VideoRam := $a000;π end;π R320x400 : Case Side Ofπ 1 : VideoRam := $a000;π 2 : VideoRam := $a800;π else VideoRam := $a000;π end;π R360x480,π R640x400 : VideoRam := $a000;π elseπ VideoRam := $a000;π end;πend;πππProcedure Show(Resolution, Side : Word);πVarπ Start : Word;πbeginπ Case Resolution Ofπ R320x240 :π Case Side Ofπ 1 : Start := 0;π 2 : Start := $4b;π 3 : Start := $96;π else { Default } Start := 0;π end;ππ R320x400:π Case Side Ofπ 1 : Start := 0;π 2 : Start := $80;π else { Default } Start := 0;π end;ππ R360x480,π R640x400 : Start := 0;ππ else { Default } Start := 0;π end;π portw[$03d4] := Start SHL 8 + $0c;πend;πππProcedure SetPoint(x, y, Color : Word);πVarπ Offset : Word;πbeginπ{ if actualMode=R640x400π then Offset:=(y*zb4)+ (x shr 1 and $FE)π else}π Offset := (y * zb4) + (x Shr 2);π portw[$03c4] := (1 Shl ((x And 3) + 8)) + 2;π mem[VideoRam : Offset] := Color;πend;πππFunction GetPoint(x, y : Word) : Word;πVarπ Offset : Word;πbeginπ{ if actualMode=R640x400π then Offset:=(y*zb4)+ (x shr 1 and $FE)π else}π Offset := (y * zb4) + (x Shr 2);π portw[$03ce] := (x And 3) SHL 8 + 4;π GetPoint := mem[VideoRam : Offset];πend;ππ{ Demo-HauptProgramm }ππProcedure main;πVarπ x,π y,π c,π OldMod : Word;ππbeginπ OldMod := ReadMode; { speichert alten Videomodus in Oldmod }π Writeln('VGASTAR');π Writeln('320x240 (3 Seiten), 320x400 (2 Seiten ) 360x480 oder');π Writeln('640x400 Pixel in 256 Farben auf Standard-VGA mit 256K');π Writeln('1991 Ingo Spitczok von Brisinski, c''t 12/91');π Writeln(' Modus 1: 320 x 240 Pixel mit 3 Seiten');π Write('Bitte Return-Taste druecken');π ch := ReadKey;π Mode(R320x240);π Show(R320x240, 1);π Paint(R320x240, 1);π x := 0;π While (x <= max_X) Doπ beginπ y := 0;π While (y <= max_Y) Doπ beginπ { male in 256 Farben }π SetPoint(x, y, ((x + y) And 255));π y := Succ(y)π end;π x := Succ(x)π end;ππ Show(R320x240, 2);π Paint(R320x240, 2);π x := 100;π While (x < 201) Doπ beginπ y := 100;π While (y < 201) Doπ beginπ { Quadrat 100x100 Pixel }π SetPoint(x, y, ((x + y) And 255));π y := Succ(y)π end;π x := Succ(x)π end;ππ Paint(R320x240, 3);π c := 0;π While (c <= max_Y) Doπ beginπ SetPoint(c, c, 10);π c := Succ(c)π end;ππ ch := ReadKey;π Show(R320x240, 3);π ch := ReadKey;π Show(R320x240, 1);π ch := ReadKey;π OldMode(OldMod);π Writeln(' Modus 2: 320 x 400 Pixel, 2 Seiten');π ch := ReadKey;π Mode(R320x400);π Show(R320x400, 1);π Paint(R320x400, 1);π x := 0;ππ While (x <= max_X) Doπ beginπ y := 0;π While (y < 200) Doπ beginπ SetPoint(x, y, ((x + y) And 255));π y := Succ(y)π end;π x := Succ(x)π end;ππ x := 0;π While (x < 320) Doπ beginπ y := 200;π While (y < 400) Doπ beginπ SetPoint(x, y, 22);π y := Succ(y)π end;π x := Succ(x)π end;ππ Paint(R320x400, 2);π x := 80;π While (x < 220) Doπ beginπ y := 0;π While (y <= max_Y) Doπ beginπ SetPoint(x, y, ((x + y) And 255));π y := Succ(y)π end;π x := Succ(x)π end;ππ ch := ReadKey;π Show(R320x400, 2);π ch := ReadKey;π Show(R320x400, 3);π Paint(R320x400, 1);π x := 100;ππ While (x < 200) Doπ beginπ y := 0;π While (y < 50) Doπ beginπ c := GetPoint(x, y);π { Lies die Farbe }π SetPoint(x, y + 250, c);π { Male die gelesene Farbe } ;π y := Succ(y)π end;π x := Succ(x)π end { For };ππ ch := ReadKey;π OldMode(OldMod);π Writeln(' Modus 3: 360 x 400 Pixel, 1 Seite');π ch := ReadKey;π Mode(R360x480);π x := 0;ππ While (x < 320) Doπ beginπ y := 0;π While (y < 200) Doπ beginπ SetPoint(x, y, (x And 255));π y := Succ(y)π end;π x := Succ(x)π end;ππ x := 0;π While (x <= max_X) Doπ beginπ y := 200;π While (y <= max_Y) Doπ beginπ SetPoint(x, y, y And 255);π y := Succ(y)π end;π x := Succ(x)π end;ππ x := 320;π While (x <= max_X) Doπ beginπ y := 0;π While (y <= max_Y) Doπ beginπ SetPoint(x, y, 25);π y := Succ(y)π end;π x := Succ(x)π end;ππ x := 0;π While (x <= max_X) Doπ beginπ y := 400;π While (y <= max_Y) Doπ beginπ SetPoint(x, y, 26);π y := Succ(y)π end;π x := Succ(x)π end;ππ ch := ReadKey;π OldMode(OldMod);π Writeln(' Modus 4: 640 x 400 Pixel, 1 Seite');π ch := ReadKey;π Mode(R640x400);π x := 0;ππ While (x <= max_X) Doπ beginπ y := 0;π While (y <= max_Y) Doπ beginπ { male in 256 Farben };π SetPoint(x, y, ((x+y) And 255));π y := Succ(y)π end;π x := Succ(x)π end;ππ x := 0;π While (x < 400) Doπ beginπ y := x;π While (y < 400) Doπ beginπ c := GetPoint(x, y);π SetPoint(x, y, 255-c);π { aendere Farbe};π y := Succ(y)π end;π x := Succ(x)π end;π ch := ReadKey;π OldMode(OldMod);πend;ππProcedure SetPix(x, y, Color : Word);πVarπ Offset : Word;πbeginπ if actualMode = R640x400 thenπ Offset := (y * zb4) + (x shr 1 and $FE)π elseπ Offset := (y * zb4) + (x Shr 2);π portw[$03c4] := (1 Shl ((x And 3) + 8)) + 2;π mem[VideoRam : Offset] := Color;πend;πππFunction GetPix(x, y : Word) : Word;πVarπ Offset : Word;πbeginπ{ if actualMode=R640x400π then Offset := (y*zb4)+ (x shr 1 and $FE)π else}π Offset := (y * zb4) + (x Shr 2);π portw[$03ce] := (x And 3) SHL 8 + 4;π GetPix := mem[VideoRam : Offset];πend;ππbeginπ main;πend.π 67 11-02-9310:35ALL MARC BIR Setting Video Mode IMPORT 14 Üd─╦ {πMARC BIRππ>My second problem is the video memory. From my technicalπ>reference manual, it tells me that the address starts at segment A000H,π>offset 0000H. I've been Programming the VGA 320x200x256 mode quite alot,π>but in the EGA address, whenever I Write to video memory, all I see isπ>black and white, like monochrome. if I will be happy if I get informationπ>about that. Another thing that actually question me is that when I'mπ>using the BIOS block palette to create a fade in/out, it makes the screenπ>flicker, which is quite disturbing. What Info I need is how the VGA portπJS>works on setting up the RGB palette. Thanks.ππHow do you init. the mode? Call int 10h With 13h? if so then usingπA000:0000 is correct. As far as fading, use the following.π}ππTypeπ PalType = Array [0..255, 0..2] of Byte;ππProcedure SetPalette(Color, Count : Byte; Palette : PalType);πVarπ Ct, Col : Byte;πbeginπ Port[$3C8] := Color; { First color to set, Change this to $3C7 toπ read. And switch the Port=Pal at bottom }π For Ct := 1 to Count Do { Count is the total number of DACs to set }π For Col := 0 to 2 Do { Sets the Red, Green and Blue }π Port[$3C9] := Palette[Ct, Col];πend;ππProcedure SetMode(Mode : Byte); Assembler;πAsmπ Mov AH, 0π Mov AL, Modeπ Int 10hπend;ππ{You can test your mode set With this }πProcedure TestScreen;πVarπ X, Y : Integer;πbeginπ For X := 0 to 319 Doπ For Y := 0 to 199 Doπ Mem[$A000 : Y * 320 + X] := (X * Y) Mod 256;πend;ππbeginπ SetMode($13);π TestScreen;πend.π 68 11-02-9312:14ALL JOHN BECK Set the VGA Palette IMPORT 12 Üd▄~ {πJOHN BECKππ> question me is that when I'm using the BIOS block paletteπ> to create a fade in/out, it makes the screen flicker, whichπ> is quite disturbing. What Info I need is how the VGA portπ> works on setting up the RGB palette. Thanks.π}ππTypeπ colorType = Recordπ rvalue,π gvalue,π bvalue : Byte;π end;ππ paletteType = Array [0..255] of colorType;ππProcedure setpal(Var tp : paletteType);πVarπ palseg,π palofs : Word;ππLabel wait1 {,wait2};ππbeginπ palseg := seg(tp);π palofs := ofs(tp);π Asmπ mov dx, $3DAππ wait1:π in al, dxπ test al, $08π jz wait1ππ { wait2:π in al,dxπ test al,$08π jnz wait2 }ππ mov ax, 1012hπ xor bx, bxπ mov cx, 256π mov es, palsegπ mov dx, palofsπ int 10hπ end;πend;ππProcedure readpal(Var tp : paletteType);πVarπ palseg,π palofs : Word;πbeginπ palseg := seg(tp);π palofs := ofs(tp);π Asmπ mov ax, 1017hπ xor bx, bxπ mov cx, 256π mov es, palsegπ mov dx, palofsπ int 10hπ end;πend;ππ{π I cheat a little bit in the way that the screen flickering is handled,πbut I find that this way is faster For many animations+palette manipulations /πsecond While still eliminating screen flickering. Normally there would beπtwo tests for retrace, a 'jz' and a 'jnz', instead this only performs theπ'jz' test. if your monitor still flickers, uncomment the other code.π}π 69 11-21-9309:25ALL BERNIE PALLEK BitMap Scaler IMPORT 18 Üd⌐¼ πTYPEπ Fixed = RECORD CASE Boolean OFπ True : (w : LongInt); False : (f, i : Word);π END;ππ{ originally by SEAN PALMER, I just mangled it :^) }πPROCEDURE ScaleBitmap(VAR bmp2scale; actualx, actualy : Byte;π bstrtx, bstrty, bendx, bendy : Word);π{ These are notes I added, so they might be wrong. :^) }π{ - bmp2scale is an array [0..actualx, 0..actualy] of byte }π{ which contains the original bitmap }π{ - actualx and actualy are the actual width and height of }π{ the normal bitmap }π{ - bstrtx and bstrty are the x and y values for the upper- }π{ left-hand corner of the scaled bitmap }π{ - bendx and bendy are the lower-right-hand corner of the }π{ scaled version of the original bitmap }π{ - eg. to paste an unscaled version of a bitmap that is }π{ 64x64 pixels in size in the top left-hand corner of the }π{ screen, fill the array with data and call: }π{ ScaleBitmap(bitmap, 64, 64, 0, 0, 63, 63); }π{ - apparently, the bitmap is read starting at (0,0) and }π{ then going to (0,1), then (0,2), etc; meaning that it's }π{ not read horizontally, but vertically }πVARπ bmp_sx, bmp_sy, bmp_cy : Fixed;π bmp_s, bmp_w, bmp_h : Word;πBEGINπ bmp_w := bendx - bstrtx + 1; bmp_h := bendy - bstrty + 1;π bmp_sx.w := actualx * $10000 DIV bmp_w;π bmp_sy.w := actualy * $10000 DIV bmp_h;π bmp_s := 320 - bmp_w; bmp_cy.w := 0;π ASMπ PUSH DSπ MOV DS,WORD PTR bmp2scale + 2π MOV AX,$A000; MOV ES,AX; CLD; MOV AX,320;π MUL bstrty; ADD ax,bstrtx; MOV DI,AX;π @L2:π MOV AX,bmp_cy.i; MUL actualx; MOV BX,AX;π ADD BX,WORD PTR bmp2scale;π MOV CX,bmp_w; MOV SI,0; MOV DX,bmp_sx.f;π @L:π MOV AL,[BX]; STOSB; ADD SI,DX; ADC BX,bmp_sx.i;π LOOP @Lπ ADD DI,bmp_s; MOV AX,bmp_sy.f; MOV bx,bmp_sy.i;π ADD bmp_cy.f,AX; ADC bmp_cy.i,BX;π DEC WORD PTR bmp_h; JNZ @L2; POP DS;π END;πEND;ππ 70 11-26-9317:39ALL SWAG SUPPORT GROUP Wait for RETRACE IMPORT 4 Üdªu {π * PROCEDURE WaitRetraceπ *π * Waits for a verticle retrace to complete before exiting. Usefulπ * for reducing flicker in video intensive operations, like colorπ * cycling.π }π πPROCEDURE WaitRetrace;π beginπ while ((Port[$3DA] AND 8) > 0) do;π while ((Port[$3DA] AND 8) = 0) do;π end;π 71 11-26-9317:48ALL SWAG SUPPORT TEAM VESA Video Support IMPORT 67 ÜdφO Unit VESA;ππInterfaceππType ModeList=Array[1..32] Of Word; { List of VESA mode numbers }ππ TVesaMode=Recordπ Attr : Word; { Mode Attributes }π WinA : Byte; { Window A attributes }π WinB : Byte; { Window B attributes }π Gran : Word; { Window granularity in K bytes }π WinSiz : Word; { Size of window in K bytes }π SegA : Word; { Segment address of window A }π SegB : Word; { Segment address of window B }π WinFunc : Procedure; { Windows positioning function }π Bytes : Word; { Number of bytes per line }π Width : Word; { Number of horizontal pixels }π Height : Word; { Number of vertical pixels }π CharW : Byte; { Width of character cell }π CharH : Byte; { Height of character cell }π Planes : Byte; { Number of memory planes }π Bits : Byte; { Number of bits per pixel }π nBanks : Byte; { Number of banks (not used) }π Model : Byte; { Memory model type }π Banks : Byte; { Size of bank (not used) }π Pages : Byte; { Number of image pages }π Reserved : Byte; { The following are for 15,16,24,32 bit colour modes }π RedMaskSize : Byte; { Size of Red mask in bits }π RedFieldPos : Byte; { Bit position of LSB of Red mask }π GreenMaskSize : Byte; { Size of Green mask in bits }π GreenFieldPos : Byte; { Bit position of LSB of Green mask }π BlueMaskSize : Byte; { Size of Blue mask in bits }π BlueFieldPos : Byte; { Bit position of LSB of Blue mask }π RsvdMaskSize : Byte; { Size of Reserved mask in bits }π RsvdFieldPos : Byte; { Bit pos. of LSB of Reserved mask }π DirColModeInf : Byte; { Direct Colour mode attributes }π Filler : Array[0..215] Of Byte; { Not used - filler }π End;ππ TVesaInfo=Recordπ Signature : LongInt; { Signature - "VESA" }π Version : Word; { VESA Version number }π OEMName : PChar; { Pointer to manufacturer name }π Capabilities : Longint; { Capabilities (Not used) }π List : ^ModeList; { Pointer to list of VESA modes }π TotalMemory : Word; { Number of 64k memory blocks on card }π Filler : Array[1..238] of Byte;π End; { 258 byte size due to bug in the Diamond SpeedStar 24X v1.01 BIOS }πππVar VesaMode : TVesaMode;π { Contains all info needed for drawing on the screen }π VesaInfo : TVesaInfo;π { Contains info on the VESA BIOS Extensions }ππ vesaon : Byte;π { Specifies whether a VESA mode is on or not }ππFunction IsVesa:Boolean;π { Detects whether VESA support is present }πProcedure GetVesaInfo;π { Get Information on VESA modes, etc }πProcedure GetVesaModeInfo(md:Word);π { Get Information on a VESA mode (md) }πFunction SetMode(md:Word):Boolean;π { Sets a video mode (OEM and VESA) }πFunction GetMode:Word;π { Returns the current video mode }πFunction SizeOfVideoState:Word;π { Returns the size of the buffer needed to save the video state }πProcedure SaveVideoState(Var buf);π { Saves the SVGA video state in the buffer }πProcedure RestoreVideoState(Var buf);π { Restores the SVGA video state from the buffer}πProcedure SetBank(bank:Word);π { Set the video bank to draw on }πFunction GetBank:Word;π { Gets the current active video bank }πProcedure SetLineLength(Var len:Word);π { Sets the logical scan line length, returns the actual length set }πFunction GetLineLength:Word;π { Returns the current logical scan line length }πProcedure SetDisplayStart(pixel,line:Word);π { Sets the first pixel and line on the display }πProcedure GetDisplayStart(Var pixel,line:Word);π { Returns the first pixel and line on the display }ππ{---------------------------------------------------------------------------}π{-----------------------------} Implementation {----------------------------}π{---------------------------------------------------------------------------}ππUses Dos;ππVar rp : Registers;ππFunction IsVesa:Boolean;πBeginπ rp.ax:=$4F03;π Intr($10,rp);π IsVesa:=(rp.al=$4F);πEnd;ππProcedure GetVesaInfo;πBeginπ rp.ax:=$4F00;π rp.di:=Ofs(VesaInfo);π rp.es:=Seg(VesaInfo);π Intr($10,rp);πEnd;ππProcedure GetVesaModeInfo(md:Word);πBeginπ rp.ax:=$4F01;π rp.cx:=md;π rp.di:=Ofs(VesaMode);π rp.es:=Seg(VesaMode);π Intr($10,rp);πEnd;ππFunction SetMode(md:Word):Boolean;πBeginπ SetMode:=True; vesaon:=1;π If md>$FF Then Beginπ rp.bx:=md;π rp.ax:=$4F02;π Intr($10,rp);π If rp.ax<>$4F Then SetMode:=False Else GetVesaModeInfo(md);π End Else Beginπ rp.ax:=md;π Intr($10,rp);π VesaMode.Gran:=64; vesaon:=0;π VesaMode.SegA:=$A000;π Case md Of { OEM (standard) video modes }π 1..3,7 : Begin { Text modes }π VesaMode.Width:=80; VesaMode.Height:=25;π If md=7 Then Beginπ VesaMode.Bits:=1; VesaMode.SegA:=$B000;π End Else Beginπ VesaMode.Bits:=4; VesaMode.SegA:=$B800;π End;π VesaMode.Bytes:=160; VesaMode.Model:=0;π End;π $13 : Begin { 320 x 200 x 256 colours, VGA & MCGA }π VesaMode.Width:=320; VesaMode.Height:=200;π VesaMode.Bits:=8; VesaMode.Model:=4;π VesaMode.Bytes:=320;π End;π $12 : Begin { 640 x 480 x 16 colours, VGA only }π VesaMode.Width:=640; VesaMode.Height:=480;π VesaMode.Bits:=4; VesaMode.Model:=3;π VesaMode.Bytes:=80;π End;π $10 : Begin { 640 x 350 x 16 colours, VGA & EGA with 128k+ }π VesaMode.Width:=640; VesaMode.Height:=350;π VesaMode.Bits:=4; VesaMode.Model:=3;π VesaMode.Bytes:=80;π End;π $0E : Begin { 640 x 200 x 16 colours, VGA & EGA }π VesaMode.Width:=640; VesaMode.Height:=200;π VesaMode.Bits:=4; VesaMode.Model:=3;π VesaMode.Bytes:=80;π End;π $0D : Begin { 320 x 200 x 16 colours, VGA & EGA }π VesaMode.Width:=320; VesaMode.Height:=200;π VesaMode.Bits:=4; VesaMode.Model:=3;π VesaMode.Bytes:=40;π End;π Else SetMode:=False;π End;π End;πEnd;ππFunction GetMode:Word;πBeginπ rp.ax:=$4F03;π Intr($10,rp);π GetMode:=rp.bx;πEnd;ππFunction SizeOfVideoState:Word;πBegin { Will save/restore all video states }π rp.ax:=$4F04;π rp.dl:=0;π rp.cx:=$0F; { hardware, BIOS, DAC & SVGA states }π Intr($10,rp);π SizeOfVideoState:=rp.bx;πEnd;ππProcedure SaveVideoState(Var buf);πBeginπ rp.ax:=$4F04;π rp.dl:=1;π rp.cx:=$0F;π rp.es:=Seg(buf);π rp.bx:=Ofs(buf);π Intr($10,rp);πEnd;ππProcedure RestoreVideoState(Var buf);πBeginπ rp.ax:=$4F04;π rp.dl:=2;π rp.cx:=$0F;π rp.es:=Seg(buf);π rp.bx:=Ofs(buf);π Intr($10,rp);πEnd;ππProcedure SetBank(bank:Word);πVar winnum:Word;πBeginπ winnum:=bank*64 Div VesaMode.Gran;π rp.ax:=$4F05;π rp.bx:=0;π rp.dx:=winnum;π Intr($10,rp);π rp.ax:=$4F05;π rp.bx:=1;π rp.dx:=winnum;π Intr($10,rp);πEnd;ππFunction GetBank:Word;πBeginπ rp.ax:=$4F05;π rp.bx:=$100;π Intr($10,rp);π GetBank:=rp.dx;πEnd;ππProcedure SetLineLength(Var len:Word);πBeginπ rp.ax:=$4F06;π rp.bl:=0;π rp.cx:=len;π Intr($10,rp); { dx:=maximum number of scan lines }π len:=rp.cx;πEnd;ππFunction GetLineLength:Word;πBeginπ rp.ax:=$4F06;π rp.bl:=1;π Intr($10,rp); { dx:=maximum number of scan lines }π GetLineLength:=rp.cx;πEnd;ππProcedure SetDisplayStart(pixel,line:Word);πBeginπ rp.ax:=$4F07;π rp.bx:=0;π rp.cx:=pixel;π rp.dx:=line;π Intr($10,rp);πEnd;ππProcedure GetDisplayStart(Var pixel,line:Word);πBeginπ rp.ax:=$4F07;π rp.bx:=1;π Intr($10,rp);π pixel:=rp.cx;π line:=rp.dx;πEnd;ππEnd.π 72 11-26-9317:48ALL SWAG SUPPORT TEAM VIDEO MODE IMPORT 10 Üdmp {πHow can I save and restore the text screen mode (e.g. 132*28 characters)πwhen using BGI calls in a Turbo Pascal program ?πUnfortunately I always have 80*25 after program exit.π}ππfunction get_video_mode : byte;π{ Returns the current video mode (from interrupt $10,$f).π Byte [$40:$49] also contains this information, but might not alwaysπ have the correct value.π}π πvarπ check_b : byte; {video mode byte : absolute $40:$49}π πbegin {get_video_mode}π asmπ mov ah, 0fhπ int 10hπ mov check_b, alπ end;π if check_b > 127π then get_video_mode:=check_b-128 {last mode change was done withoutπ screen clearing, mode is given by theπ low 7 bits}π else get_video_mode:=check_b;πend; {get_video_mode}π π πprocedure set_video_mode(m : byte);π{ Sets the given video mode (via interrupt $10,0).π If high bit is on screen is not cleared (works only for text modes?).π}π πbegin {set_video_mode}π asmπ mov ah, 00hπ mov al, mπ int 10hπ end;πend; {set_video_mode}π 73 01-27-9411:52ALL MAYNARD PHILBROOK More Characters IMPORT 13 Üd85 {π> I know that a double-byte char system exists on the PC forπ> producing characters beyond the 256 ASCII chars. How is this modeπ> initialized and manipulated? I am interested in creating far more thanπ> 256 characters and writing them to the screen in text mode, and thisπ> appears to be the only way.ππ Don't think that can be done in normal Text Block Mode.π But if you flip your Video in Graphics you could always create Displayπ Driver to imulate many charactors.π There is a mode that lets you change one of the Charactor Attributeπ Bits normal use to be used to select a different charactor set, but whenπ you do this you also lost that option of what that bit was prior.π here is the interrupt callπ}ππProcedure Set512CharSet; Assembler;πAsmπ Mov AH, 11H;π Mov AL, 03H;π Mov BL, $12; {Selects the Charactor Sets VIA Bit 3 in Char Attriπ { BL must be loaded so the Video COntroler knows which Block to use }π { Depending on wether Bit 3 of the Charactor Attri is on of Off }π { The Upper 4 bits selects a block number to use for The On state ofπ { Bit 3, the ,Lower Four Bits Selects the OF State of Bit 3 }π Int 10H;πEnd;ππ{π So after this, when ever you use TextColor(8 - 15) you will get theπ Next Charactor set, ou lose the Intensity option..π this means only 7 8 colors. like the Background..π But you can chage the pallets.πINt 10hπFunction 10hπSubfunction 00hπBX = 0712HπINT 10H;π{ Function always loaded in AH reg, Subs in AL. }π 74 01-27-9411:53ALL BO BENDTSEN Bitmap Display IMPORT 11 ÜdDd {π> Does anyone know how to view BIT map picture, thanx......π}ππTypeπ PBitmapCoreHeader = ^TBitmapCoreHeader;π TBitmapCoreHeader = recordπ bcSize: Longint; { used to get to color table }π bcWidth: Word;π bcHeight: Word;π bcPlanes: Word;π bcBitCount: Word;π end;ππ PBitmapInfoHeader = ^TBitmapInfoHeader;π TBitmapInfoHeader = recordπ biSize: Longint;π biWidth: Longint;π biHeight: Longint;π biPlanes: Word;π biBitCount: Word;π biCompression: Longint;π biSizeImage: Longint;π biXPelsPerMeter: Longint;π biYPelsPerMeter: Longint;π biClrUsed: Longint;π biClrImportant: Longint;π end;ππ{ Constants for the biCompression field }ππconstπ bi_RGB = 0;π bi_RLE8 = 1;π bi_RLE4 = 2;ππtypeπ PBitmapInfo = ^TBitmapInfo;π TBitmapInfo = recordπ bmiHeader: TBitmapInfoHeader;π bmiColors: array[0..0] of TRGBQuad;π end;ππtypeπ PBitmapCoreInfo = ^TBitmapCoreInfo;π TBitmapCoreInfo = recordπ bmciHeader: TBitmapCoreHeader;π bmciColors: array[0..0] of TRGBTriple;π end;ππtypeπ PBitmapFileHeader = ^TBitmapFileHeader;π TBitmapFileHeader = recordπ bfType: Word;π bfSize: Longint;π bfReserved1: Word;π bfReserved2: Word;π bfOffBits: Longint;π end;ππ 75 01-27-9411:54ALL MICHAEL HOENIE Character Editor IMPORT 72 Üd░ {πThis program allows you to create characters using the GRAPHICS unitπsupplied otherwise with the SWAG routines. If you have any questionsπon these routines, please let me know.ππMICHAEL HOENIE - Intelec Pascal Moderator. }ππprogram charedit;ππusesπ dos, crt;ππconstπ numnewchars = 1;ππtypeπ string80 = string[80];ππvar { all variables inside of the game }π char_map : array [1..16] of string[8];π xpos,π ypos,π x, y, z : integer;π out,π incom : string[255];π charout : char;π outfile : text;π char : array [1..16] of byte;ππprocedure loadchar;πtypeπ bytearray = array [0..15] of byte;π chararray = recordπ charnum : byte;π chardata : bytearray;π end;πvarπ regs : registers;π newchars : chararray;πbeginπ with regs doπ beginπ ah := $11; { video sub-Function $11 }π al := $0; { Load Chars to table $0 }π bh := $10; { number of Bytes per Char $10 }π bl := $0; { Character table to edit }π cx := $1; { number of Chars we're definig $1}π dx := 176;π for x := 0 to 15 doπ newchars.chardata[x] := char[x + 1];π es := seg(newchars.chardata);π bp := ofs(newchars.chardata);π intr($10, regs);π end;πend;ππProcedure FastWrite(Col, Row, Attrib : Byte; Str : string80);πbeginπ inlineπ ($1E/$1E/$8A/$86/row/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/π $03/$C3/$03/$C0/$8B/$F8/$be/$00/$00/$8A/$BE/attrib/π $8a/$8e/str/$22/$c9/$74/$3e/$2b/$c0/$8E/$D8/$A0/$49/$04/π $1F/$2C/$07/$74/$22/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/$46/π $8a/$9A/str/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/π $89/$1D/$47/$47/$E2/$Ea/$2A/$C0/$74/$10/$BA/$00/$B0/π $8E/$DA/$46/$8a/$9A/str/$89/$1D/$47/$47/$E2/$F5/$1F);πend;ππprocedure initalize;πbeginπ for x := 1 to 16 doπ char[x] := 0;π xpos := 1;π ypos := 1;π for x := 1 to 16 doπ char_map[x] := ' '; { clear it out }πend;ππprocedure display_screen;πbeginπ loadchar;π fastwrite(1,1,$1F,' CHAREDIT - By Michael S. Hoenie ');π fastwrite(1,2, $7,' 12345678 ┌─────Data');π fastwrite(1,3, $7,' ▄▄▄▄▄▄▄▄▄▄ │');π fastwrite(1,4, $7,' 1 █ █ 000');π fastwrite(1,5, $7,' 2 █ █ 000 Single: ░');π fastwrite(1,6, $7,' 3 █ █ 000');π fastwrite(1,7, $7,' 4 █ █ 000 Multiple:');π fastwrite(1,8, $7,' 5 █ █ 000');π fastwrite(1,9, $7,' 6 █ █ 000 ░░░░░░');π fastwrite(1,10,$7,' 7 █ █ 000 ░░░░░░');π fastwrite(1,11,$7,' 8 █ █ 000 ░░░░░░');π fastwrite(1,12,$7,' 9 █ █ 000 U ');π fastwrite(1,13,$7,' 10 █ █ 000 f1=paint spot │ MOVEMENT');π fastwrite(1,14,$7,' 11 █ █ 000 f2=erase spot L──┼──R ');π fastwrite(1,15,$7,' 12 █ █ 000 S=save char │ ');π fastwrite(1,16,$7,' 13 █ █ 000 Q=quit editor D');π fastwrite(1,17,$7,' 14 █ █ 000 C=reset char r=scroll-right');π fastwrite(1,18,$7,' 15 █ █ 000 l=scroll-left');π fastwrite(1,19,$7,' 16 █ █ 000 r=scroll-right');π fastwrite(1,20,$7,' ▀▀▀▀▀▀▀▀▀▀ u=scroll-up');πend;ππprocedure calculate_char;πbeginπ for x := 1 to 16 doπ char[x] := 0;π for x := 1 to 16 doπ beginπ fastwrite(7, x + 3, $4F, char_map[x]);π incom := char_map[x];π y := 0;π if copy(incom, 1, 1) = '█' then y := y + 1;π if copy(incom, 2, 1) = '█' then y := y + 2;π if copy(incom, 3, 1) = '█' then y := y + 4;π if copy(incom, 4, 1) = '█' then y := y + 8;π if copy(incom, 5, 1) = '█' then y := y + 16;π if copy(incom, 6, 1) = '█' then y := y + 32;π if copy(incom, 7, 1) = '█' then y := y + 64;π if copy(incom, 8, 1) = '█' then y := y + 128;π char[x] := y;π end;π for x := 1 to 16 doπ beginπ str(char[x], incom);π while length(incom) < 3 doπ insert(' ', incom, 1);π fastwrite(17, x + 3, $4E, incom);π end;π loadchar;πend;ππprocedure do_online;πvarπ done : boolean;π int1,π int2,π int3 : integer;πbeginπ done := false;π int1 := 0;π int2 := 0;π int3 := 0;π while not done doπ beginπ incom := copy(char_map[ypos], xpos, 1);π int1 := int1 + 1;π if int1 > 150 thenπ int2 := int2 + 1;π if int2 > 4 thenπ beginπ int1 := 0;π int3 := int3 + 1;π if int3 > 2 thenπ int3 := 1;π case int3 ofπ 1 : fastwrite(xpos + 6, ypos + 3, $F, incom);π 2 : fastwrite(xpos + 6, ypos + 3, $F, '');π end;π end;ππ if keypressed thenπ beginπ charout := readkey;π out := charout;π if ord(out[1]) = 0 thenπ beginπ charout := readkey;π out := charout;π fastwrite(60, 2, $2F, out);ππ case out[1] ofπ ';' :π begin { F1 }π delete(char_map[ypos], xpos, 1);π insert('█', char_map[ypos], xpos);π calculate_char;π end;ππ '<':π begin { F2 }π delete(char_map[ypos], xpos, 1);π insert(' ', char_map[ypos], xpos);π calculate_char;π end;ππ 'H':π begin { up }π ypos := ypos - 1;π if ypos < 1 thenπ ypos := 16;π calculate_char;π end;ππ 'P':π begin { down }π ypos := ypos + 1;π if ypos > 16 thenπ ypos := 1;π calculate_char;π end;ππ 'K':π begin { left }π xpos := xpos - 1;π if xpos < 1 thenπ xpos := 8;π calculate_char;π end;ππ 'M':π begin { right }π xpos := xpos + 1;π if xpos > 8 thenπ xpos := 1;π calculate_char;π end;π end;π endπ elseπ begin { regular keys }ππ case out[1] ofπ 'Q', 'q':π begin { done }π clrscr;π write('Are you SURE you want to quit? (Y/n) ? ');π readln(incom);π case incom[1] ofπ 'Y', 'y' : done := true;π end;π clrscr;π display_screen;π calculate_char;π end;ππ 'S','s':π begin { save }π assign(outfile, 'chardata.txt');π {$i-} reset(outfile) {$i+};π if (ioresult) >= 1 thenπ rewrite(outfile);π append(outfile);π writeln(outfile, 'Character Char:');π writeln(outfile, '');π writeln(outfile, ' 12345678');π for x := 1 to 16 doπ beginπ str(x, out);π while length(out) < 6 doπ insert(' ', out, 1);π writeln(outfile, out + char_map[x]);π end;π writeln(outfile, '');π write(outfile, 'Chardata:');π for x := 1 to 15 doπ beginπ str(char[x], incom);π write(outfile, incom + ',');π end;π str(char[16], incom);π writeln(outfile, incom);π writeln(outfile, '-----------------------------');π close(outfile);π clrscr;π writeln('File was saved under CHARDATA.TXT.');π writeln;π write('Press ENTER to continue ? ');π readln(incom);π clrscr;π display_screen;π calculate_char;π end;ππ 'U','u':π begin { move entire char up }π incom := char_map[1];π for x := 2 to 16 doπ char_map[x - 1] := char_map[x];π char_map[16] := incom;π calculate_char;π end;ππ 'R','r':π begin { move entire char to the right }π for x := 1 to 16 doπ beginπ out := copy(char_map[x], 8, 1);π incom := copy(char_map[x], 1, 7);π char_map[x] := out + incom;π end;π calculate_char;π end;ππ 'L','l':π begin { move entire char to the left }π for x := 1 to 16 doπ beginπ out := copy(char_map[x], 1, 1);π incom := copy(char_map[x], 2, 7);π char_map[x] := incom + out;π end;π calculate_char;π end;ππ 'D','d':π begin { move entire char down }π incom := char_map[16];π for x := 16 downto 2 doπ char_map[x] := char_map[x - 1];π char_map[1] := incom;π calculate_char;π end;ππ 'C','c':π begin { reset }π clrscr;π write('Are you SURE you want to clear it? (Y/n) ? ');π readln(incom);π case incom[1] ofπ 'Y','y' : initalize;π end;π clrscr;π display_screen;π calculate_char;π end;ππ end;π end;π end;π end;πend;ππbeginπ textmode(c80);π initalize;π display_screen;π calculate_char;π do_online;π clrscr;π writeln('Thanks for using CHAREDIT!');πend.π 76 01-27-9411:56ALL THORSTEN BARTH Color Bars IMPORT 12 Üd╝â {π> im coding a program at the moment that needs to have a scrolly barπ> menu. I have got all the movement's worked out, however! I cannotπ> work out how to have some sort of bar (like in PowerMenu)... you pressπ> enter when the scrolly bar hits your desired selection and itπ> executes another procedure or function...ππAs I understand your problem, you need to know how to display a bar onπthe screen where the screen and text have different colors, and then,πafter moving away, restore the original colors in that bar. I hopeπyou have found out how to handle the cursor keys.π... searching for routines ... loading ... clippingπ}ππProcedure Colorbar(X,Y,Count: Word;Color: Byte); Assembler;πAsmπ MOV AX,80π MUL Yπ ADD AX,Xπ SHL AX,1π INC AXπ MOV DI,AXπ MOV AX,Vidsegπ MOV ES,AXπ MOV CX,Countπ MOV AL,Colorπ@@1: STOSBπ INC DIπ LOOP @@1πEnd;π{ππGive that procedure the vidseg ($B000 for Hercules or $B800 for the rest),πthen call it. It sets a part of the screen to the color given to it.πThe color values are 16*Backgroundcolor + Forgroundcolor, using theπcolor constants of the unit CRT. Add $80 to get it blink.πTo delete the bar, just set the neutral color you have used while drawingπthe screen.πBTW, there is no error checking in that routine, so giving bad values willπcause problems. You can use it for painting many lines by giving a largerπ"count" parameter to it.π} 77 01-27-9411:56ALL JENS LARSSON Retrace Correction IMPORT 7 Üd8" {π> I think TP is fast enough for that, because your video card needs muchπ> time to display the screen. Perhaps this is a little bit faster onπ> REALLY slow machines :ππ Actually, that won't do what it's supposed to do...π When you use the IN instruction the format is like this:ππ IN op1,op2 That transfers a byte, word or dword from the inπ op2 specified port into AL, AX or EAX.ππ> Asmπ> MOV DX,$03DAπ> @@1:π> IN DX,AX <----- Therefore, change to: in al,dxπ> TEST AX,$08 <----- test al,8π> JZ @@1π> @@2:π> IN DX,AX <----- in al,dxπ> TEST AX,$08 <----- test al,8π> JNZ @@2π> End;π} 78 01-27-9411:56ALL COLIN BUCKLEY Read VGA Dacs IMPORT 14 Üdéq {π>Well, I have a procedure to return the VGA palette registers in BYTEπ>vars called likeππ>GetColor(Color,Red,Green,Blue:BYTE);ππThis will not return anything as they will be removed from the Stack. Youπcan pass like this, but you can no receive. You must use Var R,G,B:Byte;ππ>I want to do thgis, but in assembler:ππ>││ PORT[$3C8] := Color;π>││ Red := PORT[$3C9];π>││ Green := PORT[$3C9];π>││ Blue := PORT[$3C9];ππ>but in assembler....argh, any ideas?π}ππProcedure VGAReadDAC(Reg:Byte; Var R,G,B:Byte); Assembler;πASMπ MOV DX,3C7h {; |Send Starting DAC Register }π MOV AL,[Reg] {; | }π OUT DX,AL {;/ }π INC DX {; |DX:=DAC Data Address }π INC DX {;/ }π IN AL,DX {; |Read Red Byte }π LES DI,[R] {; | }π MOV [ES:DI],AL {;/ }π IN AL,DX {; |Read Green Byte }π LES DI,[G] {; | }π MOV [ES:DI],AL {;/ }π IN AL,DX {; |Read Blue Byte }π LES DI,[B] {; | }π MOV [ES:DI],AL {;/ }πEnd;ππ 79 01-27-9411:59ALL JAN DOGGEN EGA/VGA Bitplanes IMPORT 39 Üd»L {π> Attention: All those who are familiar with graphics portsπ> (ie. Sean Palmer, Jan Doggen, and others I don't yet know).ππDon't consider myself that familiar with 'em, but here are someπsnippets and remarks. BTW I consider phasing out all BGI stuff in myπcode in the first half of '93 or so, which will be a major effort.πAfter that, I'll rank myself among the register-twiddlers. Maybe weπshould team up on this project if you plan on going in that directionπtoo.ππ> Would you mind explaining the EGA map mask (?) andπ> sequencer (?) register ports (I don't know what they areπ> *really* called, but they are the ones that control whichπ> bitplane gets written to in EGA modeπ> 640x350x16, 4 bitplanes) to me (please)?ππThere are several write modes and read modes for EGA/VGA, and theπexact workings of the registers depend on the mode. What you areπtalking about (I assume) is read/write mode 0 which you would useπto pump bytes directly into a bit plane. I use the followingπprocedure for this:πππ(*************************** EGA/VGA bit planes ****************************)π}ππCONSTπ GDCIndexReg = $3CE; { Index register of EGA/VGA Graphics Device Controller }π GDCDataReg = $3CF; { Data register of EGA/VGA Graphics Device Controller }π SeqIndexReg = $3C4; { Index register of EGA/VGA Sequencer }π SeqDataReg = $3C5; { Data register of EGA/VGA Sequencer }ππPROCEDURE PrepareBitPlaneRead(Plane: Byte);π BEGINπ Port[GDCIndexReg] := 5; { Number of Mode register }π Port[GDCDataReg ] := 0; { Value of register: 0: read mode 0 }π Port[GDCIndexReg] := 4; { Number of Read Map Select register }π Port[GDCDataReg ] := Plane; { Value of register: bit for plane toπread }π END; { PrepareBitPlaneRead }πππPROCEDURE ConcludeBitPlaneRead(Plane: Byte);π BEGINπ Port[GDCIndexReg] := 5; { Number of Mode register }π Port[GDCDataReg ] := $10; { Value of register: 10: default forπmodes 10h and 12h }π Port[GDCIndexReg] := 4; { Number of Read Map Select register }π Port[GDCDataReg ] := 0; { Value of register: plane to read }π END; { ConcludeBitPlaneRead }πππPROCEDURE PrepareBitPlaneWrite(Plane,PutMode: Byte);π BEGINπ Port[GDCIndexReg] := 5; { Number of Mode register }π Port[GDCDataReg ] := 0; { Value of register: 0: write mode 0 }π Port[GDCIndexReg] := 1; { Number of Enable Set/Reset register }π Port[GDCDataReg ] := 0; { Value of register: 0 }π Port[GDCIndexReg] := 3; { Number of Data Rotate/Function Selectπregister }π (* Bits 3 and 4 from the Rotate/Function Select register mean:π * Bit 4 Bit 3 Replacement function:π * 0 0 Replaceπ * 0 1 ANDπ * 1 0 ORπ * 1 1 XOR *)π CASE PutMode OFπ AndPut : Port[GDCDataReg] := 8; { No rotation; AND with buffer }π OrPut : Port[GDCDataReg] := 16; { No rotation; OR with buffer }π XORPut : Port[GDCDataReg] := 24 { No rotation; XOR with buffer }π ELSEπ Port[GDCDataReg] := 0; { No rotation; replace; use this as default }π END; { CASE }π Port[GDCIndexReg] := 8; { Number of BitMask register }π Port[GDCDataReg ] := $FF; { Value of register: $FF: use all bits }π Port[SeqIndexReg] := 2; { Number of Map Mask register }π Port[SeqDataReg ] := 1 SHL Plane; { Value of register: plane number }π END; { PrepareBitPlaneWrite }πππPROCEDURE ConcludeBitPlaneWrite(Plane: Byte);π BEGINπ Port[GDCIndexReg] := 1; { Number of Enable Set/Reset register }π Port[GDCDataReg ] := 0; { Value of register: 0 }π Port[SeqIndexReg] := 2; { Number of Map Mask register }π Port[SeqDataReg ] := $0F; { Value of register: Enable all planes }π Port[GDCIndexReg] := 3; { Number of Data Rotate/Function Selectπregister }π Port[GDCDataReg ] := 0; { Value of register: No rotation; replaceπ}π END; { ConcludeBitPlaneWrite }ππ{πA good explanation can be found in:π Wilton,R - Programmers' guide to PC and PS/2 video systemsπ Microsoft PressππYou should invest in some books on EGA/VGA programming if you haveπmore of these questions, otherwise you're being 'penny wise, poundπfoolish'.ππThe book by Wilton is considered more or less a 'must have' togetherπwithπ Ferraro, R.F. - Programmer's guide to the EGA and VGA cardsπ Addison-WesleyππFerraro gives you detailed register info. It also deals with SuperπVGAs. Because I'll have to expand a program to use VESA super VGAπmodes, I bought this together with:π Rimmer, S - Super VGA graphics programming secretsπ WindCrest/McGraw Hillπ} 80 01-27-9412:00ALL PEDER HERBORG Fast VGA Routines IMPORT 25 Üd¼÷ {πI've must say that im not exactly the perfect programmer, but I think I've anπanswer to some of your questions.ππ1. Well to post a whole program who does that is quite complicated. Butπ if you use the Pelpanning register it's possible to create really fastπ scrollers even on slow 286 and XT's. Here comes a simple proc just toπ get the Idea:ππ}ππconst Crtadress:word=$3d4;π Inputstatus:word=$3DA;πππProcedure Pan(X,Y: Word);assembler; { This pans the screen } asmπ mov bx,320π mov ax,yπ mul bxπ add ax,xπ push axπ pop bxπ mov dx,INPUTSTATUSπ@WaitDE:π in al,dxπ test al,01hπ jnz @WaitDE {display enable is active?}π mov dx,Crtadressπ mov al,$0Cπ mov ah,bhππ out dx,axπ mov al,$0Dπ mov ah,blπ out dx,axπ MOV dx,inputstatusπ@wait:π in al,dxπ test al,8 {?End Vertical Retrace?}π jz @waitπEnd;ππ{πIf you use this, you should realize that if you increase x by one the screenπmoves four pixels. This procedure move the whole screen, so if you want a logoπor something at the screen too you have to use this little procedure, it resetsπthe scanlines at the screen soo it is only the top of the screen that moves.π}ππprocedure vgasplit(whatline:word);πbeginπ asmπ{VGASplit Proc Near}π Mov BX,whatlineπ Mov DX,3DAh-6 {; Port = 3D4H}π Mov AX,BXπ Mov BH,AHπ Mov BL,BHπ And BX,0201Hπ Mov CL,4π Shl BX,CLπ Shl BH,1π Mov AH,ALπ Mov AL,18Hπ Out DX,AXππ Mov AL,7π Out DX,ALππ Inc DXπ In AL,DXππ Dec DXπ Mov AH,ALπ And AH,11101111Bπ Or AH,BLπ Mov AL,7π Out DX,AXππ Mov AL,9π Out DX,ALππ Inc DXπ In AL,DXππ Dec DXπ Mov AH,ALπ And AH,10111111Bπ Or AH,BHπ Mov AL,9π Out DX,AXππ End;πend;ππ{π2. There are several unit's out there that comes with source so i suggestπ that you have another look at one of them, There is a really nice oneπ called ANIVGA.ππ3. Well its almost the same as the first question. Just dont set the vgasplitπ rutine. And increase the y parameter instead of x.πππAll of the rutines have been written for mode X, but it's also possible to useπthem with standard Vgamode $13.πThats it. I really hope it helped you or/and somebody else a little bit,if youπor anyone else have any questions. Please feel free to write me a Letter.ππ} 81 01-27-9412:01ALL JOHN BECK Flames IMPORT 102 Üd£O π{$G+}ππprogram flames;ππuses crt;ππ{**************************************************************************}π{* *}π{* FLAMES by M.D.Mackey (C) 1993 *}π{* This code released into the public domain. It may be freely *}π{* used, distributed and modified. I would appreciate it if *}π{* credit were given, however. If you have any improvements, *}π{* find any bugs etc. mail me at mackey@aqueous.ml.csiro.au *}π{* with MARK: in the subject header. *}π{* *}π{**************************************************************************}ππ{**************************************************************************}π{* *}π{* Modified 12-Dec-93: John M. Beck *}π{* *}π{* Restructured and added wave effect by tracing sin path. *}π{* *}π{**************************************************************************}ππconst palette : array [1..768] of byte = (ππ 0, 0, 0, 0, 0, 24, 0, 0, 24, 0, 0, 28,π 0, 0, 32, 0, 0, 32, 0, 0, 36, 0, 0, 40,π 8, 0, 40, 16, 0, 36, 24, 0, 36, 32, 0, 32,π 40, 0, 28, 48, 0, 28, 56, 0, 24, 64, 0, 20,π 72, 0, 20, 80, 0, 16, 88, 0, 16, 96, 0, 12,π 104, 0, 8, 112, 0, 8, 120, 0, 4, 128, 0, 0,π 128, 0, 0, 132, 0, 0, 136, 0, 0, 140, 0, 0,π 144, 0, 0, 144, 0, 0, 148, 0, 0, 152, 0, 0,π 156, 0, 0, 160, 0, 0, 160, 0, 0, 164, 0, 0,π 168, 0, 0, 172, 0, 0, 176, 0, 0, 180, 0, 0,π 184, 4, 0, 188, 4, 0, 192, 8, 0, 196, 8, 0,π 200, 12, 0, 204, 12, 0, 208, 16, 0, 212, 16, 0,π 216, 20, 0, 220, 20, 0, 224, 24, 0, 228, 24, 0,π 232, 28, 0, 236, 28, 0, 240, 32, 0, 244, 32, 0,π 252, 36, 0, 252, 36, 0, 252, 40, 0, 252, 40, 0,π 252, 44, 0, 252, 44, 0, 252, 48, 0, 252, 48, 0,π 252, 52, 0, 252, 52, 0, 252, 56, 0, 252, 56, 0,π 252, 60, 0, 252, 60, 0, 252, 64, 0, 252, 64, 0,π 252, 68, 0, 252, 68, 0, 252, 72, 0, 252, 72, 0,π 252, 76, 0, 252, 76, 0, 252, 80, 0, 252, 80, 0,π 252, 84, 0, 252, 84, 0, 252, 88, 0, 252, 88, 0,π 252, 92, 0, 252, 96, 0, 252, 96, 0, 252, 100, 0,π 252, 100, 0, 252, 104, 0, 252, 104, 0, 252, 108, 0,π 252, 108, 0, 252, 112, 0, 252, 112, 0, 252, 116, 0,π 252, 116, 0, 252, 120, 0, 252, 120, 0, 252, 124, 0,π 252, 124, 0, 252, 128, 0, 252, 128, 0, 252, 132, 0,π 252, 132, 0, 252, 136, 0, 252, 136, 0, 252, 140, 0,π 252, 140, 0, 252, 144, 0, 252, 144, 0, 252, 148, 0,π 252, 152, 0, 252, 152, 0, 252, 156, 0, 252, 156, 0,π 252, 160, 0, 252, 160, 0, 252, 164, 0, 252, 164, 0,π 252, 168, 0, 252, 168, 0, 252, 172, 0, 252, 172, 0,π 252, 176, 0, 252, 176, 0, 252, 180, 0, 252, 180, 0,π 252, 184, 0, 252, 184, 0, 252, 188, 0, 252, 188, 0,π 252, 192, 0, 252, 192, 0, 252, 196, 0, 252, 196, 0,π 252, 200, 0, 252, 200, 0, 252, 204, 0, 252, 208, 0,π 252, 208, 0, 252, 208, 0, 252, 208, 0, 252, 208, 0,π 252, 212, 0, 252, 212, 0, 252, 212, 0, 252, 212, 0,π 252, 216, 0, 252, 216, 0, 252, 216, 0, 252, 216, 0,π 252, 216, 0, 252, 220, 0, 252, 220, 0, 252, 220, 0,π 252, 220, 0, 252, 224, 0, 252, 224, 0, 252, 224, 0,π 252, 224, 0, 252, 228, 0, 252, 228, 0, 252, 228, 0,π 252, 228, 0, 252, 228, 0, 252, 232, 0, 252, 232, 0,π 252, 232, 0, 252, 232, 0, 252, 236, 0, 252, 236, 0,π 252, 236, 0, 252, 236, 0, 252, 240, 0, 252, 240, 0,π 252, 244, 0, 252, 244, 0, 252, 244, 0, 252, 248, 0,π 252, 248, 0, 252, 248, 0, 252, 248, 0, 252, 252, 0,π 252, 252, 4, 252, 252, 8, 252, 252, 12, 252, 252, 16,π 252, 252, 20, 252, 252, 24, 252, 252, 28, 252, 252, 32,π 252, 252, 36, 252, 252, 40, 252, 252, 40, 252, 252, 44,π 252, 252, 48, 252, 252, 52, 252, 252, 56, 252, 252, 60,π 252, 252, 64, 252, 252, 68, 252, 252, 72, 252, 252, 76,π 252, 252, 80, 252, 252, 84, 252, 252, 84, 252, 252, 88,π 252, 252, 92, 252, 252, 96, 252, 252, 100, 252, 252, 104,π 252, 252, 108, 252, 252, 112, 252, 252, 116, 252, 252, 120,π 252, 252, 124, 252, 252, 124, 252, 252, 128, 252, 252, 132,π 252, 252, 136, 252, 252, 140, 252, 252, 144, 252, 252, 148,π 252, 252, 152, 252, 252, 156, 252, 252, 160, 252, 252, 164,π 252, 252, 168, 252, 252, 168, 252, 252, 172, 252, 252, 176,π 252, 252, 180, 252, 252, 184, 252, 252, 188, 252, 252, 192,π 252, 252, 196, 252, 252, 200, 252, 252, 204, 252, 252, 208,π 252, 252, 208, 252, 252, 212, 252, 252, 216, 252, 252, 220,π 252, 252, 224, 252, 252, 228, 252, 252, 232, 252, 252, 236,π 252, 252, 240, 252, 252, 244, 252, 252, 248, 252, 252, 252,π 252, 252, 240, 252, 252, 244, 252, 252, 248, 252, 252, 252);ππ radius = 1.9;π frequency = 2;π angleinc = 3 * pi / frequency;ππvarπ count : word;π delta : integer;π path : array[0..199] of word;π buffer : array[0..102,0..159] of integer;ππprocedure buildpath;π varπ count : byte;π currangle : real;π beginπ currangle := pi;π for count := 0 to 199 doπ beginπ path[count] := 320 + round(radius*sin(currangle));ππ { the sin path _must_ lie on an even number }π { otherwise the picture will be garbage }ππ if path[count] mod 2 <> 0 thenπ if path[count] > 320 thenπ dec(path[count]) { round down }π elseπ inc(path[count]); { round up }ππ { the path is rounded to the closest even number to 320 }ππ currangle := currangle + angleinc;π end;π end;ππbeginπ randomize;π buildpath;ππ asmπ mov ax,13h { ; AX := 13h }π int 10h { ; Set Mode 13h (320x200x256) }ππ xor ax,ax { ; AX := 0 }π mov cx,768 { ; CX := # of palette entries }π mov dx,03C8h { ; DX := VGA Port }π mov si,offset palette { ; SI := palette[0] }ππ out dx,al { ; send zero to index port }π inc dx { ; inc to write port }ππ @l1:ππ mov bl,[si] { ; set palette entry }π shr bl,2 { ; divide by 4 }π mov [si],bl { ; save entry }π outsb { ; and write to port }π dec cx { ; CX := CX - 1 }π jnz @l1 { ; if not done then loop }ππ mov ax,seg buffer { ; AX := segment of buffer }π mov es,ax { ; ES := AX }π mov di,offset buffer { ; DI := buffer[0] }π mov cx,8109 { ; CX := sizeof(buffer) div 2 }π xor ax,ax { ; AX := 0 }π rep stosw { ; clear every element in buffer to zero}π end;ππ repeatππ asmπ mov bx,1 { ; BX := 1 }π mov si,offset path { ; SI := path[0] }ππ mov cx,16160 { ; CX := # of elements to change }π mov di,offset buffer { ; DI := buffer[0] }π add di,320 { ; DI := buffer[320] (0,1) }ππ @l2:ππ mov ax,ds:[di-2] { ; AX := buffer[DI-2] (x-1,y) }π add ax,ds:[di] { ; AX += buffer[DI] (x ,y) }π add ax,ds:[di+2] { ; AX += buffer[DI+2] (x+1,y) }π add ax,ds:[di+320] { ; AX += buffer[DI+320] (x,y+1) }π shr ax,2 { ; AX := AX div 4 (calc average) }ππ jz @l3 { ; if AX = 0 then skip next line }π dec ax { ; else AX-- }ππ @l3:ππ push di { ; save DI }π sub di,ds:[si] { ; DI := (x + or - sin,y-1) }π mov word ptr ds:[di],ax { store AX somewhere one line up }π pop di { ; restore DI }ππ inc di { ; DI++ }π inc di { ; DI++ (move to next word) }ππ inc bx { ; BX++ }π cmp bx,320 { ; if bx <> 320 }π jle @l4 { ; then jump to @l4 }π mov bx,1 { ; else BX := 1 (we're on a new line) }π inc si { ; point SI to next element in path }π inc si { ; }ππ @l4:π dec cx { ; CX-- }π jnz @l2 { ; if CX <> 0 then loop }π end;ππ for count := 0 to 159 do {set new bottom line}π beginπ if random < 0.4 thenπ delta := random(2)*255;π buffer[101,count] := delta;π buffer[102,count] := delta;π end;ππ asmπ mov si,offset buffer { ; SI := buffer[0] }π mov ax,0A000h { ; AX := 0A000h (vga segment) }π mov es,ax { ; ES := AX }π xor di,di { ; DI := 0 }π mov dx,100 { ; DX := 100 (# of rows div 2) }ππ @l5:π mov bx,2 { ; BX := 2 }ππ @l6:π mov cx,160 { ; CX := 160 (# of cols div 2) }ππ @l7:π mov al,ds:[si] { ; AL := buffer[si] }π mov ah,al { ; AH := AL (replicate byte) }π mov es:[di],ax { ; store two bytes into video memory }π inc di { ; move to next word in VRAM }π inc di { ; }π inc si { ; move to next word in buffer }π inc si { ; }π dec cx { ; CX-- }π jnz @l7 { ; repeat until done with column }ππ sub si,320 { ; go back to start of line in buffer }π dec bx { ; BX-- }π jnz @l6 { ; repeat until two columns filled }ππ add si,320 { ; restore position in buffer }π dec dx { ; DX-- }π jnz @l5 { ; repeat until 100 rows filled }π end;ππ until keypressed;ππ asmπ mov ax,03h { ; AX := 3h }π int 10h { ; restore text mode }π end;ππend.π 82 01-27-9412:01ALL DARRELL STEWART Font Size IMPORT 20 Üdr {πHow does Norton defeat the one vertical scan line dividing itsπcharacters in order to write their alphanumeric menu screens? I have aπ"user-font" which loads successfully into vga display memory using tp7:π}πtypeπ bytearray = array[0..maxbytes] of byte;πvarπ fontarray : bytearray; { character byte array }πprocedure wrfont(input : bytearray; blknum, numline : byte); assembler;π{ "input" is an array containing character bit patterns (8x16 character)π "blknum" is the block numberπ "numline" is the number of scanlines per character }π asmπ push bp { save the base point register }π mov bl, blknum { get block number }π and bl, 07 { limit to 0-7 block number }π les ax, input { point to "C" buffer es:ax }π mov bh, numline { number of bytes per characters }π mov bp, ax { load offset to "C" buffer es:bp }π mov cx, 100h { do for 256 characters }π xor dx, dx { begin at 0 }π mov ax, 1110h { load font }π int 10h { call interrupt }π pop bp { restore the base point register }π end;π{π This procedure loads my user-font correctly into display memory;πhowever, I still have one verical scanline between my horizontal lineπcharacters making them basically worthless for my purposes (it "draws"πa dashed line like above). I thought when alphanumeric characters areπmapped, you need to leave a bit pattern open along the right and bottomπedges in order to separate the characters. Closing up the right andπbottom edges should "connect" the characters, yet I've found it doesπnot. I have tried replacing the original ASCII horizontal lineπcharacters and this also fails.π What information do I need? How can I connect my font charactersπto display Norton-like menus in alphanumeric 8x16 vga font format (orπfor that matter, any two primitive graphic fonts)? Does it make anyπdifference with which ASCII characters I replace in my table?π By the way, I noticed that Norton's alternate font does have aπsmall (anal retentively) defect. Their upper right box charactersπdo not have a "crisp" corner. Each one has a pixel "nub" to the right.πI have a feeling this is a clue to answer my problem but I stillπhaven't gotten it right. Anyone know?π} 83 01-27-9412:02ALL MIGUEL MARTINEZ Fractals! IMPORT 30 Üd@S {πFor all of you who are interested on fractals, here is a little program,πtaken from a source code in Modula-2, that will draw a Mandelbrot fractal.ππJust one problem: If your computer doesn't have a math coprocessor, theπprogram will run "a bit" slow :).ππTry modifying all the constants, you'll get strange results :).π}π{$N+}π{$X+ Enable Extended Syntax }πProgram Mandelbrot; {Using real numbers. For TP 6.0 and above }ππUses Crt; {Only to use "ReadKey" Function. }ππConst Colours=255; {Number of colors to be on the image. }π Width=320; {Width of the image. }π Height=200; {Height of the image. }π Limit=8.0; {Until when we calculate. }π XRMin=-2.0; {Left limit of the fractal. }π XRMax=1.0; {Right limit of the fractal. }π YRMin=-1.3; {Lower limit of the fractal. }π YRMax=1.3; {Upper limit of the fractal. }ππType Palette=Array[0..767] of Byte; {MCGA/VGA palette type }ππVar XPos,YPos:Word;ππ{Sets the desired video mode (13h) }πProcedure SetVideoMode(VideoMode:Byte); Assembler;πAsmπ xor ax,ax {BIOS Function 00h: Set Video Mode. }π mov al,VideoMode {Desired Video Mode. }π int 10hπEnd;ππ{Creates a palette: Black --> red --> yellow }πProcedure MakePalette;πVar CPal:Palette;π i:Byte;ππ {Sets the palette. }π Procedure SetPalette(Pal:Palette); Assembler;π Asmπ push esπ mov ax,1012h {BIOS function 10h, subfunction 12h. }π xor bx,bx {first color register. }π mov cx,20h {number of color registers. }π les dx,Pal {ES:DX Segment:Offset of color table. }π Int 10hπ pop esπ End;ππBeginπ For i:=0 to 15 doπ Beginπ CPal[3*i]:=4*i+3; CPal[3*i+1]:=0; CPal[3*i+2]:=0;π CPal[3*i+48]:=63; CPal[3*i+49]:=4*i+3; CPal[3*i+50]:=0;π End;π SetPalette(CPal);πEnd;ππ{Draws a Plot of the desired color on screen. }πProcedure DrawPixel(XPos,YPos:Word; PlotColour:Byte);πBeginπ Mem[$A000:YPos*320+XPos]:=PlotColour;πEnd;ππ{Needs to be explained? ;-) }πProcedure Beep;πBeginπ Sound(3000); Delay(90); Sound(2500); Delay(90);π NoSound;πEnd;ππ{Calculates the color for each point. }πFunction ComputeColour(XPos,YPos:Word):Byte;πVar RealP,ImagP:Real;π CurrX,CurrY:Real;π a2,b2:Real;π Counter:Byte;ππBeginπCurrX:=XPos/Width*(XRMax-XRMin)+XRMin;π CurrY:=YPos/Height*(YRMax-YRMin)+YRMin;π RealP:=0;π ImagP:=0;π Counter:=0;π Repeatπ a2:=Sqr(RealP);π b2:=Sqr(ImagP);π ImagP:=2*RealP*ImagP+CurrY;π RealP:=a2-b2+CurrX;π Inc(Counter);π Until (Counter>=Colours) or (a2+b2>=Limit);π ComputeColour:=Counter-1;πEnd;ππBeginπ Writeln('Program to draw Fractals of Mandelbrot.');π Writeln('Written by Miguel Martínez. ');π Writeln('Press any key to continue...');π If ReadKey=#0 Then ReadKey; {Skip double codes. }ππ SetVideoMode(19); {Set 320x200x256 graphics mode. }π MakePalette;π For YPos:=0 to (Height-1) doπFor XPos:=0 to (Width-1) doπ DrawPixel(XPos,YPos,ComputeColour(XPos,YPos));π Beep; {Beep when finished. }π If ReadKey=#0 Then ReadKey;π ReadKey;π SetVideoMode(3); {Restore text mode. }πEnd.π 84 01-27-9412:07ALL FRANK HIRSCH Screen Images IMPORT 12 Üdå▄ {π> I'm trying to find out a way to do GET and PUT of sections of the screenπ> into a variable... but the method I'm using is too slow and I cannot trulyπ> store it in a variable (it does a .INC program that you link with yourπ> files...).ππWell, the most simple attempt would probably be something like....π}ππPROGRAM bitmap_images;ππUSESπ CRT,π some_mode13h_routs;ππVARπ screen : ARRAY [0..199,0..319] OF BYTE ABSOLUTE $a000:0000;π imgptr : POINTER;π ch : CHAR;ππPROCEDURE get_image(p:POINTER;xp,yp:WORD;xs,ys:BYTE);πVARπ s,o : WORD;πBEGINπ s:=SEG(p^);π o:=OFS(p^);π FOR yp:=yp TO PRED(yp+ys)π DO BEGINπ MOVE(screen[yp,xp],MEM[s:o],xs);π INC(o,xs);π END;πEND;ππPROCEDURE put_image(p:POINTER;xp,yp:WORD;xs,ys:BYTE);πVARπ s,o : WORD;πBEGINπ s:=SEG(p^);π o:=OFS(p^);π FOR yp:=yp TO PRED(yp+ys)π DO BEGINπ MOVE(MEM[s:o],screen[yp,xp],xs);π INC(o,xs);π END;πEND;ππBEGINπ init_mode($13); { init mode 13h }π load_piccy('some.gfx'); { load some picture }π GETMEM(imgptr,160*100); { allocate memory for bitmap }π get_image(p,0,0,160,100); { get left part of screen }π put_image(p,160,0,160,100); { copy to right part of screen }π FREEMEM(imgptr,160*100); { release memory }π ch:=READKEY; { wait for a key }π init_mode($03); { back to textmode }πEND.π 85 01-27-9412:10ALL NORBERT IGL Julia Set IMPORT 12 Üdë) {π To try out the program, some complex constants you canπ use are -1, -0.1+0.8i, 0.3-0.5i, -1.139+0.238i. ie, whenπ asked for the real part, enter 0.3. For the imaginary,π enter -.5 }ππprogram julia;π{$N+,E+}πuses crt;πType Real = double;πvar cx, cy, xo, yo, x1, y1 : real;π mx, my, a, b, i, orb : word;ππlabel XXX;ππprocedure pset ( rx, ry: real; c:byte );πvar a, x, y :word;πbeginπ x := round(rx);π y := round(ry);π a := 320* pred(y) + x;π mem[$A000:A] := cπend;πbeginπ write('Real part: ');π readln(CX);π write('Imaginary part: ');π readln(CY);π asmπ mov ax, $13π int 10hπ end;π MX := 319; { ' the box we want to plot on the screen }π MY := 199;π FOR A := 1 TO MX do {'X screen coordinate}π FOR B := 1 TO MY do {'Y screen coordinate }π beginπ XO := -2 + A / (MX / 4); {'X complex plane coordinate}π YO := 2 - B / (MY / 4); {'Y complex plane coordinate}π Orb := 0;π FOR I := 1 TO 255 do {'iterations for 255 colors}π beginπ X1 := XO * XO - YO * YO + CX;π Y1 := 2 * XO * YO + CY;π IF X1 * X1 + Y1 * Y1 > 4.0 THEN {'orbit escapes, plot it}π beginπ Orb := I;π GOTO XXX;π END;π XO := X1;π YO := Y1;π end;πXXX:π PSET (A, B, Orb); { 'plot orbit}π end;π readln;π textmode(lastmode);πend.π 86 01-27-9412:10ALL ANDREW KEY Julia Set IMPORT 22 ÜdhR program Julia;π{program computes and displays a Julia Set using VGA 256 color graphics inπ mode 13h. written by Andrew Key and released to the public domain. notπ guaranteed -- use at own risk (but it has been put through limited tests...)π }πusesπ Crt;ππconstπ MX = 100; {horizontal number of pixels}π MY = 100; {vertical num. of pixels}ππtypeπ Complex = record {Data type for complex numbers}π A,Bi: real;π end;π VGAMemType = array[1..200,1..320] of byte; {addressed y,x}ππvarπ Num, C: Complex;π X,Y,SaveMode,I: integer;π ch: char;π VGAMem : VGAMemType Absolute $A000:$0000; {accesses actual video memory}ππprocedure SetMode(mode: integer); assembler; {sets video card to specifiedπ mode}π asmπ mov ax,modeπ int $10 {Video interrupt}π end;ππfunction CurrentMode: integer; assembler; {returns current video mode}π asmπ mov ax,$0f00π int $10π xor ah,ahπ end;ππprocedure SqCplx(var N: complex); {squares a variable of type Complex)}π varπ temp: real;π beginπ temp:= (N.A * N.A) - (N.Bi * N.Bi);π N.Bi:= 2 * N.A * N.Bi;π N.A:= temp;π end;ππprocedure AddCplx(var X: complex; Y: complex);π{Adds two complex variables -- X := X + Y}π beginπ X.A := X.A + Y.A;π X.Bi:= X.Bi + Y.Bi;π end;ππfunction SqDist(X: complex): real;π{Computes the square of the distance from the point X to the origin}π beginπ SqDist := X.A * X.A + X.Bi * X.Bi;π end;ππprocedure ClrVidScr; {Clears video screen in mode 13h}π var x,y: integer;π beginπ for x:=1 to 320 doπ for y:=1 to 200 doπ VGAMem[y,x]:=0;π end;ππbeginπ {Get values for complex constant}π ClrScr;π write('Real part: ');π readln(C.A);π write('Imaginary part: ');π readln(C.Bi);ππ {set video mode to 320*200*256 VGA and clear screen}π SaveMode:= CurrentMode; {save current mode}π SetMode($13); {set mode 13h}π ClrVidScr;ππ {compute julia set}π for y:= 0 to (MY-1) doπ for x:= 0 to (MX-1) doπ beginπ Num.A := -2 + x / ( MX / 4); {compute REAL component}π Num.Bi:= 2 - y / ( MX / 4); {compute IMAGINARY component}π I:=0; {reset number of iterations}π repeatπ SqCplx(Num); {square the complex number}π AddCplx(Num,C); {and add the complex constant}π Inc(I);π until ((I>=255) or (SqDist(Num)>4));π VGAMem[y+1,x+1]:=I; {plot the point}π end;ππ {julia set completed}π ch:=readkey; {wait for a keypress}π SetMode(SaveMode); {return to original mode}πend.π 87 01-27-9412:12ALL CHRIS PRIEDE Font Banks IMPORT 13 Üd {π>have a vga that I want to use the above mentioned interrupt with. Theπ>problem is that I can't seem to get the interrupt to do its thing. Theπ>program seems to go through it with no effect at all. My question is howπ>do I get the results?ππThe following procedures may help you. VGA has 8 font banksπ(0..7). Load your font using LoadFont, then activate that bank withπSelectFont. Selecting two different font banks will let you displayπtwo fonts simultaneously -- intensity bit selects secondary font (youπloose high intensity colors).π}πprocedure SelectFont(Prim, Sec: byte);πvar Tmp: byte;πbeginπ Tmp := (Prim and $3) or (Prim shl 2 and $10)π or (Sec shl 2 and $C) or (Sec shl 3 and $20);π asmπ mov bl, Tmpπ mov ax, $1103π int $10π end;π if (Prim and $7) = (Sec and $7) thenπ Tmp := $Fπ elseπ Tmp := $7;π asmπ mov bh, Tmpπ mov bl, $12π mov ax, $1000π int $10π end;πend;πππprocedure LoadFont(var Buf; Bank, Height: byte; First, Last: char); assembler;πasmπ mov dl, Firstπ xor dh, dhπ mov cl, Lastπ sub cl, dlπ mov ch, dhπ inc cxπ mov bl, Bankπ mov bh, Heightπ les bp, Bufπ mov ax, $1100π int $10πend;ππvar Buf: array [1..4096] of byte;ππbeginπ { Load 256 8x16 characters in buffer }π LoadFont(Buf, 0, 16, #0, #255);π SelectFont(0, 0);πend.πππ 88 01-27-9412:16ALL BAS VAN GAALEN Better Julia Set IMPORT 15 ÜdOê {π> Thanks for writing a working Pascal source. Hopefully it willπ> work with 640x480 resolution (320x200 is a bit grainy, specieallyπ> with the default palette.)ππI changed Norbert's source a little. Now it looks nicer, and I believe it'sπeven a fraction faster (not sure, though, didn't time it):π}ππ{$G+,N+,E-} { if you have no CoPro, set E+ }ππ{ Reals Complexπ -1 0π -0.1 0.8π 0.3 -0.5π -1.139 0.238π}ππprogram Julia;πconst Gseg : word = $a000;πType real = double;πvar Cx,Cy,Xo,Yo,X1,Y1 : real; Mx,My,A,B,I,Orb : word;ππprocedure Pset(X,Y : word; C : byte); assembler;πasmπ mov es,Gsegπ mov ax,[Y]π shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,[X]π mov al,[C]π mov [es:di],alπend;ππfunction keypressed : boolean; assembler; asmπ mov ah,0bh; int 21h; and al,0feh; end;ππprocedure Setpalette;πvar I : byte;πbeginπ for I := 1 to 64 do beginπ port[$3c8] := I;π port[$3c9] := 10+I div 3;π port[$3c9] := 10+I div 3;π port[$3c9] := 15+round(I/1.306122449);π end;πend;ππbeginπ write('Real part: '); readln(Cx);π write('Imaginary part: '); readln(Cy);π asm mov ax,13h; int 10h; end;π Setpalette;π Mx := 319; My := 199;π for A := 1 to Mx doπ for B := 1 to My do beginπ Xo := -2+A/(Mx/4); { X complex plane coordinate }π Yo := 2-B/(My/4); { Y complex plane coordinate }π Orb := 0; I := 0;π repeatπ X1 := Xo*Xo-Yo*Yo+Cx;π Y1 := 2*Xo*Yo+Cy;π Xo := X1;π Yo := Y1;π inc(I);π until (I = 64) or (X1*X1+Y1*Y1 > 4);π if I <> 64 then Orb := I;π Pset(A,B,Orb); { Plot orbit }π end;π while not keypressed do;π asm mov ax,3; int 10h; end;πend.ππ 89 01-27-9412:16ALL COLIN BUCKLEY Reding VGA Palettes IMPORT 16 ÜdΘ/ {π>thanks for the example -- do you have any idea how to read the wholeπ>palette at one time, etc?ππHere you go... It will work on all computers. I do not use the 286πstring instructions, as they go too fast for some VL-Bus video cards causingπincorrect colours. The first part waits for a full vertical retraceπbefore changing the colours to prevent "snow" at the top of the display onπslower computers. The only time you'll see the snow is if you continuouslyπget or set the palette such as in a screen fade.π}ππProcedure VGAGetPalette(Pal:Pointer); Assembler;πAsmπ { Wait for Vertical Retrace }π MOV DX,3DAhπ@@WaitNotVSync:π IN AL,DXπ(91 min left), (H)elp, More? AND AL,00001000bπ JNZ @@WaitNotVSyncπ@@WaitVSync:π IN AL,DXπ AND AL,00001000bπ JZ @@WaitVSyncππ LES DI,[Pal] {;ES:DI:=Palette Pointer }π XOR AX,AX {;Start with DAC 0 }π MOV CX,256 {;End with DAC 255 }π MOV DX,3C7h {; |Send Starting DAC register }π OUT DX,AL {;/ }π INC DX {; |DX:=DAC Data register }π INC DX {;/ }π CLDπ@@DACLoop:π IN AL,DX {;Read Red Byte }π STOSB {;Store Red Byte }π IN AL,DX {;Read Green Byte }π STOSB {;Store Green Byte }π IN AL,DX {;Read Blue Byte }π STOSB {;Store Blue Byte }π LOOP @@DACLoop {;Loop until CX=0 }πEnd;ππ 90 01-27-9412:21ALL JOHN IOZIA Bank Switching IMPORT 2 ÜdG@ πProcedure SetBank(b : byte); Assembler; {vesa}πAsmπ mov AX, 4f05hπ xor DX, DXπ mov Dl, bπ Int 10hπEND;ππ 91 01-27-9412:21ALL SHAUN ROOT Shading IMPORT 12 Üd╨O πProgram Shading;ππUses CRT;ππVarπ ColorNum, Y : Integer;ππ{--------------------------------------------------------------}ππprocedure setcolors;ππvarπ Color : Byte;π A : Integer;ππBeginπ For A := 1 to 63 doπ Beginπ port[$3c8]:=A;π port[$3c9]:=1;π port[$3c9]:=1;π port[$3c9]:=A;π End;πend;ππ{----------------------------------------------------------------}ππprocedure horizontal_line (x1,x2,y : integer;color:byte);ππVarπtemp,Counter : Integer;ππbeginπIF X1 > X2 thenπ beginπ Temp:=X1;π X1:=X2;π X2:=Temp;π End;ππ X1:=(y*320)+X1;π X2:=(y*320)+X2;ππ For Counter := X1 to X2 doππ mem[$A000:Counter]:=color;πEnd;π{---------------------------------------------------------------}πProcedure Init13h; {Sets video to 320X200X256}ππBeginππASMπ MOV AH,00π MOV AL,13hπ int 10hπEnd;πEnd;π{----------------------------------------------------------------}πProcedure InitText; {Sets video to Textmode}ππBeginππASMπ MOV AH,00π MOV AL,3π INT 10hπEnd;πEnd;π{--------------------------------------------------------------------------}ππBegin {Main}πColorNum:=1;πinit13h;πSetcolors;πFor Y:=1 to 63 doπ Beginπ Horizontal_Line(80,239,Y,Colornum);π ColorNum:=Colornum+1;π End;πFor Y:=64 to 126 doπ Beginπ ColorNum:=ColorNum-1;π Horizontal_Line(80,239,Y,ColorNum);π End;πReadkey;πInitText;πEnd.π 92 01-27-9412:24ALL OLAF BARTELT Vesa Unit IMPORT 28 Üd+' {π> Any chance you can post that uVesa Unit? Or maybe a routine toπ> set up a Vesa mode, and a Vesa plotPixel routine?π}ππUNIT uVesa; { (c) 1993 by NEBULA-Software }π { Unterstützung des VESA-Standards } { Olaf Bartelt & Oliver Carow }ππINTERFACE { Interface-Teil der Unit }πππTYPE tVesa = OBJECT { Objekt für VESA }π xmax, ymax : WORD;π page : WORD;π switch_ptr : POINTER;ππ CONSTRUCTOR init(modus : WORD);π PROCEDURE putpixel(x, y : WORD; c : BYTE); { Longint }π FUNCTION getpixel(x, y : LONGINT) : BYTE; { wegen Berechn.}π END;πVAR vVesa : ^tVesa;πππCONST c640x400 = $100; { VESA-Modi }π c640x480 = $101;π c800x600 = $102;π c1024x768 = $103;ππFUNCTION vesa_installed : BOOLEAN;πππIMPLEMENTATION { Implementation-Teil d. Unit }ππUSES DOS, CRT; { Units einbinden }πππVAR regs : REGISTERS; { benötigte Variablen }πππFUNCTION vesa_installed : BOOLEAN; { VESA-Treiber vorhanden? }πBEGINπ regs.AH := $4F; regs.AL := 0; INTR($10, regs);π vesa_installed := regs.AL = $4F;πEND;πππCONSTRUCTOR tVesa.init(modus : WORD);πVAR mib : ARRAY[0..255] OF BYTE;π s, o : WORD;πBEGINπ IF vesa_installed = FALSE THENπ BEGINπ WRITELN(#7, 'Kein VESA-Treiber installiert! / No VESA-driver installed!');π HALT(1);π END;ππ regs.AX := $4F02; regs.BX := modus; INTR($10, regs);π regs.AX := $4F01; regs.DI := SEG(mib); regs.ES := OFS(mib); INTR($10, regs);ππ s := mib[$0C] * 256 + mib[$0D]; o := mib[$0E] * 256 + mib[$0F];π switch_ptr := PTR(s, o);ππ CASE modus OFπ c640x400 : BEGIN xmax := 640; ymax := 400; END;π c640x480 : BEGIN xmax := 640; ymax := 480; END;π c800x600 : BEGIN xmax := 800; ymax := 600; END;π c1024x768: BEGIN xmax := 1024; ymax := 768; END;π END;ππ page := 0;π ASMπ MOV AX, 4F05hπ MOV DX, pageπ INT 10hπ END;πEND;πππPROCEDURE tVesa.putpixel(x, y : WORD; c : BYTE);πVAR bank : WORD;π offs : LONGINT;πBEGINπ offs := LONGINT(y)*640 + x; { SHL 9+SHL 7 ist auch nicht schneller!! }π bank := offs SHR 16;π offs := offs - (bank SHL 16); { MOD 65536 ist langsamer!! }ππ IF bank <> page THENπ BEGINπ page := bank;π ASMπ MOV AX, 4F05hπ MOV DX, bankπ INT 10hπ END;π END;ππ ASMπ MOV AX, 0A000hπ MOV ES, AXπ MOV DI, WORD(offs)π MOV AL, cπ MOV ES:[DI], ALπ END;πEND;πππFUNCTION tVesa.getpixel(x, y : LONGINT) : BYTE;πVAR bank : WORD;π offset : LONGINT;πBEGINπ offset := y SHL 9+y SHL 7+x;π bank := offset SHR 16;π offset := offset - (bank SHL 16);ππ IF bank <> page THENπ BEGINπ page := bank;π ASMπ MOV AX, 4F05hπ MOV DX, bankπ INT 10hπ END;π END;ππ getpixel := MEM[$A000:offset];πEND;πππBEGINπ NEW(vVesa);πEND.ππ{πThat routine could be faster if one implemented a bank switching routine byπdoing a far call to the vesa bios (the address can be received by a simpleπcall, I just hadn't had time yet to implement it - if you should do it,π*please* post the modified routine for me - thanx!)π} 93 01-27-9412:25ALL SEAN PALMER Vesa Unit 2! IMPORT 78 ÜdÇ▐ {πHere's some VESA routines. The drawing stuff is quite limited right nowπ(to pixels and horizontal lines in 256-color linear modes only) but itπdetects/sets/describes most everything else. Also no save/restore videoπstate yet. It uses direct VESA function calls instead of interrupts, andπtries to optimize where it puts the window based on what the routinesπwill be used for . . .π}ππ{VESA1.PAS}π{by Sean Palmer}π{with help from Ferraro and Olaf Bartlett}ππtypeπ pModeList = ^tModeList;π tModeList = Array [0..255] of word; {list of modes terminated by -1}π {VESA modes are >=100h}ππ modeAttrBits = (modeAvail,π modeExtendInfo,π modeBIOSsupport,π modeColor,π modeGraphics,π modeBit5,π modeBit6,π modeBit7,π modeBit8);ππ winAttrBits = (winSupported,π winReadable,π winWriteable);ππ tMemModel = (modelText,π modelCGA,π modelHerc,π model4Plane,π modelPacked,π modelModeX,π modelRGB);πππvarπ VESAinfo : recordπ signature : array [1..4] of char;π version : word;π str : pChar;π caps : longint;π modeList : pModeList;π pad : array [18..255] of byte;π end;ππ modeInfo : recordπ attr : set of modeAttrBits;π winAAttr,π winBAttr : set of winAttrBits;π winGranularity : word; {in K}π winSize : word; {in K}π winASeg,π winBSeg : word; {segment to access window with}π winFunct : procedure;π scanBytes : word; {bytes per scan line}π extendedInfo : recordπ xRes, yRes : word; {pixels}π xCharSize,π yCharSize : byte;π planes : byte;π bitsPixel : byte;π banks : byte;π memModel : tMemModel;π bankSize : byte; {in K}π end;ππ pad : array [29..255] of byte;π end;ππ xSize,π ySize,π xBytes : word;π bits : byte;π model : tMemModel;π window : byte;π winSeg : word;π granShifts : byte;π winLo,π winHi,π winBytes,π granMask : longint;π funct : procedure;ππ m, i : word;ππππfunction getVESAInfo : boolean; assembler;πasmπ mov ax,4F00hπ push dsπ pop esπ mov di,offset VESAinfoπ int 10hπ sub ax,004Fh {make sure we got 004Fh back}π cmp ax,1π sbb al,alπ cmp word ptr es:[di],'V'or('E'shl 8) {signature should be 'VESA'}π jne @@ERRπ cmp word ptr es:[di+2],'S'or('A'shl 8)π je @@Xπ @@ERR:π mov al,0π @@X:πend;πππfunction getModeInfo(mode:word):boolean;assembler;asmπ mov ax,4F01hπ mov cx,modeπ push dsπ pop esπ mov di,offset modeInfoπ int 10hπ sub ax,004Fh {make sure it's 004Fh}π cmp ax,1π sbb al,alπ end;πππ{if the VESA driver supports info on the regular VGA modes, add them to list}πprocedure includeStandardVGAModes;var p:^word;beginπ p:=pointer(VESAInfo.modeList);π while p^<>$FFFF do inc(p);π if getModeInfo($10) then begin p^:=$10; inc(p);end;π if getModeInfo($12) then begin p^:=$12; inc(p);end;π if getModeInfo($13) then begin p^:=$13; inc(p);end;π p^:=$FFFF;π end;πππfunction setMode(mode:word):boolean;var i:word;beginπ if getModeInfo(mode) then beginπ with modeInfo do beginπ if winSupported in winAAttr then begin window:=0; winSeg:=winASeg;endπ else if winSupported in winBAttr then begin window:=1; winSeg:=winBSeg;endπ else exit; {you call this a VESA mode?}π with extendedInfo do beginπ xSize:=xRes; ySize:=yRes; xBytes:=scanBytes; bits:=bitsPixel;π model:=memModel;π end;π winBytes:=longint(winSize)*1024; {wraps to 0 if 64k}π winLo:=0; winHi:=winBytes;π i:=winGranularity;π granShifts:=10; {for 1K}π while not odd(i) do beginπ i:=i shr 1;π inc(granShifts);π end;π if i<>1 then begin setMode:=false;exit;end; {granularity not power of 2}π granMask:=(longint(1)shl granShifts)-1;π funct:=winFunct;π end;π asmπ mov ax,4F02hπ mov bx,modeπ int 10hπ sub ax,004Fhπ cmp ax,1π sbb al,alπ mov @RESULT,alπ end;π end;π end;ππfunction getMode:word;assembler;asm {return -1 if error}π mov ax,4F03hπ int 10hπ cmp ax,004Fhπ je @@OKπ mov ax,-1π jmp @@Xπ@@OK: mov ax,bxπ@@X:π end;πππprocedure plot(x, y : word; c : byte);πvarπ bank : word;π offs : longint;πbeginπ offs := longint(y) * xBytes + x;π if (offs < winLo) or (offs >= winHi) thenπ beginπ winLo := (offs - (winBytes shr 1)) and not granMask;π winHi := winLo + winBytes;π bank := winLo shr granShifts;π asmπ mov bl, windowπ mov dx, bankπ call [funct]π end;π end;π mem[winSeg : word(offs) - word(winLo)] := c;πend;ππprocedure hLin(x,x2,y:word;c:byte);πvar bank,w:word; offs:longint;πbeginπ w:=x2-x;π offs:=longint(y)*xBytes+x;π if (offs<winLo)or(offs+w>=winHi) then beginπ winLo:=offs and not granMask;π winHi:=winLo+winBytes;π bank:=winLo shr granShifts;π asmπ mov bl,windowπ mov dx,bankπ call [funct]π end;π end;π fillChar(mem[winSeg:word(offs)-word(winLo)],w,c);π end;ππfunction scrn(x,y:word):byte;πvar bank:word; offs:longint;πbeginπ offs:=longint(y)*xBytes+x;π if (offs<winLo)or(offs>=winHi) then beginπ winLo:=(offs-(winBytes shr 1))and not granMask;π winHi:=winLo+winBytes;πbank:=winLo shr granShifts;π asmπ mov bl,windowπ mov dx,bankπ call [funct]π end;π end;π scrn:=mem[winSeg:word(offs)-word(winLo)];π end;ππ{will find a color graphics mode that matches parms}π{if parm is 0, finds best mode for that parm}πfunction findMode(x,y:word;model:tMemModel;nBits,nPlanes,nBanks:byte):word;πvar p:^word; m:word; gx,gy,gb,lp,lb:word;πbeginπ gx:=0;gy:=0;gb:=0;lp:=255;lb:=255;π p:=pointer(VESAInfo.modeList);π m:=$FFFF;π while p^<>$FFFF do beginπ if getModeInfo(p^) thenπ with modeInfo doπ if attr+[modeAvail,modeExtendInfo,modeColor,modeGraphics]=attr thenπ with extendedInfo doπif ((xRes=x)or((x=0)and(gx<=xRes)))π and((yRes=y)or((y=0)and(gy<=yRes)))π and(memModel=model)π and((bitsPixel=nBits)or((nBits=0)and(gb<=bitsPixel)))π and((planes=nPlanes)or((nPlanes=0)and(lp>=planes)))π and((banks=nBanks)or((nBanks=0)and(lb>=banks)))π then beginπ gx:=xRes;gy:=yRes;gb:=bitsPixel;lp:=planes;lb:=banks;π m:=p^;π end;π inc(p);π end;π if m<>$FFFF then getModeInfo(m);π findMode:=m; {0FFFFh if not found. Try a standard mode number then.}π end;πππprocedure displayVESAInfo;ππtypeπ string2=string[2];π string4=string[4];π string8=string[8];πconstπ modelStr : array[tMemModel]of pChar=π ('Text','CGA','Hercules','EGA','Linear','mode X','RGB');πvarπ p:^word;ππ function hexB(n:byte):string2; assembler;asmπ les di,@RESULT; {adr of function result}π cld; mov al,2; stosb; {set len}π mov al,n; mov ah,al; {save it}π shr al,1; shr al,1; shr al,1; shr al,1; {high nibble}π add al,$90; daa; adc al,$40; daa; {convert hex nibble to ASCII}π stosb;π mov al,ah; and al,$F; {low nibble}π add al,$90; daa; adc al,$40; daa;π stosb;π end;ππ function hexW(n:word):string4;π beginπ hexW:=hexB(hi(n))+hexB(lo(n));π end;ππ function hexL(n:longint):string8;π beginπ hexL:=hexW(n shr 16)+hexW(n);π end;ππbeginπ if getVESAInfo thenπ with VESAinfo do beginπ includeStandardVGAModes;π writeln(signature,' Version ',hexB(hi(version)),'.',hexB(version));π writeln(str);π writeln('Capabilities: $',hexL(caps));π p:=pointer(modeList);πwhile p^<>$FFFF do beginπ write('Mode $',hexW(p^),' = ');π if getModeInfo(p^) thenπ with modeInfo do beginπ if not(modeAvail in attr) then write('Unavailable-');π if modeColor in attr then write('Color ') else write('Mono ');π if modeGraphics in attr then write('Graphics') else write('Text');π if modeBIOSSupport in attr then write('-BIOSsupport');π writeln;π if modeExtendInfo in attr thenπ with extendedInfo do beginπ write(' ',xRes,'x',yRes,', ',bitsPixel,' bits, ',modelStr[memModel],π ', ',scanBytes,' bytes per row');π if not (modeGraphics in attr) thenπ write(^M^J' Character size ',xCharSize,'x',yCharSize);π if planes>1 then write(', ',planes,' planes');π if banks>1 then write(', ',banks,' banks of ',bankSize,'K');π writeln;π endπ else write(' No extended info available');π if winSupported in winAAttr then beginπ write(' Window A: ');π if winReadable in winAAttr then write('R');πif winWriteable in winAAttr then write('W');π writeln(' at segment $',hexW(winASeg),', ',winSize,'K, granular by 'π ,winGranularity,'K, function at $',hexL(longint(@winFunct)));π end;π if winSupported in winBAttr then beginπ write(' Window B: ');π if winReadable in winBAttr then write('R');π if winWriteable in winBAttr then write('W');π writeln(' at segment $',hexW(winBSeg),', ',winSize,'K, granular by 'π ,winGranularity,'K, function at $',hexL(longint(@winFunct)));π end;π endπ else writeln('ERROR');π inc(p);π end;π endπ else writeln('No VESA driver found');π end;ππbeginπ writeln;π displayVESAInfo;π readln;π m := findMode(0, 0, modelPacked, 8, 1, 1);π getModeInfo(m);π if m <> $FFFF thenπ with modeInfo.extendedInfo doπ writeln('Found ', xRes, 'x', yRes, 'x',π longint(1) shl bitsPixel, ' mode ', m)π elseπ exit;ππ setMode(m);π for i := 1 to 10000 doπ plot(random(xSize), random(ySize), random(256));ππ readln;ππ for i := 1 to 200 doπ hlin(random(xSize shr 1), random(xSize shr 1) + xSize shr 1,π random(ySize), random(256));π readln;ππ asmπ mov ax, 3hπ int 10hπ end;πend.π 94 01-27-9417:46ALL DARRYL FRIESEN High Intensity BackgroundIMPORT 36 Üdk UNIT Lite;π{***************************************************************************}π{* *}π{* Unit Lite - Routines to produce high intensity backgrounds *}π{* *}π{* AUTHOR: Darryl Friesen *}π{* CREATED: 01-JUN-1991 *}π{* LAST MODIFIED: 06-JAN-1992 *}π{* CURRENT VERSION: Version 1.0.1 *}π{* COMPILED USING: Turbo Pascal 6.0 *}π{* *}π{* *}π{* UNIT DEPENDANCIES: *}π{* *}π{* INTERFACE: [none] *}π{* IMPLEMENTATION: DOS *}π{* *}π{***************************************************************************}π{* *}π{* REVISION HISTORY *}π{* ---------------- *}π{* 01-JUN-1991 - Creation of VERSION 1.00 *}π{* 06-JAN-1992 - Version 1.0.1 *}π{* Fixed a bug in the BlinkOn routine. On a VGA machine *}π{* the blink state was turned off instead of on. *}π{* *}π{***************************************************************************}ππ{=========================================================================}πINTERFACEπ{=========================================================================}ππProcedure BlinkOff;πProcedure BlinkOn;πFunction EGA: Boolean;πππ{=========================================================================}πIMPLEMENTATIONπ{=========================================================================}ππUSES DOS;πππ{================================================================}πPROCEDURE SetBlinkState(State : BOOLEAN);π{================================================================}π{================================================================}ππVARπ ModeReg : BYTE;π ModeRegPort : WORD;ππBeginπ INLINE($FA); { CLI }π ModeRegPort:=MEMW[$0040:$0063]+4;π ModeReg:=MEM[$0040:$0065];π If State Thenπ ModeReg:=ModeReg OR $20π Elseπ ModeReg:=ModeReg AND $DF;ππ Port[ModeRegPort] := ModeReg;π MEM[$0040:$0065]:= ModeReg;π INLINE($FB) { STI }πEND;πππ{================================================================}πFUNCTION EGA : BOOLEAN;π{================================================================}π{================================================================}ππVARπ Regs : Registers;ππBeginπ Regs.AH:=$12;π Regs.BX:=$FF10;π INTR( $10, Regs );π EGA := (Regs.BX AND $FEFC=0)πEnd;πππ{================================================================}πPROCEDURE SetEGABlinkState(State : BOOLEAN);π{================================================================}π{================================================================}ππVARπ Regs: Registers;ππBeginπ Regs.AX := $1003;π Regs.BL := ORD(State);π INTR( $10, Regs )πEnd;πππ{================================================================}πPROCEDURE BlinkOn;π{================================================================}π{================================================================}ππBeginπ If EGA Thenπ SetEGABlinkState(TRUE)π Elseπ SetBlinkState(TRUE)πEnd;πππ{================================================================}πPROCEDURE BlinkOff;π{================================================================}π{================================================================}ππBeginπ If EGA Thenπ SetEGABlinkState(FALSE)π Elseπ SetBlinkState(FALSE)πEnd;πππ{=========================================================================}ππEnd.π 95 02-03-9410:50ALL SWAG SUPPORT TEAM Detect EGA/VGA in ASM IMPORT 7 Üd# program EGAORVGA;π{For TP 6.0 because of assembler code. Put these functions into a UNITπ for general use.}ππ FUNCTION IsEGAorVGA : Boolean; Assembler;π ASMπ MOV AH, 12hπ MOV BL, 10hπ INT 10hπ MOV AL, 0π CMP BH, 1π JA @Nopeπ CMP BL, 3π JA @Nopeπ INC ALπ @Nope:π END;ππ FUNCTION IsVGA : Boolean; Assembler;π ASMπ MOV AH, 12hπ MOV AL, 00hπ MOV BL, 36hπ INT 10hπ MOV AH, 0π CMP AL, 12hπ JNZ @Nopeπ INC AHπ @Nope:π END;ππbeginπ If IsEGAorVGA thenπ beginπ Writeln('Programs supporting EGA or VGA will run on this computer.');π If IsVGA thenπ Writeln('VGA detected.')π Elseπ Writeln('EGA detected.')π endπ Elseπ Writeln('No EGA or VGA detected!');πend.π 96 02-03-9416:15ALL ROB PERELMAN Change EGA/VGA Font Char IMPORT 16 Üd┘ π{OK...for awhile I've been saying I'm going to post my unit for changingπcharacters...well today's the day. This unit has one procedure calledπProcessChar. You pass ProcessChar the ordinal value of the characterπyou wish to process (between 0 and 255), the data that holds your newπcharacter or where you want to load the existing character, and if youπwant to load it or save it. There are also four constants that simulateπa copyright symbol. One is bigger than the other (that's the onlyπdifference). You can replace characters with the copyright symbol soπeffectively you can have a legal C-in-a-circle in text mode!! Although,πI do not know if this is actually legal, so don't mark my words... }πππUnit ModChar;ππ { Unit Name: ModChar }π { Author: Rob Perelman }ππInterfaceππConst LoadChar=False;π SaveChar=True;ππType CharPic=Array[1..16] of Byte;ππConst CRLeft: CharPic=(0,31,48,99,198,140,140,140,140,140,140,198,99,48,π 31,0);π CRRight: CharPic=(0,248,12,198,99,1,1,1,1,1,33,99,198,12,248,0);π BigCRLeft: CharPic=(31,48,96,195,134,140,140,140,140,140,140,134,π 195,96,48,31);π BigCRRight: CharPic=(248,12,6,195,97,1,1,1,1,1,33,97,195,6,12,π 248);ππ Procedure ProcessChar(CharNum: Byte; var Pic: CharPic; Which: Boolean);ππImplementationππUses Dos;ππProcedure ProcessChar(CharNum: Byte; var Pic: CharPic; Which: Boolean);πBeginπ Inline($FA);π PortW[$3C4]:=$0402;π PortW[$3C4]:=$0704;π PortW[$3CE]:=$0204;π PortW[$3CE]:=$0005;π PortW[$3CE]:=$0006;π If Which then Move(Pic, Mem[$A000:CharNum*32], SizeOf(CharPic))π Else Move(Mem[$A000:CharNum*32], Pic, SizeOf(CharPic));π PortW[$3C4]:=$0302;π PortW[$3C4]:=$0304;π PortW[$3CE]:=$0004;π PortW[$3CE]:=$1005;π PortW[$3CE]:=$0E06;π Inline($FB);πEnd;ππEnd.π 97 02-05-9407:55ALL MIRKO HOLZER Graphical Fades and PaletIMPORT 14 ÜdA¡ {πhere are some routines, with which you can fade the screen in/out.πHow to use:ππ Fade out: Get the original palette with the GetPal(0,255,pal) command.π (Of course you have to allocate 768 Bytes Memory for the palπ pointer first).π Then call FadePal(Pal,true,steps) and the screen will beπ faded out.ππ Fade in: Just pass the target-pal. to the Fade-Routine:ππ FadePal(Targetpal,false,steps).ππNote: Low step-rates mean high fading speed. }πππProcedure SetPal(Start: byte; Anz: word; pal: pointer); assembler;πasmπ push dsπ cldπ lds si,palπ mov dx,3c8hπ mov al,startπ out dx,alπ inc dxπ mov ax,anzπ mov cx,axπ add cx,axπ add cx,axπ rep outsbπ pop dsπend;πππProcedure GetPal(Start: byte; Anz: word; pal: pointer); assembler;πasmπ les di,palπ mov al,startπ mov dx,3c7hπ out dx,alπ inc dxπ mov ax,anzπ mov cx,axπ add cx,axπ add cx,axππ mov dx,3c9hπ cldπ rep insbπend;πππProcedure FadePal(OrigPal : pPal; FadeOut : Boolean; steps: byte);πVarπ r,g,b : byte;π Fade : word;π Pct : real;π I : byte;πbeginπ For Fade := 0 to Steps do beginπ Pct := Fade / Steps;π If FadeOut then Pct := 1 - Pct;π For I := 0 to 255 do beginπ r := Round(OrigPalI].R * Pct);π g := Round(OrigPalI].G * Pct);π b := Round(OrigPalI].B * Pct);π asmπ mov dx,3c8hπ mov al,iπ out dx,alπ mov dx,3c9hπ mov al,rπ out dx,alπ mov al,gπ out dx,alπ mov al,bπ out dx,alπ end;π end;π end;πend;π 98 02-05-9407:57ALL BAS VAN GAALEN Screen Sweep IMPORT 18 Üd! {π WA> I was wondering if anyone could help me out here. What Iπ WA> would like is a program that sweeps my screen clear or to aπ WA> color then self terminates. Something similar to a radarπ WA> sweep. I have a limited knowledge of TP 7.ππI guess everyone who programs in Pascal has a limited knowledge of TP.ππAnyway, this is what I just made:ππ--- cut here --- }ππprogram screensweep;πuses crt;πconst vseg : word = $b800; fillchar = 32;πvar x,i,maxx,maxy : integer;ππprocedure retrace;πbeginπ while (port[$3da] and 8) <> 0 do;π while (port[$3da] and 8) = 0 do;πend;ππprocedure plot(x,y : integer); beginπ mem[vseg:y*160+x+x] := fillchar; end;ππprocedure line(x,y,x2,y2 : integer);πvar d,dx,dy,ai,bi,xi,yi : integer;πbeginπ if x < x2 then begin xi := 1; dx := x2-x; endπ else begin xi := -1; dx := x-x2; end;π if y < y2 then begin yi := 1; dy := y2-y; endπ else begin yi := -1; dy := y-y2; end;π plot(x,y);π if dx > dy then beginπ ai := (dy-dx)*2; bi := dy*2; d := bi-dx;π repeatπ if d >= 0 then begin inc(y,yi); inc(d,ai); end else inc(d,bi);π inc(x,xi); plot(x,y);π until x = x2;π endπ else beginπ ai := (dx-dy)*2; bi := dx*2; d := bi-dy;π repeatπ if d >= 0 then begin inc(x,xi); inc(d,ai); end else inc(d,bi);π inc(y,yi); plot(x,y);π until y = y2;π end;πend;ππbeginπ if lastmode = 7 then vseg := $b000;π maxx := lo(windmax); maxy := hi(windmax);ππ { fill the screen with characters added by G.DAVIS}π for i := 1 to SUCC(maxy) doπ beginπ gotoxy(1,i);π for x := 1 to SUCC(maxx) do write(Chr(X+32));π end;ππ for i := 0 to maxx do beginπ retrace;π line(maxx div 2,maxy div 2,i,0);π end;π for i := 0 to maxy do beginπ retrace;π line(maxx div 2,maxy div 2,maxx,i);π end;π for i := maxx downto 0 do beginπ retrace;π line(maxx div 2,maxy div 2,i,maxy);π end;π for i := maxy downto 0 do beginπ retrace;π line(maxx div 2,maxy div 2,0,i);π end;πend.ππ--- cut here ---ππThe line-routine was taken from Sean Palmers 320x240-mode-x unit (just a littleπre-idented. ;-))ππ 99 02-09-9411:49ALL BAS VAN GAALEN Video Addresses IMPORT 14 Üdêé πCONSTπ { Constants for bit plane, video page, and memory block sizes: }π MonoBase = $B000; { Segment offset of MDA/Herc video buffer }π CGABase = $B800; { Segment offset of CGA video buffer }π EGAVGABase = $A000; { Segment offset of EGA/VGA video buffer }ππ { Size of one video page buffer in modes 0..3: }π TxtVidPageSize : Array[0..3] of Word = ($800,$800,$1000,$1000);π { Actual number of bytes used in these buffers }π TxtVidPageFilled : Array[0..3] of Word = (2000,2000,4000,4000);ππ CGAMemBankSize = $2000; { Size of one CGA memory bank in modes 4, 5 and 6}π CGAMemBankFilled = 8000; { Actual number of bytes used in that bank }π HercMemBankSize = $2000; { Size of one Hercules memory bank }π HercMemBankFilled = 7830; { Actual number of bytes used in that bank }π VGA256MemBankSize = 64000;ππ MDAPageSize = 4000; { Size of MDA text buffer }π V400PageSize = 32000; { Size video page in V400VM mode }πππFUNCTION GetVidMode: Byte;π VAR Regs : Registers;π BEGINπ Regs.AH := $0F;π Intr($10,Regs);π GetVidMode := Regs.AL;π END; { GetVidMode }πππFUNCTION VidAddress: Pointer;π VAR VM: Byte;π BEGINπ VM := GetVidMode;π CASE VM OFπ 0..3 : VidAddress := Ptr(CGABase,GetVisualPage * TxtVidPageSize[VM]);π 4..6 : VidAddress := Ptr(CGABase,0);π 7 : VidAddress := Ptr(MonoBase,0); { Also HercVM }π 13..19 : VidAddress := Ptr(EGAVGABase,0);π V400VM : VidAddress := Ptr(EGAVGABase,GetVisualPage * V400PageSize);π ELSE DumBool := CheckError(TRUE,'VIDADDRESS',68);π END;π END; { VidAddress }π 100 02-09-9411:49ALL WOLFGANG FRINK Fade and Palette RoutinesIMPORT 17 Üd0` π{$M 16384,0,255360}πuses Dos,crt;ππprocedure waitretrace;assembler; {wait for next vertical retrace}πasmπ mov dx,$3DAπ @V1: in al,dx; test al,8; jz @v1;π @V2: in al,dx; test al,8; jnz @v2;πend;ππtypeπ rgb = record r, g, b : byte; end;π paltype = array[0..255]of rgb;πvarπ i : integer;π pal : paltype;ππprocedure get_color(var pal : paltype); {save palette}πvarπ i : integer;πbeginπ port[$3C7] := $00;π for i:= 0 to 255 do beginπ pal[i].r := port[$3C9];π pal[i].g := port[$3C9];π pal[i].b := port[$3C9];π end;πend;ππprocedure set_intensity(intensity : byte);πvarπ i : integer;πbeginπ port[$3C8] := $00;π for i := 0 to 255 do beginπ port[$3C9] := pal[i].r*intensity div 63;π port[$3C9] := pal[i].g*intensity div 63;π port[$3C9] := pal[i].b*intensity div 63;π end;πend;ππprocedure set_to_color(r,g,b,h: integer);πvarπ i : integer;πbeginπ port[$3C8] := $00;π for i := 0 to 255 do beginπ port[$3C9] := pal[i].r+(r-pal[i].r)*h div 63;π port[$3C9] := pal[i].g+(g-pal[i].g)*h div 63;π port[$3C9] := pal[i].b+(b-pal[i].b)*h div 63;π end;πend;ππprocedure fade_out(t : integer); {fades from pal to black}πbeginπ for i := 63 downto 0 do begin waitretrace; set_intensity(i); delay(t); end;πend;ππprocedure fade_in(t : integer); {fades from black to pal}πbeginπ for i := 0 to 63 do begin waitretrace; set_intensity(i); delay(t); end;πend;ππprocedure flash_in(r,b,g: byte;t : integer); {fades from pal to color}πbeginπ for i := 0 to 63 do begin waitretrace; set_to_color(r,b,g,i); delay(t); end;πend;ππprocedure flash_out(r,g,b: byte;t : integer); {fades from color to pal}πbeginπ for i := 63 downto 0 do begin waitretrace;set_to_color(r,g,b,i);delay(t);end;πend;ππBEGINππ { Put some stuff on the screen }π SwapVectors;π Exec(GetEnv('COMSPEC'),' /c dir \ /w');π SwapVectors;π Get_Color(pal);π fade_out(50);π fade_in(50);π Flash_Out(100,16,32,50);π Flash_In (100,16,32,50);π ASMπ MOV AX,00003h {reset to textmode}π INT 010hπ END;ππEND. 101 02-18-9407:00ALL BOB SWART VGA/EGA Multi Line Modes IMPORT 30 Üdx {πCheck out Hax #179 from PC Techniques vol.4 no.6 Feb/Mar issue (page 70),π(coincidently written by me), where a small program is presented that'll notπonly detect whether a VGA adapter is installed, but is also capable of puttingπthe screen in 80x12, 80x14, 80x21, 80x25, 80x28, 80x43 or 80x50 mode...}ππ{$IFDEF VER70}π{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}π{$ELSE}π{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}π{$ENDIF}π{$M 1024,0,0}π{π VGA 3.0π Borland Pascal (Objects) 7.01π Copr. (c) 7-17-1993 DwarFools & Consultancy drs. Robert E. Swartπ P.O. box 799π 5702 NP Helmondπ The Netherlandsππ Code size: 3248 Bytesπ Data size: 676 Bytesπ}πConstπ VGAInside: Boolean = False; { Assume no VGA-card is installed }ππvar VGALines,i: Integer;ππ procedure Lines200;π { Set 200 scanlines on VGA display }π InLine(π $B8/$03/$00/ { mov AX,$0003 }π $CD/$10/ { int $10 }π $B8/$00/$12/ { mov AX,$1200 }π $B3/$30/ { mov BL,$30 }π $CD/$10); { int $10 }ππ procedure Lines350;π { Set 350 scanlines on VGA display }π InLine(π $B8/$03/$00/ { mov AX,$0003 }π $CD/$10/ { int $10 }π $B8/$01/$12/ { mov AX,$1201 }π $B3/$30/ { mov BL,$30 }π $CD/$10); { int $10 }ππ procedure Lines400;π { Set 400 scanlines on VGA display }π InLine(π $B8/$03/$00/ { mov AX,$0003 }π $CD/$10/ { int $10 }π $B8/$02/$12/ { mov AX,$1202 }π $B3/$30/ { mov BL,$30 }π $CD/$10); { int $10 }ππ procedure Font8x8;π { Set 8x8 CGA-font on VGA display. }π InLine(π $B8/$03/$00/ { mov AX,$0003 }π $CD/$10/ { int $10 }π $B8/$12/$11/ { mov AX,$1112 }π $B3/$00/ { mov BL,0 }π $CD/$10); { int $10 }ππ procedure Font8x14;π { Set 8x14 EGA-font on VGA display }π InLine(π $B8/$03/$00/ { mov AX,$0003 }π $CD/$10/ { int $10 }π $B8/$11/$11/ { mov AX,$1111 }π $B3/$00/ { mov BL,0 }π $CD/$10); { int $10 }ππ procedure Font8x16;π { Set 8x16 VGA-font on VGA display }π InLine(π $B8/$03/$00/ { mov AX,$0003 }π $CD/$10/ { int $10 }π $B8/$14/$11/ { mov AX,$1114 }π $B3/$00/ { mov BL,0 }π $CD/$10); { int $10 }πππbeginπ writeln('VGALines 3.0 (c) 1993 DwarFools & Consultancy' +π ', by drs. Robert E. Swart.'#13#10);π ASM { Detect VGA display }π mov AX,$0F00π int $10π cmp AL,$03 { TextMode = CO80 }π jne @Endπ mov AX,$1C00π mov CX,$0007π int $10π cmp AL,$1Cπ jne @Endπ mov VGAInside,True { VGA display installed }π @End:π end { VGA display };ππ Val(ParamStr(1),VGALines,i);ππ if not ((ParamCount >= 1) and VGAInside and (i = 0) andπ (VGALines in [12,14,21,25,28,43,50])) thenπ beginπ writeln('Usage: VGALines #Lines [test]'#13#10);π writeln('Where #Lines is any of [12,14,21,25,28,43,50]':52);π if not VGAInside thenπ writeln(#13#10'Error: VGA display required!');π Haltπ end;ππ case VGALines of { first set scan-lines }π 12,14: Lines200;π 21,43: Lines350;π else Lines400π end;ππ case VGALines of { then select the font }π 43,50: Font8x8;π 14,28: Font8x14;π else Font8x16π end;ππ if ParamCount > 1 then { test parameter is used }π beginπ for i:=0 to VGALines-1 do writeln(i);π write(VGALines,' lines set.')π endπend.π 102 05-25-9408:13ALL MIGUEL MARTINEX VGA Text Fonts SWAG9405 8 ÜdÜ▄ {π ▒ Hey.. AnyBody out there know how to change TEXT fonts w/ Pascal?π ▒ Any routines would be apprecited....ππYes, a friend of mine made a text font editor, a couple of years ago, but itπwould be too long to post it in this conference. You may use this routine toπset a 8x16 text font.ππYou should pass to this procedure an array of 4096 bytes. This array shouldπcontain the whole 256 character set, structured in blocks of 16 bytes forπeach char:ππ{------Cut Here------}ππUnit Fonts;ππInterfaceππType TextFont=Array[0..4095] of byte;ππProcedure ActivateFont(Block:Textfont);ππImplementationππProcedure ActivateFont; Assembler;πAsmπ push esπ mov ax,1100hπ mov bx,1000hπ mov cx,100hπ xor dx,dxπ push bpπ les bp,Blockπ int 10hπ pop bpπ pop esπEnd;ππBeginπEnd.ππ 103 05-25-9408:22ALL GREG ESTABROOKS ROM Font in $13 SWAG9405 21 Üdé {π The following does not use assembly but it should do what you want,π and should give you an idea about how its done incase you want toπ translate it to BASM later. It uses the ROM text font informationπ for its screen writes.ππ{***********************************************************************}πPROGRAM RomFontDemo; { May 08/94, Greg Estabrooks. }πVARπ Colors :BYTE;ππPROCEDURE SetVidMode( Mode :BYTE ); ASSEMBLER;π { Routine to set video mode }πASMπ Mov AH,00 { Function to set mode }π Mov AL,Mode { Mode to change to }π Int $10 { Call dos }πEND;{SetVidMode}ππPROCEDURE PutPixel( X,Y :WORD; Color :BYTE );πBEGINπ Mem[$A000:(320*Y)+X]:= Color;πEND;ππPROCEDURE WriteXY( X,Y :WORD; Color :BYTE; Str :STRING );πVARπ OldX :WORD; { Holds Original Column. }π OldY :WORD;π StrPos :BYTE; { Character pos in string to write. }π FontChr:BYTE; { ROM font info. }π FontPos:BYTE;π BitPos :BYTE;πBEGINπ OldY := Y; { Save Starting Row. }π FOR StrPos := 1 TO Length(Str) DOπ BEGIN { Loop through every character. }π OldX := X; { Save Current Column. }π Y := OldY; { Restore starting row. }π FOR FontPos := 0 TO 7 DOπ BEGIN { Scroll through all 8 BYTES of font. }π FontChr := MEM[$FFA6:$E+(ORD(Str[StrPos]) SHL 3) + FontPos];π FOR BitPos := 7 DOWNTO 0 DOπ BEGIN { Scroll through all 8 BITS of each BYTE.}π IF (FontChr AND (1 SHL BitPos)) <> 0 THENπ PutPixel(X,Y,Color); { IF bit is set then draw pixel. }π INC(X); { point to next column. }π END;π INC(Y); { point to next row. }π X := OldX; { Restore old column for next line. }π END;π X := X + 8; { Move 9 columns ahead. }π END;πEND;{WriteXY}ππBEGINπ SetVidMode($13);π FOR Colors := 1 TO 19 DOπ WriteXY(Colors*10,Colors*10,Colors,'Greg Estabrooks');π Readln;π SetVidMode($03);πEND.π{***********************************************************************}π 104 05-25-9408:24ALL IAN LIN 25 & 50 Line mode in ASM SWAG9405 4 ÜdÅ| {π SG> ok.. how do you switch from 50 line mode to 25 line mode in assembly,π SG> and vice versa? I've tried many ways, which crash every now and then...π}πTo 25 lines:ππUses crt;πbeginπtextmode(co80); {co80=3}πend.ππTo 50 lines:πprocedure vga50;πassembler;πasmπ mov ax,1202hπ mov bl,30hπ int 10hπ mov ax,3π int 10hπ mov ax,1112hπ mov bl,0π int 10hπend;πbeginπ vga50πend.ππ 105 05-25-9408:24ALL GARETH BRAID VGA Detection SWAG9405 8 Üdôä {πPF> Can anyone give me the source code for a vga detectionπPF> routine taht doesnt use the bgi driver. Thanks in advance PF> for yourπhelp.ππPF> Patrick FoxππTo detect a VGA card simply <g> call Interrupt 10h with ah set as 1Ah, if al isπnow 1A then there is a VGA present - otherwise it must be something else...ππi.e. ( regs is declared as of type registers from the DOS unit)π}ππbeginπ with regs doπ beginπ ah:=$1A;π al:=00;π intr ($10, regs);π If al=$1A then Writeln ('VGA Detected...'); {or whatever...}π end;πend.ππor in the built-in assembler something like this...ππFunction isVGA:Boolean; Assembler;ππasmπ mov AH, $1Aπ mov al, $00π Int $10π cmp al, $1Aπ jne @@NOVGABIOSπ mov al, 1π jmp @@EXITπ @@NOVGABIOS:π mov al, 0π @@EXIT:πend;π 106 05-25-9409:25ALL WIM VAN DER VEGT Linked in BGI files IMPORT 12 Üdèô {πHere's the recipe to get rid of missing BGI drivers!πππTo get EGAVGA.OBJ use the BINOBJ utility supplied with Turbo PascalπππBINOBJ EGAVGA.BGI EGAVGA EGAVGAπππTo use this unit just add it to your uses statement once and forgetπall about path's in Initgraph (use ''). The unit can be extended toπsupport additional drivers, like CGA.BGI. Read the GRAPH.DOC fileπon the TP disks.ππ-----------------------<cut hereππ{---------------------------------------------------------}π{ Project : Turbo EGAVGA Driver }π{ Auteur : G.W. van der Vegt }π{---------------------------------------------------------}π{ Datum .tijd Revisie }π{ 920301.1300 Creatie. }π{---------------------------------------------------------}ππUNIT Bgi_01;ππINTERFACEππUSESπ Graph;ππIMPLEMENTATIONππ{------------------------------------------------}π{----EGAVGA.BGI Driver }π{------------------------------------------------}ππPROCEDURE Egavga; External;ππ{$L Egavga.obj}ππBEGINπ IF RegisterBGIDriver(@Egavga)<0π THENπ BEGINπ Writeln('Error registering driver: ',π GraphErrorMsg(GraphResult));π Halt(1);π END;πEND.π 107 05-26-9406:15ALL FLORIAN ANSORGE Fading Unit IMPORT 18 ÜdtG UNIT FadeUnit; { This unit does some fading (I hope!) }π { The SetCol procedure lets you change individual}π { palette entries , for an easier way, try }π { the TP setrgbpalette procedure...}π { Regards Florian Ansorge :-) }πINTERFACEππProcedure InitCol; {gets the current palette and saves it}ππProcedure FadeOUT(Duration:Byte); { lowers/increases the brightness,}πProcedure FadeIN(Duration:Byte); { duration determines the time it takes}ππProcedure SetBrightness(Brightness :Byte);π {sets the brightness to brightness / 63 }πIMPLEMENTATIONππUSES Crt, Dos;ππCONST PelIdxR = $3c7; {Port to read}π PelIdxW = $3c8; {Port to write}π PelData = $3c9; {Dataport}π Maxreg = 255; {Set to 63 for textmode}π MaxInten = 63;ππVAR col : ARRAY[0..MaxReg] of RECORDπ r, g, b : Byteπ END;ππPROCEDURE GetCol(ColNr :Byte; var r, g, b :Byte);πBEGINπ Port[PelIdxR] := ColNr;π r := Port[PelData];π g := Port[PelData];π b := Port[PelData];;πEND;ππPROCEDURE SetCol(ColNr, r, g, b :Byte); {Change just one colour}πBEGINπ Port[PelIdxW] := ColNr;π Port[PelData] := r;π Port[PelData] := g;π Port[PelData] := b;πEND;ππPROCEDURE InitCol; {save initial palette}ππVAR i :Byte;ππBEGINπ FOR i := 0 to MaxReg DOπ GetCol(i,col[i].r,col[i].g,col[i].b);πEND;ππPROCEDURE SetBrightness(Brightness :Byte);ππVAR i :Byte;π fr, fg, fb :Byte;ππBEGINπ FOR i := 0 to MaxReg DOπ BEGINπ fr := col[i].r * Brightness DIV MaxInten;π fg := col[i].g * Brightness DIV MaxInten;π fb := col[i].b * Brightness DIV MaxInten;π SetCol(i,fr,fg,fb);π END;πEND;ππPROCEDURE FadeOUT(Duration :Byte);ππVAR i :Byte;ππBEGINπ FOR i := MaxInten downto 0 DOπ BEGINπ SetBrightness(i);π Delay(Duration);π END;πEND;ππPROCEDURE FadeIN(Duration :Byte);ππVAR i :Byte;ππBEGINπ FOR i := 0 to MaxInten DOπ BEGINπ SetBrightness(i);π Delay(Duration);π END;πEND;ππBEGINπEND.π 108 05-26-9406:20ALL ANDRES TARZIA 28 EGA/VGA Rows IMPORT 5 Üd≡ {πAG> Does anyone out there know how to set the screen display for 28 rows, inπAG> VGA mode? I've seen this in a couple of programs, and really like it.ππHere goes a small assembly routine to switch the screen to 28-line mode. }ππ MOV AX,1202 ;set up 400 scan linesπ MOV BL,30π INT 10π MOV AX,0003 ;set up normal text modeπ INT 10π MOV AX,1111 ;load ega character setπ MOV BL,00π INT 10ππ 109 08-24-9413:25ALL PAUL KAHLER Rotate 256x256 bitmap SWAG9408 ▌N∞Å 57 Üd {$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+,Y+}π{$M 16384,0,32786}πProgram BitMap; { rotates/pans/scales a 256x256 bitmap }πUSES CRT; { by Paul H. Kahler Jan 1994 }ππVar SinTable,CosTable: Array[0..255] of integer;π Sin2Table,Cos2Table: Array[0..255] of integer;π Map:word; {used as a pointer to the bitmap}ππProcedure MakeTables; {Creates sin/cos tables}πVar direction:integer;π angle:real;πbeginπ For Direction:=0 to 255 do begin {use 256 degrees in circle}π angle:=Direction;π angle:=angle*3.14159265/128;π SinTable[Direction]:=round(Sin(angle)*256);π CosTable[Direction]:=round(Cos(angle)*256);π Sin2Table[Direction]:=round(Sin(angle+3.14159265/2)*256*1.2);π Cos2Table[Direction]:=round(Cos(angle+3.14159265/2)*256*1.2);π end; { the 1.2 accounts for pixel aspect ratio }πend;ππProcedure DrawScreen(x,y,scale:word; rot:byte);πvar Temp:Longint; {used for intermediate large values}π ddx,ddy,d2x,d2y:integer;π i,j:word;π label hloop,vloop,nodraw;ππbeginπ{ the following 8 lines of code calculate a 'right' and 'down' vector usedπ for scanning the source bitmap. I use quotes because these directionsπ depend on the rotation. For example, with a rotation, 'right' could meanπ up and to the left while 'down' means up and to the right. Since theπ destination image (screen) is scanned left-right/top-bottom, the bitmapπ needs to be scanned in arbitrary directions to get a rotation. }ππ Temp:=(CosTable[rot]);Temp:=(Temp*Scale) div 256;π ddx:=Temp;π Temp:=(SinTable[rot]);Temp:=(Temp*Scale) div 256;π ddy:=Temp;ππ{ Different tables are used for the 'down' vector to account for the non-π square pixels in mode 13h (320x200). The 90 degree difference is builtπ into the tables. If you don't like that, then use (rot+64)and255 hereπ and take the pi/2 out of CreateTables. To each his own I guess. }ππ Temp:=(Cos2Table[rot]);Temp:=(Temp*SCALE) div 256;π d2x:=Temp;π Temp:=(Sin2Table[rot]);Temp:=(Temp*SCALE) div 256;π d2y:=Temp;ππ{ Since we want to rotate around the CENTER of the screen and not the upperπ left corner, we need to move 160 pixels 'left' and 100 'up' in the bitmap.}ππ i:=x-ddx*160-d2x*100; j:=y-ddy*160-d2y*100;ππ{ The following chunk of assembly does the good stuff. It redraws the entireπ screen by scanning left-right/top-bottom on screen while also scanning theπ bitmap in the arbitrary directions determined above. }ππ ASMπ push dsπ mov ax,[Map] {get segment of bitmap}π mov ds,axπ mov ax,$a000 {set es: to video memory}π mov es,axπ mov ax,0 {set ds: to upper left corner of}π mov di,ax {the video memory}π mov ax,[ddx] {this is just to speed things up later}π mov si,ax {add ax,si faster than add ax,[ddx] }π mov cx,200 {Number of rows on Screen}π vloop:π push cxπ mov ax,[i] {start scanning the source bitmap}π mov dx,[j] {at i,j which were calculated above.}π mov cx,320 {Number of coulumns on screen}π hloop:π add ax,si {add the 'right' vector to the current}π add dx,[ddy] {bitmap coordinates. 8.8 fixed point}π mov bl,ah { bx = 256*int(y)+int(x) }π mov bh,dhπ mov bl,[ds:bx] { load a pixel from source }π mov [es:di],bl { copy it to destination }π inc di { advance to next destination pixel }ππ {*** by repeating the above 7 instructions 5 times, and reducingπ the loop count to 64, I have hit 37fps on a 486-33 with aπ fast video card. ***}ππ loop hloop {End of horizontal loop}ππ mov ax,d2x { get the 'down' vector }π mov dx,d2yππ { add si,2 } {** uncomment this instr. for extra fun **}ππ add i,ax { i,j is the starting coords for a line }π add j,dx { so this moves down one line }π pop cx { get the row count back and loop }π loop vloop { End of verticle loop }π pop ds { Restore the ds }π end;πend;ππProcedure GraphMode; {start 320x200x256 mode}πbeginπ Asmπ Mov AH,00π Mov AL,13hπ Int 10hπ end;πend;ππProcedure AllocateMem; {returns a segment pointer for a 64K bitmap}πlabel noerror;πbeginπ asmπ mov ah,$48π mov bx,$1000 { request 64K }π int $21π jnc noerrorπ mov ax,0000π noerror: mov Map,ax { The segment pointer goes in Map }π end;π If Map=0 then beginπ Writeln('Could not allocate enough memory');π Writeln('Program ending...');π Halt;end;πend;ππProcedure GiveBackMem; {returns the memory used for the map to the system}πbeginπ asmπ mov ah,$49π mov dx,Mapπ mov es,dxπ int $21π end;πend;ππProcedure DrawImage; {draws a test image which shows some limitations.}ππ{ If anyone stuffs in code to load a picture in a standard formatπ (ie .gif .bmp etc..) I'd like if you send me a copy. Preferablyπ something simple. This will have to do for now. }ππVar x,y:integer;πBeginπ for x:=-32768 to 32767 do mem[Map:x]:=0;π for y:=0 to 15 do {this just frames the area}π for x:=y to 255 do beginπ mem[Map:Y*256+x]:=1;π mem[Map:X*256+y]:=2;π end;π for y:=16 to 47 do { this part show Aliasing effects }π for x:=16 to 255 do mem[Map:Y*256+x]:=2+(x and 1)+(y and 1);ππ for y:= -50 to 50 do { this draw the circles }π for x:= round(-sqrt(2500 - y*y)) to round(sqrt(2500 - y*y)) doπ mem[Map:(y+100)*256+x+100]:=5+(X*X+Y*Y) div 100;ππ for x:=0 to 100 do { These lines also show sampling effects }π for y:=0 to 8 doπ mem[Map:(Y*2560)+x+41100]:=5;πend;ππVar rot,dr:word;π x,y,dist,dd:word;ππBeginπ AllocateMem;π DrawImage;π MakeTables;π GraphMode;π x:=32768; y:=0; {this corresponds to (128,0) in fixed point}π rot:=0; dr:=1; {rotation angle and it's delta}π dist:=1200; dd:=65534; {distance to bitmap (sort of) and its delta}π repeatπ DrawScreen(x,y,dist,lo(rot));π rot:=rot+dr;π y:=y+128; {slow panning. 1/2 pixel per frame}π dist:=dist+dd;π if (dist=2000) or (dist=2) then dd:=-dd;π if random(150)=1 then dr:=random(7)-3;π until keypressed;π GiveBackMem;π ASM {back to 80x25}π MOV AX,3π INT 10hπ END;πend. 110 08-24-9413:25ALL JOSE CAMPIONE High intensity backgroundSWAG9408 i±{2 10 Üd {π The solutions proposed so far to this problem have ignoredπ the fact that there was a way to use high intensity back-π ground in CGA screens by direct addressing the video port.π The following procedure works with EGA/VGA as well as CGAπ (and possibly MDA?) videos:ππ (I skipped function GetAdapterType that should return theπ AdapterType as indicated).ππ -Jose-π }π procedure ToggleBlink(Blink: Boolean);π varπ Adapter : AdapterType;π regs : registers;π port_ : word;π beginπ Adapter:= GetAdapterType;π if Adapter in [CGA,MDA] then beginπ if Adapter = CGA then port_:= $03D8π else port_:= $03B8;π if not Blink then PortW[port_]:= MemW[$0040:$0065] and $00DFπ else PortW[port_]:= MemW[$0040:$0065] or $0020;π end elseπ if (Adapter in [VGAColor,EGAColor,VGAMono,EGAMono]) then beginπ if not Blink then regs.bl:= $00π else regs.bl:= $01;π regs.ah:= $10;π regs.al:= $03;π intr($10,regs);π end;π end;π 111 08-24-9413:26ALL BAS VAN GAALEN Set Border (BASM) SWAG9408 tf7 4 Üd { EM> Does anyone happen to know how to change the border color?}ππconst border:boolean=true;πprocedure setborder(col:byte); assembler;πasmπ xor ch,chπ mov cl,borderπ jcxz @outπ mov dx,3dahπ in al,dxπ mov dx,3c0hπ mov al,11h+32π out dx,alπ mov al,colπ out dx,alπ @out:πend;ππBEGINπSetBorder(1); { make it blue }πReadln;πSetBorder(0); { back to black }πEND. 112 08-24-9413:29ALL DAVID DAHL TEXTMODE COPPECOPPER2.PAS SWAG9408 ≤wO 95 Üd Program CopperExampleNo2;π{$G+} { Enable 286 Instructions }ππ{ }π{ Copper Example #2 }π{ Programmed by David Dahl }π{ }π{ THIS EXAMPLE RUNS IN TEXT MODE }π{ }π{ This is PUBLIC DOMAIN }π{ }πππ{ This Example Works FLAWLESSLY On My ET4000AX Based VGA Card. }π{ On My Friend's Trident, However, The Three Sinus Bars Have Snow }π{ Covering Their Leftmost Sides For About An Inch. This Is Due }π{ To The Double VGA DAC Set Required To Display Both The Sinus }π{ Bars And The Smooth Color Transitions Of The Large Text. }ππUses CRT;ππConst MaxRaster = 399;ππ Status1 = $3DA;π DACWrite = $3C8;π DACData = $3C9;ππType CopperRec = Recordπ Color : Byte;π Red : Byte;π Green : Byte;π Blue : Byte;π End;ππ CopperArray = Array [0..MaxRaster] of CopperRec;ππ BarArray = Array [0..19] of CopperRec;ππVar CopperList : CopperArray;ππ Bar : Array[0..2] of BarArray;π BarPos : Array[0..2] of Integer;ππ SinTab : Array[0..255] of Integer;ππ{-[ Build Sine Lookup Table ]----------------------------------------------}πProcedure MakeSinTab;πVar Counter : Integer;πBeginπ For Counter := 0 to 255 doπ SinTab[Counter] := 115 + Round(90 * Sin(Counter * PI / 128));πEnd;π{-[ Build Colors For Sinus Bars ]------------------------------------------}πProcedure MakeBars;πVar Counter : Integer;πBeginπ { Clear Colors }π FillChar (Bar, SizeOf(Bar), 0);ππ For Counter := 0 to 9 doπ Beginπ Bar[0][Counter].Red := Trunc(Counter * (63 / 9));π Bar[1][Counter].Green := Trunc(Counter * (63 / 9));π Bar[2][Counter].Blue := Trunc(Counter * (63 / 9));π If Odd(Counter)π Thenπ Beginπ Bar[0][Counter].Green := Trunc(Counter * (63 / 9));π Bar[1][Counter].Red := Trunc(Counter * (63 / 9));π Bar[1][Counter].Blue := Trunc(Counter * (63 / 9));π Bar[2][Counter].Green := Trunc(Counter * (63 / 9));π End;π End;π For Counter := 10 to 19 doπ Beginπ Bar[0][Counter].Red := Trunc((19-Counter) * (63 / 9));π Bar[1][Counter].Green := Trunc((19-Counter) * (63 / 9));π Bar[2][Counter].Blue := Trunc((19-Counter) * (63 / 9));π If Odd(Counter)π Thenπ Beginπ Bar[0][Counter].Green := Trunc((19-Counter) * (63 / 9));π Bar[1][Counter].Red := Trunc((19-Counter) * (63 / 9));π Bar[1][Counter].Blue := Trunc((19-Counter) * (63 / 9));π Bar[2][Counter].Green := Trunc((19-Counter) * (63 / 9));π End;π End;πEnd;π{-[ Make COPPER List ]-----------------------------------------------------}πProcedure MakeCopperList;πVar Counter1 : Integer;π Counter2 : Integer;πBeginπ { Clear List }π FillChar (CopperList, SizeOf(CopperList), 0);ππ { Make Transition From White To Yellow For }π { Color 1 On Scanlines 10 Through 250 }π For Counter1 := 10 to 250 doπ With CopperList[Counter1] doπ Beginπ Color := 1;π Red := 63;π Green := 63;π Blue := Round((250 - Counter1) * (63 / 200));π End;ππ { Make Transition From Black To Dark Blue For }π { Color 0 On Scanlines 254 Through 274 }π For Counter1 := 254 to 254 + 20 doπ With CopperList[Counter1] doπ Beginπ Color := 0;π Red := 0;π Green := 0;π Blue := Counter1 - 254;π End;π { Make Dark Blue Background (Color 0) For }π { Scanlines 275 Through 287 Except Scanline }π { 280 Which Is Yellow }π For Counter1 := 275 to 287 doπ With CopperList[Counter1] doπ Beginπ Color := 0;π Red := 0;π Green := 0;π If Counter1 = 280π Thenπ Beginπ Red := 45;π Green := 45;π Endπ Elseπ Blue := 20;π End;π { Make Dark Blue Background (Color 0) For }π { Scanlines 336 Through 394 Except Scanline }π { 343 Which Is Yellow }π For Counter1 := 336 to 349 doπ With CopperList[Counter1] doπ Beginπ Color := 0;π Red := 0;π Green := 0;π If Counter1 = 343π Thenπ Beginπ Red := 45;π Green := 45;π Endπ Elseπ Blue := 20;π End;π { Make Transition From Dark Blue To Black }π { For Background From Scanline 350 to 370 }π For Counter1 := 350 to 350 + 20 doπ With CopperList[Counter1] doπ Beginπ Color := 0;π Red := 0;π Green := 0;π Blue := (350 + 20 - Counter1);π End;ππ { Color Text Lines 18, 19, and 20 For Text Color 1 }π { As Red -> Yellow (L18), Purple -> White (L20) }π For Counter1 := 18 to 20 doπ For Counter2 := 0 to 15 doπ With CopperList[Counter2 + (Counter1 * 16)] doπ Beginπ Color := 1;π Red := 63;π Green := Trunc(Counter2 * (63 / 15));π Blue := ((Counter1 - 18) * 31) AND 63;π End;πEnd;π{-[ Center And Write A String As Solid Chars And Spaces ]------------------}πProcedure WSol (StringIn : String);πVar Counter : Integer;πBeginπ For Counter := 1 to (40 - (Length(StringIn) DIV 2)) doπ Write(#32);ππ For Counter := 1 to Length(StringIn) doπ If StringIn[Counter] <> #32π Thenπ Write (#219)π Elseπ Write (#32);ππ Writeln;πEnd;π{-[ Put Text On Screen ]---------------------------------------------------}πProcedure SetUpScreen;πBeginπ ClrScr;ππ GotoXY (1,5);π TextColor (1);π WSol(' #### #### ###### ###### ######## ###### ');π WSol(' ## ## ## ## ## ## ## ## ## ## ## ');π WSol('## ## ## ## ## ## ## ## ## ##');π WSol('## ## ## ## ## ## ## ##### ## ##');π WSol('## ## ## ## ## ## ## ## ## ## ');π WSol('## ## ## ###### ###### ## ###### ');π WSol(' ## ## ## ## ## ## ## ## ## ');π WSol(' #### #### ## ## ######## ## ##');π GotoXY(21, 19);π Writeln('Textmode COPPER Example #2 by David Dahl');π GotoXY(27, 21);π Writeln('This Program is Public Domain');πEnd;π{-[ Update COPPER ]--------------------------------------------------------}πProcedure UpdateCopper;πVar Raster : Word;π DrawBar : Integer;π BarNum : Integer;π BarCounter : Integer;πBeginπ Raster := 1;ππ DrawBar := -1;π BarNum := 0;ππ Inc(BarPos[0],1);π Inc(BarPos[1],1);π Inc(BarPos[2],1);ππ { Sorry For All The Assembly Here, But Plain Vanilla Pascal }π { Just Isn't Fast Enough To Properly Display BOTH Sinus Bars }π { And The Color Transitions For The Large Text. }π ASMπ PUSH DSπ MOV AX, SEG @Dataπ MOV DS, AXπ CLIππ { Wait For End Of Vertical Retrace }π MOV DX, Status1π @NotVert:π IN AL, DXπ AND AL, 8π JNZ @NotVertπ @IsVert:π IN AL, DXπ AND AL, 8π JZ @IsVertπππ @DrawAllBarsLoop:π {--- Check For Bars ---}π MOV CX, 3π @BarRasterCompare:ππ { Calculate Location of Bar (Start Line Placed In AX) }π MOV BX, CXπ DEC BXπ SHL BX, 1π MOV BX, word(BarPos[BX])π AND BX, 255π SHL BX, 1π MOV AX, word(SinTab[BX])ππ { Check If A Bar Is On Current Raster }π CMP AX, Rasterπ JNS @BarNotDisplayedπ MOV BX, AXπ ADD AX, 20π CMP Raster, AXπ JNS @BarNotDisplayedππ { Bar Is On Raster So Mark It }π SUB BX, Rasterπ XOR AX, AXπ SUB AX, BXππ MOV word(DrawBar), AXπ MOV word(BarNum), CXπ DEC word(BarNum)ππ @BarNotDisplayed:π @DoneChecking:π LOOP @BarRasterCompareππ {--- Draw Bars ---}π MOV BX, DrawBarπ OR BX, BXπ JL @NoDrawBarππ { Build Index To Bar Color Table }π SHL BX, 2ππ MOV AX, word(BarNum)π MOV CX, AXπ SHL AX, 6π SHL CX, 4π ADD AX, CXπ ADD BX, AXππ { Set Up Next Scan Line Color }π MOV DX, DACWRITEπ XOR AX, AXπ OUT DX, ALππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(Bar[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(Bar[BX])π OUT DX, ALππ { Wait For End of Horiz Retrace }π MOV DX, Status1π @NotHoriz1:π IN AL, DXπ AND AL, 1π JNZ @NotHoriz1π @IsHoriz1:π IN AL, DXπ AND AL, 1π JZ @IsHoriz1ππ { Send Last Byte Of DAC Reg So Color Is Updated }π MOV DX, DACDATAπ INC BXπ MOV AL, byte(Bar[BX])π OUT DX, ALππ { Update Color From Copper Table }π MOV DX, DACWRITEπ MOV BX, Rasterπ SHL BX, 2π MOV AL, Byte(CopperList[BX])π OUT DX, ALππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ JMP @Doneππ @NoDrawBar:π { Update Color }π MOV DX, DACWRITEπ MOV BX, Rasterπ SHL BX, 2π MOV AL, Byte(CopperList[BX])π OUT DX, ALππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ { Wait For End of Horiz Retrace }π MOV DX, Status1π @NotHoriz2:π IN AL, DXπ AND AL, 1π JNZ @NotHoriz2π @IsHoriz2:π IN AL, DXπ AND AL, 1π JZ @IsHoriz2ππ { Update Last }π MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ @Done:ππ INC Word(Raster)ππ { If Raster <= 250 Then Loop }π CMP Word(Raster), 250π JLE @DrawAllBarsLoopππ {--- Color Background And Text At Bottom of Screen ---}π @TextColorLoop:π MOV DX, DACWRITEπ MOV BX, Rasterπ SHL BX, 2π MOV AL, Byte(CopperList[BX])π OUT DX, ALππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ MOV DX, Status1π @NotHoriz3:π IN AL, DXπ AND AL, 1π JNZ @NotHoriz3π @IsHoriz3:π IN AL, DXπ AND AL, 1π JZ @IsHoriz3ππ MOV DX, DACDATAπ INC BXπ MOV AL, Byte(CopperList[BX])π OUT DX, ALππ INC Word(Raster)π CMP Word(Raster), MaxRasterπ JLE @TextColorLoopπ STIπ POP DSπ END;πEnd;π{=[ Main Program ]=========================================================}πVar Key : Char;πBeginπ TextMode (C80);π MakeSinTab;π MakeCopperList;π MakeBars;π SetUpScreen;π BarPos[0] := 30;π BarPos[1] := 15;π BarPos[2] := 0;π Repeatπ UpdateCopper;π Until Keypressed;π While Keypressed doπ Key := ReadKey;π TextMode (C80);πEnd.ππ 113 08-24-9413:29ALL YVES HETZER Cube SWAG9408 ▌τt┴ 102 Üd program cube; { Author: Yves Hetzer 2:248/1003.8 }πuses crt; { Erfurt, Germany }ππconst gCrtc = $3d4; gScreensize = 400*80;π gscreenPage0 = $0000; gScreenpage1 = gscreensize;π gscreensegment = $0a000; gscrwidth = 80; scal= 20;π sintab : array[0..90] of byte = (0,4,9,13,18,22,27,31,36,40,44,49,53,58,62,66,71,75,79,83,88,π 92,96,100,104,108,112,116,120,124,128,132,136,139,143,147,150,154,158,161,165,π 168,171,175,178,181,184,187,190,193,196,199,202,204,207,210,212,215,217,219,222,π 224,226,228,230,232,234,236,237,239,241,242,243,245,246,247,248,249,250,251,252,π 253,254,254,254,255,255,255,255,255,255);ππtype tupel = recordπ x,y,z : integer;π end;π rtupel = recordπ x,y,z : real;π end;π PointType = recordπ X, Y : integer;π end;π bild_point = array[1..12] of rtupel;π kehrtab = array [1..10000] of real;ππconst pk : bild_point =((x:0;y:6;z:0),(x:2;y:2;z:2),(x:-2;y:2;z:2),π (x:2;y:2;z:-2),(x:-2;y:2;z:-2),(x:2;y:-2;z:2),(x:-2;y:-2;z:2),π (x:2;y:-2;z:-2),(x:-2;y:-2;z:-2),(x:0;y:-6;z:0),(x:6;y:0;z:0),π (x:-6;y:0;z:0));ππvar scrofs, hlength, scrmemoff,offs,gscreen : word;π bit_maske :byte;π rp : array[1..3,1..3] of real;π pd : bild_point;π u,v: array[1..12] of integer;π lauf,al,ga,f,leftb,rightb,upb,downb,help : integer;π eck : array [0..4] of pointtype;π kehrt:^kehrtab;π rmask,lmask:array [0..639] of byte;ππprocedure waitblank;πassembler;πasm;πmov dx,gCRTC+6;@g_r: in al,dx;test al,8;jz @g_r;@g_d: in al,dx;πtest al,8;jnz @g_dπend;ππprocedure calcxy;πassembler;πasm;π mov cx,ax;mov ax,80;mul bx;mov dx,0a000h;push dx;mov dx,ax;π mov ax,cx;shr ax,1;shr ax,1;shr ax,1;add dx,ax;mov di,dx;π and cl,7;mov dl,80h;shr dl,cl;pop es;mov ax,gscreen;add di,ax;π mov ds:[offs], di;mov ds:[bit_maske],dlπend;ππprocedure set_dot(x,y,farbe : word);πassembler;πasm;π mov ax,x;mov bx,y;mov cx,farbe;call calcxy;mov ah,bit_maske;π mov dx,3ceh;mov al,08h;out dx,ax;mov ax,0a000h;mov es,ax;π mov di,offs;mov cx,farbe;mov ch,[es:di];mov [es:di], cl;πend;ππprocedure graph_init;πassembler;πasm;π mov ax,0012h;int 10h;mov dx,3ceh;mov ax,0205h;out dx,ax;mov ax,1003h;π out dx,ax; end;ππPROCEDURE Draw(xA,yA,xB,yB,col:Integer); { DRAWALL.INC }πVARπ x,y,kriterium,dX,dY,stepX,stepY:Integer;πBEGINπ dX:=Abs(xB-xA);π dY:=Abs(yB-yA);π IF dX=0 THEN kriterium:=0 ELSE kriterium:=Round(-dX/2);π IF xB>xA THEN stepX:=1 ELSE stepX:=-1;π IF yB>yA THEN stepY:=1 ELSE stepY:=-1;π x:=xA;y:=yA;π set_dot(x,y,col);π WHILE Not ((x=xB) And (y=yB)) DOπ BEGINπ IF kriterium <0 THENπ BEGINπ x:=x+stepX; kriterium:=kriterium+dY;π END;π IF (kriterium>=0) And ( y<>yB) THENπ BEGINπ y:=y+stepY; kriterium:=kriterium-dX;π END;π set_dot(x,y,col);π END;πEND;ππprocedure hline(x1,x2:integer);πvar y : word;πBeginπ if x1>x2 then Begin help := x2;x2:=x1;x1:=help;end;π help := x1 shr 3;π scrofs := help + scrmemoff;π hlength := x2 shr 3 - help;π if hlength = 0 thenπ Beginπ port[$3cf] := lmask[x1] and rmask[x2];π inc (mem[$a000:scrofs]);π end elseπ if hlength > 1 thenπ Beginπ port[$3cf] := lmask[x1];π inc (mem[$a000:scrofs]);π port [$3cf] := $ff;π for lauf := 1 to hlength-1 do inc(mem[$a000:scrofs+lauf]);π port [$3cf] := rmask[x2];π inc (mem[$a000:scrofs+hlength]);π end elseπ Beginπ port [$3cf] := lmask [x1];π inc (mem[$a000:scrofs]);π port [$3cf] := rmask [x2];π inc (mem[$a000:scrofs+1]);π end;πend;ππprocedure fillfourangle(var x1,y1,x2,y2,x3,y3,x4,y4,ficol:integer);πvar ho1,ho2,ho3,ho4,ypos,start,ende,diff,counter1,counter2,polyho,π ya,ye,yr,yl,dy : integer;π stepx1,stepx2,stepx3,stepx4,links,rechts,xa,xe,xr,xl : longint;π sre,ore,sl,ol : word;π trapez,clip : boolean;π stepx : real;πprocedure height (var h : integer);πBeginπ if h = 0 then h := 1 else if h > 5000 then h := 5000;πend;πBeginπasm;mov dx,3ceh;mov ax,0005h;out dx,ax;mov ax,1003h;out dx,ax;end;π if ((x1<leftb) and (x2<leftb) and (x3<leftb) and (x4<leftb)) orπ ((x1>rightb) and (x2>rightb) and (x3>rightb) and (x4> rightb)) then exit;π clip := false;π if (x1<=leftb) or (x2<=leftb) or (x3<=leftb) or (x4<=leftb) orπ (x1>=rightb) or (x2 >= rightb) or (x3 >= rightb) or (x4>=rightb) then clip :=πtrue;π eck[1].x := x1;eck[2].x := x2;eck[3].x := x3;eck[4].x := x4;π eck[1].y := y1;eck[2].y := y2;eck[3].y := y3;eck[4].y := y4;π for start := 1 to 3 doπ for ende := 4 downto start doπ if eck[start].y > eck[ende].y then beginπ eck[0] := eck[start];π eck[start] := eck[ende];π eck[ende] := eck[0];π end;π polyho := eck[4].y-eck[1].y;π if (eck[1].y > downb) or (eck[4].y < upb) or (polyho < 1) then exit;π dy := eck[4].y - eck[1].y;π if dy = 0 then dy := 1;π if dy < 5000 then stepx := (eck[4].x-eck[1].x)*kehrt^[dy] elseπ stepx := (eck[4].x-eck[1].x)/dy;π xa := trunc ((eck[2].y-eck[1].y)*stepx+eck[1].x);π xe := trunc (eck[4].x-(eck[4].y-eck[3].y)*stepx);π if ((xa<eck[2].x)and(xe<eck[3].x)) or ((xa>eck[2].x) and (xe>eck[3].x))π then trapez := true else trapez := false;π xa := eck[1].x; xa := xa * 256;ya := eck[1].y; xe := eck[4].x;π xe := xe * 256; ye := eck[4].y;xl := eck[2].x; xl := xl * 256;π yl := eck[2].y; xr := eck[3].x;xr := xr * 256; yr := eck[3].y;πif not trapez thenπBeginπ ho1 := abs(yr-ya);ho2 := abs(ye-yr);height (ho1);height (ho2);π stepx1 := trunc((xr-xa)*kehrt^[ho1]);stepx2 := trunc((xe-xr)*kehrt^[ho2]);π ho4 := abs(yl-ya);ho3 := abs(ye-yl);height (ho4);height (ho3);π stepx4 := trunc((xl-xa)*kehrt^[ho4]);stepx3 := trunc((xe-xl)*kehrt^[ho3]);πend elseπBeginπ ho1 := abs(yl-ya);ho2 := abs(yr-yl);height (ho1);height (ho2);π stepx1 := trunc((xl-xa)*kehrt^[ho1]);stepx2 := trunc((xr-xl)*kehrt^[ho2]);π ho4 := abs(ye-ya);ho3 := abs(ye-yr);height (ho4);height (ho3);π stepx4 := trunc((xe-xa)*kehrt^[ho4]);stepx3 := trunc((xe-xr)*kehrt^[ho3]);πend;π port[$3ce] := 1; port[$3cf] := $0f;port[$3ce] := 0; port[$3cf]:=ficol;π port[$3ce] := 8;π links := xa; rechts := links; start := ya; ende := start + polyho - 1;π counter1:= 0; counter2 :=0;π if start < upb then Beginπ diff := upb - start;inc (start,diff);inc (counter1,diff);π if not trapez then Beginπ inc (counter2,diff);π if counter2<ho4 then inc (links,diff*stepx4)π else links := xl + (upb-yl)*stepx3;π if counter1<ho1 then inc(rechts,diff*stepx1)π else rechts := xr + (upb-yr)*stepx2;π end else Beginπ inc(links,diff*stepx4);π if counter1<ho1 then inc(rechts,diff*stepx1)π else Beginπ inc (counter2,diff-ho1);π if counter2 < ho2 then rechts := xl + (upb-yl)*stepx2π else rechts := xr + (upb-yr)*stepx3;π end;π end;π end;π scrmemoff := gscreen+start*gscrwidth;π if ende > downb then ende := downb;π sl := seg(links);ol := ofs(links)+1;sre := seg(rechts);ore := ofs(rechts)+1;π if not trapez thenπ beginπ for ypos := start to ende doπ beginπ if counter2< ho4 thenπ Beginπ inc(links,stepx4);inc(counter2);π end else inc(links,stepx3);π if counter1<ho1 thenπ beginπ inc(rechts,stepx1);inc(counter1);π end else inc (rechts,stepx2);π hline(memw[sl:ol],memw[sre:ore]);π inc(scrmemoff,gscrwidth);π end;π end elseπ beginπ for ypos := start to ende doπ beginπ inc(links,stepx4);π if counter1<ho1 thenπ beginπ inc(rechts,stepx1);inc(counter1);π end elseπ if counter2<ho2 thenπ beginπ inc(rechts,stepx2);inc(counter2);π end else inc(rechts,stepx3);π hline(memw[sl:ol],memw[sre:ore]);π inc(scrmemoff,gscrwidth);π end;π end;πport [$3cf] := $ff; port[$3ce] := 1;port [$3cf] := 0; port [$3ce] := 0;πport [$3cf] := 15;πend;ππprocedure setrgbpalette(i,r,g,b : byte);πbeginπasm;mov dx,3c8h;mov al,i;out dx,al;inc dx;mov al,r;out dx,ax;mov al,g;πout dx,al;mov al,b;out dx,al;end;end;ππfunction csin(winkel :integer): integer;πbeginπwhile winkel < 0 do winkel := winkel + 360;πwinkel := winkel mod 360;πif (winkel >= 0) and (winkel <= 90) then csin := sintab[winkel];πif (winkel > 90) and (winkel <= 180) then csin := sintab[180-winkel];πif (winkel > 180) and (winkel <= 270) then csin := -sintab[winkel-180];πif (winkel > 270) and (winkel <= 360) then csin := -sintab[360-winkel];πend;ππfunction ccos(winkel :integer): integer;πbeginπwinkel := winkel+ 90;πwhile winkel < 0 do winkel := winkel + 360;πwinkel := winkel mod 360;πccos := csin(winkel);πend;ππprocedure gstartaddr(addr : word);πassembler;πasm;πmov bx,addr;push ds;mov dx,gCRTC;mov ah,bh;mov al,0ch;out dx,ax;πmov ah,bl;mov al,0dh;out dx,ax;mov cx,0040h;mov ds,cx;πmov word ptr ds:[004eh],bx;pop ds;end;ππprocedure waehle_seite (seite : byte);πbeginπgscreen := seite * gscreensize;πend;ππprocedure zeige_seite(seite : byte);πvar adr : word;πbeginπ adr := seite * gscreensize;π gstartaddr (adr);πend;ππprocedure wechsel5;ππbeginπif gscreen = gscreenpage0 then beginπ zeige_seite(0); waehle_seite(1); endπ else beginπ zeige_seite(1); waehle_seite(0);π end;πend;ππprocedure gclear;πassembler;πasm;πmov ax,gscreensegment;mov es,ax;mov al,es:[0];mov di,gscreen;mov dx,3ceh;πmov ax,0205h;out dx,ax;mov ax,0003h;out dx,ax;mov ax,0ffffh;out dx,ax;πmov ax,$00;mov cx,gscreensize/2;rep stosw;mov dx,3ceh;mov ax,0205h;out dx,ax;πmov ax,1003h;out dx,ax;end;ππprocedure dreh_m;πvar x,y,u,v : real;πbeginπ x:=csin(ga)/256; y:=ccos(al)/256; u:=csin(al)/256; v:=ccos(ga)/256;π rp[1,1]:=v; rp[2,1]:=x; rp[3,1]:=0; rp[1,2]:=y*x; rp[2,2]:=y*v; rp[3,2]:=-u;π rp[1,3]:=u*x; rp[2,3]:=u*v; rp[3,3]:=y;end;ππprocedure dreh(var x:rtupel);πvar temp:rtupel;πbeginπ temp.x:=(x.x*rp[1,1]+x.y*rp[1,2]+x.z*rp[1,3]) * scal;π temp.y:=(x.x*rp[2,1]+x.y*rp[2,2]+x.z*rp[2,3])*scal;π temp.z:=(x.y*rp[3,2]+x.z*rp[3,3])*scal;π x:=temp;πend;ππprocedure zeichnen;πbeginπfor lauf := 1 to 12 do beginπu[lauf] := round(pd[lauf].x)+320;v[lauf] := round(pd[lauf].z)+200;end;ππdraw(u[1],v[1],u[2],v[2],1);draw(u[1],v[1],u[4],v[4],1);πdraw(u[1],v[1],u[3],v[3],1);draw(u[1],v[1],u[5],v[5],1);πdraw(u[2],v[2],u[3],v[3],1);draw(u[2],v[2],u[4],v[4],1);πdraw(u[3],v[3],u[5],v[5],1);draw(u[5],v[5],u[4],v[4],1);πdraw(u[6],v[6],u[7],v[7],1);draw(u[6],v[6],u[8],v[8],1);πdraw(u[7],v[7],u[9],v[9],1);draw(u[9],v[9],u[8],v[8],1);πdraw(u[2],v[2],u[6],v[6],1);draw(u[3],v[3],u[7],v[7],1);πdraw(u[4],v[4],u[8],v[8],1);draw(u[5],v[5],u[9],v[9],1);πdraw(u[10],v[10],u[6],v[6],1);draw(u[10],v[10],u[7],v[7],1);πdraw(u[10],v[10],u[8],v[8],1);draw(u[10],v[10],u[9],v[9],1);πdraw(u[11],v[11],u[6],v[6],1);draw(u[11],v[11],u[2],v[2],1);πdraw(u[11],v[11],u[8],v[8],1);draw(u[11],v[11],u[4],v[4],1);πdraw(u[12],v[12],u[3],v[3],1);draw(u[12],v[12],u[5],v[5],1);πdraw(u[12],v[12],u[7],v[7],1);draw(u[12],v[12],u[9],v[9],1); end;ππprocedure initkehrtaB;πvar a: word;πbegin new (kehrt); for a:= 1 to 10000 do kehrt^[a] := 1/a; end;ππprocedure initmasktab;πvar a,wert : word;πbeginπ for a:= 0 to 639 doπ beginπ lmask[a]:=$ff shr (a and 7);wert := $ff shl (7-(a and 7));π rmask[a] := lo(wert); end;end;ππprocedure gexit;πassembler; asm;push ax;xor ah,ah;mov al,3h;int 10h;pop ax;end;πππbeginπ graph_init;π setrgbpalette(1,63,0,0); setrgbpalette(2,0,42,0); setrgbpalette(3,10,63,10);π setrgbpalette(4,42,0,0); setrgbpalette(5,63,10,10);setrgbpalette(6,42,21,0);π setrgbpalette(7,42,42,42);π gscreen := 0; initkehrtab; initmasktab;π al := 0; ga := 0;leftb := 10;upb := 10;rightb := 600;downb := 400;π repeatπ dec(al,5);ga := ga + csin(al) div 25+csin(ga) div 50;pd := pk;π dreh_m;for lauf := 1 to 12 do dreh(pd[lauf]);π zeichnen;f := 2;π fillfourangle(u[1],v[1],u[4],v[4],u[5],v[5],u[1],v[1],f);π fillfourangle(u[1],v[1],u[2],v[2],u[3],v[3],u[1],v[1],f);π fillfourangle(u[1],v[1],u[5],v[5],u[3],v[3],u[1],v[1],f);π fillfourangle(u[1],v[1],u[2],v[2],u[4],v[4],u[1],v[1],f);f := 4;π fillfourangle(u[11],v[11],u[2],v[2],u[6],v[6],u[11],v[11],f);π fillfourangle(u[11],v[11],u[4],v[4],u[8],v[8],u[11],v[11],f);π fillfourangle(u[11],v[11],u[6],v[6],u[8],v[8],u[11],v[11],f);π fillfourangle(u[11],v[11],u[2],v[2],u[4],v[4],u[11],v[11],f);f := 2;π fillfourangle(u[10],v[10],u[8],v[8],u[9],v[9],u[10],v[10],f);π fillfourangle(u[10],v[10],u[6],v[6],u[7],v[7],u[10],v[10],f);π fillfourangle(u[10],v[10],u[9],v[9],u[7],v[7],u[10],v[10],f);π fillfourangle(u[10],v[10],u[6],v[6],u[8],v[8],u[10],v[10],f);f := 4;π fillfourangle(u[12],v[12],u[3],v[3],u[7],v[7],u[12],v[12],f);π fillfourangle(u[12],v[12],u[5],v[5],u[9],v[9],u[12],v[12],f);π fillfourangle(u[12],v[12],u[3],v[3],u[5],v[5],u[12],v[12],f);π fillfourangle(u[12],v[12],u[7],v[7],u[9],v[9],u[12],v[12],f);π wechsel5; waitblank; gclear;π until keypressed;πdispose(kehrt);gexit;end.π 114 08-24-9413:31ALL PATRICK ROBERTS Set Border Colors SWAG9408 ½# 11 Üd πprogram Demo_4_SWAG;πvarπ old_border : integer; { used in main body of program }π Rnd_border : integer;ππ(****************************************************************************)πprocedure Set_Border(color:byte); { Written by Pat Roberts 1994 }πbeginπ asmπ mov ah,10h { This subroutine sets the color value stored in the }π mov al,01h { overscan register of the current palette from the }π mov BH,Color { Bios thru int 10h . Assumes EGA\VGA }π int 10hπ end;πend;ππ(****************************************************************************)πfunction Get_Border:byte; { Written by Pat Roberts 1994 }πbeginπ asmπ mov ah,10h { This subroutine reads the color value stored in the }π mov al,08h { overscan register of the current palette from the }π int 10h { Bios thru int 10h. Assumes EGA\VGA }π mov @result,bH { result is byte(BL) not a integer(BX) }π end;πend;ππ(******************************Main******************************************)πbeginπ Randomize;π old_border := get_border;π writeln(' Old border color was ',old_border);π Rnd_border := ((random(7)+1));π set_border(rnd_border);π writeln(' Get_Border reports color ',get_border); readln; end.πend.π 115 08-24-9413:31ALL JASON KANE Loading FONT file SWAG9408 ┐╙J▓ 15 Üd {πRN> Hi! Does anyone know if it's possible to modify theπRN> characters in the ASCII chart using Pascal? The reason IπRN> want to do this is to define the upper ASCII charactersπRN> (128+) to implement the Cyrillic alphabet, for anπRN> application I'm developping (or will be developping if I canπRN> figure this out :-)))π}ππUnit Font;ππ{ AX = $1110 (ah = $11, al = $10)π BH = bytes per characterπ BL = block to load to. (use 0)π CX = number of character defined by tableπ DX = starting character valueπ ES = segment of the table (use Seg())π BP = offset of the table (use Ofs()) }πInterfaceππProcedure DoFont(Fname: String);ππImplementationππUses DOS;πType FontArray= Array[1..$1000] of Char;ππ FontFile= Recordπ Gfont_POINTS: Byte;π Gfont: FontArray;π End; {of record}πVAR FonF: File;π Tfont: FontFile;π ESr,BPr: Word;π{---------------------------------------------------------------------------}πProcedure DoFont(Fname: String);ππVAR R: Registers;ππBegin;πAssign (FonF,Fname+'.FON');πReset (FonF, SizeOf(FontFile));πBlockRead (FonF, Tfont, 1);πClose (FonF);πESr:= Seg(Tfont.Gfont);πBPr:= Ofs(Tfont.Gfont);πr.ax := $1110;πr.bh := Tfont.Gfont_Points; (* bytes per character *)πr.bl := 0; (* load to block 0 *)πr.cx := 256; (* 256 characters *)πr.dx := 0; (* start with character 0 *)πr.es := Seg(Tfont.Gfont); (* segment of table *)πr.bp := Ofs(Tfont.Gfont); (* offset of the table *)πintr($10, r);πEnd; {of procedure}ππEnd.π 116 08-24-9413:36ALL JUSTIN KING More Text Fading. SWAG9408 ╣fì~ 14 Üd { In Procdures FADEIN & FADEOUT, the (X) is the delay betweenπ screen darkenings. }ππ Unit Fade;π Interfaceππ Uses Crt;ππ Constπ PelAddrRgR = $3C7; π PelAddrRgW = $3C8; π PelDataReg = $3C9;ππ Typeπ RGB = Record π R, π G,π B : Byte;π End;π Color = Array [0..63] Of RGB; ππ Varπ Col : Color; πππ Procedure GetCol(C : Byte; Var R, G, B : Byte);π Procedure SetCol(C, R, G, B : Byte);π Procedure SetInten(B : Byte);π Procedure FadeIn (X:Integer);π Procedure FadeOut (X:Integer);ππ Implementationππ ππProcedure GetCol(C : Byte; Var R, G, B : Byte);πBeginπ Port[PelAddrRgR] := C;π R := Port[PelDataReg];π G := Port[PelDataReg];π B := Port[PelDataReg];πEnd;π πProcedure SetCol(C, R, G, B : Byte);πBeginπ Port[PelAddrRgW] := C;π Port[PelDataReg] := R;π Port[PelDataReg] := G;π Port[PelDataReg] := B;πEnd;ππProcedure SetInten(b : Byte);π Varπ I : Integer;π FR, FG, FB : Byte;π Beginπ For I:=0 To 63 Doπ Beginπ FR:=Col[I].R*B Div 63;π FG:=Col[I].G*B Div 63;π FB:=Col[I].B*B Div 63;π SetCol(I, FR, FG, FB);π End;π End;ππProcedure FadeIn (X:Integer);π Varπ Y:Integer; (* Y is the LCV *)π Beginπ For Y:=0 To 63 Doπ Beginπ SetInten(Y);π Delay(X);π End;π End;ππProcedure FadeOut (X:Integer);π Varπ Y:Integer; (* Y is the LCV *)π Beginπ For Y:=0 To 63 Doπ GetCol(Y, Col[Y].R, Col[Y].G, Col[Y].B);π For Y:=63 DownTo 0 Doπ Beginπ SetInten(Y);π Delay(X);π End;π End;πEnd.ππ 117 08-24-9413:36ALL DAVE JARVIS Text Screen Fading SWAG9408 ╒µ╩· 17 Üd {πI recently found out that you can adjust the colours regardless of whatπvideo mode you happen to be in. Play around with this program ...ππ------------------- 8< ------------------------------------π{ Simple little program to "fade" out text on the screen.ππ Feel free to play around with it ...ππ Doesn't fully work, but should give you a good idea. Note that it requiresπ a VGA (or better) graphics card. }ππUSES CRT;π πCONST π { Colour of DOS text. } π DOS_COLOUR = LIGHTGRAY; π πTYPE π PaletteType = RECORD π R, G, B : BYTE; π End; π πVAR π Colour, π ColourCnt : BYTE; π AllColours : ARRAY[ 0..63 ] OF PaletteType; π πBEGIN π FOR Colour := 0 TO 16 DO π Begin π TextColor( Colour ); π WriteLn( 'This is some text' );π End; π π { Read in all the colours of the palette into an array. } π FOR Colour := 0 TO 63 DO π Begin π { Indicate that the palette registers are going to be read } π Port[ $3C7 ] := 0; π π AllColours[ Colour ].R := Port[ $3C9 ]; π AllColours[ Colour ].G := Port[ $3C9 ]; π AllColours[ Colour ].B := Port[ $3C9 ]; π End; π π { Fade out any text that is on the screen. } π WHILE AllColours[ 61 ].B > 1 DO π FOR Colour := 0 TO 63 DO π Begin π Port[ $3C8 ] := Colour; π π IF AllColours[ Colour ].R > 0 THENπ DEC( AllColours[ Colour ].R ); π π IF AllColours[ Colour ].G > 0 THEN π DEC( AllColours[ Colour ].G ); π π IF AllColours[ Colour ].B > 0 THEN π DEC( AllColours[ Colour ].B ); π π Port[ $3C9 ] := AllColours[ Colour ].R; π Port[ $3C9 ] := AllColours[ Colour ].G; π Port[ $3C9 ] := AllColours[ Colour ].B; π π Delay( 10 ); π End; π π TextColor( DOS_COLOUR ); π π ClrScr; π WriteLn( 'Watch me fade back in ...' ); ππ FOR ColourCnt := 0 TO 42 DO π Begin π Port[ $3C8 ] := DOS_COLOUR; π π Port[ $3C9 ] := ColourCnt; π Port[ $3C9 ] := ColourCnt; π Port[ $3C9 ] := ColourCnt; π π Delay( 20 ); π End; πEND. π 118 08-24-9413:36ALL GRANT BEATTIE Fader in textmode SWAG9408 `° 16 Üd Unit FadeUnit; { called FadeUnit.Pas }ππ{ This unit does fading for text/graph modes }ππinterfaceππprocedure InitCol; { gets the current palette and saves it }πprocedure FadeOut(Duration : byte); { lowers/increases the brightness, }πprocedure FadeIn(Duration : byte); { duration determines the time it takes}πprocedure SetBrightness(Brightness : byte); { sets the brightness to brightnes}ππimplementationππuses Crt; { use Delay procedure from there }ππconstπPelIdxR = $3C7; { Port to read from }πPelIdxW = $3C8; { Port to write to }πPelData = $3C9; { Dataport }πMaxreg = 63; { Set to 255 for graphmode }πMaxInten = 63;ππtypeπTRGB = record R, G, B : byte end;ππvarπCol : array[0..MaxReg] of TRGB;πI : byte;ππProcedure GetCol(ColNr : byte; var R, G, B : byte); assembler;πAsmπMOV DX,PelIdxRπMOV AL,ColNrπOUT DX,ALπMOV DX,PelDataπLES SI,RπIN AL,DXπMOV BYTE PTR [ES:SI],ALπLES SI,GπIN AL,DXπMOV BYTE PTR [ES:SI],ALπLES SI,BπIN AL,DXπMOV BYTE PTR [ES:SI],ALπEnd; { GetCol }ππProcedure SetCol(ColNr, R, G, B : byte); assembler; { Change just one color }πAsmπMOV DX,PelIdxWπMOV AL,ColNrπOUT DX,ALπMOV DX,PelDataπMOV AL,RπOUT DX,ALπMOV AL,GπOUT DX,ALπMOV AL,BπOUT DX,ALπEnd; { SetCol }ππProcedure InitCol; { Save initial palette }πBeginπfor I := 0 to MaxReg do GetCol(I, Col[I].R, Col[I].G, Col[I].B)πEnd; { InitCol }ππProcedure SetBrightness;πBeginπfor I := 0 to MaxReg doπSetCol(I,πCol[I].R * Brightness div MaxInten,πCol[I].G * Brightness div MaxInten,πCol[I].B * Brightness div MaxInten)πEnd; { SetBrightness }ππProcedure FadeOut;πvar I : byte;πBeginπfor I := MaxInten downto 0 doπbeginπSetBrightness(I);πDelay(Duration)πendπEnd; { FadeOut }ππProcedure FadeIn;πvar I : byte;πBeginπfor I := 0 to MaxInten doπbeginπSetBrightness(I);πDelay(Duration)πendπEnd; { FadeIn }ππEnd. { FADEUNIT.PAS }π 119 08-24-9413:40ALL THIERRY DE LEEUW EGA/VGA Font Editor SWAG9408 m╫╝Θ 340 Üd π{..$define First} { disable to force loading of file }ππ{use this if you launch the program for the first time (you also may add aπcode to detect if the file already exiists but... normally, you should useπthis option once.}ππprogram GenSmallCar;π{CopyRight Thierry De Leeuw 1994}πuses crt, dos, graph;ππType TSmallCar = Array [0..8] of Byte;π PSmallCar = ^TSmallCar;ππvar SmallCar : Array[32..180] of PSmallCar;π Buffer : Array[0..7,0..8] of Char;π grDriver : Integer;π grMode : Integer;π ErrCode : Integer;π EnCours : Byte;ππProcedure ReserveMemoire;πvar i : byte;πbeginπ For i := 32 to 180 doπ beginπ New(SmallCar[i]);π end;πend;ππprocedure ChargeTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ {$Ifndef First}π Assign(Fichier, 'Small.FON');π Reset(Fichier);π {$Endif}π For i := 32 to 180 doπ beginπ for j := 0 to 8 doπ beginπ {$IFDEF First}π SmallCar[i]^[j] := 0;π {$Else}π readLn(Fichier, SmallCar[i]^[j]);π {$Endif}π end;π {$Ifndef First}π Readln(Fichier);π {$Endif}π end;π {$Ifndef First}π Close(Fichier);π {$endif}πend;ππfunction Analyse(Valeur: byte) : String;πvar Tmp : String[19];πbeginπ Tmp := ' ';π Analyse := Tmpπππend;ππProcedure Update(No : Byte);πvar i : byte;π j : byte;ππbeginπ ClrScr;π LowVideo;π GotoXY(22,1);π Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');π GotoXY(22,2);π Write('══════════════════════════════════');π gotoXY(30,4);π Write('╔═════════════════╗');π gotoXY(30,5);π Write('║ ║');π gotoXY(30,6);π Write('║ ║');π gotoXY(30,7);π Write('║ ║');π gotoXY(30,8);π Write('║ ║');π gotoXY(30,9);π Write('║ ║');π gotoXY(30,10);π Write('║ ║');π gotoXY(30,11);π Write('║ ║');π gotoXY(30,12);π Write('║ ║');π gotoXY(30,13);π Write('║ ║');π gotoXY(30,14);π Write('╚═════════════════╝');π For i := 0 to 8 doπ beginπ gotoXY(31,5+i);π For j := 0 to 7 doπ Write(' ' + Buffer[j,i]);π end;πend;ππProcedure Bufferize(No : Byte);πvar i : byte;πbeginπ for i := 0 to 8 doπ beginπ if SmallCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i]π:= '·';π if SmallCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i]π:= '·';π if SmallCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i]π:= '·';π if SmallCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i]π:= '·';π if SmallCar[No]^[i] and 16 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]π:= '·';π if SmallCar[No]^[i] and 32 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]π:= '·';π if SmallCar[No]^[i] and 64 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]π:= '·';π if SmallCar[No]^[i] and 128 <> 0 then Buffer[7,i] := '*' elseπBuffer[7,i] := '·';ππ end;πend;ππprocedure Encode(No : Byte);πvar i,j : byte;πbeginπ for i := 0 to 8 doπ beginπ SmallCar[No]^[i] := 0;π if Buffer[0,i] = '*' then SmallCar[No]^[i] := 1;π if Buffer[1,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 2;π if Buffer[2,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 4;π if Buffer[3,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 8;π if Buffer[4,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 16;π if Buffer[5,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 32;π if Buffer[6,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 64;π if Buffer[7,i] = '*' then SmallCar[No]^[i] := SmallCar[No]^[i] + 128;π end;πend;ππprocedure Preview;πvar i, j : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for i := 0 to 8 doπ beginπ for j := 0 to 7 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY divπ2,15);π end;π end;π readkey;π closeGraph;πend;ππprocedure PreviewAll;πvar i, j, k : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for k := 32 to 96 doπ beginπ Bufferize(k);π for i := 0 to 8 doπ beginπ for j := 0 to 7 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-32) * 9 ,i+GetMaxY divπ2-10,15);π end;π end;π end;π for k := 97 to 180 doπ beginπ Bufferize(k);π for i := 0 to 8 doπ beginπ for j := 0 to 7 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-97) * 9 ,i+GetMaxY divπ2+10,15);π end;π end;π end;π readkey;π closeGraph;πend;ππfunction Edit(No : byte) : Char;πvar x, y : byte;π car : Char;π Sortie : Boolean;π Go : byte;πbeginπ UpDate(No);π x := 0;π y := 0;π Sortie := false;ππ repeatπ GotoXY(32 + 2*x,5+y);π HighVideo;π Write(Buffer[x,y]);π GotoXY(32 + 2*x,5+y);π repeatπ until keypressed;π car := ReadKey;π GotoXY(32 + 2*x,5+y);π LowVideo;π Write(Buffer[x,y]);π if (car = 'q') or (car = 'Q') then car := #13;π if car = #0 then car := ReadKey;π case car ofπ '2',chr(80) : if y = 8 then y := 0 else inc(y);π '8',chr(72) : if y = 0 then y := 8 else dec(y);π '4',chr(75) : if x = 0 then x := 7 else dec(x);π '6',chr(77) : if x = 7 then x := 0 else inc(x);π ' ' : if Buffer[x,y] = '*' then Buffer[x,y] := '·' elseπBuffer[x,y] := '*';π #13, #81, #73 : Sortie := true;π #27 : Sortie := True;π 'G','g' : beginπ GotoXY(20,24);π Write('Aller à quel code ascii ? ');π Read(Go);π if (Go >= 32) and (go <= 180) thenπ beginπ Encode(No);π EnCours := Go -1;π Car := #81;π Sortie := true;π end;π GotoXY(1,24);π ClrEol;π end;ππ 'v' : beginπ Preview;π update(No);π end;π 'a' : beginπ Encode(No);π PreviewAll;π Bufferize(No);π Update(No);π end;π end;π until (sortie);π Encode(No);π Edit := Car;πend;ππprocedure EditeTable;πvar fin : boolean;π Car : char;π Car_Retour : char;πbeginπ fin := false;π Encours := 32;π repeatπ Bufferize(Encours);π Car_Retour := Edit(EnCours);π case car_Retour ofπ #13 : beginπ gotoXY(20,24);π Write('Quitter ? ');π Car := UpCase(readKey);π GotoXY(1,24);π ClrEol;π if Car = 'O' then Fin := true;π end;π #81 : beginπ if EnCours = 180 then Encours := 32 else inc(EnCours);π end;π #73 : beginπ if EnCours = 32 then Encours := 180 else dec(EnCours);π end;π #27 : beginπ gotoXY(20,24);π Write('Abandon des modifications ? ');π Car := UpCase(readKey);π GotoXY(1,24);π ClrEol;π if Car = 'O' then Halt(0);π end;π end;π until fin;πend;ππprocedure SauveTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ Assign(Fichier, 'Small.FON');π Rewrite(Fichier);π For i := 32 to 180 doπ beginπ for j := 0 to 8 doπ beginπ writeLn(Fichier, SmallCar[i]^[j]);π end;π WriteLn(Fichier);π end;π Close(Fichier);πend;ππbeginπ DetectGraph(GrDriver, GrMode);π InitGraph(grDriver, grMode,'\turbo\tp\');π ErrCode := GraphResult;π if ErrCode <> grOk thenπ beginπ Writeln('Graphics error:', GraphErrorMsg(ErrCode));π Halt(255);π end;π CloseGraph;πππ NormVideo;π ReserveMemoire;π ChargeTable;π EditeTable;π SauveTable;πend.ππ{$define}π{same remark as above}ππprogram GenMidCar;π{CopyRight Thierry De Leeuw 1994}πuses crt, dos, graph;ππType TMidCar = Array [0..18] of Word;π PMidCar = ^TMidCar;ππvar MidCar : Array[32..180] of PMidCar;π Buffer : Array[0..15,0..18] of Char;π grDriver : Integer;π grMode : Integer;π ErrCode : Integer;π EnCours : Byte;ππProcedure ReserveMemoire;πvar i : byte;πbeginπ For i := 32 to 180 doπ beginπ New(MidCar[i]);π end;πend;ππprocedure ChargeTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ {$Ifndef First}π Assign(Fichier, 'Mid.FON');π Reset(Fichier);π {$Endif}π For i := 32 to 180 doπ beginπ for j := 0 to 18 doπ beginπ {$IFDEF First}π MidCar[i]^[j] := 0;π {$Else}π readLn(Fichier, MidCar[i]^[j]);π {$Endif}π end;π {$Ifndef First}π Readln(Fichier);π {$Endif}π end;π {$Ifndef First}π Close(Fichier);π {$endif}πend;ππfunction Analyse(Valeur: byte) : String;πvar Tmp : String[19];πbeginπ Tmp := ' ';π Analyse := Tmpπππend;ππProcedure Update(No : Byte);πvar i : byte;π j : byte;ππbeginπ ClrScr;π LowVideo;π GotoXY(22,1);π Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');π GotoXY(22,2);π Write('══════════════════════════════════');π gotoXY(20,4);π Write('╔═════════════════════════════════╗');π gotoXY(20,5);π Write('║ ║');π gotoXY(20,6);π Write('║ ║');π gotoXY(20,7);π Write('║ ║');π gotoXY(20,8);π Write('║ ║');π gotoXY(20,9);π Write('║ ║');π gotoXY(20,10);π Write('║ ║');π gotoXY(20,11);π Write('║ ║');π gotoXY(20,12);π Write('║ ║');π gotoXY(20,13);π Write('║ ║');π gotoXY(20,14);π Write('║ ║');π gotoXY(20,15);π Write('║ ║');π gotoXY(20,16);π Write('║ ║');π gotoXY(20,17);π Write('║ ║');π gotoXY(20,18);π Write('║ ║');π gotoXY(20,19);π Write('║ ║');π gotoXY(20,20);π Write('║ ║');π gotoXY(20,21);π Write('║ ║');π gotoXY(20,22);π Write('║ ║');π gotoXY(20,23);π Write('║ ║');π gotoXY(20,24);π Write('╚═════════════════════════════════╝');π For i := 0 to 18 doπ beginπ gotoXY(21,5+i);π For j := 0 to 15 doπ Write(' ' + Buffer[j,i]);π end;πend;ππProcedure Bufferize(No : Byte);πvar i : byte;πbeginπ for i := 0 to 18 doπ beginπ if MidCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i] :=π'·';π if MidCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i] :=π'·';π if MidCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i] :=π'·';π if MidCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i] :=π'·';π if MidCar[No]^[i] and 16 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]π:= '·';π if MidCar[No]^[i] and 32 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]π:= '·';π if MidCar[No]^[i] and 64 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]π:= '·';π if MidCar[No]^[i] and 128 <> 0 then Buffer[7,i] := '*' else Buffer[7,i]π:= '·';π if MidCar[No]^[i] and 256 <> 0 then Buffer[8,i] := '*' else Buffer[8,i]π:= '·';π if MidCar[No]^[i] and 512 <> 0 then Buffer[9,i] := '*' else Buffer[9,i]π:= '·';π if MidCar[No]^[i] and 1024 <> 0 then Buffer[10,i] := '*' elseπBuffer[10,i] := '·';π if MidCar[No]^[i] and 2048 <> 0 then Buffer[11,i] := '*' elseπBuffer[11,i] := '·';π if MidCar[No]^[i] and 4096 <> 0 then Buffer[12,i] := '*' elseπBuffer[12,i] := '·';π if MidCar[No]^[i] and 8192 <> 0 then Buffer[13,i] := '*' elseπBuffer[13,i] := '·';π if MidCar[No]^[i] and 16384 <> 0 then Buffer[14,i] := '*' elseπBuffer[14,i] := '·';π if MidCar[No]^[i] and 32768 <> 0 then Buffer[15,i] := '*' elseπBuffer[15,i] := '·';ππ end;πend;ππprocedure Encode(No : Byte);πvar i,j : byte;πbeginπ for i := 0 to 18 doπ beginπ MidCar[No]^[i] := 0;π if Buffer[0,i] = '*' then MidCar[No]^[i] := 1;π if Buffer[1,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 2;π if Buffer[2,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 4;π if Buffer[3,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 8;π if Buffer[4,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 16;π if Buffer[5,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 32;π if Buffer[6,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 64;π if Buffer[7,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 128;π if Buffer[8,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 256;π if Buffer[9,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 512;π if Buffer[10,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 1024;π if Buffer[11,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 2048;π if Buffer[12,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 4096;π if Buffer[13,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 8192;π if Buffer[14,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 16384;π if Buffer[15,i] = '*' then MidCar[No]^[i] := MidCar[No]^[i] + 32768;π end;πend;ππprocedure Preview;πvar i, j : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY divπ2,15);π end;π end;π readkey;π closeGraph;πend;ππprocedure PreviewAll;πvar i, j, k : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for k := 32 to 64 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-32) * 18 ,i+GetMaxY divπ2-20,15);π end;π end;π end;π for k := 65 to 96 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-65) * 18 ,i+GetMaxY divπ2+10,15);π end;π end;π end;π for k := 97 to 127 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-97) * 18 ,i+GetMaxY divπ2+30,15);π end;π end;π end;π for k := 128 to 155 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-128) * 18 ,i+GetMaxY divπ2+50,15);π end;π end;π end;π for k := 156 to 180 doπ beginπ Bufferize(k);π for i := 0 to 18 doπ beginπ for j := 0 to 15 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-156) * 18 ,i+GetMaxY divπ2+70,15);π end;π end;π end;π readkey;π closeGraph;πend;ππfunction Edit(No : byte) : Char;πvar x, y : byte;π car : Char;π Sortie : Boolean;π Go : byte;π CaracTempo : char;πbeginπ UpDate(No);π x := 0;π y := 0;π Sortie := false;ππ repeatπ GotoXY(22 + 2*x,5+y);π HighVideo;π Write(Buffer[x,y]);π GotoXY(22 + 2*x,5+y);π repeatπ until keypressed;π car := ReadKey;π GotoXY(22 + 2*x,5+y);π LowVideo;π Write(Buffer[x,y]);π if (car = 'q') or (car = 'Q') then car := #13;π if car = #0 then car := ReadKey;π case car ofπ '2',chr(80) : if y = 18 then y := 0 else inc(y);π '8',chr(72) : if y = 0 then y := 18 else dec(y);π '4',chr(75) : if x = 0 then x := 15 else dec(x);π '6',chr(77) : if x = 15 then x := 0 else inc(x);π ' ' : if Buffer[x,y] = '*' then Buffer[x,y] := '·' elseπBuffer[x,y] := '*';π #13, #81, #73 : Sortie := true;π #27 : Sortie := True;π 'G','g' : beginπ GotoXY(20,24);π Write('Aller à quel code ascii ? ');π Read(Go);π if (Go >= 32) and (go <= 180) thenπ beginπ Encode(No);π EnCours := Go -1;π Car := #81;π Sortie := true;π end;π GotoXY(1,24);π ClrEol;π end;ππ 'v', 'V' : beginπ Preview;π update(No);π end;π 'a', 'A' : beginπ Encode(No);π PreviewAll;π Bufferize(No);π Update(No);π end;π 'c', 'C' : beginπ gotoXY(20,24);π Write('Copier quel caractère ? ');π CaracTempo := ReadKey;π if CaracTempo <> #13 thenπ beginπ Bufferize(ord(CaracTempo));π UpDate(EnCOurs);π end;π GotoXY(20,24);π ClrEol;π end;π end;π until (sortie);π Encode(No);π Edit := Car;πend;ππprocedure EditeTable;πvar fin : boolean;π Car : char;π Car_Retour : char;πbeginπ fin := false;π Encours := 32;π repeatπ Bufferize(Encours);π Car_Retour := Edit(EnCours);π case car_Retour ofπ #13 : beginπ gotoXY(20,24);π Write('Quitter ? ');π Car := UpCase(readKey);π GotoXY(1,24);π ClrEol;π if Car = 'O' then Fin := true;π end;π #81 : beginπ if EnCours = 180 then Encours := 32 else inc(EnCours);π end;π #73 : beginπ if EnCours = 32 then Encours := 180 else dec(EnCours);π end;π #27 : beginπ gotoXY(20,24);π Write('Abandon des modifications ? ');π Car := UpCase(readKey);π GotoXY(1,24);π ClrEol;π if Car = 'O' then Halt(0);π end;π end;π until fin;πend;ππprocedure SauveTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ Assign(Fichier, 'Mid.FON');π Rewrite(Fichier);π For i := 32 to 180 doπ beginπ for j := 0 to 18 doπ beginπ writeLn(Fichier, MidCar[i]^[j]);π end;π WriteLn(Fichier);π end;π Close(Fichier);πend;ππbeginπ DetectGraph(GrDriver, GrMode);π InitGraph(grDriver, grMode,'\turbo\tp\');π ErrCode := GraphResult;π if ErrCode <> grOk thenπ beginπ Writeln('Graphics error:', GraphErrorMsg(ErrCode));π Halt(255);π end;π CloseGraph;πππ NormVideo;π ReserveMemoire;π ChargeTable;π EditeTable;π SauveTable;πend.ππ{$define}π{same remark as above}πprogram GenMidCar;ππ{CopyRight Thierry De Leeuw 1994}ππuses crt, dos, graph;ππType TBigCar = Array [0..36] of LongInt;π PBigCar = ^TBigCar;π TEtat = (Move, delete, trace);ππvar BigCar : Array[32..180] of PBigCar;π Buffer : Array[0..31,0..36] of Char;π grDriver : Integer;π grMode : Integer;π ErrCode : Integer;π EnCours : Byte;π Etat : TEtat;ππProcedure ReserveMemoire;πvar i : byte;πbeginπ For i := 32 to 180 doπ beginπ New(BigCar[i]);π end;πend;ππprocedure ChargeTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ {$Ifndef First}π Assign(Fichier, 'Big.FON');π Reset(Fichier);π {$Endif}π For i := 32 to 180 doπ beginπ for j := 0 to 36 doπ beginπ {$IFDEF First}π BigCar[i]^[j] := 0;π {$Else}π readLn(Fichier, BigCar[i]^[j]);π {$Endif}π end;π {$Ifndef First}π Readln(Fichier);π {$Endif}π end;π {$Ifndef First}π Close(Fichier);π {$endif}πend;ππfunction Analyse(Valeur: byte) : String;πvar Tmp : String[19];πbeginπ Tmp := ' ';π Analyse := Tmpπend;ππProcedure Update(No : Byte);πvar i : byte;π j : byte;ππbeginπ ClrScr;π textMode(258);π LowVideo;π GotoXY(1,1);π if etat = move then write('Move')π elseπ if etat = delete then write('Delete')π elseπ if etat = trace then write('Trace');π GotoXY(22,1);π Write('Edition du caractère n° ',No:3,' - "',Chr(No),'".');π GotoXY(22,2);π Write('══════════════════════════════════');π gotoXY(2,4);πWrite('╔══════════════════════════════════════════════════════════════════╗');π gotoXY(2,5);π Write('║ ║');π gotoXY(2,6);π Write('║ ║');π gotoXY(2,7);π Write('║ ║');π gotoXY(2,8);π Write('║ ║');π gotoXY(2,9);π Write('║ ║');π gotoXY(2,10);π Write('║ ║');π gotoXY(2,11);π Write('║ ║');π gotoXY(2,12);π Write('║ ║');π gotoXY(2,13);π Write('║ ║');π gotoXY(2,14);π Write('║ ║');π gotoXY(2,15);π Write('║ ║');π gotoXY(2,16);π Write('║ ║');π gotoXY(2,17);π Write('║ ║');π gotoXY(2,18);π Write('║ ║');π gotoXY(2,19);π Write('║ ║');π gotoXY(2,20);π Write('║ ║');π gotoXY(2,21);π Write('║ ║');π gotoXY(2,22);π Write('║ ║');π gotoXY(2,23);π Write('║ ║');π gotoXY(2,24);π Write('║ ║');π gotoXY(2,25);π Write('║ ║');π gotoXY(2,26);π Write('║ ║');π gotoXY(2,27);π Write('║ ║');π gotoXY(2,28);π Write('║ ║');π gotoXY(2,29);π Write('║ ║');π gotoXY(2,30);π Write('║ ║');π gotoXY(2,31);π Write('║ ║');π gotoXY(2,32);π Write('║ ║');π gotoXY(2,33);π Write('║ ║');π gotoXY(2,34);π Write('║ ║');π gotoXY(2,35);π Write('║ ║');π gotoXY(2,36);π Write('║ ║');π gotoXY(2,37);π Write('║ ║');π gotoXY(2,38);π Write('║ ║');π gotoXY(2,39);π Write('║ ║');π gotoXY(2,40);π Write('║ ║');π gotoXY(2,41);π Write('║ ║');π gotoXY(2,42);π Write('║ ║');π gotoXY(2,43);πWrite('╚══════════════════════════════════════════════════════════════════╝');π For i := 0 to 36 doπ beginπ gotoXY(3,5+i);π For j := 0 to 31 doπ Write(' ' + Buffer[j,i]);π end;πend;ππProcedure Bufferize(No : Byte);πvar i : byte;πbeginπ for i := 0 to 36 doπ beginπ if BigCar[No]^[i] and 1 <> 0 then Buffer[0,i] := '*' else Buffer[0,i] :=π'·';π if BigCar[No]^[i] and 2 <> 0 then Buffer[1,i] := '*' else Buffer[1,i] :=π'·';π if BigCar[No]^[i] and 4 <> 0 then Buffer[2,i] := '*' else Buffer[2,i] :=π'·';π if BigCar[No]^[i] and 8 <> 0 then Buffer[3,i] := '*' else Buffer[3,i] :=π'·';π if BigCar[No]^[i] and $10 <> 0 then Buffer[4,i] := '*' else Buffer[4,i]π:= '·';π if BigCar[No]^[i] and $20 <> 0 then Buffer[5,i] := '*' else Buffer[5,i]π:= '·';π if BigCar[No]^[i] and $40 <> 0 then Buffer[6,i] := '*' else Buffer[6,i]π:= '·';π if BigCar[No]^[i] and $80 <> 0 then Buffer[7,i] := '*' else Buffer[7,i]π:= '·';π if BigCar[No]^[i] and $100 <> 0 then Buffer[8,i] := '*' else Buffer[8,i]π:= '·';π if BigCar[No]^[i] and $200 <> 0 then Buffer[9,i] := '*' else Buffer[9,i]π:= '·';π if BigCar[No]^[i] and $400 <> 0 then Buffer[10,i] := '*' elseπBuffer[10,i] := '·';π if BigCar[No]^[i] and $800 <> 0 then Buffer[11,i] := '*' elseπBuffer[11,i] := '·';π if BigCar[No]^[i] and $1000 <> 0 then Buffer[12,i] := '*' elseπBuffer[12,i] := '·';π if BigCar[No]^[i] and $2000 <> 0 then Buffer[13,i] := '*' elseπBuffer[13,i] := '·';π if BigCar[No]^[i] and $4000 <> 0 then Buffer[14,i] := '*' elseπBuffer[14,i] := '·';π if BigCar[No]^[i] and $8000 <> 0 then Buffer[15,i] := '*' elseπBuffer[15,i] := '·';π if BigCar[No]^[i] and $10000 <> 0 then Buffer[16,i] := '*' elseπBuffer[16,i] := '·';π if BigCar[No]^[i] and $20000 <> 0 then Buffer[17,i] := '*' elseπBuffer[17,i] := '·';π if BigCar[No]^[i] and $40000 <> 0 then Buffer[18,i] := '*' elseπBuffer[18,i] := '·';π if BigCar[No]^[i] and $80000 <> 0 then Buffer[19,i] := '*' elseπBuffer[19,i] := '·';π if BigCar[No]^[i] and $100000 <> 0 then Buffer[20,i] := '*' elseπBuffer[20,i] := '·';π if BigCar[No]^[i] and $200000 <> 0 then Buffer[21,i] := '*' elseπBuffer[21,i] := '·';π if BigCar[No]^[i] and $400000 <> 0 then Buffer[22,i] := '*' elseπBuffer[22,i] := '·';π if BigCar[No]^[i] and $800000 <> 0 then Buffer[23,i] := '*' elseπBuffer[23,i] := '·';π if BigCar[No]^[i] and $1000000 <> 0 then Buffer[24,i] := '*' elseπBuffer[24,i] := '·';π if BigCar[No]^[i] and $2000000 <> 0 then Buffer[25,i] := '*' elseπBuffer[25,i] := '·';π if BigCar[No]^[i] and $4000000 <> 0 then Buffer[26,i] := '*' elseπBuffer[26,i] := '·';π if BigCar[No]^[i] and $8000000 <> 0 then Buffer[27,i] := '*' elseπBuffer[27,i] := '·';π if BigCar[No]^[i] and $10000000 <> 0 then Buffer[28,i] := '*' elseπBuffer[28,i] := '·';π if BigCar[No]^[i] and $20000000 <> 0 then Buffer[29,i] := '*' elseπBuffer[29,i] := '·';π if BigCar[No]^[i] and $40000000 <> 0 then Buffer[30,i] := '*' elseπBuffer[30,i] := '·';π if BigCar[No]^[i] and $80000000 <> 0 then Buffer[31,i] := '*' elseπBuffer[31,i] := '·';ππ end;πend;ππprocedure Encode(No : Byte);πvar i,j : byte;πbeginπ for i := 0 to 36 doπ beginπ BigCar[No]^[i] := 0;π if Buffer[0,i] = '*' then BigCar[No]^[i] := 1;π if Buffer[1,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2;π if Buffer[2,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4;π if Buffer[3,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8;π if Buffer[4,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10;π if Buffer[5,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20;π if Buffer[6,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40;π if Buffer[7,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80;π if Buffer[8,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $100;π if Buffer[9,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $200;π if Buffer[10,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $400;π if Buffer[11,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $800;π if Buffer[12,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $1000;π if Buffer[13,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2000;π if Buffer[14,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4000;π if Buffer[15,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8000;π if Buffer[16,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10000;π if Buffer[17,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20000;π if Buffer[18,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40000;π if Buffer[19,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80000;π if Buffer[20,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $100000;π if Buffer[21,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $200000;π if Buffer[22,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $400000;π if Buffer[23,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $800000;π if Buffer[24,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $1000000;π if Buffer[25,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $2000000;π if Buffer[26,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $4000000;π if Buffer[27,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $8000000;π if Buffer[28,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $10000000;π if Buffer[29,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $20000000;π if Buffer[30,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $40000000;π if Buffer[31,i] = '*' then BigCar[No]^[i] := BigCar[No]^[i] + $80000000;π end;πend;ππprocedure Preview;πvar i, j : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+GetMaxX div 2 ,i+GetMaxY divπ2,15);π end;π end;π readkey;π closeGraph;πend;ππprocedure PreviewAll;πvar i, j, k : byte;πbeginπ initGraph(grDriver,GrMode,'\turbo\tp\');π for k := 32 to 47 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-32) * 36 ,i+20,15);π end;π end;π end;π for k := 48 to 96 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-48) * 36 ,i+60,15);π end;π end;π end;π for k := 97 to 127 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-97) * 36 ,i+100,15);π end;π end;π end;π for k := 128 to 155 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-128) * 36 ,i+140,15);π end;π end;π end;π for k := 156 to 180 doπ beginπ Bufferize(k);π for i := 0 to 36 doπ beginπ for j := 0 to 31 doπ beginπ if Buffer[j,i] = '*' then putpixel(j+(k-156) * 36 ,i+GetMaxY divπ2+70,15);π end;π end;π end;π readkey;π closeGraph;πend;ππfunction Edit(No : byte) : Char;πvar x, y : byte;π car : Char;π Sortie : Boolean;π Go : byte;π CaracTempo : char;πbeginπ UpDate(No);π x := 0;π y := 0;π Sortie := false;π Etat := Move;ππ repeatπ GotoXY(1,1);π Write(' ');π gotoxy(1,1);π if etat = move then write('Move')π elseπ if etat = delete then write('Delete')π elseπ if etat = trace then write('Trace');π GotoXY(60,1);π write('(',x:2,' , ',y:2,')');π GotoXY(4 + 2*x,5+y);π HighVideo;π Write(Buffer[x,y]);π GotoXY(4 + 2*x,5+y);π repeatπ until keypressed;π car := ReadKey;π GotoXY(4 + 2*x,5+y);π LowVideo;π Write(Buffer[x,y]);π if (car = 'q') or (car = 'Q') then car := #13;π if car = #0 then car := ReadKey;π case car ofπ '2',chr(80) : beginπ if y = 36 then y := 0 else inc(y);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '8',chr(72) : beginπ if y = 0 then y := 36 else dec(y);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '4',chr(75) : beginπ if x = 0 then x := 31 else dec(x);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '6',chr(77) : Beginπ if x = 31 then x := 0 else inc(x);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '1',chr(80) : beginπ if y = 36 then y := 0 else inc(y);π if x = 0 then x := 31 else dec(x);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '7',chr(72) : beginπ if y = 0 then y := 36 else dec(y);π if x = 0 then x := 31 else dec(x);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '9',chr(75) : beginπ if x = 31 then x := 0 else inc(x);π if y = 0 then y := 36 else dec(y);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π '3',chr(77) : Beginπ if x = 31 then x := 0 else inc(x);π if y = 36 then x := 0 else inc(y);π if etat = trace then buffer[x,y] := '*'π else if etat = delete then buffer[x,y] := '·';π end;π ' ' : if etat <> trace then etat := succ(etat) else etat :=πmove;π #13, #81, #73 : Sortie := true;π #27 : Sortie := True;π 'G','g' : beginπ GotoXY(20,49);π Write('Aller à quel code ascii ? ');π Read(Go);π if (Go >= 32) and (go <= 180) thenπ beginπ Encode(No);π EnCours := Go -1;π Car := #81;π Sortie := true;π end;π GotoXY(1,49);π ClrEol;π end;ππ 'v', 'V' : beginπ Preview;π update(No);π end;π 'a', 'A' : beginπ Encode(No);π PreviewAll;π Bufferize(No);π Update(No);π end;π 'c', 'C' : beginπ gotoXY(20,49);π Write('Copier quel caractère ? ');π CaracTempo := ReadKey;π if CaracTempo <> #13 thenπ beginπ Bufferize(ord(CaracTempo));π UpDate(EnCOurs);π end;π GotoXY(20,49);π ClrEol;π end;π end;π until (sortie);π Encode(No);π Edit := Car;πend;ππprocedure EditeTable;πvar fin : boolean;π Car : char;π Car_Retour : char;πbeginπ fin := false;π Encours := 32;π repeatπ Bufferize(Encours);π Car_Retour := Edit(EnCours);π case car_Retour ofπ #13 : beginπ gotoXY(20,49);π Write('Quitter ? ');π Car := UpCase(readKey);π GotoXY(1,49);π ClrEol;π if Car = 'O' then Fin := true;π end;π #81 : beginπ if EnCours = 180 then Encours := 32 else inc(EnCours);π etat := move;π end;π #73 : beginπ if EnCours = 32 then Encours := 180 else dec(EnCours);π etat := move;π end;π #27 : beginπ gotoXY(20,49);π Write('Abandon des modifications ? ');π Car := UpCase(readKey);π GotoXY(1,49);π ClrEol;π if Car = 'O' then Halt(0);π end;π end;π until fin;πend;ππprocedure SauveTable;πvar Fichier : Text;π i : byte;π j : byte;πbeginπ Assign(Fichier, 'Big.FON');π Rewrite(Fichier);π For i := 32 to 180 doπ beginπ for j := 0 to 36 doπ beginπ writeLn(Fichier, BigCar[i]^[j]);π end;π WriteLn(Fichier);π end;π Close(Fichier);πend;ππbeginπ DetectGraph(GrDriver, GrMode);π InitGraph(grDriver, grMode,'\turbo\tp\');π ErrCode := GraphResult;π if ErrCode <> grOk thenπ beginπ Writeln('Graphics error:', GraphErrorMsg(ErrCode));π Halt(255);π end;π CloseGraph;πππ NormVideo;π ReserveMemoire;π ChargeTable;π EditeTable;π SauveTable;πend.ππ{πYou'll find here the fonts I had already done. They are not complete. (use Aπto see all the characters) You must use XX3402 that you'll find on the Swag.πIf you make others fonts, would you please send them to me ?π}ππ{ cut this out as save as FON.XX. Use XX3402 : XX3402 d FON.XX toπ create FON.ZIP containing the FONT files need here }ππ*XX3402-004554-160794--72--90-49467---------FON.ZIP--1-OF--1πI2g1--E++++6+1lIWFn1MZsTikA++8QI+++7++++Iop-H2kiFYxCXJVhggAU0DnTaRv3449hπyIzq+c6iWiaP0Ool-70D3NDSfxrpTaJujocOlDRAA5mzXdHptmmlaDi5Z+tylkr6i6vvvSiaπmd8HXZCvtn2z3xPDHKRh2okwHDTQhs6Y2trjmNAOAQAr8lDJFaRi9mlKqsDe9tvWFvTcKw1mπa4FSF-k3XAwoJeTeCZCbH5v0aBN91NgaBHPSxRA3ARGLS35gZaxd5V2fvjgmZg8K3zAn9y4Xπ2lRMmJsFfyfMuAVUXIYet1lwc2b6EzfzeAlw7k8DX6gX0MYYAAKGH7ilpNJ3lAlKno5eJhRpπ5D46Km81627lm1m1rTKIa3l99ao9iPEkjzjIURmqxsMkmMYcX8C8Sebqj75bIdS-RvJQVqBcπr-UHVaMS-t4YI-AnTz788AFGVVdqh739nt+XG3zG7IS7oAqTpshfjV+PU7nn1eWoHgIbX+aKπSTqTZR3miIKrueyhyij4M-snAbkAu-Uit4RS3fsRyaQ8wRP7FYBRBZ-vndj+66Lce0MLO6sEπ63fIIy0B8CrZa9j3xvCjyutOlbXaEEKFoHrvcAdvJUeHS9F4Znld6-HVX2F-CAv++8HHvRjVπhNZarRQZ4vfczzKi-PWVfupVCACKlbkFD60I4a8AxFFAD5wKqu0qIUlE5+j9yHFnQbRsVi+Cπx1QJdWvHsr6y4DrGdSkEtgn9iV-XiW6KHGe9oeHeeLlEKPi6Fi6PHOtHsJ2tSyR4FEUmZ0tfπEll5fNBnhIg8VCnWQlKD8lPVCYJKcoq9U5ajQjpBKj-Wld8Jcl6orMs1cKFpe1C+pq9q+gxVπuLVcjUoIyQuFbxecthQbY10GnfFvXR03wdHnsYdUZMS0UwwDxTcx4Dh5usHPJFIE8a1gt42Dπ8r1+a+iytmEUrkB+oLxEf5dhANDdgz9P6y6KvqdYRvGqx7j3BcrzWRa03JWntOazAOzIzzGYπu278HpnJRMrOAffaWWi4gOOaQE8HBWNVxOn55MIauLj0DBfUrmyK8MQW3h0oHrq6utt7THLlπxBDFJM+dOVpRr+7BoL21tI-CBrE7RpvNPB-YppDpLA8YOZYqhRpm6j--MkxJA+mHAWScBD1-πjenfvle7TFakv6Aa4zqDfFVsv41EizHCN8aiqgg0ptXcKXCCeOTeIT0IWejm6fDPANOD8CTVπDRQXSIVPeq3gwJ6RqNoC3vMY-rHxyX+KHHpEoKQqr5IZLJHW7vybdVOT44RD9TOrSCxtw9wBπYETwfIUFujjJD+gbUZBdEChACGCiDp-9+kEI++++0++JUMoQbzQ8qa+5++-FC+++-k+++2p7πF0t4HovJKyhmvGc6zhyNjcire5by7ng-j60L74NZRQyNOP-B6WX07q0eTbySzTnyu1qurlybπT83F-mwdTofjlxobEbnkptsJSzbskxbRpANM0nmAUPSpBaj1hhec8yernKuZySkhcYQ92n78πcqvURyq0Wn+R5sv4vWcF-nAmmc3mh3Ts6f+kPjSW0OMk6Mv25EIVkFZP2o09PhTFEnSj3SfEπ59qx-VtK6OQBh-dwH7opu-dvFZExXWEsEspqp4VwNYBGvUTaJ+o1lv0V3XOzm+F5vPJnSJdqπkwbUt5G+dwUSGFJNtG8V3uYHAG-al7W256c-RGPxu8EgB2dwXgH-kofe+rkDHFxukXBYZRSgπ9C5F9NNJ1Zs-7lJJKKgHT4rc5XqbRpB5sZ8t6a29pXldWDMKC8Paz3qq3jTLfGe6b+FKLNhsπlcEAbiWdFOkOcg+b6N0kls+aiM4RyUpOUw43ZKBWO71+F8DpYTpuI9HTUP3rk0DFPMCb-fVvπMz3rJTcG5sM-KJOmtdpQ3zFu94INyGQo2ikXnR9G+1kAoWcQ8UuDR9OYCSCuVOM7gSr07szrπOWVWXqInsGsg8TJ3TqKPHuCyaF8H8UZZT4COuyfXjEqvRX6MFnh8cwwFrInKD+SA9AMd45NYπIyT026hI9-i9BZOPKkrTxYRHmfO+WuvOrOSpW0aVmQUdQTHXMbd8vxltQuv+dx8S9JQ9H9TEπeoD-FFPxDYnyg6W-3C0Nx6XqJxdNaIAadV7n9u5yt32OOhqW9sNl0wPbWpyw+8QVanBBhHhbπ2vmFWC82GbKBpHUlNmWY36opV2Q64bhA0WaLhy0fFyCNtb4d8GV5Z9D7YjSdslQqq3l1V3mWπGtUdHZ3ccz2V0gK0M8qsaeX6DWrywSgIspMawvGNHoWeDlf2FHtwr16GPON3PogCvr5bZyGOπoVcmj-Dpuwp4pYmg1mBttBUuzqoZftfkaI5nfSZw2vivisbpcC0M4fu-9ZAK9St1tF2gMoBVπ7gIRSUAcW9+yawcYob9hdYEbFbJQIhCcuwFeFhQBaoq9Yuc3aoDUQqWXqVdAWkvpLI16wffLπNnFLFs8GGO4KhA4ci2ULXIKcpnNWcaVhWcQ6nmbv5iDb1B+yVdkNmd4vQmkS-Xpl5FXi-pILπ33Ab5YUpgQmBST+Ns3eaaU0gVAlfKbdrUR03T7qpPOCVohlPZkmc0F9r64cOuyElb9tbOizkπdyW36Va8OX1+YRKZRyEZLmOIGNWH2QWm4Ce4qAac8vYNcBqTcN0sZn-trJGOzREEueqZ1FR+πvnRomhEwr4V5F18ayFmDXXh9yMFkNCCqE1JMGDCUKdQXvUoee2VSb27ZaidcK3i9kfpiZpFLπSrG3wItB5sxV08Y0APo3FQg6Isi6wJU2qvbz82OaM5stB2kFgolBFvB97OTHM3UCTEGIOd7vπrZ56yHHCZ0JnwLYAnNIVtpCDWXfacYFZ+2ZrHpSBCzARThKbwz4Ou+DHlxbeWWltcaCi8lfkπqyMYaatSPFKVph7jY25ofqF-fUVdvexEZ3GCF8fBpWjUgEISAS1iH-3n7jUbDg-LM3DBhDRVπSEWnHb11DfLqsDXiZ4DrlSP8btXtjKIdRnpq+S4ewts8GQ-XzOn7vVBG+A0jR6MuMxzLZXbBπJQ9UtkJMABAdEBQHJYdfNwbAo75YODqkw759T5s+szVG5m5bxVsatgjeic4IIsvtS-z5kKEPπJcJn41sDTTg+y1lsTn7sYM7jm1HgR4kDhwtLYm7IAZzOcOkVnFeJEo7WVfTd3NozLx0bTjBIπtxp4hPDu5JfFI7csscJSBMH34G+WIjp3RIT0H2hdMyoRP3O5Gjg1bOily9abDQwYvBLMSIEUπSKgClldwceF3pSm3Lm8GErNlcqr1s8Zy0CIISCbbs8WXqksVpgC56zzcfxwDuietqVJRZ01LπbESCzS8dfpn1J7CJjVvXhiQgLwtgt3vvHK51NCwvcUVVAOQaaWJyAo3QmRqcKdWhb4RjPSZXπNV1TG8l49jGWY3aqzzswq+QMvyExkq97dolZcSU3bWYucb5yoIbhqBIK1cijNPTG8jX8ngodπtCE2wjeQuBbDdpr5PjupJ4nJptw94vfxRoGBRTWB84+seKw6SWqmiNw3XCGxQNcsCQptNrdfπloSeeMvNyhrUSg4pGkcy+s9zJxQqLjZqi1cKxwaiCKPt5MmOmbcRCfE7W2ts64pX4r+lF5UcπKQf0+nx35tAbRqgzS1Xtoi5V7ktDPLOO5Z0pMMoDkzzF+OWRT1DMO9FKWiVoUoMmYTnd2SS2πvGR5Xe9udG9zG+xfDCXny7Ju85o0famA0jyr-SgqJDZFuKFU3ddRG5+FDlDN6+9Mw-oLe1N3πyk2KJ7n4TtbEGWvdxLwReSNXq4TzvREdLlgg2uJecOOeZpTZJACLqvZO8AwW7atlrbgWfERtπyhXZI0-coOBPzwKhMqn-iTrrNvQS10A4Q7szj+TTsSVUXw5t06tVcc7zZjffarxEm3nuSi07πUDw+I2g1--E++++6+AloXVlDpuzgVkI++DBH+++5++++EYZ59YNDHipNuqsXCkXyLubjkgI4πyzaTv-XkX4SmiPFdYxoX6OK-n6IDA4-AsTDXbNzD1mFePL-I4tHqyJ47eA0W02JfdKSNGr4rπu+NzWqtevdzGoSFzLSpPW3DEkGKAdLM0SAFFFJ4K2nSchh-UtlerXaEuMmxJLfCChGa-Eba4πEp1KUcrUOzlDgBv9jRCmnkyWnWe9WW6otQ2V3o6J4MyFhA8pY9r9oVFO5kwIuPqXDp0+KeDaπ2GNBd68GmlGIfpD5PdsuUKocUQqRBalhdUMATKefwVfKh+yqksvKdNrgDrXZs8jZk2jLPjGEπ+ppUmd48t5uIKgZnL9d8EElB43gh7P7KU1pCe1M4x2KXXiCpaSZ8JbLEe3Uium1gBngHSgPrπ6QESuYB0qGeHeH9SxURauF6gRdh-DSeepkgJiwLB8oOr4khTlawdrQCbYcUf5SloZ93FRc8ZπBhw0iqyG9ifBSrSLokNnWvfPRW8pqb7DkeEK7mVgQTc8tIFJmTCagk0O+lT5J030SEL+jisvπgurvFjw6pFY5SnlUYRNyXpv8jwGzp0x0y7cZ-mhrmuztNLbBZb3Qw-Hq9zP2bj2Q6Hv71Dx7πjaj2fx25Wr4VtQa0g0cgL-Ov+usMw6+mBk08AZZpL+9PGvd6wQ958CWZVp4VxB0WPko3cfeEπUdrx8M7SAHOwIcdRWRcO3TQFivyoWxY3vp+9TKaoh3mO9qiKVRzpnIMDeTegW4zHq6T8ZxVrπuHHdKufsfQG7PKvFQsJy+aRhy+zN7wlseMiSKuRdY0K2hmOAheZtOo7lVf5KF06F8oeRtkUOπH7kTpcPyRpcHHzfE9nGnnDTwzjlcpzrTS+-saFGp5hHfEeoZBbhfRQ0XOaVA09vJaVCuq+tpπNeKnOs5IJL1ePrpWl0KdxWfFKIUPTu4W1+jN1s6o-044-+4RdNpe9sJw0lWghMjHtlpVQrxhπd-Gg+BCwKaNNhhNFcYwlRWu9gP50nW9uAS+q0x4RBXJ5mB39mrCvAzTmT5Pqjhs2JdZhNI08πxosoffiCUqbF8ECd-kDq9bvOkBuUcCSuqW5N-PPMwHT7zmC4iFO75Sg8RzMQEFQrp1mfRXsmπLoTQK9A1PPO14Xo+ZdaRpVGVrnpnZmrHTKuZAnAkc1Tu3hbC1HqeklNgsa40I8Gu023D1zhZπhcjjhx4WFAvSzptFRdyvW1C9G1EjqFCFZLtIWomAwlhgKE0+gdKliVqqe3Bddy9q91jY2zgqπ6EcxwbSclH5RKRmuSrXZ3z+jqMBRRFohkkT9AwhRmsL9fFTiXV6zaAOnLDssoKRzqtJpvVFxπVcIx2cl4+FlMRRhBcanvOA51vWvrpemLMMSXbborFknh8qntnhT-nAjNXVz1EutsUow+bLo+πQxXWLw1KTQ+VJLQoLRpyH5fL2CVeE3s25lRgNNyhMDRdZ6YHobpwledaRCRSapO9kkOJiQKaπBVtiseAavLmcHrOZalsyt6Vuiby3Pac01XrrMKGonSow6E-2a5ogyptyuT1ElKT5fU5RTQvrπVV-ZRI-hHzdtezRDY4gC+PUmgHkgzHN1N7jRkPjNUnc57KzcypsZZrSi8vbQywTVtBzmz+PQπHXLUlVHvdTKohDpIJdTlTivxWPjj12ArydDDBqLzCsdRbEGTFw0TVktonarbGTZuCzqSor5kπqtEk5hgaWBizJuTA1KD1L8SJHOpRoQAoRfTbQ5XMvJuyi9OUlwzOsyxnxtTlRuEQ0vyTB8oBπg7mDErKQHZvcrFQDGIePBdZlXxPZNTxvGQ+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2πHA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+2HA+T+js5I2g-π+VE+3+++++U+D3G75ABWLVyv+k++dlE+++Y++++++++++E+U+++++++++3BBEIlA9YNDHZ-9π+E6I+-E++++6+-K-XFmTxkfOM+Q++32s+++5++++++++++2+6++++C61++-BGIEiFYxCI2g-π+VE+3+++++U+n5GC52zLfym5-E++wpA+++Q++++++++++E+U++++Nkg++277Fmt4HotEGkI4π++++++A++k0V++++2l2+++++π***** END OF BLOCK 1 *****π 120 08-24-9413:49ALL RODNEY JOHNSON VGA Palette Code SWAG9408 hΣ3 9 Üd π{ Here is the VGA palette changing code. }ππUnit PalChg;πInterfaceπUSES DOS;πTypeπ TPalette16 = array[0..15] of array[0..2] of Byte;π TPalette256 = array[0..255] of array[0..2] of Byte;πprocedure SetVGAPalette16(PalBuf : TPalette16);πprocedure SetVGAPalette256(PalBuf : TPalette256);πImplementationπprocedure SetVGAPalette16(PalBuf : TPalette16);πvarπ Reg:Registers;πbeginπ reg.ax:=$1012; {Code for chg. palette}π reg.bx:=0; {start with color 0}π reg.cx:=16; {change 16 colors}π reg.es:=Seg(PalBuf); {address: segment}π reg.dx:=Ofs(PalBuf); {address: offset}π intr($10, reg); {interrupt call}πend;πprocedure SetVGAPalette256(PalBuf : TPalette256);πvarπ Reg: Registers;πbeginπ reg.ax:=$1012; {code for chg. palette}π reg.bx:=0; {start with color 0}π reg.cx:=256; {change 256 colors}π reg.es:=Seg(PalBuf); {address: segment}π reg.dx:=Ofs(PalBuf); {address: offset}π intr($10, reg); {interrupt call}πend;πEnd.π 121 08-24-9413:55ALL IAN LIN Text in mode 13h? SWAG9408 ½xτ 15 Üd π{ When you change modes, you lose the contents of the screenπ(cleared). It's all IBM's fault. You see, there is also a change inπresolution and available colors and how video is used. It totally changesπand that's a way of life on the PC. Sorry, no way around it but to useπfull graphics mode.ππ FA> use, of course...) (I can't do it on a IBM, but ask me for C64-sources,π FA> if you want to have a look <grin>)ππ320 x 200 x 256c, 13h, isn't the same as the resolution required for 80x50πtext (640 x 400 x 256). In that case, I have seen graphics (simple) underπtext in text mode. If you're forced to change resolution, kiss it all goodπbye.ππRun this under text: }ππ{$A+,B-,E-,F-,G+,I-,L-,N-,O-,R-,S-,V-,X-}ππprogram RedBar;ππVARπ C:Byte;π C2,C3,C4:Word;π SINTAB:Array[0..127] of Word;π HeadPtr:Word absolute $40:$1A;π TailPtr:Word absolute $40:$1C;ππbegin;π for c:=0 to 127 doπ sintab[c]:=Trunc((Sin((2*Pi/128)*C)+1)*135);π C3:=0;π REPEATπ INLINE($FA);ππ repeat until (port[$3da] and 8)>0;π repeat until (port[$3da] and 8)=0;π for c4:=0 to sintab[c3 and 127] do beginπ repeat until (port[$3da] and 1)=0;π repeat until (port[$3da] and 1)>0;π end;π for c:=0 to 63 do beginπ repeat until (port[$3da] and 1)>0;π Port[$3C8]:=0;π Port[$3C9]:=C;π Port[$3C9]:=0;π Port[$3C9]:=0;π repeat until (port[$3Da] and 1)=0;π end;ππ for c:=63 downto 0 do begin;π repeat until (port[$3Da] and 1)>0;π Port[$3C8]:=0;π Port[$3C9]:=C;π Port[$3C9]:=0;π Port[$3C9]:=0;π Repeat until (port[$3da] and 1)=0;π end;ππ port[$3C8]:=0;π port[$3c9]:=0;port[$3c9]:=0;Port[$3c9]:=0;π Inc(C3);π inline($FB);π until headptr<>tailptr;π headptr:=tailptr;πend.π 122 08-24-9413:57ALL BAS VAN GAALEN smooth text scroll SWAG9408 îΦa¼ 16 Üd {πHere's a demo for a REAL smooth textscroll. Reset lines to something usefull,πcut the sideborders, place some readable text, and your scroller is ready! ;-)ππ}πprogram smoothtextscroll;π{ by Bas van Gaalen and Sven van Heel, Holland, PD }πuses crt;πconst vidseg:word=$b800; lines=23;πvar ofs:byte;ππprocedure vertrace; assembler; asmπ mov dx,03dah; @vert1: in al,dx; test al,8; jnz @vert1π @vert2: in al,dx; test al,8; jz @vert2; end;ππprocedure setaddress(ad:word); assembler; asmπ mov dx,3d4h; mov al,0ch; mov ah,[byte(ad)+1]; out dx,axπ mov al,0dh; mov ah,[byte(ad)]; out dx,ax; end;ππprocedure setsmooth(smt:byte); assembler; asmπ mov dx,03c0h; mov al,13h+32; out dx,al; inc dx; in al,dxπ and al,11110000b; mov ah,smt; or al,ah; dec dx; out dx,al; end;ππprocedure setup(ad:word); assembler;πasmπ mov dx,3d4hπ mov al,18hπ mov ah,[byte(ad)]π out dx,axπ mov al,7π out dx,alπ inc dxπ in al,dxπ dec dxπ mov ah,[byte(ad)+1]π and ah,00000001bπ shl ah,4π and al,11101111bπ or al,ahπ mov ah,alπ mov al,7π out dx,axππ mov al,9π out dx,alπ inc dxπ in al,dxπ dec dxπ mov ah,[byte(ad)+1]π and ah,00000010bπ shl ah,5π and al,10111111bπ or al,ahπ mov ah,alπ mov al,9π out dx,axππ mov dx,03c0hπ mov al,10h+32π out dx,alπ inc dxπ in al,dxπ and al,11011111bπ or al,00100000bπ dec dxπ out dx,alπend;ππvar x,y,i:word; cx:byte;πbeginπ setup(lines*16);π setaddress((25-lines)*80);π gotoxy(1,1);π writeln('Hey, a smooth textscroll...');π x:=0; cx:=0;π randomize;π repeatπ vertrace;π setsmooth(x); ofs:=ofs mod 4;π x:=(1+x) mod 9; if x=0 then beginπ for y:=0 to lines-1 do beginπ move(mem[$b800:160*(25-lines+y)+4],mem[$b800:160*(25-lines+y)+2],158);π mem[$b800:(25-lines+y)*160+158]:=random(26)+32;π end;π end;π until keypressed;π textmode(lastmode);πend.π 123 08-24-9413:57ALL NICK BATALAS SNOW SCREEN SAVER SWAG9408 IcÅ 27 Üd π{Hello All! I've recently coded this screen saver.It really looks like snowπis falling all over, don't you think?πHowever, I did not set out to do a snow screen saver and if you experimentπwith it a little you will see that it can even turn out to be a firework!πIf anyone can improve this code or make anything out of it, I would beπvery pleased to have a copy of the source.πPlease, excuse my English.I haven't practised it for a long time.}ππPROGRAM SnowScreenSaver; {Nick Batalas 14-6-1994}πUSES crt,dos;πconstπ dots =100; {Set this to more than 100 and the result is awful}ππvarπ j,k : integer; {loop variables}π i : longint;π x,y : array[1..dots] of integer;π cols : array[1..dots] of byte;π f,g : word;ππ{--------------Procedures Needed For This Great Screen Saver------------}πPROCEDURE SetVideoMode(mode : byte);assembler;π ASMπ mov AH,0π mov AL,modeπ int 10hπ END;ππPROCEDURE writeDACreg(color,red,green,blue : byte);π BEGINπ port[$03C8]:=color;π port[$03C9]:=red;π port[$03C9]:=green;π port[$03C9]:=blue;π END;ππPROCEDURE SetBordColB(color : byte); Assembler;π ASMπ mov AH,10hπ mov AL,01hπ mov BH,colorπ int 10hπ END;ππPROCEDURE PutPixel1(x, y : word; color : byte);π BEGINπ mem[$A000:x+y*320] := color;π END;ππPROCEDURE HideTextCursor;π VARπ regs : registers;ππ BEGINπ regs.ah:= 1;π regs.cx:=$2000;π intr($10,regs);π END;ππProcedure WaitrBest;Assembler;π ASMπ cliπ mov dx,3DAhπ @l1:π in al,dxπ and al,08hπ jnz @l1π @l2:π in al,dxπ and al,08hπ jz @l2π stiπ END;ππFUNCTION xf3(ux,t : real) : word; {Calculates the speed of a point}π BEGIN {on the x axis}π xf3 := round(ux*t) +160;π END;ππFUNCTION yf3(uy,g,t : real) : word; {Calculates the speed of a point}π VAR {on the y axis (which is affected}π u,tmax,hmax : real; {by gravity)}π ym : array[1..200] of word;π a : word;π BEGINπ u := uy-g*t;π a:= round(uy*t-1/2*g*t*t);π yf3 := 200-a ;π END;ππFunction RandomCol :byte; {Just a random value between 7 and 15 (I think)}π BEGINπ randomcol:=random(6)+9;π END;ππ{-------------------------------MAIN PROGRAMME-------------------------}πBEGINπ hideTextCursor;π j:=-50; {calculate the values of the speed of each dot}π for k:=1 to dots do begin {with this loop}π j:=j+3;π x[k]:=j;π y[k]:=random(150);π END;π For i:=1 to dots do {Calculate the color of each dot}π cols[i]:= randomcol;π SetVideoMode($13);π For i:= 1 to 63 doπ writedacreg(15,i,i,i);π writedacreg(7,15,15,15); {modify color registers in order}π writedacreg(8,20,20,20); {to give a sense of depth to the}π writedacreg(9,25,25,25); {dots}π writedacreg(10,30,30,30);π writedacreg(11,35,35,35);π writedacreg(12,40,40,40);π writedacreg(13,45,45,45);π writedacreg(14,50,50,50);π For i:=1 to 5 do {the background color turns to dark blue}π writedacreg(0,0,0,i);π setbordcolb(0);π i:=18500;π j:=1;π Repeatπ i:=i+1;π FOR k:=1 to dots doπ putpixel1(xf3(x[k],0.01*i),yf3(y[k],j,0.01*i),cols[k]);π waitrbest;π FOR k:=1 to dots doπ putpixel1(xf3(x[k],0.01*i),yf3(y[k],j,0.01*i),0);π Until keypressed;π SetVideoMode(3);ππEND.π 124 08-24-9413:57ALL ERIC COOLMAN Snow Screen Saver SWAG9408 *┤╢+ 25 Üd {πNB>{Hello All! I've recently coded this screen saver.It really looks likeπNB>snow is falling all over, don't you think?ππYeah, it looked pretty neat!ππNB>However, I did not set out to do a snow screen saver and if you expπNB>with it a little you will see that it can even turn out to be a firπNB>If anyone can improve this code or make anything out of it, I wouldπNB>very pleased to have a copy of the source.ππOk, I played around with it a bit today, and following is my modifiedπversion. I pretty much just cleaned it up, got rid of all the unusedπvariables and stuff (there were quite a few <G>) for readability,πsimplified a the calculations, and removed a lot of the overhead, andπremoved most of the global variables. You will see that now you canπhave a lot more snowflakes without it bogging out. I also removed theπcustom palette because you can get pretty much the same colours usingπthe default palette (indexes 19-31). It can probably be simplifiedπeven further (ie. remove the x and y tables and just use newPos table).πOh yeah, I threw in a little snowflake explosion at the start too :-).ππ(********************************************************************π Originally by : Nick Batalas, 14-6-1994π Modifications by : Eric Coolman, 19-6-1994π********************************************************************)π}ππProgram SnowFall;πUses crt; { for keypressed only }ππconstπ Flakes = 500; { try less flakes for faster snowfall }ππ{---------------- Stuff not specific to snowfall ----------------}πProcedure vidMode(mode : byte);assembler;π asm mov ah,$00; mov al,mode; int 10h; end;ππProcedure setPixel(pixPos : word; color : byte);πbeginπ mem[$A000:pixPos] := color;πend;ππ{---------------------------MAIN PROGRAM-------------------------}ππvarπ CurFlake : integer; { snowflake counter }π i : longint; { to add velocity to flakes }π x,y, newPos: array[0..Flakes] of word; { lookup tables }πBEGINπ randomize;π for curFlake:=0 to Flakes do { set up snow lookup table }π beginπ x[curFlake]:=random(319);π y[curFlake]:=random(199);π end;ππ vidMode($13); { 320x200x256 graphics mode }ππ i := 0; { change to 100 or higher to get rid of start explosion }ππ repeatπ inc(i);ππ for curFlake:=0 to Flakes doπ beginπ setPixel(newPos[curFlake], 0); { erase old snowflake }π newPos[curFlake] := { set up and draw new snowflake }π round(x[curFlake]*(i*0.01)) + { new X }π round(y[curFlake]*(i*0.01)) * 320; { new Y }π setPixel(newPos[curFlake], (curFlake mod 13) + 19);π end;ππ while (port[$3da] and $08) = $08 do; { wait for vRetrace to }π while (port[$3da] and $08) = $00 do; { start and end }π until keypressed;ππ vidMode($03); { return to 80x25 textmode }πend.ππ 125 08-24-9414:00ALL BAS VAN GAALEN Fading Textscreen SWAG9408 ïy / 15 Üd {π AK> howdie, nice fader! i was wandering if you would be ableπ AK> to comment the program and repost it. i.e what the portsπ AK> are etc for us less experienced programmers...ππOkay, if you don't quote so much next time.ππ}ππprogram copper;π{ bar-fade in, copper v7.0, by Bas van Gaalen, Holland, PD }πuses crt;πconst size=20; { number of text-lines }πvar pal:array[0..3*size-1] of byte;ππ{ increase first value in the pal-array (the one representing red), and scrollπthat in the array }πprocedure incbars;πvar i:word;πbeginπ if pal[0]<63 then inc(pal[0]);π for i:=3*size-2 downto 0 do pal[i+1]:=pal[i];πend;ππprocedure copperbars;πvar cc,l,j:word;πbeginπ asm cli end;π while (port[$3da] and 8)<>0 do; { vertical retrace }π while (port[$3da] and 8)=0 do;π cc:=0;π for l:=0 to size-1 do beginπ port[$3c8]:=1; { set pal-idx number (1=blue) }π port[$3c9]:=pal[cc]; { set first two pal-value's (red and green }π port[$3c9]:=pal[cc+1]; { intensities }π for j:=0 to 15 do begin { 16 vertical retraces = one text line }π while (port[$3da] and 1)<>0 do;π while (port[$3da] and 1)=0 do;π end;π port[$3c9]:=pal[cc+2]; { set last pal-value (blue), and thus activateπ new palette }π inc(cc,3);π end;π asm sti end;πend;ππvar i:byte;πbeginπ textmode(co80); { 25 lines mode }π fillchar(pal,sizeof(pal),0); { clear palette array }π copperbars; { default = black -> otherwise flash of blue will appear }π textcolor(1); { set text to blue (now black, 'cos pal changed) }π writeln;π writeln('Is this what you mean?'); writeln;π for i:=1 to 15 do writeln('Test line ',i);π repeatπ incbars;π copperbars;π until keypressed; { do stuff until keypressed... }π textmode(lastmode); { back to last mode }πend.ππ 126 08-24-9417:52ALL PAUL KAHLER 32x32 Bitmap Tiles SWAG9408 6jà: 43 Üd π{$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+,Y+}π{$M 16384,0,655360}πProgram Tiles; { by Paul H. Kahler 1994 }πUSES CRT; {email: phkahler@oakland.edu}ππ{ This program is mostly undocumented. If you want to know whats going on,π see the other program, it has more comments and much of the same code, soπ it should be more helpful. This version doesn't account for the non-squareπ pixels in mode 13h (see the other program to fix that) and it's slowerπ because a different fixed-point format is used (see the hloop of bothπ programs). I like it because it's shorter and simpler. }ππ{ A 32x32 bitmap is defined in the data below. Feel free to change it toπ whatever you like, I just punched in the first thing that came to mind. }ππConst Tile: array [0..1023] of byte =π ( 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,1,1,1,1,0,0,1,1,1,0,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,1,1,1,1,0,1,1,1,1,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,1,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,1,1,1,0,0,1,1,1,1,1,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,0,0,5,5,5,5,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,5,5,5,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,5,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,0,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,3,3,3,3,0,0,3,3,3,0,0,0,3,3,3,0,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,3,0,0,0,0,0,3,0,0,0,3,0,3,0,0,0,3,0,3,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,3,3,3,3,0,0,3,3,3,0,0,0,3,3,3,0,0,3,3,3,3,3,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 );ππVar SinTable,CosTable: Array[0..255] of longint;ππProcedure MakeTables;πVar direction:integer;π angle:real;πbeginπ For Direction:=0 to 255 do beginπ angle:=Direction;π angle:=angle*3.14159265/128;π SinTable[Direction]:=round(Sin(angle)*256);π CosTable[Direction]:=round(Cos(angle)*256);π end;πend;ππProcedure GraphMode; {set 320x200x256 mode}πbeginπ Asmπ Mov AH,00π Mov AL,13hπ Int 10hπ end;πend;ππProcedure DrawScreen(x,y:word; rot,scale:byte);πvar Temp:Longint;π ddx,ddy,d2x,d2y:word;π i,j:word;π label hloop,vloop;ππbeginπ Temp:=(CosTable[rot]);Temp:=(Temp*Scale) div 32;π ddx:=Temp;π Temp:=(SinTable[rot]);Temp:=(Temp*Scale) div 256;π ddy:=Temp;π Temp:=(CosTable[(rot+64) and 255]);Temp:=(Temp*SCALE) div 32;π d2x:=Temp;π Temp:=(SinTable[(rot+64) and 255]);Temp:=(Temp*SCALE) div 256;π d2y:=Temp;π i:=x-ddx*160-d2x*100; j:=y-ddy*160-d2y*100;ππ ASMπ mov ax,0π mov di,axπ mov ax,$a000π mov es,axπ mov cx,200π vloop:π push cxπ mov ax,[i]π mov dx,[j]π mov cx,320π hloop:π add ax,[ddx]π add dx,[ddy]π mov bl,ahπ mov bh,dhπ shr bx,3π and bx,$03FFπ add bx,OFFSET tileπ mov si,bxπ movsbπ loop hloopππ mov ax,d2xπ add i,axπ mov ax,d2yπ add j,axπ pop cxπ loop vloopπ end;πend;ππVar dist,dd,rot,dr:byte;π x,y:word;πBeginπ MakeTables;π GraphMode;π x:=32768; y:=1024;π rot:=0; dr:=1;π dist:=127; dd:=255;π repeatπ DrawScreen(x,y,rot,dist);π rot:=rot+dr;π y:=y+128;π dist:=dist+dd;π if (dist=250) or (dist=3) then dd:=-dd;π if random(150)=3 then beginπ dr:=0; while dr=0 do dr:=random(5)-3; end;π until keypressed;π ASM {back to 80x25}π MOV AX,3π INT 10hπ END;πend. 127 08-24-9417:53ALL DAVID DAHL Palette Fades/TransparentSWAG9408 4e⌐╪ 118 Üd Program Transparent;π{ }π{ Example of How Transparency Works }π{ }π{ Programmed by David Dahl @ 1:272/38 }π{ }π{ This program is PUBLIC DOMAIN }π{ }πUses CRT, Palette;ππType ImageArray = Array [0..15, 0..15] of Byte;ππ LocationRec = Recordπ X : Integer;π Y : Integer;π End;ππ VGABufferArray = Array[0..199, 0..319] of Byte;π VGABufferPtr = ^VGABufferArray;ππConst BobTemplate : ImageArray =π ((00,00,00,00,00,00,07,07,07,07,00,00,00,00,00,00),π (00,00,00,00,07,07,04,04,04,04,06,05,00,00,00,00),π (00,00,00,07,04,04,04,04,04,04,04,04,04,00,00,00),π (00,00,07,04,04,04,04,04,04,04,04,04,04,03,00,00),π (00,07,04,04,04,04,04,04,04,04,04,04,04,04,02,00),π (00,07,04,04,04,04,04,04,04,04,04,04,04,04,01,00),π (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),π (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),π (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),π (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),π (00,06,04,04,04,04,04,04,04,04,04,04,04,04,01,00),π (00,06,04,04,04,04,04,04,04,04,04,04,04,04,01,00),π (00,00,05,04,04,04,04,04,04,04,04,04,04,01,00,00),π (00,00,00,04,04,04,04,04,04,04,04,04,01,00,00,00),π (00,00,00,00,03,02,04,04,04,04,01,01,00,00,00,00),π (00,00,00,00,00,00,01,01,01,01,00,00,00,00,00,00));ππ MaxBob = 2; { 3 Bobs (0 .. 2) }ππVar VGA : VGABufferPtr;π BackGround : VGABufferPtr;π WorkPage : VGABufferPtr;ππ Pal : PaletteArray;ππ BobImage : Array[0..MaxBob] of ImageArray;π BobLocation : Array[0..MaxBob] of LocationRec;ππ Counter1 : Integer;π Counter2 : Integer;ππ{-[ Set VGA Mode 13h (320 X 200 X 256 Chain 4) ]------------------------}πProcedure SetMode13h; Assembler;πASMπ MOV AX, $13π INT $10πEnd;π{-[ Put A 16 X 16 Image by ORing it With Background ]-------------------}πProcedure Put16X16ImageOR (Var Bob : ImageArray;π X, Y : Integer);πVar CounterX,π CounterY : Integer;πBeginπ For CounterY := 0 to 15 doπ For CounterX := 0 to 15 doπ WorkPage^[CounterY + Y, CounterX + X] :=π WorkPage^[CounterY + Y, CounterX + X] OR Bob[CounterX, CounterY];πEnd;π{-[ Update Bob Positions ]----------------------------------------------}πProcedure UpdateBobs;πVar BobCounter : Integer;πBeginπ For BobCounter := 0 to MaxBob doπ Beginπ Inc (Counter1, 1);π While (Counter1 >= 360) doπ Dec(Counter1, 360);ππ If (Counter1 MOD 2) = 0π Thenπ Beginπ Inc(Counter2,1);π While (Counter2 >= 360) doπ Dec(Counter2, 360);π End;ππ BobLocation[BobCounter].X := 160 +π Round(90 * -Sin((Counter1 + (BobCounter*Counter2))*PI/180));ππ BobLocation[BobCounter].Y := 95 +π Round(60 * Cos((Counter2 + (BobCounter*Counter1))*PI/180));ππ End;πEnd;π{-[ Draw All Bobs To Work Buffer ]--------------------------------------}πProcedure DrawBobs;πVar BobCounter : Integer;πBeginπ For BobCounter := 0 to MaxBob doπ Put16X16ImageOR (BobImage[BobCounter],π BobLocation[BobCounter].X, BobLocation[BobCounter].Y);πEnd;π{-[ Initialize Variables ]----------------------------------------------}πProcedure InitializeVariables;πConst Tbl : Array [0..MaxBob] of Byte = (8, 16, 32);πVar BobCounter : Integer;π CX, CY : Integer;πBeginπ { Make Individual Bobs From Template }π For BobCounter := 0 to MaxBob doπ Beginπ BobImage[BobCounter] := BobTemplate;ππ For CY := 0 to 15 doπ For CX := 0 to 15 doπ If BobImage[BobCounter][CX,CY] <> 0π Thenπ BobImage[BobCounter][CX,CY] :=π BobImage[BobCounter][CX,CY] OR Tbl[BobCounter];π End;ππ Counter1 := 0;π Counter2 := 0;πEnd;π{-[ Build Palette ]-----------------------------------------------------}πProcedure BuildPalette;πVar ColorCounter : Integer;πBeginπ { Initialize Palette Buffer To All Black }π FillChar (Pal, SizeOf(Pal), 0);ππ For ColorCounter := 0 to 7 doπ Beginπ { Make Red, Green, and Blue Bobs }π Pal[ColorCounter OR 08].Red := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 16].Green := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 32].Blue := 21 + (ColorCounter * 6);ππ { Make Colors Where Red and Green Bobs Overlap }π Pal[ColorCounter OR 08 OR 16].Red := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 08 OR 16].Green := 21 + (ColorCounter * 6);ππ { Make Colors Where Red and Blue Bobs Overlap }π Pal[ColorCounter OR 08 OR 32].Red := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 08 OR 32].Blue := 21 + (ColorCounter * 6);ππ { Make Colors Where Green and Blue Bobs Overlap }π Pal[ColorCounter OR 16 OR 32].Green := 21 + (ColorCounter * 6);π Pal[ColorCounter OR 16 OR 32].Blue := 21 + (ColorCounter * 6);ππ { Make Colors Where Red, Green and Blue Bobs Overlap }π Pal[ColorCounter OR 08 OR 16 OR 32].Red := 21+(ColorCounter * 6);π Pal[ColorCounter OR 08 OR 16 OR 32].Green := 21+(ColorCounter * 6);π Pal[ColorCounter OR 08 OR 16 OR 32].blue := 21+(ColorCounter * 6);π End;ππ { Make Colors Where The Grey Square Overlaps The Bobs }π For ColorCounter := 128 to 255 doπ Beginπ Pal[ColorCounter].Red := (Pal[ColorCounter-128].Red DIV 4)+14;π Pal[ColorCounter].Green := (Pal[ColorCounter-128].Green DIV 4)+14;π Pal[ColorCounter].Blue := (Pal[ColorCounter-128].Blue DIV 4)+14;π End;πEnd;π{-[ Draw Grey Square In Background Buffer ]-----------------------------}πProcedure BuildBackground;πVar Y, X : Integer;πBeginπ FillChar (BackGround^, SizeOf(BackGround^), 0);ππ For Y := 50 to 150 doπ For X := 100 to 220 doπ BackGround^[Y, X] := 128;ππEnd;π{=[ Main Program ]======================================================}πBeginπ VGA := Ptr ($A000,$0000);π New (WorkPage);π New (BackGround);ππ InitializeVariables;π BuildPalette;π BuildBackground;ππ SetMode13h;π SetPalette (Pal);ππ Repeatπ UpdateBobs; { Update Bob Positions }π WorkPage^ := BackGround^; { Clear WorkPage With Static Image }π DrawBobs; { Draw Bobs }ππ { Wait For Retrace }π Repeat Until ((Port[$3DA] AND 8) <> 0);ππ VGA^ := WorkPage^; { Display Page }π Until KeyPressed;ππ TextMode (C80);ππ Dispose (BackGround);π Dispose (WorkPage);πEnd.ππ{ PALETTE CODE FOLLOWS }ππ{π TD> I've seen it done in many places, but I haven't seen any info onπ TD> how it's done: What is the basic algorithm for fading from oneπ TD> palette to another.ππ Many people do palette fading incorrectly. The correctπway to do it would be to set up a relation such as:ππ Palette_Element Calculated_Elementπ --------------- = ------------------π Max_Intensity Current_IntensityππWhere Palette_Element is a single element in our master DACπtable, Max_Intensity is the maximum allowable intensity level forπour scale, Current_Intensity is a number between 0 andπMax_Intensity which represents the level we want, andπCalculated_Element is the new value for the element of our DACπtable. But since we want the Calculated_Element, we re-write itπas this equation:ππ Calculated_Element = Palette_Element * Current_Intensityπ -----------------------------------π Max_IntensityππThe above equation will allow us to fade a given palette set toπblack or from black to a given palette set. To fade out an entireπpalette set, you would need to calculate the above for the red,πgreen, and blue components of each color in the 256 element DACπtable.π Fading from one palette set to another palette set isπvery similar. What you must do is fade one palette set to blackπwhile simultaneously fade from black to another palette set andπadd the two values. The equation for this is:ππ CE = ((PE1 * (MI - CI)) + (PE2 * CI)) / MIππWhere CE is the calculated element, PE1 and PE2 are correspondingπpalette elements from palette 1 and 2, MI is the maximumπintensity in our scale, and CI is the current intensity we wantπ(num between 0 and MI). }ππUnit Palette;π{ Programmed By David Dahl @ FidoNet 1:272/38 }π(* PUBLIC DOMAIN *)πInterfaceπ Type PaletteRec = Recordπ Red : Byte;π Green : Byte;π Blue : Byte;π End;π PaletteArray = Array [0..255] of PaletteRec;ππ Procedure SetPalette (Var PaletteIn : PaletteArray);π Procedure FadeFromPaletteToBlack (Var PaletteIn : PaletteArray);π Procedure FadeFromBlackToPalette (Var PaletteIn : PaletteArray);π Procedure FadeFromPalette1ToPalette2 (Var Palette1 : PaletteArray;π Var Palette2 : PaletteArray);πImplementationπProcedure SetPalette (Var PaletteIn : PaletteArray); Assembler;πAsmπ { Get Address of PaletteIn }π LDS SI, PaletteInπ CLDππ { Tell VGA To Start With First Palette Element }π XOR AX, AX π MOV DX, $3C8π OUT DX, ALππ { Wait For Retrace }π MOV DX, $3DAπ @VRWait1:π IN AL, DXπ AND AL, 8π JZ @VRWait1π π { Set First Half Of Palette }π MOV DX, $3C9π MOV CX, 128 * 3π @PALLOOP1:π LODSB { DON'T use "REP OUTSB" since some VGA cards can't handle it }π OUT DX, ALπ LOOP @PALLOOP1ππ { Wait For Retrace }π PUSH DXπ MOV DX, $3DAπ @VRWait2:π IN AL, DXπ AND AL, 8π JZ @VRWait2π POP DXππ { Set Last Half Of Palette }π MOV CX, 128 * 3π @PALLOOP2:π LODSBπ OUT DX, ALπ LOOP @PALLOOP2πEnd;ππProcedure FadeFromPaletteToBlack (Var PaletteIn : PaletteArray);πVar WorkPalette : PaletteArray;π Counter : Integer;π Intensity : Integer;πBeginπ For Intensity := 31 downto 0 do π Beginπ For Counter := 0 to 255 doπ Beginπ WorkPalette[Counter].Red := π (PaletteIn[Counter].Red * Intensity) DIV 32;π WorkPalette[Counter].Green := π (PaletteIn[Counter].Green * Intensity) DIV 32;π WorkPalette[Counter].Blue := π (PaletteIn[Counter].Blue * Intensity) DIV 32;π End;π SetPalette (WorkPalette);π End;πEnd;ππProcedure FadeFromBlackToPalette (Var PaletteIn : PaletteArray);πVar WorkPalette : PaletteArray;π Counter : Integer;π Intensity : Integer;πBeginπ For Intensity := 1 to 32 do π Beginπ For Counter := 0 to 255 doπ Beginπ WorkPalette[Counter].Red := π (PaletteIn[Counter].Red * Intensity) DIV 32;π WorkPalette[Counter].Green := π (PaletteIn[Counter].Green * Intensity) DIV 32;π WorkPalette[Counter].Blue := π (PaletteIn[Counter].Blue * Intensity) DIV 32;π End;π SetPalette (WorkPalette);π End;πEnd;ππProcedure FadeFromPalette1ToPalette2 (Var Palette1 : PaletteArray;π Var Palette2 : PaletteArray);πVar WorkPalette : PaletteArray;π Counter : Integer;π CrossFade : Integer;πBeginπ For CrossFade := 0 to 32 doπ Beginπ For Counter := 0 to 255 doπ Beginπ WorkPalette[Counter].Red :=π ((Palette1[Counter].Red * (32 - CrossFade)) + π (Palette2[Counter].Red * CrossFade)) DIV 32;π WorkPalette[Counter].Green :=π ((Palette1[Counter].Green * (32 - CrossFade)) + π (Palette2[Counter].Green * CrossFade)) DIV 32;π WorkPalette[Counter].Blue :=π ((Palette1[Counter].Blue * (32 - CrossFade)) + π (Palette2[Counter].Blue * CrossFade)) DIV 32;π End;π SetPalette (WorkPalette);π End;πEnd;πEnd.ππTUTORIAL !!ππ Transparent objects are rather simple. What you do isπset up your palette so pure colors are represented by powers ofπtwo. This way you can "mix" your colors by ORing the valuesπtogether. For simplicity's sake, this example will use 3 colors:ππ Bit 7 6 5 4 3 2 1 0π | | |π | | +----> Redπ | +------> Greenπ +--------> BlueππSo now you would set your palette up as follows:ππ All single colors:ππ 2^0 = 1 -- Redπ 2^1 = 2 -- Greenπ 2^2 = 4 -- Blueππ All possible 2 color mixes:ππ 2^0 OR 2^1 = 1 OR 2 = 3 -- Red + Green = Yellowπ 2^0 OR 2^2 = 1 OR 4 = 5 -- Red + Blue = Magentaπ 2^1 OR 2^2 = 2 OR 4 = 6 -- Green + Blue = Cyanππ All possible 3 color mixes:ππ 2^0 OR 2^1 OR 2^2 = 1 OR 2 OR 4 = 7 -- R + G + B = WhiteππSo our palette is set up as:ππ 0 - Blackπ 1 - Redπ 2 - Greenπ 3 - Yellowπ 4 - Blueπ 5 - Magentaπ 6 - Cyanπ 7 - WhiteππNow let's say we have a Red, Green, and a Blue square. Theπbitmap of the red square will be made up of bytes of the value 1,πthe green square will be made up of the value 2, and the blueπsquare will be made up of the value 4 as so:ππ Red Green Blueππ 11111111 22222222 44444444π 11111111 22222222 44444444π 11111111 22222222 44444444π 11111111 22222222 44444444ππTo put the squares, you just have to OR put them to your frameπbuffer. If they overlap, they will automatically mix as so:ππ The 3 overlaping bitmaps The 3 overlaping bitmapsπ in frame buffer using an in frame buffer showingπ OR'd image put: what colors are where:ππ 11111111 RRRRRRRRπ 11111111 RRRRRRRRπ 111133332222 RRRRYYYYGGGGπ 155577776222 RMMMWWWWCGGGπ 44466666222 BBBCCCCCGGGπ 44466666222 BBBCCCCCGGGπ 44444444 BBBBBBBBππThe following example program uses this bit scheme:ππ Bit 7 6 5 4 3 2 1 0π | | | | +-+-+---> Color Intensity (0:Least - 7:Full)π | | | +---------> Redπ | | +-----------> Greenπ | +-------------> Blueπ +-----------------> GreyπππDavid Dahl 128 08-24-9417:53ALL LEW ROMNEY VGA-TEXT-FONT-EDITOR SWAG9408 C½ 28 Üd {πDL> When i redefine a character as "─", i don't get a smooth line, but oneπDL> pixel left blank between every character, so "---" instead of "───".ππWith EGA, everything used to be so simple: all characters are 8x16 bits.ππWith VGA, there's an odd difference; you'll love this story. Somebody inπIBM once said, "Why not do our share in making this universe a completeπchaos, and thus implement an infuriating and highly illogical technologicalπmess in this new system we're calling VGA?" Of course. The brilliant newπinvetion, ladies and germs, was the 9th vertical line. It's all gone intoπthe history books by now; it tooks months and truckloads of money just toπthink it up but as always, IBM succeeded.ππNow, all characters in the VGA font set are 8 bits, or pixels, wide.πExcept for 24 characters, 192 through 216 in ASCII. These characters haveπan additional vertical line; no problem. The truly ingenious touch (as theπlesser-known Harry Stottle of the celebrated IBM Vertical Line Team said,π"Eureka!") is how this addition line is actually a copy of the 8th.ππIe., to make a horizontal line ('─'), use any of the characters 192-216 andπactivate 8 bits from left to right. The 8th bit is copied to the 9th, andπyou've got a horizontal line.ππAnd here the tale endeth. Almost. For it leaves to each haplessπprogrammer to figure this out and now I told you. Pass the tale on as theπlast oral tradition of the cybernetic age.ππLest we forget.ππDL> 1 2 3 4 5 6 7 8 I believe the way to get this right, is toπDL> ┌─┬─┬─┬─┬─┬─┬─┬─┐ repeat column 8 (x).πDL> 1│ │ │ │ │ │ │ │x│ However, i don't know how to do this...πDL> 2│ │ │ │ │ │ │ │x│πDL> 3│ │ │ │ │ │ │ │x│πDL> 4│ │ │ │ │ │ │ │x│πDL> : : : : : : : : :πDL> 15│ │ │ │ │ │ │ │x│πDL> 16│ │ │ │ │ │ │ │x│ Please help,πDL> └─┴─┴─┴─┴─┴─┴─┴─┘ Dirk Loeckx. [@]ππDon't forget, too: use IN/OUT or Port/PortW to program the video card. Ifπyou use the BIOS routines, you'll generate flicker (even on a VGA card) andπstress that poor old card. In case you missed those routines in SWAG, hereπare my versions:ππ procedure PutFontC (C : Char; var Data);π {-Define font character bitmap}π beginπ inline($FA);π PortW[$3C4]:=$0402;π PortW[$3C4]:=$0704;π PortW[$3CE]:=$0204;π PortW[$3CE]:=$0005;π PortW[$3CE]:=$0006;π Move(Data, Mem[SegA000:Byte(C) * 32], 16);π PortW[$3C4]:=$0302;π PortW[$3C4]:=$0304;π PortW[$3CE]:=$0004;π PortW[$3CE]:=$1005;π PortW[$3CE]:=$0E06;π inline($FB);π end;ππ procedure GetFontC (C : Char; var Data);π {-Retrieve font character bitmap}π beginπ inline($FA);π PortW[$3C4]:=$0402;π PortW[$3C4]:=$0704;π PortW[$3CE]:=$0204;π PortW[$3CE]:=$0005;π PortW[$3CE]:=$0006;π Move(Mem[SegA000:Byte(C) * 32], Data, 16);π PortW[$3C4]:=$0302;π PortW[$3C4]:=$0304;π PortW[$3CE]:=$0004;π PortW[$3CE]:=$1005;π PortW[$3CE]:=$0E06;π inline($FB);π end;ππ(If you are using TP versions earlier than 7.0, replace "SegA000" withπ"$A000"... but you knew that.)ππ ttyl, Lew.π lew.romney@thcave.bbs.noπ 129 08-24-9417:54ALL OLAF BARTELT Text Font Routines SWAG9408 ΩsΘL 58 Üd πUNIT video;ππINTERFACEππUSES DOS;ππTYPE fontSize = (font8,font14,font16, unknownFontSize);π adapterType = (none,mda,cga,egaMono,egaColor,vgaMono,π vgaColor,mcgaMono,mcgaColor);ππVAR textBufferOrigin : pointer; {pointer to text buffer}π textBufferSeg : word;π textBufferSize : word; {size in bytes of...}π visibleX,visibleY : byte;π fontLines : byte;ππfunction queryAdapterType : adapterType;πfunction fontCode(h : byte) : fontSize; {convert from byte to enum}πfunction getFontSize : fontSize; {normal 25 lines,ega 25 lines,vga 25 lines}πfunction fontHeight(f : fontSize) : byte;πprocedure getTextBufferStats(var BX : byte; {visible x dimentions}π var BY : byte; {visible y dimentions}π var buffSize : word {refresh buffer size}π );πconst maxX : integer = 79;π maxY : integer = 24;ππIMPLEMENTATIONππ(******************************************************************************π* queryAdapterType *π******************************************************************************)πfunction queryAdapterType : adapterType;ππvar regs : Registers;π code : byte;ππbeginπ regs.ah := $1a; {vga identify}π regs.al := $0; {clear}π intr($10,regs);π if regs.al = $1a then { is this a bug ???? }π begin {ps/2 bios search for ..}π case regs.bl of {code back in here}π $00 : queryAdapterType := none;π $01 : queryAdapterType := mda;π $02 : queryAdapterType := cga;π $04 : queryAdapterType := egaColor;π $05 : queryAdapterType := egaMono;π $07 : queryAdapterType := vgaMono;π $08 : queryAdapterType := vgaColor;π $0A,$0C : queryAdapterType := mcgaColor;π $0B : queryAdapterType := mcgaMono;π else queryAdapterType := cga;π end; {case}π end {ps/2 search}π elseπ begin {look for ega bios}π regs.ah := $12;π regs.bx := $10; {bl=$10 retrn ega info if ega}π intr($10,regs);π if regs.bx <> $10 then {bx unchanged mean no ega}π beginπ regs.ah := $12; {ega call again}π regs.bl := $10; {recheck}π intr($10,regs);π if (regs.bh = 0) thenπ queryAdapterType := egaColorπ elseπ queryAdapterType := egaMono;π end {ega identification}π else {mda or cga}π beginπ intr($11,regs); {get eqpt.}π code := (regs.al and $30) shr 4;π case code ofπ 1,2 : queryAdapterType := cga;π 3 : queryAdapterType := mda;π else queryAdapterType := none;π end; {case}π end {mda, cga}π end;πend; {quertAdapterType}ππ(******************************************************************************π* getTextBufferStats *π* return bx = #of columns, by = #of rows, buffSize = #of bytes in buffer *π******************************************************************************)πprocedure getTextBufferStats;πconst screenLineMatrix : array[adapterType,fontSize] of integer =π ( (25,25,25, -1) {none adapter}, (-1,25,-1, -1) {mda},π (25,-1,-1, -1) {cga},(43,25,-1, -1) {egaMono}, (43,25,-1, -1) {egaColor},π (50,28,25, -1) {vgaMono}, (50,28,25, -1) {vgaColor},π (-1,-1,25, -1) {mcgaMono}, (-1,-1,25, -1) {mcgaColor} );π{this matrix is saved in font8,font14,font16 sequence in rows of matrix}πvarπ regs:registers;πbeginπ regs.ah := $0f; {get current video mode}π intr($10,regs);π bx := regs.ah; {# of chars in a line, row}π by := screenLineMatrix[queryAdapterType, getFontSize];π if by > 0 then {legal height}π buffSize := bx * 2 * byπ elseπ buffSize := 0;πend; {getTextBufferStats}ππ(******************************************************************************π* getFontSize *π******************************************************************************)πfunction getFontSize : fontSize;πvarπ regs : registers;π fs : fontSize;π at : adapterType;πbeginπ at := queryAdapterType;π case at ofπ cga : fs := font8;π mda : fs := font14;π mcgaMono,π mcgaColor : fs:= font16;π egaMono,π egaColor,π vgaMono,π vgaColor : beginπ with regs do beginπ (* check this interrupt call, there might be some bug,π either in the call conventions, or in the 3300Aπ bios. *)π ah := $11; {egavga call}π al := $30;π(* bl := $0; *)π bh := $0;π end; {with}π intr($10,regs);π fs := fontCode(regs.cl);π if (fs = unknownFontSize) thenπ fs := font16; { assume a work around in 330A screen}π end; {ega vga}π end; {case}π getFontSize := fs;πend; {getFontSize}ππ(******************************************************************************π* fontCode *π* Convert from byte size to a fontSize type *π******************************************************************************)πfunction fontCode;πbeginπ case h ofπ 8 : fontCode := font8;π 14 : fontCode := font14;π 16 : fontCode := font16;π else fontCode := unknownFontSize; { unKnown, assume 8 }π end; {case}πend; {fontCode}ππ(******************************************************************************π* fontHeight *π******************************************************************************)πfunction fontHeight(f : fontSize) : byte;πbeginπ case f ofπ font8 : fontHeight := 8;π font14 : fontHeight := 14;π font16 : fontHeight := 16;π end; {case}πend; {fontHeight}ππbeginπ getTextBufferStats(visibleX, visibleY, textBufferSize);π maxX := visibleX - 1;π maxY := visibleY - 1;π fontLines := fontHeight(getFontSize);πend.π 130 08-25-9409:09ALL JAMIE MORTIMER Map Drawing SWAG9408 ┼V╢ 37 Üd (*πI have *really* simple code I wrote for loading a 320x200x256 pcx ifπthat'd do. I have other stuff that you could work with, but it's notπmine and not finished.ππCL/ Display a background .PCX (a map in this case), and allow for theπCL/movement of foreground objects w/o affecting the background .PCX.ππWhat you want to do is use virtual screens or page flipping, dependingπon the graphic mode. If you're in low res (really easy!) 320x200x256,πyou can easily use 64k virtual screens (just arrays of [0..199,0..319]πfor simplicity) and treat *them* like a screen. Then dump them to theπreal screen once all your updates are done. For higher vid modes,πvirtual screens can get a *bit* more complex, 'specially for 16 colorπmodes.ππCL/Item_REc = recπCL/ name : string [30];πCL/ amt : byte;πCL/ end;πCL/Item_Type = array[1..5] of Item_Rec;ππCL/Map_Rec = RecordπCL/ Occupant : Byte; { Player=1, Nobody=0, etc }πCL/ Items : Item_type;πCL/ Case Terrain:Char ofπCL/ 'F' : etc,etc...πCL/ End; { Map_rec }πCL/map_type = array[1..100,1..100] of map_rec;ππCL/varπCL/ Map : map_type;ππWell, the list of items should be link listed. I mean, not *every* mapπwill always have 5 items, right? Save memory that way. Also, useπitem numbers instead of signifying an item by it's entire name. Usingπa record structure something like this might help a bit:π*)ππTypeπ PItemRec = ^ItemRec;π ItemRec = recordπ name : string[28];π idnum : word;π next : PItemRec;π end; {ItemRec 35 bytes}ππ PItemIdx = ^ItemIdx;π ItemIdx = recordπ idnum : word; {maximum of ~65535 items, depending on mem}π amt : Byte;π next : PItemIdx;π end; {ItemIdx 7 bytes }ππ PPlayerIdx = ^PlayerIdxπ PlayerIdx = recordπ idnum : word;π next : PPlayerIdxπ end; {PlayerIdx 6 bytes} {This will allow for more than one playerπ on a map coord if you want. Just an idea}ππ Map_Rec = Recordπ Occupants : PPlayerIdx; {list of players}π Items : PItemIdx; {list of items}π Case Terrain:char etcπ End; { Map_rec 9 bytes}ππ{If you only want one player per square at a time, you can changeπoccupants to type byte, makeing map_rec 6 bytes, increasing your maximumπmap size by like 1/3ππAgain, you could do linked lists for the map, but I'm sure you won'tπhave *that* big a map... 85x85 should be ok, right?π}ππ pmap_type = ^Map_Type; {This will save your data segment some room}π map_type = array[1..85,1..85] of map_rec; {with 9 byte maprec}π map_type = array[1..104,1..104] of map_rec; {with 6 byte maprec}ππ{here's some examples of how to access these variables}ππProcedure AddItem(NewName:string;NewId:Word;Var List:PItemIdx);πvarπ NewItem:PItemRec;πbeginπ New(Newitem); {alloc mem for new item}π with newitem^ doπ beginπ name:=newname;π Idnum:=newid;π Next:=List; {chain "list" after newitem}π end;π List:=NewItem; {Insert into front of list}πend;ππVarπ Map : PMap_Type;π ItemList : PItemRec;π t,i : integer;π pPlr : PPlayerIdx;π pItm : PItemIdx;ππbeginπ new(map); { get heap memory for the MAP pointer}π ItemList:=nil; { no items in master list yet}ππ fillchar(map^,sizeof(map^),0); { clear *ALL* map memory to zeros }ππ {Make some arbitary items}π Additem('Sword',0,ItemList);π Additem('Shield',1,ItemList);π Additem('Dagger',2,ItemList);π Additem('Helm',3,ItemList);ππ For T:=1 to 85 doπ for I:=1 to 85 doπ beginπ terrain:=terraintypes[random(10)]; {whatever}π if random(100) thenπ beginπ new(pitm); {make a new item idex}π with pitm^ doπ beginπ idnum:=random(4);π amt:=1;π next:=nil;π end;π Map^[t,i].items^:=pitm;π end;π end;ππ{these next lines should clean up the entire map, no matter how manyπitems, players or whatever you have around. As long as you don't haveπany invalid pointers...<G>}ππ For T:=1 to 85 doπ for I:=1 to 85 doπ beginπ while occupant<>nil doπ beginπ pplr:=occupant;π occupant:=occupant^.next;π dispose(pplr);π end;π while items<>nil doπ beginπ pitm:=items;π items:=items^.next;π dispose(pitm);π end;π end;π dispose(map); { free heap memory for the MAP pointer}πend.ππ 131 08-25-9409:11ALL LEON DEBOER CatMull-Rom spline sourceSWAG9408 ╨ a( 56 Üd {πFrom: ldeboer@cougar.multiline.com.au (Leon DeBoer)ππ{------------------------------------------------------------------------}π{ Catmull_Rom and BSpline Parametric Spline Program }π{ }π{ All source written and devised by Leon de Boer, (c)1994 }π{ E-Mail: ldeboer@cougar.multiline.com.au }π{ }π{ After many request and talk about spline techniques on the }π{ internet I decided to break out my favourite spline programs and }π{ donate to the discussion. }π{ }π{ Each of splines is produced using it's parametric basis matrix }π{ }π{ B-Spline: }π{ -1 3 -3 1 / }π{ 3 -6 3 0 / }π{ -3 0 3 0 / 6 }π{ 1 4 1 0 / }π{ }π{ CatMull-Rom: }π{ -1 3 -3 1 / }π{ 2 -5 4 -1 / }π{ -1 0 1 0 / 2 }π{ 0 2 0 0 / }π{ }π{ The basic differences between the splines: }π{ }π{ B-Splines only passes through the first and last point in the }π{ list of control points, the other points merely provide degrees of }π{ influence over parts of the curve (BSpline in green shows this). }π{ }π{ Catmull-Rom splines is one of a few splines that actually pass }π{ through each and every control point the tangent of the curve as }π{ it passes P1 is the tangent of the slope between P0 and P2 (The }π{ curve is shown in red) }π{ }π{ There is another spline type that passes through all the }π{ control points which was developed by Kochanek and Bartels and if }π{ anybody knows the basis matrix could they E-Mail to me ASAP. }π{ }π{ In the example shown the program produces 5 random points and }π{ displays the 2 spline as well as the control points. You can alter }π{ the number of points as well as the drawing resolution via the }π{ appropriate parameters. }π{------------------------------------------------------------------------}ππPROGRAM Spline;ππUSES Graph;ππTYPEπ Point3D = Recordπ X, Y, Z: Real;π End;ππVAR CtrlPt: Array [-1..80] Of Point3D;ππPROCEDURE Spline_Calc (Ap, Bp, Cp, Dp: Point3D; T, D: Real; Var X, Y: Real);πVAR T2, T3: Real;πBEGINπ T2 := T * T; { Square of t }π T3 := T2 * T; { Cube of t }π X := ((Ap.X*T3) + (Bp.X*T2) + (Cp.X*T) + Dp.X)/D; { Calc x value }π Y := ((Ap.Y*T3) + (Bp.Y*T2) + (Cp.Y*T) + Dp.Y)/D; { Calc y value }πEND;ππPROCEDURE BSpline_ComputeCoeffs (N: Integer; Var Ap, Bp, Cp, Dp: Point3D);πBEGINπ Ap.X := -CtrlPt[N-1].X + 3*CtrlPt[N].X - 3*CtrlPt[N+1].X + CtrlPt[N+2].X;π Bp.X := 3*CtrlPt[N-1].X - 6*CtrlPt[N].X + 3*CtrlPt[N+1].X;π Cp.X := -3*CtrlPt[N-1].X + 3*CtrlPt[N+1].X;π Dp.X := CtrlPt[N-1].X + 4*CtrlPt[N].X + CtrlPt[N+1].X;π Ap.Y := -CtrlPt[N-1].Y + 3*CtrlPt[N].Y - 3*CtrlPt[N+1].Y + CtrlPt[N+2].Y;π Bp.Y := 3*CtrlPt[N-1].Y - 6*CtrlPt[N].Y + 3*CtrlPt[N+1].Y;π Cp.Y := -3*CtrlPt[N-1].Y + 3*CtrlPt[N+1].Y;π Dp.Y := CtrlPt[N-1].Y + 4*CtrlPt[N].Y + CtrlPt[N+1].Y;πEND;ππPROCEDURE Catmull_Rom_ComputeCoeffs (N: Integer; Var Ap, Bp, Cp, Dp: Point3D);πBEGINπ Ap.X := -CtrlPt[N-1].X + 3*CtrlPt[N].X - 3*CtrlPt[N+1].X + CtrlPt[N+2].X;π Bp.X := 2*CtrlPt[N-1].X - 5*CtrlPt[N].X + 4*CtrlPt[N+1].X - CtrlPt[N+2].X;π Cp.X := -CtrlPt[N-1].X + CtrlPt[N+1].X;π Dp.X := 2*CtrlPt[N].X;π Ap.Y := -CtrlPt[N-1].Y + 3*CtrlPt[N].Y - 3*CtrlPt[N+1].Y + CtrlPt[N+2].Y;π Bp.Y := 2*CtrlPt[N-1].Y - 5*CtrlPt[N].Y + 4*CtrlPt[N+1].Y - CtrlPt[N+2].Y;π Cp.Y := -CtrlPt[N-1].Y + CtrlPt[N+1].Y;π Dp.Y := 2*CtrlPt[N].Y;πEND;ππPROCEDURE BSpline (N, Resolution, Colour: Integer);πVAR I, J: Integer; X, Y, Lx, Ly: Real; Ap, Bp, Cp, Dp: Point3D;πBEGINπ SetColor(Colour);π CtrlPt[-1] := CtrlPt[1];π CtrlPt[0] := CtrlPt[1];π CtrlPt[N+1] := CtrlPt[N];π CtrlPt[N+2] := CtrlPt[N];π For I := 0 To N Do Beginπ BSpline_ComputeCoeffs(I, Ap, Bp, Cp, Dp);π Spline_Calc(Ap, Bp, Cp, Dp, 0, 6, Lx, Ly);π For J := 1 To Resolution Do Beginπ Spline_Calc(Ap, Bp, Cp, Dp, J/Resolution, 6, X, Y);π Line(Round(Lx), Round(Ly), Round(X), Round(Y));π Lx := X; Ly := Y;π End;π End;πEND;ππPROCEDURE Catmull_Rom_Spline (N, Resolution, Colour: Integer);πVAR I, J: Integer; X, Y, Lx, Ly: Real; Ap, Bp, Cp, Dp: Point3D;πBEGINπ SetColor(Colour);π CtrlPt[0] := CtrlPt[1];π CtrlPt[N+1] := CtrlPt[N];π For I := 1 To N-1 Do Beginπ Catmull_Rom_ComputeCoeffs(I, Ap, Bp, Cp, Dp);π Spline_Calc(Ap, Bp, Cp, Dp, 0, 2, Lx, Ly);π For J := 1 To Resolution Do Beginπ Spline_Calc(Ap, Bp, Cp, Dp, J/Resolution, 2, X, Y);π Line(Round(Lx), Round(Ly), Round(X), Round(Y));π Lx := X; Ly := Y;π End;π End;πEND;ππVAR I, J, Res, NumPts: Integer;πBEGINπ I := Detect;π InitGraph(I, J, 'e:\bp\bgi');π I := GetMaxX; J := GetMaxY;π Randomize;π CtrlPt[1].X := Random(I); CtrlPt[1].Y := Random(J);π CtrlPt[2].X := Random(I); CtrlPt[2].Y := Random(J);π CtrlPt[3].X := Random(I); CtrlPt[3].Y := Random(J);π CtrlPt[4].X := Random(I); CtrlPt[4].Y := Random(J);π CtrlPt[5].X := Random(I); CtrlPt[5].Y := Random(J);π Res := 20;π NumPts := 5;π BSpline(NumPts, Res, LightGreen);π CatMull_Rom_Spline(NumPts, Res, LightRed);π SetColor(Yellow);π For I := 1 To NumPts Do Beginπ Line(Round(CtrlPt[I].X-3), Round(CtrlPt[I].Y),π Round(CtrlPt[I].X+3), Round(CtrlPt[I].Y));π Line(Round(CtrlPt[I].X), Round(CtrlPt[I].Y-3),π Round(CtrlPt[I].X), Round(CtrlPt[I].Y+3));π End;π ReadLn;π CloseGraph;πEND.π