SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00082 GRAPHICS ROUTINES 1 05-28-9313:47ALL SWAG SUPPORT TEAM DOTSPIN.PAS IMPORT 22 program dotspin;ππvar inPort1:word;πprocedure waitRetrace;assembler;asmπ mov dx,inPort1; {find crt status reg (input port #1)}π@L1: in al,dx; test al,8; jnz @L1; {wait for no v retrace}π@L2: in al,dx; test al,8; jz @L2; {wait for v retrace}π end;ππconstπ 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}ππ{plot a pixel in mode $13}πprocedure plot(x,y:word);Inline(π $5E/ { pop si ;y}π $5F/ { pop di ;x}π $B8/$00/$A0/ { mov ax,$A000}π $8E/$C0/ { mov es,ax}π $B8/$40/$01/ { mov ax,320}π $F7/$E6/ { mul si}π $01/$C7/ { add di,ax}π $26/$F6/$15); {es: not byte[di]}ππprocedure plot4(x,y:word);const f=60;beginπ plot(x+f,y);π plot(199+f-x,199-y);π plot(199+f-y,x);π plot(y+f,199-x);π end;ππprocedure click;assembler;asmπ in al,$61; xor al,2; out $61,al;π end;ππconst nDots=21;ππvarπ dot:array[0..nDots-1]of recordπ x,y,sx,sy:integer;π end;ππfunction colorFn(x:integer):byte;beginπ colorFn:=63-(abs(100-x)div 2);π end;ππprocedure moveDots;var i:word;beginπ for i:=0 to nDots-1 do with dot[i] do beginπ plot4(x,y);π inc(x,sx);inc(y,sy);π if(word(x)>200)then beginπ sx:=-sx;inc(x,sx);click;π end;π if(word(y)>199)then beginπ sy:=-sy;inc(y,sy);click;π end;π plot4(x,y);π end;π waitRetrace;waitRetrace;waitRetrace;{waitRetrace;}π setcolor(255,colorFn(dot[0].x),colorFn(dot[3].x),colorFn(dot[6].x));π end;ππprocedure drawdots;var i:word;beginπ for i:=0 to nDots-1 do with dot[i] do plot4(x,y);π end;ππprocedure initDots;var i,j,k:word;beginπ j:=1;k:=1;π for i:=0 to nDots-1 do with dot[i] do beginπ x:=100;y:=99;π sx:=j;sy:=k;π inc(j);if j>=k then begin j:=1;inc(k); end;π end;π end;ππfunction readKey:char;Inline(π $B4/$07/ {mov ah,7}π $CD/$21); {int $21}ππfunction keyPressed:boolean;Inline(π $B4/$0B/ {mov ah,$B}π $CD/$21/ {int $21}π $24/$FE); {and al,$FE}ππbeginπ inPort1:=memw[$40:$63]+6;π port[$61]:=port[$61]and (not 1);π setcolor(255,60,60,63);π initDots;π asm mov ax,$13; int $10; end;π drawDots;π repeat moveDots until keypressed;π readkey;π drawDots;π asm mov ax,3; int $10; end;π end.πππ * OLX 2.2 * Printers do it without wrinkling the sheets.ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π 2 05-28-9313:47ALL SWAG SUPPORT TEAM MCGATUT.TXT IMPORT 40 MCGA Graphics Tutorialπ Lesson #1π by Jim CookππI'm not sure how this online tutorial will be received, but with yourπcomments and feedback I plan on creating a full-blown animation package. Thisπgraphics library will be available to the public domain and will contain theπfollowing abilities:ππ Setting/Reading Pixelsπ Drawing linesπ Saving/Restoring areas of the screenπ Displaying PCX/LBM files to the screenπ Spriting (Display picture with transparent areas)π Palette control (Smooth fades to black)π Page flippingππBefore we're done, you will have the tools to produce programs with rich,πeven photo-realistic (for the resolution) images on your PC. The necessaryπhardware is a VGA card and monitor that's it. I'll be using Turbo Pascalπversion 6.0. Please holler if that will be a problem. I'm using it toπcreate inline assembly. My alternatives are inline code (yuk) or linking inπexternal assembly. For speed (and actually ease) the latter is better. If Iπreceive three complaints against 6.0, I'll use external assembly.ππ What is MCGA?ππMulti-Color Graphics Array is the video card that IBM built into it's Modelπ25 and 30 PS/2's. It subsequently became a subset of the standard VGAπadapter card. It has the distiction of being the first card (excludingπTarga and other expensive cards) to display 256 colors at once on theπcomputer screen. To us that meant cool games and neat pictures. The MCGAπaddapter has added two new video modes to the PC world:ππ Mode $11 640x480x2 colorsπ Mode $13 320x200x256 colorsππObviously, we will deal with mode $13. If we wanted to deal with twoπcolors, we'd be programming a CGA. So much for the history lesson...let'sπdive in.ππI've created a unit, MCGALib, that will contain all of our MCGA routines.πThe first two procedures we will concern ourselves with are setting theπgraphics mode and setting a pixel. The MCGALib is followed by a testπprogram that uses the two procedures:ππUnit MCGALib;ππinterfaceππProcedure SetGraphMode (Num:Byte);πProcedure SetPixel (X,Y:Integer;Color:Byte);ππimplementationππvarπ ScreenWide : Integer;π ScreenAddr : Word;ππProcedure SetGraphMode (Num:Byte);πbeginπ asmπ mov al,Numπ mov ah,0π int 10hπ end;π Case Num ofπ $13 : ScreenWide := 320;π end;π ScreenAddr := $A000;πend;π{πFunction PixelAddr (X,Y:Word) : Word;πbeginπ PixelAddr := Y * ScreenWide + X;πend;ππProcedure SetPixel (X,Y:Integer;Color:Byte);πvarπ Ofs : Word;πbeginπ Ofs := PixelAddr (X,Y);π Mem [ScreenAddr:Ofs] := Color;πend;π}ππProcedure SetPixel (X,Y:Integer;Color:Byte);πbeginπ asmπ push dsπ mov ax,ScreenAddrπ mov ds,axππ mov ax,Yπ mov bx,320π mul bxπ mov bx,Xπ add bx,axππ mov al,Colorπ mov byte ptr ds:[bx],alπ pop dsπ end;πend;ππBeginπEnd.ππThis is the test program to make sure it's working...ππProgram MCGATest;ππusesπ Crt,Dos,MCGALib;ππvarπ Stop,π Start : LongInt;π Regs : Registers;ππFunction Tick : LongInt;πbeginπ Regs.ah := 0;π Intr ($1A,regs);π= egs.cx hl 16 Rgs.dx;πend;ππProcedure Control;πvarπ I,J : Integr;beginπ Start := ic;π Fr I := 0 to 199 doπ For J SetPixe (J,I,Random(256));π Stop := Tick;πend;ππPocdure Closing;πvarπ Ch : Chr;πbeginπ Repet Until Keypressed;π While Keypressed do Ch:= Reake;π TextMode (3);πook '(Stop-Start),' ticks or ,(Stop-Start)/182:4:3,'π seconds!');πnd;ππProcedure Init;πbeginπ SetGaphMode ($13);π Randoiz;πend;ππBeginπ Initπ Control;π Cosing;πe where these listings coul get unbearably long in time. I'lπexplore a few ays I can get this information to ya'll without takingup tooπmuch pace. Iwould like you tomake sue this routine works, ust in caseπyou ou graphis card. You may notce two SetPxelπprocedures in the MCGALib, one is commented out. Remove he comments,πcomment up the uncommented SetPixel and run the test program aain. Noticeπthe speed degradation. Linking in raw assembly will eve improve upon theπspeed of the inline assembly.πPlease take the time to study each procedure and ASK ANY QUESTIONS tht youπmay have, even if it doesn't relate to the graphics routines. I'm cetain Iπdo not want to get pulled off track by any discussions about STYLE,ur critiqueπ for others to learn rom.ππ Coming next timeππI think a discussio of video memory is paramount. Possibly vertical andπhorizontal lines, if spce permits.ππHappy grafxπjimππ--- QuickBBS 2.75π * Origin: Quantum Leap.. (512)333-5360 HST/DS (1:387/307)π 3 07-16-9306:46ALL SWAG SUPPORT TEAM Simulate Star Field IMPORT 28 ╓ π{Program to simulate travel through a star field - try a different MaxStar}πusesπ TpCrt, TpInline, Graph; {OpInline used for HiWord only}πconstπ MaxStar = 50; {num stars}π MaxHistory = 3; {points per streak, = 2**n -1, note mask on line #59}πtypeπ T_HistoryPoint = recordπ hX, hY : Integer;π end;π T_Star = recordπ X, Y : LongInt; {star position}π DX, DY : LongInt; {delta}π DXPositive,π DYPositive : Boolean;π Speed : Word;π History : array[0..MaxHistory] of T_HistoryPoint; {Position history}π HistIndex : Byte;π end;π T_StarArray = array[1..MaxStar] of T_Star;πvarπ Gd,π Gm,π i,π j : Integer;ππ Color : Word;ππ A : T_StarArray;π BoundX,π BoundY,π CenterX,ππ CenterY : LongInt;ππ Angle : Real;ππ Shift : Byte;ππBEGINπ Gd := Detect;π InitGraph(Gd, Gm, '\turbo\tp');π if GraphResult <> grOk thenπ Halt(1);π Color := GetMaxColor;π BoundX := GetMaxX * 65536;π BoundY := GetMaxY * 65536;π CenterX := GetMaxX * 32768;π CenterY := GetMaxY * 32768;π FillChar(A, SizeOf(A), $FF);π Randomize;π {Background}π for i := 1 to 1500 doπ PutPixel(Random(GetMaxX), Random(GetMaxY), Color);π {Stars}π repeatπ for i := 1 to MaxStar doπ with A[i] doπ beginπ if (X < 0) or (X > BoundX) or (Y < 0) or (Y > BoundY) thenπ beginπ {Position is off-screen, go back to center, new angle}π Angle := 6.283185 * Random;π Speed := Random(2000) + 1000;π DX := Round(Speed * Sin(Angle));π DY := Round(Speed * Cos(Angle));π X := 300 * DX + CenterX;π Y := 300 * DY + CenterY;π DXPositive := DX > 0;π DYPositive := DY > 0;π DX := Abs(DX);π DY := Abs(DY);π {Erase all of old line segment}π for j := 0 to MaxHistory doπ with History[j] doπ PutPixel(hX, hY, 0);π endπ elseπ begin {Plot point}π Inc(HistIndex); {Next slot in history}π HistIndex := HistIndex and $03; { <-- change for new MaxHistory!}π with History[HistIndex] doπ beginπ PutPixel(hX, hY, 0); {Erase inner dot of line segment}π hX := HiWord(X);π hY := HiWord(Y);π PutPixel(hX, hY, Color); {New outer dot of line segment}π end;π {Next point}π if DXPositive thenπ Inc(X, DX)π elseπ Dec(X, DX); {Add delta}π if DYPositive thenπ Inc(Y, DY)π elseπ Dec(Y, DY);π case Speed ofπ 1000..1300 : Shift := 9;π 1300..1600 : Shift := 8;π 1600..2100 : Shift := 7;π 2100..2700 : Shift := 6;π 2700..2900 : Shift := 5;π 2900..3000 : Shift := 4;π end;π Inc(DX, DX shr Shift); {Increase delta to accelerate}π Inc(DY, DY shr Shift);π end;π end;π until KeyPressed;π ReadLn;π CloseGraph;πEND.ππ 4 07-16-9306:47ALL SWAG SUPPORT TEAM A simple Star Field IMPORT 11 ╓ π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.ππ 5 07-16-9306:47ALL SWAG SUPPORT TEAM A Color Star Field IMPORT 29 ╓ {-------------------------- SCHNIPP -----------------------------}ππ{STARSCROLL.PAS geaenderte Fassung }ππ{$A+,B-,D-,E-,F+,I+,L-,N-,O-,R-,S-,V-}π{$M 64000,0,655360}ππUSES crt,graph,BGIDriv; {ich binde die Treiber ein}ππCONST MaxStars=500; {auf meinem 386-25er muss ich inπ der geaenderten Fassung schon 500π Sterne eintragen, damit es nur nochπ ein wenig schneller ist als die alteπ Fassung mit 100 Sternen ;-)}ππTYPE Punkt=ARRAY[1..3] OF INTEGER; {Siehe ganz unten Move()}ππVARπ gd,gm,mpx,mpy,scal,a,b,e:integer;π Stars1,Stars:ARRAY[1..MaxStars] OF Punkt;ππ mx,my,m2x,m2y,sop, {siehe Init}π act:INTEGER;ππPROCEDURE dpunkt( x,y,z, Col:integer);πVAR n:INTEGER;π BEGINπ n:=z+e;ππ {n=Nenner, nur einmal berechnen, geht schneller}ππ PutPixel(mpx+ (scal*x div n),mpy+ (scal*y div n),col);ππ {hier nur integer-operationen}π END;ππPROCEDURE dline( x1,y1,z1,x2,y2,z2:integer);πVAR n1,n2:INTEGER;π BEGINπ n1:=z1+e;n2:=z2+e; {n1=Nenner fuer 1.Punkt, n2=Nenner fuer 2.Punkt}ππ Line(mpx+(scal*(x1 div n1)),mpy+(scal*(y1 div n1)),π mpx+(scal*(x2 div n2)),mpy+(scal*(y2 div n2)));ππ {Nix mit Round(xxx / nX), dauert zu lange: Integer ->Real ->Integer}π END;ππPROCEDURE Init;πbeginπ act:=1;π e:=1;π scal := 2;ππ mx:=getmaxx; {damit man es auch in EgaLo oder anderen GModes}π m2x:=mx shr 1; {betreiben kann, alle Werte abhaengig von MaximalX und}π my:=getmaxy; {MaximalY}π m2y:=my shr 1;π mpx:=m2x;π mpy:=m2y-(mpy shr 1);ππ sop:=sizeof(punkt); {Schreibt sich leichter :-) }πend;ππBEGINπ Randomize;π gd:=ega;π gm:=egahi;ππ if RegisterBGIdriver(@EgaVgaDriverProc) < 0 then halt(255);ππ InitGraph(gd,gm,''); {oder InitGraph(gd,gm,'PathToDriver');}π Init;π FOR a:=0 TO 15 DO SetRGBPalette(a,a*3,a*3,a*3);π FOR a:=1 TO MaxStars DOπ BEGINπ Stars[a,1]:=Random(mx)-m2x;π Stars[a,2]:=Random(my)-m2y;π Stars[a,3]:=Random(30)+1;π END;ππ Move(Stars,Stars1,SoP*MaxStars); {man sollte Stars1 initialisieren}π {wenn man es benutzt}π SetColor(15);π SetVisualPage(act);ππ {AB hier kommt es auf Geschwindigkeit an}ππ REPEATπ {IF act=0 THEN act:=1 ELSE act:=0; dauert zu lange, deshalb:}π {wenn (act)=1 -> act:=1-(1) = 0 wenn (act)=0 -> act:=1-(0)=1}π act:=1-act;ππ SetActivePage(act);π FOR a:= 1 TO MaxStars DOπ BEGINπ Stars[a,3]:=Stars[a,3]-1;π IF stars[a,3]= 0 THENπ BEGINπ Stars[a,1]:=Random(mx)-m2x;π Stars[a,2]:=Random(my)-m2y;π Stars[a,3]:=30;π END;π dpunkt(Stars[a,1],Stars[a,2],Stars[a,3],15-(stars[a,3] shr 1));ππ {round(xxx/2) dauert zu lange {shr 1 = div 2 }π END;π SetVisualPage(act);ππ act:=1-act; {s.o.}ππ SetActivePage(act);π FOR a:=1 TO MaxStars DOπ BEGINπ dpunkt(Stars1[a,1],Stars1[a,2],Stars1[a,3],0);ππ {Wenn man Stars1 nicht initialisierst kommt es schon mal vor, dassπ man einen Division by Zero Error beim ersten beim 1. Aufruf erhaelt}ππ move(stars[a],stars1[a],sop);ππ {nicht einzeln uebertragen, Move ist schneller, deshalb auch Type Punkt}ππ END;ππ act:=1-act; {s.o.}ππ UNTIL KeyPressed;ππ closegraph; {Nicht vergessen !!!! ;-) }πEND.ππ{------------------------- SCHNAPP --------------------------------------}ππ 6 08-23-9309:18ALL SEAN PALMER FAST Mode 13h Line Draw IMPORT 29 ╓ {π===========================================================================π BBS: Beta ConnectionπDate: 08-20-93 (09:59) Number: 2208πFrom: SEAN PALMER Refer#: NONEπ To: ALL Recvd: NO πSubj: FAST mode 13h Li (Part 1) Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------πHey! Here's THE fastest mode 13h bresenham's line drawing function ever.π(I think...prove me wrong, please!!)ππIt's written for TP 6 or better, uses BASM. If you don't know assembly, justπput it in a unit and don't worry about how it works. If you do, fine.πSome good optimizations in there...ππHave fun! If anyone wants the mostly-pascal equivalent, let me know.πIt's still fast.ππ{by Sean Palmer}π{public domain}ππvar color:byte;ππprocedure line(x,y,x2,y2:word);assembler;asm {mode 13}π mov ax,$A000π mov es,axπ mov bx,xπ mov ax,yπ mov cx,x2π mov si,y2π cmp ax,siπ jbe @NO_SWAP {always draw downwards}π xchg bx,cxπ xchg ax,siπ@NO_SWAP:π sub si,ax {yd (pos)}π sub cx,bx {xd (+/-)}π cld {set up direction flag}π jns @H_ABSπ neg cx {make x positive}π stdπ@H_ABS:π mov di,320π mul diπ mov di,axπ add di,bx {di:adr}π or si,siπ jnz @NOT_Hπ{horizontal line}π cldπ mov al,colorπ inc cxπ rep stosbπ jmp @EXITπ@NOT_H:π or cx,cxπ jnz @NOT_Vπ{vertical line}π cldπ mov al,colorπ mov cx,siπ inc cxπ mov bx,320-1π@VLINE_LOOP:π stosbπ add di,bxπ loop @VLINE_LOOPπ jmp @EXITπ@NOT_V:π cmp cx,si {which is greater distance?}π lahf {then store flags}π ja @H_INDπ xchg cx,si {swap for redundant calcs}π@H_IND:π mov dx,si {inc2 (adjustment when decision var rolls over)}π sub dx,cxπ shl dx,1π shl si,1 {inc1 (step for decision var)}π mov bx,si {decision var, tells when we need to go secondary direction}π sub bx,cxπ inc cxπ push bp {need another register to hold often-used constant}π mov bp,320π mov al,colorπ sahf {restore flags}π jb @DIAG_Vπ{mostly-horizontal diagonal line}π or bx,bx {set flags initially, set at end of loop for other iterations}π@LH:π stosb {plot and move x, doesn't affect flags}π jns @SH {decision var rollover in bx?}π add bx,siπ loop @LH {doesn't affect flags}π jmp @Xπ@SH:π add di,bpπ add bx,dxπ loop @LH {doesn't affect flags}π jmp @Xπ@DIAG_V:π{mostly-vertical diagonal line}π or bx,bx {set flags initially, set at end of loop for other iterations}π@LV:π mov es:[di],al {plot, doesn't affect flags}π jns @SV {decision var rollover in bx?}π add di,bp {update y coord}π add bx,siπ loop @LV {doesn't affect flags}π jmp @Xπ@SV:π scasb {sure this is superfluous but it's a quick way to inc/dec x coord!}π add di,bp {update y coord}π add bx,dxπ loop @LV {doesn't affect flags}π@X:π pop bpπ@EXIT:π end;ππvar k,i,j:word;πbeginπ asm mov ax,$13; int $10; end;π for k:=0 to 31 do beginπ i:=k*10;π j:=k*6;π color:=14;π line(159,99,i,0);π color:=13;π line(160,99,319,j);π color:=12;π line(160,100,319-i,199);π color:=11;π line(159,100,0,199-j);π i:=k*9;π j:=k*5;π color:=6;π line(i,0,159,99);π color:=5;π line(319,j,160,99);π color:=4;π line(319-i,199,160,100);π color:=3;π line(0,199-j,159,100);π end;π Readln;π asm mov ax,3; int $10; end;π end.ππ... I'm not unemployed, I'm indefinitely leisured.π___ Blue Wave/QWK v2.12π---π * deltaComm Online 919-481-9399 - 10 linesπ * PostLink(tm) v1.06 DELTA (#22) : RelayNet(tm) HUBπ 7 08-27-9319:57ALL STEVE CONNET 3D Rotations IMPORT 22 ╓ {πSTEVE CONNETππOkay, here's the equations For 3D rotations...ππx,y,z are the coordinates of the point you want to rotate.πrx,ry,rz are the amount of rotation you want (in degrees) For x,y,zπ}ππ x1 := round(cos(rad(ry)) * x - sin(rad(ry)) * z);π z1 := round(sin(rad(ry)) * x + cos(rad(ry)) * z);π x := round(cos(rad(rz)) * x1 + sin(rad(rz)) * y);π y1 := round(cos(rad(rz)) * y - sin(rad(rz)) * x1);π z := round(cos(rad(rx)) * z1 - sin(rad(rx)) * y1);π y := round(sin(rad(rx)) * z1 + cos(rad(rx)) * y1);ππ{πBecause in Turbo Pascal, COS and SIN require radians For the argument,πI wrote a short Function called RAD() that converts degrees into radiansπ(I find degrees much easier to visualize)π}ππ Function Rad(i : Integer) : Real;π beginπ Rad := i * (Pi / 360);π end;ππ{πOf course, since most computers don't have 3D projection screens <G>,πuse these equations to provide a sense of perspective to the Object,πbut With 2D coordinates you can plot on a screen.ππx,y,z are from the equations above, and xc,yc,zc are the center pointsπfor the Object that you are rotating... I recommend setting xc,yc at 0,0πbut zc should be very high (+100).π}π x2 := trunc((xc * z - x * zc) / (z - zc));π y2 := trunc((yc * z - y * zc) / (z - zc));ππ{πAlternatively, if you don't want to bother With perspective, just dropπthe z values, and just plot the (x,y) instead.πππTo use these equations, pick a 3D Object and figure out what the 3Dπcoordinates are For each point on the Object. You will have to have someπway to let the computer know which two points are connected. For theπcube that I did, I had one Array For the points and one For each faceπof the cube. That way the computer can draw connecting lines For eachπface With a simple for-loop.π}ππTypeπ FaceLoc = Array [1..4] of Integer;π PointLoc = Recordπ x, y, z : Integer;π end;ππConstπ face_c : Array [1..6] of faceloc =(π (1,2,3,4),π (5,6,2,1),π (6,5,8,7),π (4,3,7,8),π (2,6,7,3),π (5,1,4,8));ππ point_c : Array [1..8] of pointloc =(π (-25, 25, 25),π ( 25, 25, 25),π ( 25,-25, 25),π (-25,-25, 25),π (-25, 25,-25),π ( 25, 25,-25),π ( 25,-25,-25),π (-25,-25,-25));π{πThere you go. I'm not going to get much more complicated For now. if youπcan actually get these equations/numbers to work (and I haven't forgottenπanything!) leave me another message, and I'll give you some advice forπfilling in the sides of the Object (so that you can only see 3 sides atπonce) and some advice to speed things up abit. if you have any problemsπwith whats here, show some other people, and maybe as a collective you canπfigure it out. Thats how I got this one started!π}π 8 08-27-9320:02ALL THOMAS GROFF Endpoints of PIE SegmentIMPORT 10 ╓ {πTHOMAS GROFFππ> would like a unit to return the endpoints of a PIE segment. You couldπ> always draw the arc invisibly and then use the GetArcCoords() procedureπ> provided in the graph unit and save yourself some time.π}ππprogram getlegs;πusesπ graph;πvarπ pts3 : arccoordstype; { <---- Necessary to declare this type var. }π rad,π startang,π endang,π x, y,π gd, gm : integer;πbeginπ gd := detect;π InitGraph(gd,gm,'e:\bp\bgi');π cleardevice;π x := 100;π y := 100;π startang := 25;π endang := 130;π rad := 90;ππ setcolor(getbkcolor); { <------ Draw arc in background color. }π arc(x, y, startang, endang, rad);π GetArcCoords(pts3); { <----- This is what you want, look it up! }π setcolor(white); { <----- Show your lines now.}π line(pts3.x, pts3.y, pts3.xstart, pts3.ystart);π line(pts3.x, pts3.y, pts3.xend, pts3.yend);π outtextxy(50, 150, 'Press enter to see your original arc when ready...');ππ readln;π setcolor(yellow);π arc(x, y, startang, endang, rad);π outtextxy(50, 200, 'Press enter stop demo.');π readln;π closegraph;πend.π 9 08-27-9320:03ALL STEPHEN CHEOK ASM Fading IMPORT 11 ╓ {πSTEPHEN CHEOKππ> Could you post the fade out source?π}ππPROCEDURE DimDisplay(delayfactor : INTEGER); ASSEMBLER;ππ{ Total time to fade out in seconds = ((DelayFactor+1)*MaxIntensity) / 1000 }ππCONSTπ MaxIntensity = 45;π {MaxIntensity = 63;}ππVARπ DACTable : Array [0..255] OF RECORDπ R, G, B : BYTE;π END;πASMπ PUSH DSπ MOV AX, SSπ MOV ES, AXπ MOV DS, AXππ { Store colour information into DACTable }ππ LEA DX, DACTableπ MOV CX, 256π XOR BX, BXπ MOV AX, 1017hπ INT 10hππ MOV BX, MaxIntensityππ { VGA port 3C8h: PEL address register, (colour index,π increments automatically after every third write)π VGA port 3C9h: PEL write register (R, G, B) }ππ CLDπ @1:π LEA SI, DACTableπ MOV DI, SIπ MOV CX, 3*256π XOR AX, AXπ MOV DX, 3C8hπ OUT DX, ALπ INC DXππ { Get colour value, decrement it and update the table }ππ @2:π LODSBπ OR AX, AXπ JZ @3π DEC AXπ @3:π STOSBπ OUT DX, ALπ LOOP @2ππ { Delay before next decrement of R, G, B values }ππ PUSH ESπ PUSH BXπ MOV AX, DelayFactorπ PUSH AXπ CALL Delayπ POP BXπ POP ESππ DEC BXπ OR BX, BXπ JNZ @1π POP DSπEND; { DimDisplay }πππ 10 08-27-9320:14ALL RANDY PARKER Including BGI in EXE IMPORT 23 ╓ {πRANDY PARKERππ> Does anyone out there knwo how you can compile a Program using one ofπ> Borland's BGI units for grpahics and not have to distribute the BGIπ> file(s) with the EXE?ππ First, convert the BGI and CHR files to .OBJ files (object) by usingπBINOBJ.EXE. You may just want to clip out the following and name it as a batchπfile.ππ BINOBJ.EXE goth.chr goth gothicfontprocπ BINOBJ.EXE litt.chr litt smallfontprocπ BINOBJ.EXE sans.chr sans sansseriffontprocπ BINOBJ.EXE trip.chr trip triplexfontprocπ BINOBJ.EXE cga.bgi cga cgadriverprocπ BINOBJ.EXE egavga.bgi egavga egavgadriverprocπ BINOBJ.EXE herc.bgi herc hercdriverprocπ BINOBJ.EXE pc3270.bgi pc3270 pc3270driverprocπ BINOBJ.EXE at.bgi att attdriverprocππ You should now have the following files:ππ ATT.OBJ, CGA.OBJ, EGAVGA.OBJ GOTH.OBJ HERC.OBJ LITT.OBJ PC3270.OBJ,π SANS.OBJ, TRIP.OBJ.π}ππunit GrDriver;ππinterfaceππuses Graph;ππimplementationππprocedure ATTDriverProc; External; {$L ATT.OBJ}πprocedure CGADriverProc; External; {$L CGA.OBJ}πprocedure EGAVGADriverProc; External; {$L EGAVGA.OBJ}πprocedure HercDriverProc; External; {$L HERC.OBJ}πprocedure PC3270DriverProc; External; {$L PC3270.OBJ}ππprocedure ReportError(s : string);πbeginπ writeln;π writeln(s, ': ', GraphErrorMsg(GraphResult));π Halt(1);πend;ππbeginπ if RegisterBGIdriver(@ATTDriverProc) < 0 thenπ ReportError('AT&T');π if RegisterBGIdriver(@CGADriverProc) < 0 thenπ ReportError('CGA');π if RegisterBGIdriver(@EGAVGADriverProc) < 0 thenπ ReportError('EGA-VGA');π if RegisterBGIdriver(@HercDriverProc) < 0 thenπ ReportError('Hercules');π if RegisterBGIdriver(@PC3270DriverProc) < 0 thenπ ReportError('PC-3270');πend.πππunit GrFont;ππinterfaceππusesπ Graph;ππimplementationππprocedure GothicFontProc; External; {$L GOTH.OBJ}πprocedure SansSerifFontProc; External; {$L SANS.OBJ}πprocedure SmallFontProc; External; {$L LITT.OBJ}πprocedure TriplexFontProc; External; {$L TRIP.OBJ}ππprocedure ReportError(s : string);πbeginπ writeln;π writeln(s, ' font: ', GraphErrorMsg(GraphResult));π halt(1)πend;ππbeginπ if RegisterBGIfont(@GothicFontProc) < 0 thenπ ReportError('Gothic');π if RegisterBGIfont(@SansSerifFontProc) < 0 thenπ ReportError('SansSerif');π if RegisterBGIfont(@SmallFontProc) < 0 thenπ ReportError('Small');π if RegisterBGIfont(@TriplexFontProc) < 0 thenπ ReportError('Triplex');πend.ππ{πBy using the 2 units above, you should be able to include any video driverπof font (that were listed) by simply insertingππUsesπ GrFont, GrDriver, Graph;ππinto your graphic files.ππI got this out of a book name Mastering Turbo Pascal 6, by Tom Swan. It's anπexcellent book that covers from Turbo 4.0 to 6.0, basics to advanced subjects.πHope it works for you.π}π 11 08-27-9320:16ALL WILBER VAN LEIJEN Very Large Graphic Image IMPORT 15 ╓ {πWILBERT VAN LEIJENππ> I am looking for a way to get an Image into a pointer (besides arrays)π> and write it to my disk. I am using arrays right now, and works fine, butπ> When I get big images I run out of mem fast... :: IBUF : array [1..30000]π> of byte; getimage(x1,y1,x2,y2,IBUF); repeat Write(f,IBUF[NUM]); num:=num+1;π> until num=sizeof(ibuf);π> This works as long as I dont try to grab a large image.ππThese "large images" are in fact stored in "planes", chunks of up to 64 kByteπin size. You must understand the VGA architecture to store these in a file.πThe only VGA video mode that keeps all data (from the programmer's point ofπview) into a single data space is mode 13h (320x200 with 256 colours): a simpleπarray [1..200, 1..320] of Byte. The other video modes require you to accessπthe VGA hardware: take for example 640x480 by 16 colours: 4 planes of 38,400πbytes (Red, Green, Blue and Intensity). Together with the colour informationπas returned by BIOS call INT 10h/AX=1012h they make up the picture.ππHere's how you select a plane:π}ππProcedure SwitchBitplane(plane : Byte); Assembler;ππASMπ MOV DX, 3C4hπ MOV AL, 2π OUT DX, ALπ INC DXπ MOV AL, planeπ OUT DX, ALπend;ππ{πAssume the video mode to be 12h (640x480/16 colours), BitplaneSize = 38400, andπBitplane is an Array[0..3] of pointer to an array [1..38400] of Byte:π}π For i := 0 to 3 Doπ Beginπ SwitchBitplane(1 shl i);π Move(Bitplane[i]^, Ptr($A000, $0000)^, BitplaneSize);π end;π{πThis is a snippet of code lifted from my VGAGRAB package; a TSR that dumpsπgraphic information (any standard VGA mode) to a disk file by pressingπ<PrtScr>, plus a few demo programs written in TP - with source code. Availableπon FTP sites.π}π 12 08-27-9320:18ALL RAPHAEL VANNEY Display Text in Graphics IMPORT 11 ╓ {πRAPHAEL VANNEYππ*You mean displaying Text While in Graphics mode :-) ?ππ> Yup. Already got a suggestion on using 640x480 With 8x8 font, so ifπ> you have any other one please do tell.. ttyl...ππSure. Just call the BIOS routines to display Characters With a "standard"πlook. By standard look, I mean they look like they were Characters inπText mode.ππOkay, here is the basic Procedure to display a String (Works in any Text/πGraphics mode) :π}ππProcedure BIOSWrite(Str : String; Color : Byte); Assembler;πAsmπ les di, Strπ mov cl, es:[di] { cl = longueur chane }π inc di { es:di pointe sur 1er caractre }π xor ch, ch { cx = longueur chane }π mov bl, Color { bl:=coul }π jcxz @ExitBW { sortie si Length(s)=0 }π @BoucleBW:π mov ah, 0eh { sortie TTY }π mov al, es:[di] { al=caractre afficher }π int 10h { et hop }π inc di { caractre suivant }π loop @BoucleBWπ @ExitBW:πend ;ππ{πI'm not sure how to manage the background color in Graphics mode ; maybeπyou should experiment With values in "coul", there could be a magic bitπto keep actual background color.π}ππ 13 08-27-9320:18ALL SEAN PALMER Bit Map scaler IMPORT 18 ╓ {πSEAN PALMERππWell, I got a wild hair up my butt and decided to convert thatπbitmap scaler I posted into an inline assembler procedure (mostly)πIt's now quite a bit faster...ππby Sean Palmerπpublic domainπ}ππ{bitmaps are limited to 256x256 (duh)}ππtypeπ fixed = recordπ case boolean ofπ true : (w : longint);π false : (f, i : word);π 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π bmp2 : array [0..63, 0..63] of byte;π i, j : integer;ππprocedure scaleBitmap(var bitmap; x, y : byte; x1, y1, x2, y2 : word);πvarπ s, w, h : word; {xSkip,width,height}π sx, sy, cy : fixed; {xinc, yinc, ySrcPos}πbeginπ w := x2 - x1 + 1;π h := y2 - y1 + 1;π sx.w := x * $10000 div w;π sy.w := y * $10000 div h;π s := 320-w;π cy.w := 0;π asmπ push dsπ mov ds, word ptr bitmap+2;π mov ax, $A000π mov es, ax {setup screen seg}π cldπ mov ax, 320π mul y1π add ax, x1π mov di, ax {calc screen adr}π @L2:π mov ax, cy.iπ mul xπ mov bx, axπ add bx, word ptr bitmap {offset}π mov cx, wπ mov si, 0 {fraction of src adr (bx.si)}π mov dx, sx.fπ @L:π mov al, [bx]π stosbπ add si, dxπ adc bx, sx.i {if carry or sx.i<>0, new source pixel}π loop @Lπ add di, s {skip to next screen row}π mov ax, sy.fπ mov bx, sy.iπ add cy.f, axπ adc cy.i, bxπ dec word ptr hπ jnz @L2π pop dsπ end;πend;ππbeginπ for i := 0 to 63 do {init bmp2}π for j := 0 to 63 doπ bmp2[j, i] := j + (i xor $19) + 32;π asmπ mov ax, $13π int $10π end; {init vga mode 13h}π for i := 2 to 99 do {test bmp}π scaleBitMap(bmp, 4, 4, 0, 0, i * 2 - 1, i * 2 - 1);π for i := 99 downto 2 doπ scaleBitMap(bmp, 4, 4, 0, 0, i * 2 - 1, 197);π for i := 1 to 66 do {test bmp2}π scaleBitMap(bmp2, 64, 64, 0, 0, i * 2 - 1, i * 3 - 1);π for i := 66 downto 1 doπ scaleBitMap(bmp2, 64, 64, 0, 0, i * 2 - 1, i * 2 - 1 + 66);π asmπ mov ax, $3π int $10π end; {restore text mode}πend.π 14 08-27-9320:25ALL MICHAEL NICOLAI Drawing Graphic Circles IMPORT 23 ╓ {πMICHAEL NICOLAIπππThe basic formula (and quickest) For drawing a circle is: x^2 + y^2 = r^2.πThe r stands For radius (half the diameter). You know this formula, i amπsure. A guy called Phytagoras set i up very long ago to calculate theπhypotenuse of a given triangle. (there has to be a 90° angel between a and b)πππ |\π | \π a | \ c c^2 = a^2 + b^2π | \π |____\ππ bππRemember?ππNow look at this: ...| a quater of the circleπ .. |π . ____|yπ . |\ |π . | \ |π . | r\ |π . | \|π --------------------------π r x |0π |π |πππr is given and take 0 - r as a starting point For x. Then all you have to doπis to calculate y and plot the point.ππ y = sqrt((r * r) - (x * x)) sqrt : square rootππAfter each calculation x is increased Until it has reached 0. Then oneπquarter of the circle is drawn. The other three quarters are symmetrical.ππI have written a short Program For you to draw a circle in 320x200x256πGraphics mode. When you key in some values please remember that NO errorπchecking will be done. x has to be between 0 and 319, and y between 0 andπ199. The radius must not be greater than x and y.ππExample: x : 160; y : 100; r : 90ππWhen you start this Program you will not get correct circles because inπGraphics mode ONE pixel is not square!!! You have to calculate an aspectπratio to get nice looking circles.π}ππProgram circle;ππUsesπ Crt, Dos;ππVarπ regs : Registers;π x0, y0 : Word;π x, y, R : Real;π temp : Real;π c : Char;ππProcedure putpixel(x, y : Word; color : Byte);πbeginπ mem[$A000: (y * 320 + x)] := color;πend;ππbeginπ ClrScr;π Writeln('Enter coordinates of middle-point :');π Writeln;π Write('x : '); readln(x0);π Write('y : '); readln(y0);π Writeln;π Write('Enter radius :'); readln(R);ππ { Switch to 320x200x256 }ππ regs.ax := $0013;π intr($10, regs);ππ x := (-1) * R; { go from 0 - R to 0 }π temp := R * R;π Repeatπ y := sqrt(temp - (x * x));π putpixel((x0 + trunc(x)), (y0 - trunc(y)), 15); { 4.th quadrant }π putpixel((x0 - trunc(x)), (y0 - trunc(y)), 15); { 1.st quadrant }π putpixel((x0 + trunc(x)), (y0 + trunc(y)), 15); { 3.rd quadrant }π putpixel((x0 - trunc(x)), (y0 + trunc(y)), 15); { 2.nd quadrant }π x := x + 0.1; { change this if you want coarse or fine circle. }π Until (x >= 0.0);π c := ReadKey; { wait For keypress. }ππ { Switch back to Textmode. }ππ regs.ax := $0003;π intr($10, regs);πend.π 15 08-27-9320:25ALL MICHAEL NICOLAI More Graphic Circles IMPORT 25 ╓ {πMICHAEL NICOLAIππ>does someone have a circle routine For the 320x200x256 mode.π>I need one using the Assembler... (FAST) ( or isn't that possible)π>I doesn't need to be very perfect, if it has the shape of a circle,π>I'm satisfied.ππI don't have any Asm-Program yet but i got the same question some time ago.ππOk then, let's do some math:ππThe basic formula (and quickest?) For drawing a circle is: x^2 + y^2 = r^2.πThe r stands For radius (half the diameter). You know this formula, i amπsure. A guy called Phytagoras set i up very long ago to calculate theπhypotenuse of a given triangle.ππ |\π | \π a | \ c c^2 = a^2 + b^2π | \π |____\ππ bπRemember?ππNow look at this: ...| a quater of the circleπ .. |π . ____|yπ . |\ |π . | \ |π . | r\ |π . | \|π --------------------------π r x |0π |π |ππr is given and take 0 - r as a starting point For x. Then all you have to doπis to calculate y and plot the point.ππ y = sqrt((r * r) - (x * x)) sqrt : square rootππAfter each calculation x is increased Until it has reached 0. Then oneπquarter of the circle is drawn. The other three quarters are symmetrical.ππI have written a short Program For you to draw a circle in 320x200x256πGraphics mode. When you key in some values please remember that NO errorπchecking will be done. x has to be between 0 and 319, and y between 0 andπ199. The radius must not be greater than x and y.ππExample: x : 160; y : 100; r : 90ππWhen you start this Program you will not get correct circles because inπGraphics mode ONE pixel is not square!!! You have to calculate an aspectπratio to get nice looking circles.π}ππProgram circle;ππUsesπ Crt, Dos;ππVarπ regs : Registers;π x0, y0 : Word;π x, y, R : Real;π temp : Real;π c : Char;ππProcedure putpixel(x, y : Word; color : Byte);πbeginπ mem[$A000 : (y * 320 + x)] := color;πend;ππbeginπ ClrScr;π Writeln('Enter coordinates of middle-point :');π Writeln;π Write('x : ');π readln(x0);π Write('y : ');π readln(y0);π Writeln;π Write('Enter radius :');π readln(R);ππ { Switch to 320x200x256 }ππ regs.ax := $0013;π intr($10, regs);ππ x := (-1) * R; { go from 0 - R to 0 }π temp := R * R;π Repeatπ y := sqrt(temp - (x * x));π putpixel((x0 + trunc(x)), (y0 - trunc(y)), 15); { 4.th quadrant }π putpixel((x0 - trunc(x)), (y0 - trunc(y)), 15); { 1.st quadrant }π putpixel((x0 + trunc(x)), (y0 + trunc(y)), 15); { 3.rd quadrant }π putpixel((x0 - trunc(x)), (y0 + trunc(y)), 15); { 2.nd quadrant }π x := x + 0.1; { change this if you want coarse or fine circle. }π Until (x >= 0.0);π c := ReadKey; { wait For keypress. }ππ { Switch back to Textmode. }ππ regs.ax := $0003;π intr($10, regs);πend.π 16 08-27-9320:25ALL MIKE BURNS Another Circle Routine IMPORT 11 ╓ {πMIKE BURNSππ> does someone have a circle routine for the 320x200x256 mode. I need oneπ> using the assembler... (FAST) ( or isn't that possible) I doesn't need toπ> be very perfect, if it has the shape of a circle, I'm satisfied.π}ππPROCEDURE SWAP(VAR A, B : Integer);πVarπ X : Integer;πBeginπ X := A;π A := B;π B := X;πEnd;ππVarπ SCR : Array [0..199, 0..319] of Byte Absolute $A000 : $0000;ππPROCEDURE Circle(X, Y, Radius : Word; Color: Byte);πVARπ a, af, b, bf,π target, r2 : Integer;πBeginπ Target := 0;π A := Radius;π B := 0;π R2 := Sqr(Radius);ππ While a >= B DOπ Beginπ b:= Round(Sqrt(R2 - Sqr(A)));π Swap(Target, B);π While B < Target Doπ Beginπ Af := (120 * a) Div 100;π Bf := (120 * b) Div 100;π SCR[x + af, y + b] := color;π SCR[x + bf, y + a] := color;π SCR[x - af, y + b] := color;π SCR[x - bf, y + a] := color;π SCR[x - af, y - b] := color;π SCR[x - bf, y - a] := color;π SCR[x + af, y - b] := color;π SCR[x + bf, y - a] := color;π B := B + 1;π End;π A := A - 1;π End;πEnd;ππbeginπ Asmπ Mov ax, $13π Int $10;π end;ππ Circle(50, 50, 40, $32);π Readln;ππ Asmπ Mov ax, $03π Int $10;π end;πend.ππππππ 17 08-27-9320:28ALL SEAN PALMER Simple coppering routineIMPORT 29 ╓ {πSEAN PALMERππ>Okay, I've got this small problem porting one of my assembler routinesπ>into pascal. It's a simple coppering routine (multiple setting of theπ>same palette register for trippy effects :), and i can't seem to use itπ>in my code.. I'll post the code here now (it's fairly short), and ifπ>someone could help me out here, i'd be most grateful - since myπ>assembler/pascal stuff isn't too great..ππI imported it, but couldn't get it to work (several problems in theπsource) and in the process of getting it to work (for one thing I didn'tπknow what it was supposed to accomplish in the first place) I added aπfew things to it and this probably isn't what you wanted it to look likeπbut it wouldn't be hard to do now that it's in TP-acceptable form.ππI also added one other small palette flipper that's kind of neat.π}ππ{$G+}πusesπ crt;ππprocedure copperBars(var colors; lines : word; regNum, count : byte); assembler;πvarπ c2 : byte;πasmπ{π okay, Colors is a pointer to the variable array ofπ colours to use (6bit rgb values to pump to the dac)π Lines is the number of scanlines on the screen (for syncing)π RegNum is the colour register (DAC) to use.π valid values are 0-255. that should explain that one.π Count is the number of cycles updates to do before it exits.π}π push dsππ mov ah, [RegNum]π mov dx, $3DA {vga status port}π mov bl, $C8 {reg for DAC}π cliπ cldππ @V1:π in al, dxπ test al, 8π jz @V1 {vertical retrace}π @V2:π in al, dxπ test al, 8π jnz @V2ππ mov c2, 1π mov di, [lines]ππ @UPDATER:π mov bh, c2π inc c2π lds si, [colors]π {now,just do it.}π @NIKE:π mov cx, 3π mov dl, $DAππ @H1:π in al, dxπ and al, 1π jz @H1 {horizontal retrace}ππ mov al, ah {color}π mov dl, blπ out dx, alπ inc dxπ rep outsb {186 instruction...}ππ mov dl, $DAπ @H2:π in al, dxπ and al, 1π jnz @H2;ππ dec diπ jz @Xπ dec bhπ jnz @NIKEπ jmp @UPDATERπ @X:π dec countπ jnz @V1π sti {enable interrupts}πEnd;ππprocedure freakout0(lines : word; count : byte); assembler;πasmπ mov dx, $3DA {vga status port}π cliπ cldππ @V1:π (* in al, dxπ test al, 8π jz @V1 {vertical retrace}π @V2:π in al, dxπ test al, 8π jnz @V2π *)ππ mov di,[lines]ππ @L:π mov dl, $C8π mov al, 0 {color}π out dx, alπ inc dxπ mov al, bhπ out dx, alπ add al, 20π out dx, alπ out dx, alπ add bh, 17π mov dl, $DAπ in al, dxπ test al, 1π jz @L; {until horizontal retrace}ππ dec diπ jnz @Lππ mov dl, $DAπ dec countπ jnz @V1π sti {enable interrupts}πEnd;ππconstπ pal : array [0..3 * 28 - 1] of byte =π (2,4,4,π 4,8,8,π 6,12,12,π 8,16,16,π 10,20,20,π 12,24,24,π 14,28,28,π 16,32,32,π 18,36,36,π 20,40,40,π 22,44,44,π 24,48,48,π 26,52,52,π 26,52,52,π 28,56,56,π 28,56,56,π 30,60,60,π 30,60,60,π 30,60,60,π 33,63,63,π 33,63,63,π 33,63,63,π 33,63,63,π 33,63,63,π 30,60,60,π 28,56,56,π 26,52,52,π 24,48,48);ππvarπ i : integer;ππbeginπ asmπ mov ax, $13π int $10π end;π for i := 50 to 149 doπ fillchar(mem[$A000 : i * 320 + 50], 220, 1);ππ repeatπ copperBars(pal, 398, 0, 8); {398 because of scan doubling}π until keypressed;π readkey;ππ repeatπ freakout0(398, 8); {398 because of scan doubling}π until keypressed;π readkey;ππ asmπ mov ax, 3π int $10π end;πend.π 18 08-27-9321:03ALL CHRIS BEISEL Screen Fades IMPORT 18 ╓ {πCHRIS BEISELππI've gotten many compliments on these two fade routines (a few goodπprogrammers thought they were asm!)... plus, I made them so you can fadeπpart on the palette also... It's very smooth on my 486, as well as 386'sπand 286's at friends houses...ππ set up in your type declarationsπ rgbtype=recordπ red,green,blue:byte;π end;π rgbarray[0..255] of rgbtype;ππ and in your var declarations have something likeπ rgbpal:rgbarray;ππ and set your colors in that...π}πprocedure fadein(fadepal : rgbarray; col1, col2 : byte);πvarπ lcv,π lcv2 : integer;π tpal : rgbarray;πbeginπ for lcv := col1 to col2 doπ beginπ TPal[lcv].red := 0;π TPal[lcv].green := 0;π TPal[lcv].blue := 0;π end;π for lcv := 0 to 63 doπ beginπ for lcv2:=col1 to col2 doπ beginπ if fadepal[lcv2].red > TPal[lcv2].red thenπ TPal[lcv2].red := TPal[lcv2].red + 1;π if fadepal[lcv2].green > TPal[lcv2].green thenπ TPal[lcv2].green := TPal[lcv2].green + 1;π if fadepal[lcv2].blue > TPal[lcv2].blue thenπ TPal[lcv2].blue := TPal[lcv2].blue+1;ππ setcolor(lcv2, TPal[lcv2].red, TPal[lcv2].green, TPal[lcv2].blue);π end;π refresh;π end;πend;ππ{*******************************************************************}ππprocedure fadeout(fadepal : rgbarray; col1, col2 : byte);πvarπ lcv,π lcv2 : integer;π TPal : rgbarray;πbeginπ for lcv := col1 to col2 doπ beginπ TPal[lcv].red := 0;π TPal[lcv].green := 0;π TPal[lcv].blue := 0;π end;π for lcv := 0 to 63 doπ beginπ for lcv2 := col1 to col2 doπ beginπ if fadepal[lcv2].red > TPal[lcv2].red thenπ fadepal[lcv2].red := fadepal[lcv2].red - 1;π if fadepal[lcv2].green > TPal[lcv2].green thenπ fadepal[lcv2].green := fadepal[lcv2].green - 1;π if fadepal[lcv2].blue > TPal[lcv2].blue thenπ fadepal[lcv2].blue := fadepal[lcv2].blue - 1;ππ setcolor(lcv2, fadepal[lcv2].red, fadepal[lcv2].green, fadepal[lcv2].blue);π end;π refresh;π end;πend;ππ{*******************************************************************}ππ 19 08-27-9321:25ALL ANDRE JAKOBS Graphic FX Unit IMPORT 318 ╓ {πI hope you can do something With these listingsπI downloaded from a BBS near me....πThis File contains: Program VGA3dπ Unit DDFigsπ Unit DDVarsπ Unit DDVideoπ Unit DDProcsπJust break it in pieces on the cut here signs......ππif you need some Units or Programs (or TxtFiles) on Programming the Adlib/πSound-Blaster or Roland MPU-401, just let me know, and i see if i can digπup some good listings.....πBut , will your game also have Soundblaster/adlib fm support and SoundπBlaster Digitized Sound support, maybe even MPU/MT32? support....πAnd try to make it as bloody as you can (Heads exploding etc..)(JOKE)ππI hope i you can complete your game (i haven't completed any of my games yet)πAnd i like a copy of it when it's ready......ππPlease leave a message if you received this File.ππ Andre Jakobsπ MicroBrain Technologies Inc.π GelderlandLaan 9π 5691 KL Son en Breugelπ The Netherlands............π}πππProgram animatie_van_3d_vector_grafics;ππUsesπ Crt,π ddvideo,π ddfigs,π ddprocs,π ddVars;ππVarπ Opal : paletteType;ππProcedure wireframe(pro : vertex2Array);π{ Teken een lijnen diagram van gesloten voorwerpen met vlakken }πVarπ i, j, k,π v1, v2 : Integer;πbeginπ For i := 1 to ntf DOπ beginπ j := nfac[i];π if j <> 0 thenπ beginπ v1 := faclist[ facfront[j] + size[j] ];π For k := 1 to size[j] DOπ beginπ v2 := faclist[facfront[j] + k];π if (v1<v2) or (super[i] <> 0 ) thenπ linepto(colour[j], pro[v1], pro[v2])π v1 := v2;π end;π end;π end;πend;ππProcedure hidden(pro : vertex2Array);π{ Display van Objecten als geheel van de projectiepunten van pro }π{ b is een masker voor de kleuren }πVarπ i, col : Integer;ππ Function signe( n : Real) : Integer;π beginπ if n >0 thenπ signe := -1π elseπ if n <0 thenπ signe := 1π elseπ signe := 0;π end;ππ Function orient(f : Integer; v : vertex2Array) : Integer;π Varπ i, ind1,π ind2, ind3 : Integer;π dv1, dv2 : vector2;π beginπ i := nfac[f];π if i = 0 thenπ orient := 0π elseπ beginπ ind1 := faclist[facfront[i] + 1];π ind2 := faclist[facfront[i] + 2];π ind3 := faclist[facfront[i] + 3];π dv1.x := v[ind2].x - v[ind1].x;π dv1.y := v[ind2].y - v[ind1].y;π dv2.x := v[ind3].x - v[ind2].x;π dv2.y := v[ind3].y - v[ind2].y;π orient := signe(dv1.x * dv2.y - dv2.x * dv1.y);π end;π end;ππ Procedure facetfill(k : Integer);π Varπ v : vector2Array;π i, index, j : Integer;π beginπ j := nfac[k];π For i := 1 to size[j] DOπ beginπ index := faclist[facfront[j] + i];π v[i] := pro[index];π end;π fillpoly(colour[k], size[j], v);π polydraw(colour[k] - 1, size[j], v);π end;ππ Procedure seefacet(k : Integer);π Varπ ipt, supk : Integer;π beginπ facetfill(k);π ipt := firstsup[k];π While ipt <> 0 DOπ beginπ supk := facetinfacet[ipt].info;π facetfill(supk);π ipt := facetinfacet[ipt].Pointer;π end;π end;ππ{ hidden Programmacode }πbeginπ For i := 1 to nof DOπ if super[i] = 0 thenπ if orient(i, pro) = 1 thenπ seefacet(i);πend;ππProcedure display;πVarπ i : Integer;πbeginπ {observe}π For i := 1 to nov DOπ transform(act[i], Q, obs[i]);ππ {project}π ntv := nov;π ntf := nof;π For i := 1 to ntv DOπ beginπ pro[i].x := obs[i].x;π pro[i].y := obs[i].y;π end;ππ {drawit}π switch := switch xor 1;π hidden(pro);π Scherm_actief(switch);π Virscherm_actief(switch xor 1);π wisscherm(prevpoints, $a000, $8a00);π wis_hline(prevhline, $8a00);π prevpoints := points;prevhline := hline;π points[0] := 0;π hline[0] := 0;πend;ππProcedure anim3d;πVarπ A, B, C, D, E, F,π G, H, I, J, QE, P : matrix4x4;π zoom, inz, inzplus : Real;π angle, angleinc,π beta, betainc, frame : Integer;π huidigpalette : paletteType;ππ { Kubus Animatie : Roterende kubus }π Procedure kubus;π beginπ angle := 0;π angleinc := 9;π beta := 0;π betainc := 2;π direct.x := 9;π direct.y := 2;π direct.z := -3;π findQ;π cubesetup(104);π frame := 0;ππ While (NOT (KeyPressed)) and (frame < 91) doπ beginπ frame := frame + 1;π xyscale := zoom * 2 * sinus(beta);π rot3(1, trunc(angle/2), Qe);π rot3(2, angle, P);π mult3(P, Qe, P);π cube(P);π display;π angle := angle + angleinc;π beta := beta + betainc;π nov := 0;π end;π end;ππ {Piramides Animatie : Scene opgebouwd uit twee Piramides en 1 Kubus }π Procedure Piramides;π beginπ frame := 0;π angle := 0;π beta := 0;π betainc := 2;π scale3(4.0, 0.2, 4.0, C);π cubesetup(90);π cube(P);ππ scale3(2.5, 4.0, 2.5, D);π tran3(2.0, -0.2, 2.0, E);π mult3(E, D, F);π pirasetup(34);π piramid(P);ππ scale3(2.0, 4.0, 2.0, G);π tran3(-3.0, -0.2, 0.0, H);π mult3(H, G, I);π pirasetup(42);π piramid(P);ππ E := Q;π nov := 0;ππ While (NOT (KeyPressed)) and (frame < 18) doπ beginπ frame := frame + 1;π xyscale := zoom * 2 * sinus(beta);ππ rot3(2, angle, B);ππ mult3(B, C, P);π cube(P);ππ mult3(B, F, P);π piramid(P);ππ mult3(B, I, P);π piramid(P);ππ display;ππ angle := angle + angleinc;π beta := beta + betainc;π nov := 0;π end;ππ frame := 0;π angleinc := 7;ππ While (NOT (KeyPressed)) and (frame < 75) doπ beginπ frame := frame + 1;ππ rot3(2, angle, B);ππ mult3(B, C, P);π cube(P);ππ mult3(B, F, P);π piramid(P);ππ mult3(B, I, P);π piramid(P);ππ display;ππ angle := angle + angleinc;π nov := 0;π end;ππ frame := 0;π beta := 180-beta;ππ While (NOT (KeyPressed)) and (frame < 19) doπ beginππ frame := frame + 1;ππ xyscale := zoom * 2 * sinus(beta);π rot3(2, angle, B);ππ mult3(C, B, P);π cube(P);ππ mult3(B, F, P);π piramid(P);ππ mult3(B, I, P);π piramid(P);ππ display;ππ angle := angle + angleinc;π beta := beta + betainc;π nov := 0;π end;π end;ππ { Huis_animatie4 : Figuur huis roteert en "komt uit de lucht vallen" }π Procedure huisval;π beginπ xyscale := zoom;π nof := 0;π nov := 0;π last := 0;π angle := 1355;π angleinc := -7;π frame := 0;ππ huissetup;ππ zoom := 0.02;π Direct.x := 30;π direct.y := -2;π direct.z := 30;π findQ;ππ While (NOT (KeyPressed)) and (frame < 40) doπ beginπ frame := frame + 1;π zoom := zoom + 0.01;π Scale3(zoom, zoom, zoom, Qe);π tran3(0, (-7 / zoom) + frame / 1.8, 0, A);π mult3(Qe, A, C);π rot3(2, angle, B);π mult3(C, B, P);π huis(P);π display;π angle := angle + angleinc;π nov := 0;π end;ππ frame := 0;π beta := angle;π betainc := angleinc;ππ While (NOT (KeyPressed)) and (frame < 15) doπ beginπ frame := frame + 1;ππ rot3(2, beta, B);π mult3(B, Qe, P);π mult3(P, A, P);π huis(P);ππ display;ππ beta := beta + betainc;π betainc := trunc(betainc + (7 / 15));π nov := 0;π end;ππ frame := 0;ππ While (NOT (KeyPressed)) and (frame < 30) doπ beginπ frame := frame + 1;π direct.z := direct.z - (frame * (20 / 70));π findQ;π huis(P);π display;π nov := 0;π end;ππ frame := 0;π zoom := 1;ππ While (NOT (KeyPressed)) and (frame < 31) doπ beginπ frame := frame + 1;π mult3(B, Qe, P);π scale3(zoom, zoom, zoom, C);π mult3(P, A, P);π mult3(P, C, P);π huis(P);π display;π zoom := zoom - 1 / 30;π nov := 0;π end;ππ zoom := xyscale;π end;ππ { Ster Animatie : Roterende ster als kubus met 4 piramides }π Procedure Sterrot;π beginπ xyscale := zoom;π frame := 0;π angle := 0;π angleinc := 9;π beta := 0;π betainc := 2;π nof := 0;π last := 0;π nov := 0;ππ stersetup(140);π scale3(0, 0, 0, P);π ster(P, 4);ππ Direct.x := 30;π direct.y := -2;π direct.z := 30;π findQ;π E := Q;ππ While (NOT (KeyPressed)) and (frame < 90) doπ beginπ frame := frame + 1;π xyscale := zoom * 1.7 * sinus(beta);π rot3(1, Round(angle/5), A);π mult3(A, E, Q);π rot3(2, angle, P);π ster(P, 4);π display;π angle := angle + angleinc;π beta := beta + betainc;π nov := 0;π end;π end;ππbeginπ eye.x := 0;π eye.y := 0;π eye.z := 0;π zoom := xyscale;π Repeatπ nov := 0;π nof := 0;π last := 0;π Kubus;π Piramides;π Huisval;π Sterrot;π Until KeyPressed;πend;ππ{ _______________Hoofd Programma --------------------- }ππbeginπ nov := 0;π nof := 0;π last := 0;π start('pira', 15, Opal);ππ points[0] := 0;π prevpoints[0] := 0;π hline[0] := 0;π prevhline[0] := 0;ππ anim3D;ππ finish(Opal);π Writeln('Coded by ...... " De Vectorman "');π Writeln;πend.πππ{ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ }ππUnit ddfigs;ππInterfaceππUsesπ DDprocs, DDVars;ππConstπ cubevert : Array [1..8] of vector3 =π ((x : 1; y : 1; z : 1),π (x : 1; y : -1; z : 1),π (x : 1; y : -1; z : -1),π (x : 1; y : 1; z : -1),π (x : -1; y : 1; z : 1),π (x : -1; y : -1; z : 1),π (x : -1; y : -1; z : -1),π (x : -1; y : 1; z : -1));ππ cubefacet : Array [1..6, 1..4] of Integer =π ((1, 2, 3, 4),π (1, 4, 8, 5),π (1, 5, 6, 2),π (3, 7, 8, 4),π (2, 6, 7, 3),π (5, 8, 7, 6));ππ piravert : Array [1..5] of vector3 =π ((x : 0; y : 1; z : 0),π (x : 1; y : 0; z : -1),π (x : -1; y : 0; z : -1),π (x : -1; y : 0; z : 1),π (x : 1; y : 0; z : 1));ππ pirafacet : Array [1..5, 1..3] of Integer =π ((1, 2, 3),π (1, 3, 4),π (1, 4, 5),π (1, 5, 2),π (5, 4, 3));ππ huisvert : Array[1..59] of vector3 =π ((x : -6; y : 0; z : 4), (x : 6; y : 0; z : 4),π (x : 6; y : 0; z : -4),π (x : -6; y : 0; z : -4), (x : -6; y : 8; z : 4), (x : 6; y : 8; z : 4),π (x : 6; y : 11; z : 0), (x : 6; y : 8; z : -4), (x : -6; y : 8; z : -4),π (x : -6; y : 11; z : 0), (x : -4; y : 1; z : 4), (x : -1; y : 1; z : 4),π (x : -1; y : 3; z : 4), (x : -4; y : 3; z : 4), (x : -4; y : 5; z : 4),π (x : -1; y : 5; z : 4), (x : -1; y : 7; z : 4), (x : -4; y : 7; z : 4),π (x : 0; y : 0; z : 4), (x : 5; y : 0; z : 4), (x : 5; y : 4; z : 4),π (x : 0; y : 4; z : 4), (x : 1; y : 5; z : 4), (x : 4; y : 5; z : 4),π (x : 4; y : 7; z : 4), (x : 1; y : 7; z : 4), (x : 6; y : 5; z : -1),π (x : 6; y : 5; z : -3), (x : 6; y : 7; z : -3), (x : 6; y : 7; z : -1),π (x : 5; y : 1; z : -4), (x : 2; y : 1; z : -4), (x : 2; y : 3; z : -4),π (x : 5; y : 3; z : -4), (x : 5; y : 5; z : -4), (x : 2; y : 5; z : -4),π (x : 2; y : 7; z : -4), (x : 5; y : 7; z : -4), (x : 1; y : 0; z : -4),π (x : -1; y : 0; z : -4), (x : -1; y : 3; z : -4), (x : 0; y : 4; z : -4),π (x : 1; y : 3; z : -4), (x : -2; y : 1; z : -4), (x : -5; y : 1; z : -4),π (x : -5; y : 3; z : -4), (x : -2; y : 3; z : -4), (x : -2; y : 5; z : -4),π (x : -5; y : 5; z : -4), (x : -5; y : 7; z : -4), (x : -2; y : 7; z : -4),π (x : -6; y : 0; z : 1), (x : -6; y : 0; z : 3), (x : -6; y : 3; z : 3),π (x : -6; y : 3; z : 1), (x : -6; y : 5; z : 1), (x : -6; y : 5; z : 3),π (x : -6; y : 7; z : 3), (x : -6; y : 7; z : 1));ππ huissize : Array [1..19] of Integer =π (4, 4, 5, 4, 4, 5, 4, 4, 4, 4, 4, 4, 4, 4, 5, 4, 4, 4, 4);ππ huissuper : Array [1..19] of Integer =π (0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 3, 4, 4, 4, 4, 4, 6, 6);ππ huisfacet : Array [1..79] of Integer =π ( 1, 2, 6, 5,π 5, 6, 7, 10,π 2, 3, 8, 7,π 6, 3, 4, 9,π 8, 8, 9, 10,π 7, 4, 1, 5,π 10, 9, 4, 3,π 2, 1, 11, 12,π 13, 14, 15, 16,π 17, 18, 19, 20,π 21, 22, 23, 24,π 25, 26, 27, 28,π 29, 30, 31, 32,π 33, 34, 35, 36,π 37, 38, 39, 40,π 41, 42, 43, 44,π 45, 46, 47, 48,π 49, 50, 51, 52,π 53, 54, 55, 56,π 57, 58, 59);ππ stervert : Array [1..6] of vector3 =π ((x : 1; y : 0; z : 0),π (x : 0; y : 1; z : 0),π (x : 0; y : 0; z : 1),π (x : 0; y : 0; z : -1),π (x : 0; y : -1; z : 0),π (x : -1; y : 0; z : 0));ππProcedure cubesetup(c : Integer);πProcedure cube(P : matrix4x4);πProcedure pirasetup(c : Integer);πProcedure piramid(P : matrix4x4);πProcedure huissetup;πProcedure huis(P : matrix4x4);πProcedure hollow(P1 : matrix4x4);πProcedure stersetup(col : Integer);πProcedure ster(P : matrix4x4; d : Real);πProcedure ellips(P : matrix4x4; col : Integer);πProcedure goblet(P : matrix4x4; col : Integer);ππImplementationππProcedure cubesetup(c : Integer);π{ zet kubusdata in facetlist van de scene}πVarπ i, j : Integer;πbeginπ For i := 1 to 6 DOπ beginπ For j := 1 to 4 DOπ faclist[last + j] := cubefacet[i, j] + nov;π nof := nof + 1;π facfront[nof] := last;π colour[nof] := c;π nfac[nof] := nof;π super[nof] := 0;π firstsup[nof] := 0;π size[nof] := 4;π last := last + size[nof];π end;πend;ππProcedure cube(P : matrix4x4);πVarπ i, j : Integer;πbeginπ For i := 1 to 8 DOπ beginπ nov := nov + 1;π transform(cubevert[i], P, act[nov]);π end;πend;ππProcedure pirasetup(c : Integer);πVarπ i, j : Integer;πbeginπ For i := 1 to 5 DOπ beginπ For j := 1 to 3 DOπ faclist[last + j] := pirafacet[i, j] + nov;π nof := nof + 1;π facfront[nof] := last;π size[nof] := 3;π last := last + size[nof];π colour[nof] := c;π nfac[nof] := nof;π super[nof] := 0;π firstsup[nof] := 0;π end;ππ size[nof] := 4;π faclist[facfront[nof] + 4] := 2 + nov;π last := last + 1;πend;ππProcedure piramid(P : matrix4x4);πVarπ i, j : Integer;πbeginπ For i := 1 to 5 DOπ beginπ nov := nov + 1;π transform(piravert[i], P, act[nov]);π end;πend;πππProcedure huissetup;πVarπ i, j,π host,π nofstore : Integer;πbeginπ For i := 1 to 79 DOπ faclist[last + i] := huisfacet[i] + nov;ππ nofstore := nof;ππ For i := 1 to 19 DOπ beginπ nof := nof + 1;π facfront[nof] := last;π size[nof] := huissize[i];π last := last + size[nof];π nfac[nof] := nof;ππ if (i = 2) or (i = 5) thenπ colour[nof] := 111π elseπ if i = 7 thenπ colour[nof] := 20π elseπ if i < 8 thenπ colour[nof] := 42π elseπ colour[nof] := 25;ππ super[nof] := huissuper[i];π firstsup[nof] := 0;ππ if super[nof] <> 0 thenπ beginπ host := super[nof] + nofstore;π super[nof] := host;π pushfacet(firstsup[host], nof);π end;π end;π For i := 1 to 59 DOπ setup[i] := huisvert[i];πend;ππProcedure huis(P : matrix4x4);πVarπ i : Integer;πbeginπ For i := 1 to 59 DOπ beginπ nov := nov + 1;π transform(setup[i], P, act[nov]);π end;πend;πππProcedure hollow(P1 : matrix4x4);πVarπ A, B,π P, P2 : matrix4x4;π i : Integer;πbeginπ For i := 1 to 8 DOπ beginπ tran3(4.0 * cubevert[i].x, 4.0 * cubevert[i].y, 4.0 * cubevert[i].z, P2);π mult3(P1, P2, P);π cube(P);π end;ππ For i := 1 to 4 DOπ beginπ scale3(3.0, 1.0, 1.0, A);π tran3(0.0, 4.0 * cubevert[i].y, 4.0 * cubevert[i].z, B);π mult3(A, B, P2);mult3(P1, P2, P);π cube(P);π scale3(1.0, 3.0, 1.0, A);π tran3(4.0 * cubevert[i].y, 0.0, 4.0 * cubevert[i].z, B);π mult3(A, B, P2);mult3(P1, P2, P);π cube(P);π scale3(1.0, 1.0, 3.0, A);π tran3(4.0 * cubevert[i].z, 4.0 * cubevert[i].y, 0.0, B);π mult3(A, B, P2);mult3(P1, P2, P);π cube(P);π end;πend;ππProcedure stersetup(col : Integer);πVarπ i, j,π v1, v2 : Integer;πbeginπ For i := 1 to 6 DOπ beginπ v1 := cubefacet[i, 4] + nov;π For j := 1 to 4 DOπ beginπ v2 := cubefacet[i, j] + nov;π nof := nof + 1;π faclist[last + 1] := v1;π faclist[last + 2] := v2;π faclist[last + 3] := nov + 8 + i;π facfront[nof] := last;π size[nof] := 3;ππ last := last + size[nof];π colour[nof] := col;π nfac[nof] := nof;π super[nof] := 0;π firstsup[nof] := 0;π v1 := v2;π end;π end;πend;ππProcedure ster(P : matrix4x4; d : Real);πVarπ i, j,π v1, v2 : Integer;π A, S : matrix4x4;πbeginπ For i := 1 to 8 DOπ beginπ nov := nov + 1;π transform(cubevert[i], P, act[nov]);π end;ππ scale3(D, D, D, A);π mult3(A, P, S);ππ For i := 1 to 6 DOπ beginπ nov := nov + 1;π transform(stervert[i], S, act[nov]);π end;πend;ππProcedure ellips(P : matrix4x4; col : Integer);πVarπ v : vector2Array;π theta,π thetadiff,π i : Integer;πbeginπ theta := -90;π thetadiff := -9;π For i := 1 to 21 DOπ beginπ v[i].x := cosin(theta);π v[i].y := sinus(theta);π theta := theta + thetadiff;π end;π bodyofrev(P, col, 21, 20, v);πend;ππProcedure goblet(P : matrix4x4; col : Integer);πConstπ gobletdat : Array [1..12] of vector2 =π ((x : 0; y : -16),π (x : 8; y : -16),π (x : 8; y : -15),π (x : 1; y : -15),π (x : 1; y : -2),π (x : 6; y : -1),π (x : 8; y : 2),π (x : 14; y : 14),π (x : 13; y : 14),π (x : 7; y : 2),π (x : 5; y : 0),π (x : 0; y : 0));ππVarπ gobl : vector2Array;π i : Integer;πbeginπ For i := 1 to 12 DOπ gobl[i] := gobletdat[i];π bodyofrev(P, col, 12, 20, gobl)πend;ππbegin;πend.πππ{ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ }ππUnit ddprocs;ππInterfaceππUsesπ DDVars;ππConstπ maxv = 200;π maxf = 400;π maxlist = 1000;π vectorArraysize = 32;π sizeofpixelArray = 3200;π sizeofhlineArray = 320 * 4;ππTypeπ vector2 = Record x, y : Real; end;π vector3 = Record x, y, z : Real; end;π pixelvector = Record x, y : Integer; end;π pixelArray = Array [0..sizeofpixelArray] of Integer;π hlineArray = Array [0..sizeofhlineArray] of Integer;π vector3Array = Array [1..vectorArraysize] of vector3;π matrix3x3 = Array [1..3, 1..3] of Real;π matrix4x4 = Array [1..4, 1..4] of Real;π vertex3Array = Array [1..maxv] of vector3;π vertex2Array = Array [1..maxv] of vector2;π vector2Array = Array [1..vectorArraysize ] of vector2;π facetArray = Array [1..maxf] of Integer;π facetlist = Array [1..maxlist] of Integer;ππConstπ EenheidsM : matrix4x4 =π ((1, 0, 0, 0),π (0, 1, 0, 0),π (0, 0, 1, 0),π (0, 0, 0, 1));πVarπ Q : matrix4x4;π eye, direct : vector3;π nov, ntv,π ntf, nof,π last : Integer;π setup,π act, obs : vertex3Array;π pro : vertex2Array;π faclist : facetlist;π colour,π size,π facfront,π nfac,π super,π firstsup : facetArray;π points,π prevpoints : pixelArray;π hline,π prevhline : hlineArray;ππProcedure tran3(tx, ty, tz : Real; Var A : matrix4x4);πProcedure scale3(sx, sy, sz : Real; Var A : matrix4x4);πProcedure rot3(m : Integer; theta : Integer; Var A : matrix4x4);πProcedure mult3(A, B : matrix4x4; Var C : matrix4x4);πProcedure findQ;πProcedure genrot(phi : Integer; b, d : vector3; Var A : matrix4x4);πProcedure transform(v : vector3; A : matrix4x4; Var w : vector3);πProcedure extrude(P : matrix4x4; d : Real; col, n : Integer;π v : vector2Array);πProcedure bodyofrev(P : matrix4x4; col, nvert, nhoriz : Integer;π v : vector2Array);πProcedure polydraw(c, n : Integer; poly : vector2Array);πProcedure linepto(c : Integer; pt1, pt2 : vector2);πProcedure WisScherm(punten : pixelArray; SchermSeg, VirSeg : Word);πProcedure fillpoly(c, n : Integer; poly : vector2Array);πProcedure Wis_Hline(hline_ar : hlineArray; virseg : Word);ππImplementationππProcedure tran3(tx, ty, tz : Real; Var A : matrix4x4);π{ zet matrix A op punt tx, ty, tz }πbeginπ A := EenheidsM;π A[1, 4] := -tx;π A[2, 4] := -ty;π A[3, 4] := -tz;πend;ππProcedure scale3(sx, sy, sz : Real; Var A : matrix4x4);π{ zet matrix A om in schaal van sx, sy, sz }πbeginπ A := EenheidsM;π A[1, 1] := sx;π A[2, 2] := sy;π A[3, 3] := sz;πend;ππProcedure rot3(m : Integer; theta : Integer; Var A : matrix4x4);π{ roteer matrix A om m: 1=x-as; 2=y-as; 3=z-as met hoek theta (in graden)}πVarπ m1, m2 : Integer;π c, s : Real;πbeginπ A := EenheidsM;π m1 := (m MOD 3) + 1;π m2 := (m1 MOD 3) + 1;π c := cosin(theta);π s := sinus(theta);π A[m1, m1] := c;π A[m2, m2] := c;π A[m1, m2] := s;π A[m2, m1] := -s;πend;ππProcedure mult3(A, B : matrix4x4; Var C : matrix4x4);π{ vermenigvuldigd matrix A en B naar matrix C }πVarπ i, j, k : Integer;π ab : Real;πbeginπ For i := 1 to 4 doπ For j := 1 to 4 doπ beginπ ab := 0;π For k := 1 to 4 doπ ab := ab + A[i, k] * B[k, j];π C[i, j] := ab;π end;πend;ππProcedure findQ;π{ Bereken de Observatie-matrix 'Q' voor een punt in de ruimte }πVarπ E, F, G,π H, U : matrix4x4;π alpha,π beta,π gamma : Integer;π v, w : Real;πbeginπ tran3(eye.x, eye.y, eye.z, F);ππ alpha := angle(-direct.x, -direct.y);π rot3(3, alpha, G);ππ v := sqrt( (direct.x * direct.x) + (direct.y * direct.y));π beta := angle(-direct.z, v);π rot3(2, beta, H);ππ w := sqrt( (v * v) + (direct.z * direct.z));π gamma := angle( -direct.x * w, direct.y * direct.z);π rot3(3, gamma, U);ππ mult3(G, F, Q);π mult3(H, Q, E);π mult3(U, E, Q);πend;ππProcedure genrot (phi : Integer; b, d : vector3; Var A : matrix4x4);πVarπ F, G, H,π W, FI, GI,π HI, S, T : matrix4x4;π v : Real;π beta,π theta : Integer;πbeginπ tran3(b.x, b.y, b.z, F);π tran3(-b.x, -b.y, -b.z, FI);π theta := angle(d.x, d.y);π rot3(3, theta, G);π rot3(3, -theta, GI);π v := sqrt(d.x * d.x + d.y * d.y);π beta := angle(d.z, v);π rot3(2, beta, H);π rot3(2, -beta, HI);π rot3(2, beta, H);π rot3(2, -beta, HI);π rot3(3, phi, W);π mult3(G, F, S);π mult3(H, S, T);π mult3(W, S, T);π mult3(HI, S, T);π mult3(GI, T, S);π mult3(FI, S, A);πend;ππProcedure transform(v : vector3; A : matrix4x4; Var w : vector3);π{ transformeer colomvector 'v' uit A in colomvector 'w'}πbeginπ w.x := A[1, 1] * v.x + A[1, 2] * v.y + A[1, 3] * v.z + A[1, 4];π w.y := A[2, 1] * v.x + A[2, 2] * v.y + A[2, 3] * v.z + A[2, 4];π w.z := A[3, 1] * v.x + A[3, 2] * v.y + A[3, 3] * v.z + A[3, 4];πend;ππProcedure extrude(P : matrix4x4; d : Real; col, n : Integer;π v : vector2Array);π{ Maakt van een 2d-figuur een 3d-figuur }π{ vb: converteert 2d-letters naar 3d-letters }πVarπ i, j,π lasti : Integer;π v3 : vector3;πbeginπ For i := 1 to n DOπ beginπ faclist[last + i] := nov + i;π faclist[last + n + i] := nov + 2 * n + 1 - i;π end;π facfront[nof + 1] := last;π facfront[nof + 2] := last + n;π size[nof + 1] := n;π size[nof + 2] := n;π nfac[nof + 1] := nof + 1;π nfac[nof + 2] := nof + 2;π super[nof + 1] := 0;π super[nof + 2] := 0;π firstsup[nof + 1] := 0;π firstsup[nof + 2] := 0;π colour[nof + 1] := col;π colour[nof + 2] := col;π last := last + 2 * n;π nof := nof + 2;π lasti := n;ππ For i := 1 to n DOπ beginπ faclist[last + 1] := nov + i;π faclist[last + 2] := nov + lasti;π faclist[last + 3] := nov + n + lasti;π faclist[last + 4] := nov + n + i;π nof := nof + 1 ;π facfront[nof] := last;π size[nof] := 4;π nfac[nof] := nof;π super[nof] := 0;π firstsup[nof] := 0;π colour[nof] := col;π last := last + 4;π lasti := i;π end;π For i := 1 To n DOπ beginπ v3.x := v[i].x;π v3.y := v[i].y;π v3.z := 0.0;π nov := nov + 1;π transform(v3, P, act[nov]);π v3.z := -d;π transform(v3, P, act[nov + n]);π end;π nov := nov + n;πend;ππProcedure bodyofrev(P : matrix4x4; col, nvert, nhoriz : Integer;π v : vector2Array);π{ maakt een "rond" figuur van een 2-dimensionale omlijning van het figuur }πVarπ theta,π thetadiff,π i, j, newnov : Integer;π c, s : Array [1 .. 100] of Real;π index1,π index2 : Array [1 .. 101] of Integer;πbeginπ theta := 0;π thetadiff := trunc(360 / nhoriz);ππ For i := 1 to nhoriz DOπ beginπ c[i] := cosin(theta);π s[i] := sinus(theta);π theta := theta + thetadiff;π end;π newnov := nov;ππ if abs(v[1].x) < epsilon thenπ beginπ newnov := newnov + 1;π setup[newnov].x := 0.0;π setup[newnov].y := v[1].y;π setup[newnov].z := 0.0;π For i := 1 to nhoriz + 1 DOπ index1[i] := newnov;π endπ elseπ beginπ For i := 1 to nhoriz DOπ beginπ newnov := newnov + 1;π setup[newnov].x := v[1].x * c[i];π setup[newnov].y := v[1].y;π setup[newnov].z := -v[1].x * s[i];π index1[i] := newnov;π end;π index1[nhoriz + 1] := index1[i];π end;ππ For j := 2 to nvert DOπ beginπ if abs(v[j].x) < epsilon thenπ beginπ newnov := newnov + 1;π setup[newnov].x := 0.0;π setup[newnov].y := v[j].y;π setup[newnov].z := 0.0;π For i := 1 to nhoriz + 1 DOπ index2[i] := newnov;π endπ elseπ beginπ For i := 1 To nhoriz DOπ beginπ newnov := newnov + 1;π setup[newnov].x := v[j].x * c[i];π setup[newnov].y := v[j].y;π setup[newnov].z := -v[j].x * s[i];π index2[i] := newnov;π end;π index2[nhoriz + 1] := index2[1];π end;ππ if index1[1] <> index1[2] thenπ if index2[1] = index2[2] thenπ beginπ For i := 1 to nhoriz DOπ beginπ nof := nof + 1; size[nof] := 3;π facfront[nof] := last;π faclist[last + 1] := index1[i + 1];π faclist[last + 2] := index2[i];π faclist[last + 3] := index1[i];π last := last + size[nof];π nfac[nof] := nof;π colour[nof] := col;π super[nof] := 0;π firstsup[nof] := 0;π end;π endπ elseπ beginπ For i := 1 to nhoriz DOπ beginπ nof := nof + 1;π size[nof] := 4;π facfront[nof] := last;π faclist[last + 1] := index1[i + 1];π faclist[last + 2] := index2[i + 2];π faclist[last + 3] := index2[i];π faclist[last + 4] := index1[i];π last := last + size[nof];π nfac[nof] := nof;π colour[nof] := col;π super[nof] := 0;π firstsup[nof] := 0;π end;π endπ elseπ if index2[1] <> index2[2] thenπ For i := 1 to nhoriz DOπ beginπ nof := nof + 1;π size[nof] := 3;π facfront[nof] := last;π faclist[last + 1] := index2[i + 1];π faclist[last + 2] := index2[i];π faclist[last + 3] := index1[i];π last := last + size[nof];π nfac[nof] := nof;π colour[nof] := col;π super[nof] := 0;π firstsup[nof] := 0;π end;ππ For i := 1 to nhoriz + 1 DOπ index1[i] := index2[i];π end;ππ For i := nov + 1 to newnov DOπ transform(setup[i], P, act[i]);ππ nov := newnov;ππend;ππProcedure BressenHam( Virseg : Word; { Adres-> VIRSEG:0 }π pnts : pixelArray;π c : Byte; { c-> kleur }π p1, p2 : pixelvector); { vector } Assembler;πVarπ x, y, error,π s1, s2,π deltax,π deltay, i : Integer;π interchange : Boolean;π dcolor : Word;πAsmπ{ initialize Variables }π PUSH dsπ LDS si, pntsπ MOV ax, virsegπ MOV es, axπ MOV cx, 320π MOV ax, p1.xπ MOV x, axπ MOV ax, p1.yπ MOV y, axπ MOV dcolor, axππ MOV ax, p2.x { deltax := abs(x2 - x1) }π SUB ax, p1.x { s1 := sign(x2 - x1) }π PUSH axπ PUSH axπ CALL ddVars.signπ MOV s1, ax;π POP axπ TEST ax, $8000π JZ @@GeenSIGN1π NEG axπ @@GeenSign1:π MOV deltax, axπ MOV ax, p2.yπ SUB ax, p1.yπ PUSH axπ PUSH axπ CALL ddVars.signπ MOV s2, axπ POP axπ TEST ax, $8000π JZ @@GeenSign2π NEG axπ @@GeenSign2:π MOV deltay, axππ { Interchange DeltaX and DeltaY depending on the slope of the line }ππ MOV interchange, Falseπ CMP ax, deltaxπ JNG @@NO_INTERCHANGEπ XCHG ax, deltaxπ XCHG ax, deltayπ MOV interchange, Trueππ @@NO_INTERCHANGE:ππ { Initialize the error term to compensate For a nonzero intercept }ππ MOV ax, deltaYπ SHL ax, 1π SUB ax, deltaXπ MOV error, axππ { Main loop }π MOV ax, 1π MOV i, axπ @@FOR_begin:π CMP ax, deltaXπ JG @@EINDE_FOR_LOOPππ { Plot punt! }π MOV bx, xπ MOV ax, yπ MUL cxπ ADD bx, axπ MOV al, cπ MOV Byte PTR [es:bx], alπ INC [Word ptr ds:si] { aantal verhogen }π MOV ax, [si]π SHL ax, 1 { offset berekenen }π PUSH siπ ADD si, axπ MOV [si], bxπ POP siππ { While Loop }π @@W1_begin:π CMP error, 0π JL @@EINDE_WHILEππ { if interchange then }ππ CMP interchange, Trueπ JE @@i_is_tπ MOV ax, s2π ADD y, axπ JMP @@w1_eruitππ @@i_is_t:π MOV ax, s1π ADD x, axππ @@w1_eruit:π MOV ax, deltaxπ SHL ax, 1π SUB error, axπ JMP @@w1_beginππ @@EINDE_WHILE:π CMP interchange, Trueπ JE @@i_is_t_1π MOV ax, s1π ADD x, axπ JMP @@if_2_eruitππ @@i_is_t_1:π MOV ax, s2π ADD y, axππ @@if_2_eruit:π MOV ax, deltayπ SHL ax, 1π ADD error, axπ INC iπ MOV ax, iπ JMP @@FOR_beginπ @@Einde_for_loop:π POP dsπend;ππProcedure linepto(c : Integer; pt1, pt2 : vector2);πVarπ p1, p2 : pixelvector;πbeginπ p1.x := fx(pt1.x);π p1.y := fy(pt1.y);π p2.x := fx(pt2.x);π p2.y := fy(pt2.y);π BressenHam($a000, points, c, p1, p2);πend;ππProcedure WisScherm(punten : pixelArray; SchermSeg , Virseg : Word); Assembler;πAsmπ PUSH dsπ MOV ax, SchermSegπ MOV es, axπ LDS bx, puntenπ MOV cx, [bx]π JCXZ @@NietTekenenπ @@Wis:π INC bxπ INC bxπ MOV si, [bx]π MOV di, siπ PUSH dsπ MOV ax, virsegπ MOV ds, axπ MOVSBπ POP dsπ LOOP @@Wisπ @@NietTekenen:π POP dsπend;ππProcedure polydraw(c, n : Integer; poly : vector2Array);πVarπ i : Integer;πbeginπ For i := 1 to n - 1 doπ linepto(c, poly[i], poly[i + 1]);π linepto(c, poly[n], poly[1]);πend;ππProcedure fillpoly(c, n : Integer; poly : vector2Array);πVarπ scan_table : tabel;π scanline,π line,π offsetx : Integer;ππ Procedure Draw_horiz_line(hline_ar : hlineArray;π color : Byte;π lijn : Word;π begin_p : Word;π linelen : Word); Assembler;π Asmπ PUSH dsπ MOV cx, 320π MOV ax, 0a000hπ MOV es, axπ MOV di, begin_pπ MOV ax, lijnπ MUL cxπ ADD di, axπ PUSH diπ MOV al, colorπ MOV cx, linelenπ PUSH cxπ REP STOSBπ LDS si, hline_arπ INC [Word ptr ds:si]π MOV ax, [si]π SHL ax, 1π SHL ax, 1π ADD si, axπ POP bxπ POP dxπ MOV [si], dxπ MOV [si + 2], bxπ POP dsπ end;ππ Procedure swap(Var x, y : Integer);π beginπ x := x + y;π y := x - y;π x := x - y;π end;ππ{πProcedure Calc_x(x1, y1, x2, y2 : Word; Var scan_table : tabel);πVarπ m_inv,π xReal : Real;πbeginπ Asmπ LDS dx, scan_tableπ MOV ax, y1π MOV bx, y2π CMP ax, bxπ JNE @@NotHorizLineπ MOV bx, x1π SHL ax, 1π ADD ax, dxπ CMP bx, [dx]π JGE @@Notstorexminπ MOV [dx], bxππ @@Notstorexmin:π INC dxπ MOV bx, x2π CMP bx, [dx]π JLE @@Klaarπ MOV [dx], bxπ JMP @@Klaarππ @@NotHorizLine:π}ππ Procedure Calc_x(x1, y1, x2, y2 : Integer; Var scan_table : tabel);π Varπ m_inv, xReal : Real;π i, y, temp : Integer;π beginπ if y1 = y2 thenπ beginπ if x2 < x1 thenπ swap(x1, x2)π elseπ beginπ if x1 < scan_table[y1].xmin thenπ scan_table[y1].xmin := x1;π if x2 > scan_table[y2].xmax thenπ scan_table[y2].xmax := x2;π end;π endπ elseπ beginπ m_inv := (x2 - x1) / (y2 - y1);ππ if y1 > y2 then {swap}π beginπ swap(y1, y2);π swap(x1, x2);π end;ππ if x1 < scan_table[y1].xmin thenπ scan_table[y1].xmin := x1;π if x2 > scan_table[y2].xmax thenπ scan_table[y2].xmax := x2;π xReal := x1; y := y1;ππ While y < y2 doπ beginπ y := y + 1;π xReal := xReal + m_inv;π offsetx := round(xReal);π if xReal < scan_table[y].xmin thenπ scan_table[y].xmin := offsetx;π if xReal > scan_table[y].xmax thenπ scan_table[y].xmax := offsetx;π end;π end;π end;ππbeginπ scan_table := emptytabel;π For line := 1 to n - 1 doπ calc_x(fx(poly[line].x), fy(poly[line].y),π fx(poly[line + 1].x), fy(poly[line + 1].y), scan_table);ππ calc_x(fx(poly[n].x), fy(poly[n].y),π fx(poly[1].x), fy(poly[1].y), scan_table);ππ scanline := 0;ππ While scanline < nypix - 1 doπ beginπ With Scan_table[scanline] DOπ if xmax > xmin thenπ draw_horiz_line(hline, c, scanline, xmin, xmax - xmin + 1);π scanline := scanline + 1;π end;πend;ππProcedure Wis_Hline(hline_ar : hlineArray; virseg : Word); Assembler;πAsmπ PUSH dsπ MOV ax, 0a000hπ MOV es, axπ LDS bx, hline_arπ MOV cx, [bx]π JCXZ @@Niet_tekenenπ ADD bx, 4π @@Wis:π XCHG cx, dxπ MOV si, [bx]π MOV cx, [bx + 2]π MOV di, siπ PUSH dsπ MOV ax, virsegπ MOV ds, axπ CLDπ REP MOVSBπ POP dsπ XCHG cx, dxπ ADD bx, 4π LOOP @@Wisπ @@Niet_tekenen:π POP dsπend;ππbeginπend.πππ{ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ }ππUnitπ ddVars;ππInterfaceππConstπ pi = 3.1415926535;π epsilon = 0.000001;π rad = pi / 180;π nxpix = 320; { scherm resolutie }π nypix = 200;π maxfinf = 200;ππTypeπ xmaxymax = Record xmin, xmax : Integer; end;π facetinfo = Record info, Pointer : Integer; end;π tabel = Array [1..nypix - 1] of xmaxymax;π sincos = Array [0..359] of Real;ππVarπ sinusArray : sincos;π cosinusArray : sincos;π facetinfacet : Array [1..maxfinf] of facetinfo;π facetfree : Integer;π xyscale : Real;π emptytabel : tabel;ππFunction fx(x : Real) : Integer;πFunction fy(y : Real) : Integer;πFunction Sign(I : Integer) : Integer;πFunction macht(a, n : Real) : Real;πFunction angle(x, y : Real) : Integer;πFunction sinus(hoek : Integer) : Real;πFunction cosin(hoek : Integer) : Real;πProcedure pushfacet(Var stackname : Integer; value : Integer);ππImplementationππFunction fx(x : Real) : Integer;πbeginπ fx := nxpix - trunc(x * xyscale + nxpix * 0.5 - 0.5);πend;ππFunction fy(y : Real) : Integer;πbeginπ fy := nypix - trunc(y * xyscale + nypix * 0.5 - 0.5);πend;ππFunction Sign(I : Integer) : Integer; Assembler;πAsmπ MOV ax, iπ CMP ax, 0π JGE @@Zero_or_oneπ MOV ax, -1π JMP @@Exitππ @@Zero_or_One:π JE @@Nulπ MOV ax, 1π JMP @@Exitππ @@Nul:π xor ax, axππ @@Exit:πend;ππFunction macht(a, n : Real) : Real;πbeginπ if a > 0 thenπ macht := exp(n * (ln(a)))π elseπ if a < 0 thenπ macht := -exp(n * (ln(-a)))π elseπ macht := a;πend;ππFunction angle(x, y : Real) : Integer;πbeginπ if abs(x) < epsilon thenπ if abs(y) < epsilon thenπ angle := 0π elseπ if y > 0.0 thenπ angle := 90π elseπ angle := 270π elseπ if x < 0.0 thenπ angle := round(arctan(y / x) / rad) + 180π elseπ angle := round(arctan(y / x) / rad);πend;ππFunction sinus(hoek : Integer) : Real;πbeginπ hoek := hoek mod 360;π sinus := sinusArray[hoek];πend;ππFunction cosin(hoek : Integer) : Real;πbeginπ hoek := hoek mod 360 ;π cosin := cosinusArray[hoek];πend;ππProcedure pushfacet(Var stackname : Integer; value : Integer);πVarπ location : Integer;πbeginπ if facetfree = 0 thenπ beginπ Write('Cannot hold more facets');π HALT;π endπ elseπ beginπ location := facetfree;π facetfree := facetinfacet[facetfree].Pointer;π facetinfacet[location].info := value;π facetinfacet[location].Pointer := stackname;π stackname := location;π end;πend;ππVarπ i : Integer;πbeginπ { vul sinus- en cosinusArray met waarden }π For i := 0 to 359 DOπ beginπ sinusArray[i] := sin(i * rad);π cosinusArray[i] := cos(i * rad);π end;π { Init facetinfacet }π facetfree := 1;π For i := 1 to maxfinf - 1 DOπ facetinfacet[i].Pointer := i + 1;ππ facetinfacet[maxfinf].Pointer := 0;ππ { Init EmptyTabel }π For i := 0 to nypix - 1 DOπ beginπ Emptytabel[i].xmin := 319;π Emptytabel[i].xmax := 0;π end;πend.πππ{ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ }ππUnit ddvideo;ππInterfaceππUsesπ Dos, DDVars;ππTypeπ schermPointer = ^schermType;π schermType = Array [0..nypix - 1, 0..nxpix - 1] of Byte;π color = Record R, G, B : Byte; end;π paletteType = Array [0..255] of color;π WordArray = Array [0..3] of Word;π palFile = File of paletteType;π picFile = File of schermType;ππVarπ scherm : schermType Absolute $8A00 : $0000;π schermptr : schermPointer;π switch : Integer;ππProcedure start(Filenaam : String; horiz : Real; Var Oldpal : paletteType);πProcedure finish(Oldpal : paletteType);πProcedure VirScherm_actief(switch : Word);πProcedure Scherm_actief(switch : Word);ππImplementationππProcedure Virscherm_actief(switch : Word); Assembler;πAsmπ MOV dx, 3cchπ MOV cx, switchπ JCXZ @@volgendeπ in al, dx { switch=1 }π and al, 0dfhπ MOV dx, 3c2hπ OUT dx, al { set even mode }π JMP @@Klaarππ @@Volgende:π in al, dx { switch=0 }π or al, 20hπ MOV dx, 3c2hπ OUT dx, al { set odd mode }ππ @@Klaar:π MOV dx, 3dah { Wacht op Vert-retrace }π in al, dx { Zodat virscherm = invisible }π TEST al, 08hπ JZ @@Klaarπend;ππProcedure Scherm_actief(switch : Word);πbeginπ Asmπ @@Wacht:π MOV dx, 3dahπ in al, dxπ TEST al, 01hπ JNZ @@Wachtπ end;π port[$3d4] := $c;π port[$3d5] := switch * $80;πend;ππProcedure SetVgaPalette(Var p : paletteType);πVarπ regs : Registers;πbeginπ With regs doπ beginπ ax := $1012;π bx := 0;π cx := 256;π es := seg(p);π dx := ofs(p);π end;π intr ($10, regs);πend;πππProcedure start(Filenaam : String; horiz : Real; Var Oldpal : paletteType);ππ Procedure readimage(Filenaam : String; Var pal : paletteType);ππ Function FileExists(FileName : String) : Boolean;π Varπ f : File;π beginπ {$I-}π Assign(f, FileName);π Reset(f);π Close(f);π {$I + }π FileExists := (IOResult = 0) and (FileName <> '');π end;ππ Varπ pFile : picFile;π lFile : palFile;π a : Integer;π beginπ if (FileExists(Filenaam + '.pal')) andπ (FileExists(Filenaam + '.dwg')) thenπ beginπ assign(lFile, Filenaam + '.pal');π reset(lFile);π read(lFile, pal);π close(lFile);π assign(pFile, Filenaam + '.dwg');π reset(pFile);π read(pFile, schermptr^);π close(pFile);π endπ elseπ beginπ Writeln('Palette en Picture bestanden niet gevonden....');π Halt;π end;π end;ππ Procedure SetVgaMode; Assembler;π Asmπ mov ah, 0π mov al, 13hπ int $10π end;ππ Procedure GetVgaPalette(Var p : paletteType);π Varπ regs : Registers;π beginπ With regs doπ beginπ ax := $1017;π bx := 0;π cx := 256;π es := seg(p);π dx := ofs(p);π end;π intr ($10, regs);π end;ππVarπ pal : paletteType;ππbeginπ getmem(schermptr, sizeof(schermType));π readimage(Filenaam, pal);π GetVgaPalette(OldPal);π SetVgaPalette(pal);π SetVgaMode;π move(schermptr^, scherm, nypix * nxpix);π Virscherm_actief(0);π move(schermptr^, mem[$A000 : 0], nypix * nxpix); { blanko scherm }π VirScherm_actief(1);π move(schermptr^, mem[$A000 : 0], nypix * nxpix); { blanko scherm }π Scherm_actief(1);π switch := 0;π xyscale := (nypix - 1) / horiz;πend;ππProcedure finish(Oldpal : paletteType);ππ Procedure SetNormalMode; Assembler;π Asmπ mov ah, 0π mov al, 3π int $10π end;ππbeginπ SetVgaPalette(Oldpal);π SetNormalMode;π Virscherm_actief(0);π Freemem(schermptr, sizeof(schermType));πend;ππbeginπend.π 20 08-27-9321:27ALL SWAG SUPPORT TEAM A Simple Graph Unit IMPORT 12 ╓ Unit MyGraph;ππInterfaceππTypeπ ColorValue = Recordπ Rvalue,π Gvalue,π Bvalue : Byte;π end;ππ PaleteType = Array [0..255] of ColorValue;ππProcedure palette(tp : paleteType);πProcedure pset(x, y : Integer; c : Byte);πFunction Point(x, y : Integer) : Byte;πProcedure RotatePalette(Var p : PaleteType; n1, n2, d : Integer);πProcedure SetVga;ππImplementationππUsesπ Crt, Dos;ππππVarπ n, x,π y, c, i : Integer;π ch : Char;π p : PaleteType;π image : File;π ok : Boolean;ππProcedure palette(tp : PaleteType);πVarπ regs : Registers;πbegin { Procedure VGApalette }π Regs.AX := $1012;π Regs.BX := 0; { first register to set }π Regs.CX := 256; { number of Registers to set }π Regs.ES := Seg(tp);π Regs.DX := Ofs(tp);π Intr($10, regs);πend; { Procedure SetVGApalette }ππProcedure Pset(x, y : Integer; c : Byte);πbegin { Procedure PutPixel }π mem[$A000 : Word(320 * y + x)] := c;πend; { Procedure PutPixel }ππFunction point(x, y : Integer) : Byte;πbegin { Function GetPixel }π Point := mem[$A000 : Word(320 * y + x)];πend; { Function GetPixel }ππProcedure rotatePalette(Var p : PaleteType; n1, n2, d : Integer);πVarπ q : PaleteType;πbegin { Procedure rotatePalette }π q := p;π For i := n1 to n2 doπ p[i] := q[n1 + (i + d) mod (n2 - n1 + 1)];π palette(p);πend; { Procedure rotatePalette }ππProcedure SetVga;πbeginπ Inline($B8/$13/$00/$CD/$10);πend;ππend.ππ 21 08-27-9321:37ALL MARK DIXON ModeX Code IMPORT 41 ╓ {πMARK DIXONππUm, have a look at this, and see what you can come up with. It's some code Iπwrote a while back to use mode-x and do double buffering (or page-flipping).π}ππProgram Test_ModeX;ππUsesπ crt;πππ{ This program will put the VGA card into a MODEX mode (still only 320x200)π and demonstrate double buffering (page flipping)ππ This program was written by Mark Dixon, and has been donated to theπ Public Domain with the exception that if you make use of these routines,π the author of these routines would appreciate his name mentioned somewhereπ in the documentation.ππ Use these routines at your own risk! Because they use the VGA's registers,π cards that are not 100% register compatible may not function correctly, andπ may even be damaged. The author will bear no responsability for any actionsπ occuring as a direct (or even indirect) result of the use of this program.ππ Any donations (eg Money, Postcards, death threats.. ) can be sent to :ππ Mark Dixonπ 12 Finchley Stπ Lynwood,π Western Australiaπ 6147ππ If you have Netmail access, then I can also be contacted on 3:690/660.14ππ }ππConstπ Page : Byte = 0;ππVarπ I, J : Word;πππProcedure InitModeX;π{ Sets up video mode to Mode X (320x200x256 with NO CHAIN4) making availableπ 4 pages of 4x16k bitmaps }πBeginπ asmπ mov ax, 0013h { Use bios to enter standard Mode 13h }π int 10hπ mov dx, 03c4h { Set up DX to one of the VGA registers }π mov al, 04h { Register = Sequencer : Memory Modes }π out dx, alπ inc dx { Now get the status of the register }π in al, dx { from the next port }π and al, 0c7h { AND it with 11000111b ie, bits 3,4,5 wiped }π or al, 04h { Turn on bit 2 (00000100b) }π out dx, al { and send it out to the register }π mov dx, 03c4h { Again, get ready to activate a register }π mov al, 02h { Register = Map Mask }π out dx, alπ inc dxπ mov al, 0fh { Send 00001111b to Map Mask register }π out dx, al { Setting all planes active }π mov ax, 0a000h { VGA memory segment is 0a000h }π mov es, ax { load it into ES }π sub di, di { clear DI }π mov ax, di { clear AX }π mov cx, 8000h { set entire 64k memory area (all 4 pages) }π repnz stosw { to colour BLACK (ie, Clear screens) }π mov dx, 03d4h { User another VGA register }π mov al, 14h { Register = Underline Location }π out dx, alπ inc dx { Read status of register }π in al, dx { into AL }π and al, 0bFh { AND AL with 10111111b }π out dx, al { and send it to the register }π { to deactivate Double Word mode addressing }π dec dx { Okay, this time we want another register,}π mov al, 17h { Register = CRTC : Mode Control }π out dx, alπ inc dxπ in al, dx { Get status of this register }π or al, 40h { and Turn the 6th bit ON }π out dx, al { to turn WORD mode off }π { And thats all there is too it!}π End;πEnd;πππProcedure Flip;π{ This routine will flip to the next page, and change the value inπ PAGE such that we will allways be drawing to the invisible page. }πVarπ OfsAdr : Word;πBeginπ OfsAdr := Page * 16000;π asmπ mov dx, 03D4hπ mov al, 0Dh { Set the Start address LOW register }π out dx, alπ inc dxππ mov ax, OfsAdrπ out dx, al { by sending low byte of offset address }π dec dxπ mov al, 0Ch { now set the Start Address HIGH register }π out dx, alπ inc dxπ mov al, ahπ out dx, al { by sending high byte of offset address }π End;ππ Page := 1 - Page; { Flip the page value.π Effectively does a :π If Page = 0 then Page = 1 elseπ If Page = 1 then Page = 0. }πEnd;ππππProcedure PutPixel (X, Y : Integer; Colour : Byte );π{ Puts a pixel on the screen at the current page. }πVarπ OfsAdr : Word;πBEGINπ OfsAdr := Page * 16000;π ASMπ mov bx, xπ mov ax, Yπ mov cx, 80 { Since there are now 4 pixels per byte, weπ only multiply by 80 (320/4) }π mul cxπ mov di, axπ mov ax, bxπ shr ax, 1π shr ax, 1π add di, axπ and bx, 3π mov ah, 1π mov cl, blπ shl ah, clππ mov al, 2π mov dx, 03C4hππ mov bx, $A000π mov es, bxπ add di, OfsAdrππ out dx, ax { Set plane to address (where AH=Plane) }π mov al, Colourπ mov es:[di], alπ end;πend;ππBeginπ Randomize;π InitModeX;π Flip;ππ For I := 0 to 319 doπ For J := 0 to 199 doπ PutPixel(I, J, Random(32) );π Flip;ππ For I := 0 to 319 doπ For J := 0 to 199 doπ PutPixel(I, J, Random(32) + 32);ππ Repeatπ Flip;π Delay(200);π Until Keypressed;ππEnd.π 22 08-27-9321:52ALL MIKE BRENNAN Rotate Grahic Image IMPORT 17 ╓ {πMIKE BRENNANππ> I've been trying For some time to get a Pascal Procedure that canπ> SCALE and/or ROTATE Graphic images. if anyone has any idea how to doππ Here are a couple of Procedures I made For rotating images, 2D and 3D. Iπbasically had to rotate each dot individually, and then form the image byπconnecting the specified dots. Here they are...π}ππProcedure Rotate(cent1, cent2 : Integer; { Two centroids For rotation }π angle : Real; { Angle to rotate in degrees }π Var coord1, coord2 : Real); { both coordinates to rotate }πVarπ coord1t, coord2t : Real;πbeginπ {Set coordinates For temp system}π coord1t := coord1 - cent1;π coord2t := coord2 - cent2;ππ {set new rotated coordinates}π coord1 := coord1t * cos(angle * pi / 180) - coord2t * sin(angle * pi / 180);π coord2 := coord1t * sin(angle * pi / 180) + coord2t * cos(angle * pi / 180);ππ {Change coordinates from temp system}π coord1 := coord1 + cent1;π coord2 := coord2 + cent2;πend;ππProcedure Draw3d(x, y, z : Real; {coordinates} a, b : Real; {View angles}π Var newx, newy : Integer); {return coordinates}πVarπ Xd, Yd, Zd : Real;πbeginπ Xd := cos(a * pi / 180) * cos(b * pi / 180);π Yd := cos(b * pi / 180) * sin(a * pi / 180);π Zd := -sin(b * pi / 180);π {Set coordinates For X/Y system}π newx:= round(-z * Xd / Zd + x);π newy:= round(-z * Yd / Zd + y);πend;ππ{πFor the first Procedure, you can rotate an image along any two axes, (ieπX,Y...X,Z...Y,Z). Simply calculate the centroid For each axe, (the average Xπcoordinate, or Y or Z), then pass the angle to rotate (use a negative For otherπdirection) and it will pass back the new rotated coordinates.ππ The second Procedure is For 3D drawing only. It transforms any 3D dot intoπits corresponding position on a 2D plan (ie your screen). The new coordinatesπare returned in the NewX, and NewY. Those are what you would use to plot yourπdot on the screen.π} 23 08-27-9321:52ALL SEAN PALMER Another Graphic Rotate IMPORT 58 ╓ {πSEAN PALMERππ> I've been trying For some time to get a Pascal Procedure that canπ> SCALE and/or ROTATE Graphic images. if anyone has any idea how to do this,π> or has a source code, PLEEEAASSEE drop me a line.. THANK YOU!ππThis is an out-and-out blatant hack of the routines from Abrash'sπXSHARP21. They are too slow to be usable as implemented here.π}ππ{$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+}π{$M $2000,0,0}πProgram VectTest;πUsesπ Crt, b320x200; {<-this Unit just implements Plot(x, y) and Color : Byte; }ππConstπ ClipMinY = 0;π ClipMaxY = 199;π ClipMinX = 0;π ClipMaxX = 319;π VertMax = 3;ππTypeπ fixed = Recordπ Case Byte ofπ 0 : (f : Byte; si : shortint);π 1 : (f2, b : Byte);π 2 : (w : Word);π 3 : (i : Integer);π end;ππ ByteArray = Array [0..63999] of Byte;ππ VertRec = Recordπ X, Y : Byte;π end;ππ VertArr = Array [0..VertMax] Of VertRec;π EdgeScan = Recordπ scansLeft : Integer;π Currentend : Integer;π srcX, srcY : fixed;π srcStepX,π srcStepY : fixed;π dstX : Integer;π dstXIntStep : Integer;π dstXdir : Integer;π dstXErrTerm : Integer;π dstXAdjUp : Integer;π dstXAdjDown : Integer;π dir : shortInt;π end;ππConstπ numVerts = 4;π mapX = 7;π mapY = 7;ππ Vertex : Array [0..vertMax] of vertRec =π ((x : 040; y : 020),π (x : 160; y : 050),π (x : 160; y : 149),π (x : 040; y : 179));ππ Points : Array [0..vertMax] of vertRec =π ((x : 0; y : 0),π (x : mapX; y : 0),π (x : mapX; y : mapY),π (x : 0; y : mapY));ππ texMap : Array [0..mapY, 0..mapX] of Byte =π (($F, $F, $F, $F, $F, $F, $F, $0),π ($F, $7, $7, $7, $7, $7, $F, $0),π ($F, $7, $2, $2, $2, $7, $F, $0),π ($F, $7, $2, $2, $2, $7, $F, $0),π ($F, $7, $2, $2, $9, $7, $F, $0),π ($F, $7, $2, $2, $2, $7, $F, $0),π ($F, $7, $2, $2, $2, $7, $F, $0),π ($0, $0, $0, $0, $0, $0, $0, $0));ππVarπ lfEdge,π rtEdge : EdgeScan;π z, z2 : Integer;ππFunction fixedDiv(d1, d2 : LongInt) : LongInt; Assembler;πAsmπ db $66; xor dx, dxπ mov cx, Word ptr D1+2π or cx, cxπ jns @Sπ db $66; dec dxπ @S:π mov dx, cxπ mov ax, Word ptr D1π db $66; shl ax, 16π db $66; idiv Word ptr d2π db $66; mov dx, axπ db $66; shr dx, 16πend;ππFunction div2Fixed(d1, d2 : LongInt) : LongInt; Assembler;πAsmπ db $66; xor dx, dxπ db $66; mov ax, Word ptr d1π db $66; shl ax, 16π jns @Sπ db $66; dec dxπ @S:π db $66; idiv Word ptr d2π db $66; mov dx, axπ db $66; shr dx, 16πend;ππFunction divfix(d1, d2 : Integer) : Integer; Assembler;πAsmπ mov al, Byte ptr d1+1π cbwπ mov dx, axπ xor al, alπ mov ah, Byte ptr d1π idiv d2πend;ππProcedure Draw;πVarπ MinY,π MaxY,π MinVert,π MaxVert,π I, dstY : Integer;ππ Function SetUpEdge(Var Edge : EdgeScan; StartVert : Integer) : Boolean;π Varπ NextVert : shortint;π dstXWidth : Integer;π T,π dstYHeight : fixed;π beginπ SetUpEdge := True;π While (StartVert <> MaxVert) Doπ beginπ NextVert := StartVert + Edge.dir;π if (NextVert >= NumVerts) Thenπ NextVert := 0π elseπ if (NextVert < 0) Thenπ NextVert := pred(NumVerts);ππ With Edge Doπ beginπ scansLeft := vertex[NextVert].Y - vertex[StartVert].Y;π if (scansLeft <> 0) Thenπ beginπ dstYHeight.f := 0;π dstYHeight.si := scansLeft;π Currentend := NextVert;π srcX.f := 0;π srcX.si := Points[StartVert].X;π srcY.f := 0;π srcY.si := Points[StartVert].Y;π srcStepX.i := divFix(points[nextVert].x - srcX.si, scansLeft);π srcStepY.i := divFix(points[nextVert].y - srcY.si, scansLeft);π dstX := vertex[StartVert].X;π dstXWidth := vertex[NextVert].X-vertex[StartVert].X;ππ if (dstXWidth < 0) Thenπ beginπ dstXdir := -1;π dstXWidth := -dstXWidth;π dstXErrTerm := 1 - scansLeft;π dstXIntStep := -(dstXWidth Div scansLeft);π endπ elseπ beginπ dstXdir := 1;π dstXErrTerm := 0;π dstXIntStep := dstXWidth Div scansLeft;π end;π dstXAdjUp := dstXWidth Mod scansLeft;π dstXAdjDown := scansLeft;π Exit;π end;π StartVert := NextVert;π end;π end;π SetUpEdge := False;π end;ππ Function StepEdge(Var Edge : EdgeScan) : Boolean;π beginπ Dec(Edge.scansLeft);π if (Edge.scansLeft = 0) Thenπ beginπ StepEdge := SetUpEdge(Edge, Edge.Currentend);π Exit;π end;π With Edge Doπ beginπ Inc(srcX.i, srcStepX.i);π Inc(srcY.i, srcStepY.i);π Inc(dstX, dstXIntStep);π Inc(dstXErrTerm, dstXAdjUp);π if (dstXErrTerm > 0) Thenπ beginπ Inc(dstX, dstXdir);π Dec(dstXErrTerm, dstXAdjDown);π end;π end;π StepEdge := True;π end;ππ Procedure ScanOutLine;π Varπ srcX,π srcY : fixed;π dstX,π dstXMax : Integer;π dstWidth,π srcXStep,π srcYStep : fixed;π beginπ srcX.w := lfEdge.srcX.w;π srcY.w := lfEdge.srcY.w;π dstX := lfEdge.dstX;π dstXMax := rtEdge.dstX;ππ if (dstXMax <= ClipMinX) Or (dstX >= ClipMaxX) Thenπ Exit;π dstWidth.f := 0;π dstWidth.si := dstXMax - dstX;π if (dstWidth.i <= 0) Thenπ Exit;π srcXStep.i := divFix(rtEdge.srcX.i - srcX.i, dstWidth.i);π srcYStep.i := divFix(rtEdge.srcY.i - srcY.i, dstWidth.i);π if (dstXMax > ClipMaxX) Thenπ dstXMax := ClipMaxX;π if (dstX < ClipMinX) Thenπ beginπ Inc(srcX.i, srcXStep.i * (ClipMinX - dstX));π Inc(srcY.i, srcYStep.i * (ClipMinX - dstX));π dstX := ClipMinX;π end;ππ Asmπ mov ax, $A000π mov es, axπ mov ax, xResπ mul dstYπ add ax, dstXπ mov di, axπ mov cx, dstXMaxπ sub cx, dstXπ mov bx, srcXStep.iπ mov dx, srcYStep.iπ @L:π mov al, srcY.&siπ xor ah, ahπ shl ax, 3π add al, srcX.&siπ add ax, offset texmapπ mov si, axπ movsbπ add srcX.i,bxπ add srcY.i,dxπ loop @Lπ end;π end;ππbeginπ if (NumVerts < 3) Thenπ Exit;π MinY := vertex[numVerts - 1].y;π maxY := vertex[numVerts - 1].y;π maxVert := numVerts - 1;π minVert := numVerts - 1;π For I := numVerts - 2 downto 0 Doπ beginπ if (vertex[I].Y < MinY) Thenπ beginπ MinY := vertex[I].Y;π MinVert := I;π end;π if (vertex[I].Y > MaxY) Thenπ beginπ MaxY := vertex[I].Y;π MaxVert := I;π end;π end;π if (MinY >= MaxY) Thenπ Exit;π dstY := MinY;π lfEdge.dir := -1;π SetUpEdge(lfEdge, MinVert);π rtEdge.dir := 1;π SetUpEdge(rtEdge, MinVert);π While (dstY < ClipMaxY) Doπ beginπ if (dstY >= ClipMinY) Thenπ ScanOutLine;π if Not StepEdge(lfEdge) Thenπ Exit;π if Not StepEdge(rtEdge) Thenπ Exit;π Inc(dstY);π end;πend;ππbeginπ directVideo := False;π TextAttr := 63;π { For z:=0 to mapY do For z2:=0 to mapx do texMap[z,z2]:=random(6+53);}π For z := 4 to 38 doπ beginπ clearGraph;π vertex[0].x := z * 4;π vertex[3].x := z * 4;π draw;π if KeyPressed thenπ beginπ ReadKey;π ReadKey;π end;π end;π readln;πend.ππ 24 08-27-9321:52ALL WILLIAM SITCH Rotate PIC IMPORT 22 ╓ {πWILLIAM SITCHππ> I've been trying For some time to get a Pascalπ> Procedure that can SCALE and/or ROTATE Graphic images. ifπ> anyone has any idea how to do this, or has a source code,π> PLEEEAASSEE drop me a line.. THANK YOU!ππHere is some code to rotate an image (in MCGA screen mode $13) ... but it has aπfew drawbacks... its kinda slow and the image falls apart during rotation... itπhasn't been tested fully either...π}ππProcedure rotate(x1, y1, x2, y2 : Word; ang, ainc : Real);πVarπ ca, sa : Real;π cx, cy : Real;π dx, dy : Real;π h, i,π j, k : Word;ππ pinf : Array [1..12500] of Recordπ x, y : Word;π col : Byte;π end;ππbeginπ ca := cos((ainc / 180) * pi);π sa := sin((ainc / 180) * pi);ππ For h := 1 to round(ang / ainc) doπ beginπ k := 0;π cx := x1 + ((x2 - x1) / 2);π cy := y1 + ((y2 - y1) / 2);π For i := x1 to x2 doπ For j := y1 to y2 doπ beginπ inc(k);ππ dx := cx + (((i - cx) * ca) - ((j - cy) * sa));π dy := cy + (((i - cx) * sa) + ((j - cy) * ca));ππ if (round(dx) > 0) and (round(dy) > 0) andπ (round(dx) < 65000) and (round(dy) < 65000) thenπ beginπ pinf[k].x := round(dx);π pinf[k].y := round(dy);π pinf[k].col := mem[$A000 : j * 320 + i];π endπ elseπ beginπ pinf[k].x := 0;π pinf[k].y := 0;π pinf[k].col := 0;π end;π end;ππ For i := x1 to x2 doπ For j := y1 to y2 doπ mem[$A000 : j * 320 + i] := 0;ππ x1 := 320;π x2 := 1;π y1 := 200;π y2 := 1;π For i := 1 to k doπ beginπ if (pinf[i].x < x1) thenπ x1 := pinf[i].x;π if (pinf[i].x > x2) thenπ x2 := pinf[i].x;ππ if (pinf[i].y < y1) thenπ y1 := pinf[i].y;π if (pinf[i].y > y2) thenπ y2 := pinf[i].y;ππ if (pinf[i].x > 0) and (pinf[i].y > 0) thenπ mem[$A000 : pinf[i].y * 320 + pinf[i].x] := pinf[i].col;π end;π end;πend;ππ{πIt works, but DON'T try to use it For a main module or base a Program AROUNDπit... instead try to change it to suit your needs, as right now it's kindaπoptimized For my needs...ππSorry For not editing it to work With any screen mode, but I just don't haveπthe time. MCGA memory is a linear block of Bytes, and you can access it using:πmem[$A000:offset]. So to find the color at screen position 10,10, you wouldπgo:ππmem[$A000 : y * 320 + x]π ^ ^ ^-- x val, 10π | |----- screenwidthπ |-------- y val, 10π} 25 08-27-9321:58ALL WILLIAM SITCH Graphic Spinning Disk IMPORT 24 ╓ {πWILLIAM SITCHππ> Okay, I've just finally got my hands on the formulas forπ> doing good Graphics manipulations...well, I decided to startπ> With something simple. A rotating square. But it DOESN'Tπ> WORK RIGHT. I noticed the size seemed to shift in and outπ> and a little testing showed me that instead of following aπ> circular path (as they SHOULD), the corners (while spinning)π> actually trace out an OCTAGON. Why???? I've checked andπ> rechecked the formula logic...It's just as I was given. Soπ> there's some quirk about the code that I don't know about.π> Here's the rotating routine:ππAhhh... "rounding errors" is what my comp sci teacher explained to me, butπthere isn't much you can do about it... I've included my (rather long)πspinning disc code to take a look at ... feel free to try to port it to yourπapplication...ππ}ππUsesπ Graph, Crt;ππProcedure spin_disk;πTypeπ pointdataType = Array [1..4] of Record x,y : Integer; end;πConstπ delVar = 10;ππVarπ ch : Char;π p, op : pointdataType;π cx, cy,π x, y, r : Integer;π i : Integer;π rot : Integer;π tempx,π tempy : Integer;π theta : Real;π down : Boolean;π del : Real;πbeginπ cx := getmaxx div 2;π cy := getmaxy div 2;π r := 150;π circle(cx,cy,r);ππ rot := 0;π p[1].x := 100; p[1].y := 0;π p[2].x := 0; p[2].y := -100;π p[3].x := -100; p[3].y := 0;π p[4].x := 0; p[4].y := 100;π del := 50;π down := True;ππ Repeatπ rot := rot + 2;π theta := rot * 3.14 / 180;π For i := 1 to 4 doπ beginπ tempx := p[i].x;π tempy := p[i].y;π op[i].x := p[i].x;π op[i].y := p[i].y;π p[i].x := round(cos(theta) * tempx - sin(theta) * tempy);π p[i].y := round(sin(theta) * tempx + cos(theta) * tempy);π end;π setcolor(0);π line(op[1].x + cx,cy - op[1].y,op[2].x + cx,cy - op[2].y);π line(op[2].x + cx,cy - op[2].y,op[3].x + cx,cy - op[3].y);π line(op[3].x + cx,cy - op[3].y,op[4].x + cx,cy - op[4].y);π line(op[4].x + cx,cy - op[4].y,op[1].x + cx,cy - op[1].y);π For i := 1 to 4 doπ line(op[i].x + cx,cy - op[i].y,cx,cy);π setcolor(11);π line(p[1].x + cx,cy - p[1].y,p[2].x + cx,cy - p[2].y);π line(p[2].x + cx,cy - p[2].y,p[3].x + cx,cy - p[3].y);π line(p[3].x + cx,cy - p[3].y,p[4].x + cx,cy - p[4].y);π line(p[4].x + cx,cy - p[4].y,p[1].x + cx,cy - p[1].y);π setcolor(10);π For i := 1 to 4 doπ line(p[i].x + cx,cy - p[i].y,cx,cy);π if (del < 1) thenπ down := Falseπ else if (del > 50) thenπ down := True;π if (down) thenπ del := del - delVarπ elseπ del := del + delVar;π Delay(round(del));π Until (KeyPressed = True);π ch := ReadKey;π NoSound;πend;ππVarπ Gd, Gm : Integer;ππbeginπ Gd := Detect;π InitGraph(Gd, Gm, 'd:\bp\bgi');ππ Spin_disk;ππend. 26 08-27-9321:59ALL SEAN PALMER Drawing a B-Spline curve IMPORT 22 ╓ {πSEAN PALMERππI was just toying around With a B-Spline curve routine I got out of anπold issue of Byte, and thought it was pretty neat. I changed it to useπfixed point fractions instead of Reals, and optimized it some...ππby Sean Palmerπpublic domainπ}ππVarπ color : Byte;πProcedure plot(x, y : Word);πbeginπ mem[$A000 : y * 320 + x] := color;πend;ππTypeπ coord = Recordπ x, y : Word;π end;ππ CurveDataRec = Array [0..65521 div sizeof(coord)] of coord;ππFunction fracMul(f, f2 : Word) : Word;πInline(π $58/ {pop ax}π $5B/ {pop bx}π $F7/$E3/ {mul bx}π $89/$D0); {mov ax,dx}ππFunction mul(f, f2 : Word) : LongInt;πInline(π $58/ {pop ax}π $5B/ {pop bx}π $F7/$E3); {mul bx}πππConstπ nSteps = 1 shl 8; {about 8 For smoothness (dots), 4 For speed (lines)}ππProcedure drawBSpline(Var d0 : coord; nPoints : Word);πConstπ nsa = $10000 div 6;π nsb = $20000 div 3;π step = $10000 div nSteps;πVarπ i, xx, yy,π t1, t2, t3,π c1, c2, c3, c4 : Word;ππ d : curveDataRec Absolute d0;ππbeginπ t1 := 0;π color := 32 + 2;ππ For i := 0 to nPoints - 4 doπ beginππ {algorithm converted from Steve Enns' original Basic subroutine}ππ Repeatπ t2 := fracMul(t1, t1);π t3 := fracMul(t2, t1);π c1 := (Integer(t2 - t1) div 2) + nsa - fracmul(nsa, t3);π c2 := (t3 shr 1) + nsb - t2;π c3 := ((t2 + t1 - t3) shr 1) + nsa;π c4 := fracmul(nsa, t3);π xx := (mul(c1, d[i].x) + mul(c2, d[i + 1].x) +π mul(c3, d[i + 2].x) + mul(c4, d[i + 3].x)) shr 16;π yy := (mul(c1, d[i].y) + mul(c2, d[i + 1].y) +π mul(c3, d[i + 2].y) + mul(c4, d[i + 3].y)) shr 16;π plot(xx, yy);π inc(t1, step);π Until t1 = 0; {this is why nSteps must be even power of 2}π inc(color);π end;πend;ππConstπ pts = 24; {number of points} {chose this because of colors}ππVarπ c : Array [-1..2 + pts] of coord;π i : Integer;πbeginπ Asmπ mov ax, $13π int $10π end; {init vga/mcga Graphics}π randomize;π For i := 1 to pts doπ With c[i] doπ beginπ {x:=i*(319 div pts);} {for precision demo}π x := random(320); {for fun demo}π y := random(200);π end;π {for i:=1 to pts div 2 do c[i*2+1].y:=c[i*2].y;} {fit closer}π For i := 1 to pts doπ With c[i] doπ beginπ color := i + 32;π plot(x, y);π end;π {replicate end points so curves fit to input}π c[-1] := c[1];π c[0] := c[1];π c[pts + 1] := c[pts];π c[pts + 2] := c[pts];π drawBSpline(c[-1], pts + 4);π readln;π Asmπ mov ax, 3π int $10π end; {Text mode again}πend.π 27 08-27-9321:59ALL SEAN PALMER Another B-Spline Curve IMPORT 35 ╓ {πSEAN PALMERππI've been playing around with it as a way to make 'heat-seekingπmissiles' in games. Very interesting...ππWhat I do is have the points set up as follows:ππ1 : current positionπ2&3 : current speed + the current positionπ4 : destinationππand update current position by indexing somewhere into the curve (likeπat $100 out of $FFFFππThis works very well. Problem is that I don't know of a good way toπchange the speed.ππHere is a simple demo that makes a dot chase the mouse cursor (needsπVGA as written) that shows what I mean.ππIf ANYBODY can make this work smoother or improve on it in any way Iπwould appreciate being told how... 8)π}ππusesπ mouse, crt; { you will need to change accesses to the mouse unit }π { to use a mouse package that you provide }πtypeπ coord = recordπ x, y : word;π end;π CurveDataRec = array [0..65521 div sizeof(coord)] of coord;ππconstπ nSteps = 1 shl 8; {about 8 for smoothness (dots), 4 for speed (lines)}ππvarπ color : byte;π src, spd,π dst, mov1,π mov2 : coord;π i : integer;ππprocedure plot(x, y : word);πbeginπ mem[$A000 : y * 320 + x] := color;πend;ππfunction fracMul(f, f2 : word) : word;πInline(π $58/ {pop ax}π $5B/ {pop bx}π $F7/$E3/ {mul bx}π $89/$D0); {mov ax,dx}ππfunction mul(f, f2 : word) : longint;πinline(π $58/ {pop ax}π $5B/ {pop bx}π $F7/$E3); {mul bx}πππ{this is the original full BSpline routine}ππprocedure drawBSpline(var d0 : coord; nPoints : word);πconstπ nsa = $10000 div 6;π nsb = $20000 div 3;π step = $10000 div nSteps;πvarπ i, xx, yy : word;π t1, t2, t3 : word;π c1, c2, c3, c4 : word;π d : curveDataRec absolute d0;πbeginπ t1 := 0;π color := 32 + 2;π for i := 0 to nPoints - 4 doπ beginπ {algorithm converted from Steve Enns' original Basic subroutine}π repeatπ t2 := fracMul(t1, t1);π t3 := fracMul(t2, t1);π c1 := (integer(t2 - t1) div 2) + nsa - fracmul(nsa, t3);π c2 := (t3 shr 1) + nsb - t2;π c3 := ((t2 + t1 - t3) shr 1) + nsa;π c4 := fracmul(nsa, t3);π xx := (mul(c1, d[i].x) + mul(c2, d[i + 1].x) +π mul(c3, d[i + 2].x) + mul(c4, d[i + 3].x)) shr 16;π yy := (mul(c1, d[i].y) + mul(c2, d[i + 1].y) +π mul(c3, d[i + 2].y) + mul(c4, d[i + 3].y)) shr 16;π plot(xx, yy);π inc(t1, step);π until t1 = 0; {this is why nSteps must be even power of 2}π inc(color);π end;πend;πππ{find 1/nth point in BSpline} {this is what does the B-Spline work}ππprocedure moveTowards(d1, d2, d3, d4 : coord; t1 : word; var mov : coord);πconstπ nsa = $10000 div 6;π nsb = $20000 div 3;πvarπ t2, t3 : word;π c1, c2,π c3, c4 : word;πbeginπ t2 := fracMul(t1, t1);π t3 := fracMul(t2, t1);π c1 := (integer(t2 - t1) div 2) + nsa - fracmul(nsa, t3);π c2 := (t3 shr 1) + nsb - t2;π c3 := ((t2 + t1 - t3) shr 1) + nsa;π c4 := fracmul(nsa, t3);π mov.x := (mul(c1, d1.x) + mul(c2, d2.x) + mul(c3, d3.x) + mul(c4, d4.x)) shr 16;π mov.y := (mul(c1, d1.y) + mul(c2, d2.y) + mul(c3, d3.y) + mul(c4, d4.y)) shr 16;πend;ππbeginπ asmπ mov ax, $13π int $10π end; {init vga/mcga graphics}ππ {mouse.init;}π mshow;ππ src.x := 5;π src.y := 5;π spd.x := 5;π spd.y := 5;π dst.x := 315;π dst.y := 190;ππ repeatπ {for i:=0 to 23 do begin}π { color:=i+32;}π { inc(dst.x,i);}π delay(10);π {mouse.check;} {this loads Mouse.X, Mouse.Y, Mouse.Button from driver}π mhide;π color := 15;π plot(src.x, src.y);π color := 14;π plot(spd.x, spd.y);π dst.x := mousex shr 1;π dst.y := mousey;π color := 1;π plot(dst.x, dst.y);π mshow;ππ {the parameters in these next two lines can be changed}π {I have played with almost all possible combinations and}π {most work, but not well, so don't be afraid to play around}π {But I think an entirely different approach is needed for the}π {second moveTowards..}ππ moveTowards(src, src, spd, dst, $0010, mov1);π moveTowards(src, spd, dst, dst, $5000, mov2);π src := mov1;π longint(spd) := (longint(spd) * 7 + longint(mov2)) shr 3 and $1FFF1FFF;π until 1=0;ππ mhide;ππ asmπ mov ax, 3π int $10π end; {text mode again}πend.ππ 28 08-27-9322:00ALL BRENDEN BEAMAN Another Star field IMPORT 14 ╓ { BRendEN BEAMAN }ππProgram starfield;πUsesπ Crt, Graph;ππVarπ l, l2,π gd, gm,π x, y : Integer;π rad : Array [1..20] of Integer;π p : Array [1..20, 1..5] of Integer;ππProcedure put(p, rad : Integer; col : Word);πbeginπ setcolor(col); {1 pixel arc instead of putpixel}π arc(x, y, p, p + 1, rad);πend;ππProcedure putstar;πbeginπ For l := 1 to 20 do {putting stars. #15 below is color of stars}π For l2 := 1 to 5 do put(p[l, l2], rad[l], 15);πend;ππProcedure delstar;πbeginπ For l := 1 to 20 do {erasing stars}π For l2 := 1 to 5 do put(p[l, l2], rad[l], 0);πend;ππbeginπ randomize;π gd := detect;π initGraph(gd, gm, 'd:\bp\bgi');π x := 320;π y := 240;ππ For l := 1 to 20 doπ rad[l] := l * 10;π For l := 1 to 20 doπ For l2 := 1 to 5 doπ p[l, l2] := random(360);ππ While not KeyPressed doπ beginπ delstar;π For l := 1 to 20 doπ begin {moving stars towards 'camera'}π rad[l] := rad[l] + round(rad[l] / 20 + 1); { (20)=starspeed. }π if rad[l] > 400 thenπ rad[l] := l * 10; { starspeed must be equal }π end; { to or less than 20 }π putstar;π end;π readln;πend.ππ The concept is fairly simple, but most people underestimate arcs...π you can set where on the circle, (0-360 degres) the arc starts, andπ stops... if you set a one pixel arc at 100, and increase the radius ofπ the circle in a loop, it will apear to come towards you in threeπ dimentions... any other questions, or problems running it, contactπ me... ttylπ 29 08-27-9322:08ALL SEAN PALMER TWEAKED! Graph unit IMPORT 132 ╓ {$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+} {TP 6.0 & 286 required!}πUnit x320x240;ππ{π Sean Palmer, 1993π released to the Public Domainπ in tweaked modes, each latch/bit plane contains the entire 8-bit pixel.π the sequencer map mask determines which plane (pixel) to update, and, whenπ reading, the read map select reg determines which plane (pixel) to read.π almost exactly opposite from regular vga 16-color modes which is why I neverπ could get my routines to work For BOTH modes. 8)ππ # = source screen pixelπ Normal 16-color Tweaked 256-colorππ Bit Mask Bit Maskπ 76543210 33333333π Map 76543210 Map 22222222π Mask 76543210 Mask 11111111π 76543210 00000000ππ Functional equivalentsπ Bit Mask = Seq Map Maskπ Seq Map Mask = Bit Maskπ}πππInterfaceππVarπ color : Byte;ππConstπ xRes = 320;π yRes = 240; {displayed screen size}π xMax = xRes - 1;π yMax = yRes - 1;π xMid = xMax div 2;π yMid = yMax div 2;π vxRes = 512;π vyRes = $40000 div vxRes; {virtual screen size}π nColors = 256;π tsx : Byte = 8;π tsy : Byte = 8; {tile size}πππProcedure plot(x, y : Integer);πFunction scrn(x, y : Integer) : Byte;ππProcedure hLin(x, x2, y : Integer);πProcedure vLin(x, y, y2 : Integer);πProcedure rect(x, y, x2, y2 : Integer);πProcedure pane(x, y, x2, y2 : Integer);ππProcedure line(x, y, x2, y2 : Integer);πProcedure oval(xc, yc, a, b : Integer);πProcedure disk(xc, yc, a, b : Integer);πProcedure fill(x, y : Integer);ππProcedure putTile(x, y : Integer; p : Pointer);πProcedure overTile(x, y : Integer; p : Pointer);πProcedure putChar(x, y : Integer; p : Word);ππProcedure setColor(color, r, g, b : Byte);π{rgb vals are from 0-63}πFunction getColor(color : Byte) : LongInt;π{returns $00rrggbb format}πProcedure setPalette(color : Byte; num : Word; Var rgb);π{rgb is list of 3-Byte rgb vals}πProcedure getPalette(color : Byte; num : Word; Var rgb);ππProcedure clearGraph;πProcedure setWriteMode(f : Byte);πProcedure waitRetrace;πProcedure setWindow(x, y : Integer);ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππImplementationππConstπ vSeg = $A000; {video segment}π vxBytes = vxRes div 4; {Bytes per virtual scan line}π seqPort = $3C4; {Sequencer}π gcPort = $3CE; {Graphics Controller}π attrPort = $3C0; {attribute Controller}ππ tableReadIndex = $3C7;π tableWriteIndex = $3C8;π tableDataRegister = $3C9;ππ CrtcRegLen = 10;π CrtcRegTable : Array [1..CrtcRegLen] of Word =π ($0D06, $3E07, $4109, $EA10, $AC11, $DF12, $0014, $E715, $0616, $E317);ππππVarπ CrtcPort : Word; {Crt controller}π oldMode : Byte;π ExitSave : Pointer;π input1Port : Word; {Crtc Input Status Reg #1=CrtcPort+6}π fillVal : Byte;ππTypeπ tRGB = Recordπ r, g, b : Byte;π end;ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππProcedure clearGraph; Assembler;πAsmπ mov ax, vSegπ mov es, axπ mov dx, seqPortπ mov ax, $0F02π out dx, ax {enable whole map mask}π xor di, diπ mov cx, $8000 {screen size in Words}π cldπ mov al, colorπ mov ah, alπ repz stosw {clear screen}πend;ππProcedure setWriteMode(f : Byte); Assembler;πAsm {copy/and/or/xor modes}π mov ah, fπ shl ah, 3π mov al, 3π mov dx, gcPortπ out dx, ax {Function select reg}πend;ππProcedure waitRetrace; Assembler;πAsmπ mov dx, CrtcPortπ add dx, 6 {find Crt status reg (input port #1)}π @L1:π in al, dxπ test al, 8π jnz @L1; {wait For no v retrace}π @L2:π in al, dxπ test al, 8π jz @L2 {wait For v retrace}π end;πππ{π Since a virtual screen can be larger than the actual screen, scrolling isπ possible. This routine sets the upper left corner of the screen to theπ specified pixel. Make sure 0 <= x <= vxRes - xRes, 0 <= y <= vyRes - yResπ}πProcedure setWindow(x, y : Integer); Assembler;πAsmπ mov ax, vxBytesπ mul yπ mov bx, xπ mov cl, blπ shr bx, 2π add bx, ax {bx=Ofs of upper left corner}π mov dx, input1Portπ @L:π in al, dxπ test al, 8π jnz @L {wait For no v retrace}π sub dx, 6 {CrtC port}π mov al, $Dπ mov ah, blπ cli {these values are sampled at start of retrace}π out dx, ax {lo Byte of display start addr}π dec alπ mov ah, bhπ out dx, ax {hi Byte}π stiπ add dx, 6π @L2:π in al, dxπ test al, 8π jz @L2 {wait For v retrace}π {this also resets Attrib flip/flop}π mov dx, attrPortπ mov al, $33π out dx, al {Select Pixel Pan Register}π and cl, 3π mov al, clπ shl al, 1π out dx, al {Shift is For 256 Color Mode}πend;ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππProcedure plot(x, y : Integer); Assembler;πAsmπ mov ax, vSegπ mov es, axπ mov di, xπ mov cx, diπ shr di, 2π mov ax, vxBytesπ mul yπ add di, axπ mov ax, $0102π and cl, 3π shl ah, clπ mov dx, seqPortπ out dx, ax {set bit mask}π mov al, colorπ stosbπend;ππFunction scrn(x, y : Integer) : Byte; Assembler;πAsmπ mov ax, vSegπ mov es, axπ mov di, xπ mov cx, diπ shr di, 2π mov ax, vxBytesπ mul yπ add di, axπ and cl, 3π mov ah, clπ mov al, 4π mov dx, gcPortπ out dx, ax {Read Map Select register}π mov al, es:[di] {get the whole plane}πend;ππProcedure hLin(x, x2, y : Integer); Assembler;πAsmπ mov ax, vSegπ mov es, axπ cldπ mov ax, vxBytesπ mul yπ mov di, ax {base of scan line}π mov bx, xπ mov cl, blπ shr bx, 2π mov dx, x2π mov ch, dlπ shr dx, 2π and cx, $0303π sub dx, bx {width in Bytes}π add di, bx {offset into video buffer}π mov ax, $FF02π shl ah, clπ and ah, $0F {left edge mask}π mov cl, chπ mov bh, $F1π rol bh, clπ and bh, $0F {right edge mask}π mov cx, dxπ or cx, cxπ jnz @LEFTπ and ah, bh {combine left & right bitmasks}π @LEFT:π mov dx, seqPortπ out dx, axπ inc dxπ mov al, colorπ stosbπ jcxz @EXITπ dec cxπ jcxz @RIGHTπ mov al, $0Fπ out dx, al {skipped if cx=0,1}π mov al, colorπ repz stosb {fill middle Bytes}π @RIGHT:π mov al, bhπ out dx, al {skipped if cx=0}π mov al, colorπ stosbπ @EXIT:πend;ππProcedure vLin(x, y, y2 : Integer); Assembler;πAsmπ mov ax, vSegπ mov es, axπ cldπ mov di, xπ mov cx, diπ shr di, 2π mov ax, vxBytesπ mul yπ add di, axπ mov ax, $102π and cl, 3π shl ah, clπ mov dx, seqPortπ out dx, axπ mov cx, y2π sub cx, yπ inc cxπ mov al, colorπ @DOLINE:π mov bl, es:[di]π stosbπ add di, vxBytes-1π loop @DOLINEπend;ππProcedure rect(x, y, x2, y2 : Integer);πVarπ i : Word;πbeginπ hlin(x, pred(x2), y);π hlin(succ(x), x2, y2);π vlin(x, succ(y), y2);π vlin(x2, y, pred(y2));πend;ππProcedure pane(x, y, x2, y2 : Integer);πVarπ i : Word;πbeginπ For i := y2 downto y doπ hlin(x, x2, i);π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;ππProcedure oval(xc, yc, a, b : Integer);πVarπ x, y : Integer;π aa, aa2,π bb, bb2,π d, dx, dy : LongInt;πbeginπ x := 0;π y := b;π aa := LongInt(a) * a;π aa2 := 2 * aa;π bb := LongInt(b) * b;π bb2 := 2 * bb;π d := bb - aa * b + aa div 4;π dx := 0;π dy := aa2 * b;π plot(xc, yc - y);π plot(xc, yc + y);π plot(xc - a, yc);π plot(xc + a, yc);π While (dx < dy) doπ beginπ if(d > 0) thenπ beginπ dec(y);π dec(dy, aa2);π dec(d, dy);π end;π inc(x);π inc(dx, bb2);π inc(d, bb + dx);π plot(xc + x, yc + y);π plot(xc - x, yc + y);π plot(xc + x, yc - y);π plot(xc - x, yc - y);π end;ππ inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);ππ While (y > 0) doπ beginπ if (d < 0) thenπ beginπ inc(x);π inc(dx, bb2);π inc(d, bb + dx);π end;π dec(y);π dec(dy, aa2);π inc(d, aa - dy);π plot(xc + x, yc + y);π plot(xc - x, yc + y);π plot(xc + x, yc - y);π plot(xc - x, yc - y);π end;πend;ππProcedure disk(xc, yc, a, b:Integer);πVarπ x, y : Integer;π aa, aa2,π bb, bb2,π d, dx, dy : LongInt;πbeginπ x := 0;π y := b;π aa := LongInt(a) * a;π aa2 := 2 * aa;π bb := LongInt(b) * b;π bb2 := 2 * bb;π d := bb - aa * b + aa div 4;π dx := 0;π dy := aa2 * b;ππ vLin(xc, yc - y, yc + y);ππ While (dx < dy) doπ beginπ if (d > 0) thenπ beginπ dec(y);π dec(dy, aa2);π dec(d, dy);π end;π inc(x);π inc(dx, bb2);π inc(d, bb + dx);π vLin(xc - x, yc - y, yc + y);π vLin(xc + x, yc - y, yc + y);π end;ππ inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);ππ While (y >= 0) doπ beginπ if (d < 0) thenπ beginπ inc(x);π inc(dx, bb2);π inc(d, bb + dx);π vLin(xc - x, yc - y, yc + y);π vLin(xc + x, yc - y, yc + y);π end;π dec(y);π dec(dy, aa2);π inc(d, aa - dy);π end;πend;ππ{This routine only called by fill}πFunction lineFill(x, y, d, prevXL, prevXR : Integer) : Integer;πVarπ xl, xr, i : Integer;πLabelπ _1, _2, _3;πbeginπ xl := x;π xr := x;ππ Repeatπ dec(xl);π Until (scrn(xl, y) <> fillVal) or (xl < 0);ππ inc(xl);ππ Repeatπ inc(xr);π Until (scrn(xr, y) <> fillVal) or (xr > xMax);ππ dec(xr);π hLin(xl, xr, y);π inc(y, d);ππ if Word(y) <= yMax thenπ For x := xl to xr doπ if (scrn(x, y) = fillVal) thenπ beginπ x := lineFill(x, y, d, xl, xr);π if Word(x) > xr thenπ Goto _1;π end;ππ _1 :ππ dec(y, d + d);π Asmπ neg d;π end;π if Word(y) <= yMax thenπ beginπ For x := xl to prevXL doπ if (scrn(x, y) = fillVal) thenπ beginπ i := lineFill(x, y, d, xl, xr);π if Word(x) > prevXL thenπ Goto _2;π end;ππ _2 :ππ for x := prevXR to xr doπ if (scrn(x, y) = fillVal) thenπ beginπ i := lineFill(x, y, d, xl, xr);π if Word(x) > xr thenπ Goto _3;π end;ππ _3 :ππ end;ππ lineFill := xr;πend;ππProcedure fill(x, y : Integer);πbeginπ fillVal := scrn(x, y);π if fillVal <> color thenπ lineFill(x, y, 1, x, x);πend;πππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππProcedure putTile(x, y : Integer; p : Pointer); Assembler;πAsmπ push dsπ lds si, pπ mov ax, vSegπ mov es, axπ mov di, xπ mov cx, diπ shr di, 2π mov ax, vxBytesπ mul yπ add di, axπ mov ax, $102π and cl, 3π shl ah, cl {make bit mask}π mov dx, seqPortπ mov bh, tsyπ @DOLINE:π mov cl, tsxπ xor ch, chπ push axπ push di {save starting bit mask}π @LOOP:π {mov al, 2}π out dx, axπ shl ah, 1 {give it some time to respond}π mov bl, es:[di]π movsbπ dec diπ test ah, $10π jz @SAMEByteπ mov ah, 1π inc diπ @SAMEByte:π loop @LOOPπ pop diπ add di, vxBytesπ pop ax {start of next line}π dec bhπ jnz @DOLINEπ pop dsπend;ππProcedure overTile(x, y : Integer; p : Pointer); Assembler;πAsmπ push dsπ lds si, pπ mov ax, vSegπ mov es, axπ mov di, xπ mov cx, diπ shr di, 2π mov ax, vxBytesπ mul yπ add di, axπ mov ax, $102π and cl, 3π shl ah, cl {make bit mask}π mov bh, tsyπ mov dx, seqPortπ @DOLINE:π mov ch, tsxπ push axπ push di {save starting bit mask}π @LOOP:π mov al, 2π mov dx, seqPortπ out dx, axπ shl ah, 1π xchg ah, clπ mov al, 4π mov dl, gcPort and $FFπ out dx, axπ xchg ah, clπ inc clπ and cl, 3π lodsbπ or al, alπ jz @SKIPπ mov bl, es:[di]π cmp bl, $C0π jae @SKIPπ stosbπ dec diπ @SKIP:π test ah, $10π jz @SAMEByteπ mov ah, 1π inc diπ @SAMEByte:π dec chπ jnz @LOOPπ pop diπ add di, vxBytesπ pop ax {start of next line}π dec bhπ jnz @DOLINEπ pop dsπend;ππ{won't handle Chars wider than 1 Byte}πProcedure putChar(x, y : Integer; p : Word); Assembler;πAsmπ mov si, p {offset of Char in DS}π mov ax, vSegπ mov es, axπ mov di, xπ mov cx, diπ shr di, 2π mov ax, vxBytesπ mul yπ add di, axπ mov ax, $0102π and cl, 3π shl ah, cl {make bit mask}π mov dx, seqPortπ mov cl, tsyπ xor ch, chπ @DOLINE:π mov bl, [si]π inc siπ push axπ push di {save starting bit mask}π @LOOP:π mov al, 2π out dx, axπ shl ah, 1π shl bl, 1π jnc @SKIPπ mov al, colorπ mov es:[di], alπ @SKIP:π test ah, $10π jz @SAMEByteπ mov ah, 1π inc diπ @SAMEByte:π or bl, blπ jnz @LOOPπ pop diπ add di, vxBytesπ pop ax {start of next line}π loop @DOLINEπend;ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππ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}ππProcedure setPalette(color : Byte; num : Word; Var rgb); Assembler;πAsmπ mov cx, numπ jcxz @Xπ mov ax, cxπ shl cx, 1π add cx, ax {mul by 3}π push dsπ lds si, rgbπ cldπ mov dx, tableWriteIndexπ mov al, colorπ out dx, alπ inc dxπ @L:π lodsbπ out dx, alπ loop @Lπ pop dsπ @X:πend;ππProcedure getPalette(color : Byte; num : Word; Var rgb); Assembler;πAsmπ mov cx, numπ jcxz @Xπ mov ax, cxπ shl cx, 1π add cx, ax {mul by 3}π les di, rgbπ cldπ mov dx, tableReadIndexπ mov al, colorπ out dx, alπ add dx, 2π @L:π in al, dxπ stosbπ loop @Lπ @X:πend;ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππ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}π 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;ππProcedure Graphbegin;πVarπ p : Array [0..255] of tRGB;π i, j,π k, l : Byte;πbeginπ Asmπ mov ax, $0013π int $10π end; {set BIOS mode}ππ l := 0;π For i := 0 to 5 doπ For j := 0 to 5 doπ For k := 0 to 5 doπ With p[l] doπ beginπ r := (i * 63) div 5;π g := (j * 63) div 5;π b := (k * 63) div 5;π inc(l);π end;ππ For i := 216 to 255 doπ With p[i] doπ beginπ l := ((i - 216) * 63) div 39;π r := l;π g := l;π b := l;π end;ππ setpalette(0, 256, p);π color := 0;ππ Asmπ mov dx, seqPortπ mov ax, $0604π out dx, ax { disable chain 4}π mov ax, $0100π out dx, ax { synchronous reset asserted}π dec dxπ dec dxπ mov al, $E3π out dx, al { misc output port at $3C2}π { use 25mHz dot clock, 480 lines}π inc dxπ inc dxπ mov ax, $0300π out dx, ax { restart sequencer}π mov dx, CrtcPortπ mov al, $11π out dx, al { select cr11}π inc dxπ in al, dxπ and al, $7Fπ out dx, alπ dec dx { remove Write protect from cr0-cr7}π mov si, offset CrtcRegTableπ mov cx, CrtcRegLenπ repz outsw { set Crtc data}π mov ax, vxBytesπ shr ax, 1 { Words per scan line}π mov ah, alπ mov al, $13π out dx, ax { set CrtC offset reg}π end;ππ clearGraph;πend;ππProcedure Graphend; Far;πbeginπ ExitProc := exitSave;π Asmπ mov al, oldModeπ mov ah, 0π int $10π end;πend;ππbeginπ CrtcPort := memw[$40 : $63];π input1Port := CrtcPort + 6;π if vgaPresent thenπ beginπ ExitSave := exitProc;π ExitProc := @Graphend;π Graphbegin;π endπ elseπ beginπ Writeln(^G + 'VGA required.');π halt(1);π end;πend.π 30 10-28-9311:39ALL BAS VAN GALLEN Another STARS SWAG9311 29 ╓ {===========================================================================π BBS: Canada Remote SystemsπDate: 10-17-93 (23:26)πFrom: BAS VAN GAALENπSubj: Stars?ππ{$N+}ππprogram _Rotation;ππusesπ crt,dos;ππconstπ NofPoints = 75;π Speed = 5;π Xc : real = 0;π Yc : real = 0;π Zc : real = 150;π SinTab : array[0..255] of integer = (π 0,2,5,7,10,12,15,17,20,22,24,27,29,31,34,36,38,41,43,45,47,49,52,54,π 56,58,60,62,64,66,67,69,71,73,74,76,78,79,81,82,83,85,86,87,88,90,91,π 92,93,93,94,95,96,97,97,98,98,99,99,99,100,100,100,100,100,100,100,π 100,99,99,99,98,98,97,97,96,95,95,94,93,92,91,90,89,88,87,85,84,83,π 81,80,78,77,75,73,72,70,68,66,65,63,61,59,57,55,53,51,48,46,44,42,40,π 37,35,33,30,28,26,23,21,18,16,14,11,9,6,4,1,-1,-4,-6,-9,-11,-14,-16,π -18,-21,-23,-26,-28,-30,-33,-35,-37,-40,-42,-44,-46,-48,-51,-53,-55,π -57,-59,-61,-63,-65,-66,-68,-70,-72,-73,-75,-77,-78,-80,-81,-83,-84,π -85,-87,-88,-89,-90,-91,-92,-93,-94,-95,-95,-96,-97,-97,-98,-98,-99,π -99,-99,-100,-100,-100,-100,-100,-100,-100,-100,-99,-99,-99,-98,-98,π -97,-97,-96,-95,-94,-93,-93,-92,-91,-90,-88,-87,-86,-85,-83,-82,-81,π -79,-78,-76,-74,-73,-71,-69,-67,-66,-64,-62,-60,-58,-56,-54,-52,-49,π -47,-45,-43,-41,-38,-36,-34,-31,-29,-27,-24,-22,-20,-17,-15,-12,-10,π -7,-5,-2,0);ππtypeπ PointRec = recordπ X,Y,Z : integer;π end;π PointPos = array[0..NofPoints] of PointRec;ππvarπ Point : PointPos;ππ{----------------------------------------------------------------------------}ππprocedure SetGraphics(Mode : byte); assembler;πasm mov AH,0; mov AL,Mode; int 10h; end;ππ{----------------------------------------------------------------------------}ππprocedure Init;ππvarπ I : byte;ππbeginπ randomize;π for I := 0 to NofPoints do beginπ Point[I].X := random(250)-125;π Point[I].Y := random(250)-125;π Point[I].Z := random(250)-125;π end;πend;ππ{----------------------------------------------------------------------------}ππprocedure DoRotation;ππconstπ Xstep = 1;π Ystep = 1;π Zstep = -2;ππvarπ Xp,Yp : array[0..NofPoints] of word;π X,Y,Z,X1,Y1,Z1 : real;π PhiX,PhiY,PhiZ : byte;π I,Color : byte;ππfunction Sinus(Idx : byte) : real;ππbeginπ Sinus := SinTab[Idx]/100;πend;ππfunction Cosinus(Idx : byte) : real;ππbeginπ Cosinus := SinTab[(Idx+192) mod 255]/100;πend;ππbeginπ PhiX := 0; PhiY := 0; PhiZ := 0;π repeatπ while (port[$3da] and 8) <> 8 do;π while (port[$3da] and 8) = 8 do;π for I := 0 to NofPoints do beginππ if (Xp[I]+160 < 320) and (Yp[I]+100 < 200) thenπ mem[$a000:(Yp[I]+100)*320+Xp[I]+160] := 0;ππ X1 := Cosinus(PhiY)*Point[I].X-Sinus(PhiY)*Point[I].Z;π Z1 := Sinus(PhiY)*Point[I].X+Cosinus(PhiY)*Point[I].Z;π X := Cosinus(PhiZ)*X1+Sinus(PhiZ)*Point[I].Y;π Y1 := Cosinus(PhiZ)*Point[I].Y-Sinus(PhiZ)*X1;π Z := Cosinus(PhiX)*Z1-Sinus(PhiX)*Y1;π Y := Sinus(PhiX)*Z1+Cosinus(PhiX)*Y1;ππ Xp[I] := round((Xc*Z-X*Zc)/(Z-Zc));π Yp[I] := round((Yc*Z-Y*Zc)/(Z-Zc));π if (Xp[I]+160 < 320) and (Yp[I]+100 < 200) then beginπ Color := 31+round(Z/7);π if Color > 31 then Color := 31π else if Color < 16 then Color := 16;π mem[$a000:(Yp[I]+100)*320+Xp[I]+160] := Color;π end;ππ inc(Point[I].Z,Speed); if Point[I].Z > 125 then Point[I].Z := -125;π end;π inc(PhiX,Xstep);π inc(PhiY,Ystep);π inc(PhiZ,Zstep);π until keypressed;πend;ππ{----------------------------------------------------------------------------}ππbeginπ SetGraphics($13);π Init;π DoRotation;π textmode(lastmode);πend.ππ 31 11-02-9305:31ALL DAVE FOSTER Display PIC Files SWAG9311 27 ╓ {πDave Fosterππ> Could anyone please post any routines or help on howπ> to read an image into TURBO 6. I can save the imageπ> in any format, but i need code to be able to displayπ> it on the screen. Source code would be an advantage!π>πI wrote this Program For a friend to read a image into his Program, andπand I would be happy For any help on how to improve it.π}ππProgram Read_Image; { SRC-CODE.PAS ver 1.00 }π{-----------------------------------------------------------------------------π Program reads in a binary data File, and displays the image on the screen byπ using "PutPixel" Procedure in the Graph Unit. The image can be displayed inπ color, or in grey-scale by using the subroutine "Set64Gray" below.π This is a quick and dirty method to display the image using "PutPixel",π and I hope someone will be able to show us how to use the "PutImage" toπ display the image quicker.π-----------------------------------------------------------------------------}ππUsesπ Dos, Crt, Graph;ππTypeπ ByteArray = Array [0..175] of Byte;ππVarπ Gd, Gm,π m, n : Integer;π buffer : ByteArray;π f : File;ππ{π> Does anyone know how can I get a Graphic mode in VGA in which Iπ> could use 64 gray level (at least 32)? Could I keep on using theπ> Graphical Procedures in Unit Graph then?ππ The fragment below will initialize the first 64 VGA color values toπ gray scale. These colors are valid For any VGA mode (including Text),π but in most Graphics modes/devices the Borland Graph Unit limits youπ to using only 16 colors.π}ππProcedure Set64Gray;π{ Sets up 64 shades of gray where 0 = black, 63 = full white }πTypeπ CRec = Recordπ R, G, B: Byte;π end;πVarπ Regs : Registers;π I : Integer;π G64 : Array [0..63] of CRec;πbeginπ { Initialize the block of color values }π For I := 0 to 63 doπ With G64[I] doπ beginπ R := I;π G := I; { Color is gray when RGB values are equal }π B := I;π end;ππ Regs.ax := $1012; { Dos Function to update block of colors }π Regs.bx := 0; { First color to change }π Regs.cx := 64; { Number of colors to change }π Regs.es := seg(G64); { Address of block of color values }π Regs.dx := ofs(G64);π intr($10, Regs);πend;ππbeginπ Gd := detect;π initGraph(Gd, Gm, 'e:\bp\bgi');ππ { Open the image File which is 250 lines, and 175 pixels per line.π Each pixel is 1 Byte, and no header data, or Record delimiters.π File is 43,750 Bytes (250 x 175) in size. Have look at the inputπ File using binary File viewer. }ππ assign(f, 'DOMINO.DAT');π reset(f, 175);ππ { if you enable this, you will be able to see the image in grey-scale,π but I am not sure if it is quite right. Currently it seems to displayπ only few grey-scale levels instead of the full 64 levels.ππ }Set64Gray;ππ { Method used to read the File line at a time, and Write the pixelπ values to the screen. This is bit slow, and it would be lot fasterπ by using "PutImage" but I do not know the method For that. }ππ n := 1;π While not eof(f) doπ beginπ BlockRead(f, buffer, 1);π For m := 1 to 175 doπ PutPixel(m, n, buffer[m]);π n := n + 1;π end;ππ close(f);π readln;π closeGraph;πend.ππ{πThe image File "DOMINO.DAT" used in the Program "SRC-CODE.PAS".πImage File is 250 x 175 pixels (43,750 Bytes).π}ππ 32 11-02-9306:11ALL KEVIN OTTO Fading SWAG9311 11 ╓ { KEVIN OTTO }ππUnit Fade;ππ{ Change DelayAmt and Steps to change the speed of fading. }ππInterfaceππUsesπ Dos, Crt;ππConstπ Colors = 64;π DelayAmt = 15;π Steps = 24;ππTypeπ PalType = Array [0..Colors - 1] of Recordπ R, G, B : Byte;π end;ππVarπ OrigPal : palType;ππProcedure GetPal(Var OrigPal : PalType);πProcedure FadePal(OrigPal : PalType; FadeOut : Boolean);ππImplementationππProcedure GetPal(Var OrigPal : PalType);πVarπ Reg : Registers;πbeginπ With Reg doπ beginπ AX := $1017;π BX := 0;π CX := colors;π ES := seg(OrigPal);π DX := ofs(OrigPal);π intr ($10, Reg);π end;πend;ππProcedure FadePal(OrigPal : PalType; FadeOut : Boolean);πVarπ Reg : Registers;π WorkPal : PalType;π Fade : Word;π Pct : Real;π I : Word;πbeginπ With Reg doπ For Fade := 0 to Steps doπ beginπ Pct := Fade / Steps;π if FadeOut thenπ Pct := 1 - Pct;π For I := 0 to Colors - 1 doπ With WorkPal[I] doπ beginπ R := round(OrigPal[I].R * Pct);π G := round(OrigPal[I].G * Pct);π B := round(OrigPal[I].B * Pct);π end;π AX := $1012;π BX := 0;π CX := Colors;π ES := seg (WorkPal);π DX := ofs (WorkPal);π intr ($10, Reg);π Delay (DelayAmt);π end;πend;ππend.π 33 11-21-9309:28ALL MICHAEL HOENIE Create Chars in Graphics SWAG9311 78 ╓ π { 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;ππ{ this section moved over to be transferred across the network. }ππ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.ππ 34 11-02-9305:54ALL NICK ONOUFRIOU Quick PutImage SWAG9311 22 ╓ {πNICK ONOUFRIOUππI'm writing a small game that requires a transparent putimage Function. Iπnormally use the BGI, but in this Case I need a little bit more speed. Thisπpartial Program shows what I have already. What I want to know is there isπsimple method of masking color 0 so it won't be displayed.π}πProgram PutMan;ππUsesπ Dos, Crt;ππConstπ(* Turbo Pascal, Width= 11 Height= 23 Colors= 256 *)ππ Man : Array [1..259] of Byte = (π $0A,$00,$16,$00,$00,$00,$00,$00,$00,$00,$00,$00,π $00,$00,$00,$00,$00,$00,$00,$02,$02,$02,$00,$00,π $00,$00,$00,$00,$00,$02,$02,$02,$02,$02,$00,$00,π $00,$00,$00,$02,$2C,$2C,$2C,$2C,$2C,$02,$00,$00,π $00,$00,$2C,$10,$10,$2C,$10,$10,$2C,$00,$00,$00,π $00,$2C,$2C,$2C,$2C,$2C,$2C,$2C,$00,$00,$00,$00,π $00,$2C,$0C,$0C,$0C,$2C,$00,$00,$00,$00,$00,$00,π $00,$2C,$2C,$2C,$00,$00,$00,$00,$00,$00,$00,$00,π $00,$0F,$00,$00,$00,$00,$00,$00,$0F,$00,$00,$0F,π $0F,$0F,$00,$00,$00,$00,$00,$0F,$00,$0D,$0D,$0D,π $0D,$0D,$00,$00,$00,$00,$0F,$0D,$0D,$0D,$0D,$0D,π $0D,$0D,$00,$00,$00,$0F,$1F,$1F,$1F,$1F,$1F,$1F,π $1F,$0F,$00,$00,$00,$1F,$1F,$1F,$1F,$1F,$1F,$1F,π $0F,$00,$00,$00,$00,$1F,$1F,$1F,$1F,$1F,$00,$0F,π $00,$00,$00,$00,$00,$0D,$0D,$0D,$00,$00,$0F,$00,π $00,$00,$00,$0D,$0D,$0D,$0D,$0D,$00,$00,$00,$00,π $00,$00,$0D,$0D,$0D,$0D,$0D,$00,$00,$00,$00,$00,π $00,$0D,$0D,$00,$0D,$0D,$00,$00,$00,$00,$00,$00,π $0D,$0D,$00,$0D,$0D,$00,$00,$00,$00,$00,$00,$07,π $07,$00,$07,$07,$00,$00,$00,$00,$00,$00,$07,$07,π $00,$07,$07,$00,$00,$00,$00,$00,$00,$00,$00,$00,π $00,$00,$00,$00,$00,$00,$00);ππTypeπ _screenRec = Array [0..199, 0..319] of Byte;ππVarπ _mcgaScreen : _screenRec Absolute $A000:0000;πππProcedure SetMode(mode : Integer);πVarπ regs : Registers;πbeginπ regs.ah := 0;π regs.al := mode;π intr($10, regs);πend;ππProcedure ClearPage(color : Integer);πbeginπ FillChar(_mcgaScreen, 64000, color);πend;ππProcedure PutImg(x, y : Integer; Var Img);πTypeπ AList = Array[1..$FFFF] of Byte;πVarπ APtr : ^AList;π J, Width,π Height,π Counter : Word;πbeginπ Aptr := @Img;π Width := (Aptr^[2] SHL 8) + Aptr^[1] + 1;π Height := (Aptr^[4] SHL 8) + Aptr^[3] + 1;π Counter := 5;π For j := y to (y + height - 1) doπ beginπ Move(Aptr^[Counter], _mcgaScreen[j, x], Width);π Inc(Counter, Width);π end;πend;ππbeginπ SetMode(19);π ClearPage(Blue);π PutImg(150, 80, Ptr(seg(man), ofs(man))^);π readln;π SetMode(3);πend.π 35 11-02-9305:30ALL NORMAN YEN Display PCX Files SWAG9311 26 ╓ {π> I heard something in this echo about someone having Pascal source to viewπ> .PCX Files and I would appreciate if they would re-post the source if it'sπ> not too long or tell me where I can get it. I am also looking For someπ> good COMM routines For Pascal, anyone have any or no where I can get some?ππThe routine I have will only work With 320x200x256c images.ππ For all those Pascal Programmers who just want something simpleπ to display a 320x200x256 colour PCX File on the screen here it is.π This was a direct translation from the C source code of PCXVIEWπ written by Lee Hamel (Patch), Avalanche coder. I removed theπ Inline assembly code so that you beginners can see what was goingπ on behind those routines.ππNorman Yen - Infinite Dreams BBS - August 11, 1993π}ππTypeπ pcxheader_rec = Recordπ manufacturer : Byte;π version : Byte;π encoding : Byte;π bits_per_pixel : Byte;π xmin, ymin : Word;π xmax, ymax : Word;π hres, vres : Word;π palette : Array [0..47] of Byte;π reserved : Byte;π colour_planes : Byte;π Bytes_per_line : Word;π palette_Type : Word;π filler : Array [0..57] of Byte;π end;ππVarπ header : pcxheader_rec;π width,π depth : Word;π Bytes : Word;π palette : Array [0..767] of Byte;π f : File;π c : Byte;ππProcedure Read_PCX_Line(vidoffset : Word);πVarπ c, run : Byte;π n : Integer;π w : Word;πbeginπ n := 0;π While (n < Bytes) doπ beginπ blockread (f, c, 1);π { if it's a run of Bytes field }π if ((c and 192) = 192) thenπ beginπ { and off the high bits }π run := c and 63;π { get the run Byte }π blockread (f, c, 1);π n := n + run;π For w := 0 to run - 1 doπ beginπ mem[$a000 : vidoffset] := c;π inc(vidoffset);π end;π endπ elseπ beginπ n := n + 1;π mem[$a000 : vidoffset] := c;π inc(vidoffset);π end;π end;πend;ππProcedure Unpack_PCX_File;πVarπ i : Integer;πbeginπ For i := 0 to 767 doπ palette[i] := palette[i] shr 2;π Asmπ mov ax, 13hπ int 10hπ mov ax, 1012hπ xor bx, bxπ mov cx, 256π mov dx, offset paletteπ int 10hπ end;π For i := 0 to depth - 1 doπ Read_PCX_Line(i * 320);π Asmπ xor ax, axπ int 16hπ mov ax, 03hπ int 10hπ end;πend;ππbeginπ if (paramcount > 0) thenπ beginπ assign(f, paramstr(1));π reset(f, 1);π blockread (f, header, sizeof(header));π if (header.manufacturer = 10) and (header.version = 5) andπ (header.bits_per_pixel = 8) and (header.colour_planes = 1) thenπ beginπ seek(f, Filesize(f) - 769);π blockread(f, c, 1);π if (c = 12) thenπ beginπ blockread(f, palette, 768);π seek(f, 128);π width := header.xmax - header.xmin + 1;π depth := header.ymax - header.ymin + 1;π Bytes := header.Bytes_per_line;π Unpack_PCX_File;π endπ elseπ Writeln('Error reading palette.');π endπ elseπ Writeln('Not a 256 colour PCX File.');π close(f);π endπ elseπ Writeln('No File name specified.');πend.π 36 10-28-9311:35ALL NORMAN YEN View PCX File SWAG9311 28 ╓ {===========================================================================πDate: 08-23-93 (08:26)πFrom: NORMAN YENπSubj: RE: .PCX AND COMM ROUTINEπ---------------------------------------------------------------------------ππ MB> I heard something in this echo about someone having Pascal source toπ MB> view .PCXπ MB> files and I would appreciate if they would re-post the source if it'sπ MB> not tooπ MB> long or tell me where I can get it. I am also looking for some goodπ MB> COMM routines for Pascal, anyone have any or no where I can get some?ππ The routine I have will only work with 320x200x256c images.πHope it helps!ππNormanππ{π For all those Pascal programmers who just want something simpleπ to display a 320x200x256 colour PCX file on the screen here it is.π This was a direct translation from the C source code of PCXVIEWπ written by Lee Hamel (Patch), Avalanche coder. I removed theπ inline assembly code so that you beginners can see what was goingπ on behind those routines.ππ Norman Yenπ Infinite Dreams BBSπ August 11, 1993π}ππtype pcxheader_rec=recordπ manufacturer: byte;π version: byte;π encoding: byte;π bits_per_pixel: byte;π xmin, ymin: word;π xmax, ymax: word;π hres: word;π vres: word;π palette: array [0..47] of byte;π reserved: byte;π colour_planes: byte;π bytes_per_line: word;π palette_type: word;π filler: array [0..57] of byte;π end;ππvar header: pcxheader_rec;π width, depth: word;π bytes: word;π palette: array [0..767] of byte;π f: file;π c: byte;ππprocedure Read_PCX_Line(vidoffset: word);πvar c, run: byte;π n: integer;π w: word;πbeginπ n:=0;π while (n < bytes) doπ beginπ blockread (f, c, 1);ππ { if it's a run of bytes field }π if ((c and 192)=192) thenπ beginππ { and off the high bits }π run:=c and 63;ππ { get the run byte }π blockread (f, c, 1);π n:=n+run;π for w:=0 to run-1 doπ beginπ mem [$a000:vidoffset]:=c;π inc (vidoffset);π end;π end elseπ beginπ n:=n+1;π mem [$a000:vidoffset]:=c;π inc (vidoffset);π end;π end;πend;ππprocedure Unpack_PCX_File;πvar i: integer;πbeginπ for i:=0 to 767 doπ palette [i]:=palette [i] shr 2;π asmπ mov ax,13hπ int 10hπ mov ax,1012hπ xor bx,bxπ mov cx,256π mov dx,offset paletteπ int 10hπ end;π for i:=0 to depth-1 doπ Read_PCX_Line (i*320);π asmπ xor ax,axπ int 16hπ mov ax,03hπ int 10hπ end;πend;ππbeginπ if (paramcount > 0) thenπ beginπ assign (f, paramstr (1));π reset (f,1);π blockread (f, header, sizeof (header));π if (header.manufacturer=10) and (header.version=5) andπ (header.bits_per_pixel=8) and (header.colour_planes=1) thenπ beginπ seek (f, filesize (f)-769);π blockread (f, c, 1);π if (c=12) thenπ beginπ blockread (f, palette, 768);π seek (f, 128);π width:=header.xmax-header.xmin+1;π depth:=header.ymax-header.ymin+1;π bytes:=header.bytes_per_line;π Unpack_PCX_File;π end else writeln ('Error reading palette.');π end else writeln ('Not a 256 colour PCX file.');π close (f);π end else writeln ('No file name specified.');πend.ππ 37 11-02-9305:49ALL RANDY PARKER Writing to Graphic Pages SWAG9311 9 ╓ {πRANDY PARKERππ I've been playing With using the Absolute address $A000:0000 to do directπvideo Writes in Graphics mode and was wondering if someone could tell me howπto get colors. I use an Array of [1..NumOfBits]. NumOfBits being the numberπof bits the current Graphic page Uses when it stores it's information.ππThe following is an example of what I mean:π}ππProgram UseFastGraf;πUsesπ Graph;ππTypeπ View = Array [1..19200] of Word;ππVarπ I,π GraphDriver,π GraphMode : Integer;π View1 : View Absolute $A000:0000;π View2 : View;ππbeginπ GraphDriver := Detect;π InitGraph(GraphDriver, GraphMode, 'e:\bp\bgi');π For I := 1 to 1000 Doπ beginπ SetColor(Random(GetMaxColor));π Line(Random(GetMaxX), Random(GetMaxY), Random(GetMaxX), GetMaxY);π end;π View2 := View1;π SetColor(15);π OutTextXY(100, 100, 'Press Enter To Continue : ');π Readln;π ClearDevice;π OutTextXY(100, 100, 'Press Enter To See The Previous Screen');π Readln;π View1 := View2;π Readln;πend.ππ 38 11-02-9305:56ALL SEAN PALMER Another QUICK PutImage SWAG9311 18 ╓ (*πSEAN PALMERππ> there is simple method of masking color 0 so it won't be displayed.π> An assembly language routine based around this:ππProcedure PutImg(x, y : Integer; Var Img);πTypeπ AList = Array[1..$FFFF] of Byte; {1-based Arrays are slower than 0-based}πVarπ APtr : ^AList; {I found a very fast way to do this: With}π j, i,π Width,π Height,π Counter : Word;πbeginπ Aptr := @Img;π Width := (Aptr^[2] SHL 8) + Aptr^[1] + 1; {these +1's that 1-based Arrays }π Height := (Aptr^[4] SHL 8) + Aptr^[3] + 1; { require make For slower code}π Counter := 5;π For j := y to (y + height - 1) doπ begin {try pre-calculating the offset instead}π For i := x to (x + width - 1) doπ beginπ Case Aptr^[Counter] of {CASE is probably not the way to do this}π 0:; { do nothing }π else _mcgaScreen[j, i] := Aptr^[Counter]; { plot it }π end;π Inc(Counter);π end;π end;πend;ππok, here's my try:π*)ππTypeπ pWord = ^Word;ππProcedure putImg(x, y : Integer; Var image);πVarπ anImg : Recordπ img : Array [0..$FFF7] of Byte;π end Absolute image;ππ aScrn : Recordπ scrn : Array [0..$FFF7] of Byte;π end Absolute $A000 : 0000;ππ width,π height,π counter,π offs, src : Word;ππbeginπ width := pWord(@anImg[0])^;π height := pWord(@anImg[2])^;π offs := y * 320 + x;π src := 4; {skip width, height}π With aScrn, anImg doπ Repeatπ counter := width;π Repeatπ if img[src] <> 0 thenπ scrn[offs] := img[src];π inc(src);π inc(offs);π dec(counter);π Until counter = 0;π inc(offs, 320 - width);π dec(height);π Until height = 0;πend;ππ{πThose Arrays-pretending-to-be-Records above so they'll work With the Withπstatement should end up making BP keep the address in Registers, making itπfaster. In any Case it won't be slower than yours. I'd appreciate youπtiming them and letting me know the results. Actually, let me know if itπeven compiles and works... 8)ππBut Really, man, if you're writing Graphics routines you Really have toπgo For assembly. Pascal don't cut it. (c doesn't either...)π}π 39 11-02-9317:44ALL SEAN PALMER Bresenham Line SWAG9311 12 ╓ {πFrom: SEAN PALMERπSubj: Bresenham's LineππYou need a plot(x,y) procedure and a global color variable to use these asπposted. }πππ{bresenham's line}π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;πππ{filled ellipse}πprocedure disk(xc,yc,a,b:integer);π var x,y:integer; aa,aa2,bb,bb2,d,dx,dy:longint; beginπ x:=0;y:=b;π aa:=longint(a)*a; aa2:=2*aa;π bb:=longint(b)*b; bb2:=2*bb;π d:=bb-aa*b+aa div 4;π dx:=0;dy:=aa2*b;π vLin(xc,yc-y,yc+y);π while(dx<dy)do beginπ if(d>0)then begin dec(y); dec(dy,aa2); dec(d,dy); end;π inc(x); inc(dx,bb2); inc(d,bb+dx);π vLin(xc-x,yc-y,yc+y);vLin(xc+x,yc-y,yc+y);π end;π inc(d,(3*(aa-bb)div 2-(dx+dy))div 2);π while(y>=0)do beginπ if(d<0)then beginπ inc(x); inc(dx,bb2); inc(d,bb+dx);π vLin(xc-x,yc-y,yc+y);vLin(xc+x,yc-y,yc+y);π end;π dec(y); dec(dy,aa2); inc(d,aa-dy);π end;π end;π 40 11-02-9317:24ALL SEAN PALMER Transparent PutImage SWAG9311 15 ╓ {πFrom: SEAN PALMERπSubj: transparent putimageπ}ππProcedure PutImg(x,y : integer;Var Img);πtypeπ AList = array[1..$FFFF] of Byte; {1-based arrays are slower than 0-based}πvarπ APtr : AList; {I found a very fast way to do this: WITH}π j,i,Width,Height,Counter : Word;πbeginπ Aptr:=@Img;π Width:=(Aptr] SHL 8) + Aptr]+1; {these +1's that 1-based arrays }π Height:=(Aptr] SHL 8) + Aptr]+1; { require make for slower code}π Counter:=5;π For j:=y to (y+height-1) do begin {try pre-calculating the offset instead}π for i:=x to (x+width-1) do beginπ case AptrCounter] of {CASE is probably not the way to do this}π 0:; (* do nothing *)π else _mcgaScreen[j,i]:=AptrCounter]; (* plot it *)π end;π Inc(Counter);π end;π end;π end;ππok, here's my try:ππtype pWord=word;ππprocedure putImg(x,y:integer;var image);πvarπ anImg:record img:array[0..$FFF7]of byte; end absolute image;π aScrn:record scrn:array[0..$FFF7]of byte; end absolute $A000:0000;π width,height,counter,offs,src:word;πbeginπ width:=pWord(@anImg[0])π height:=pWord(@anImg[2])π offs:=y*320+x;π src:=4; {skip width, height}π with aScrn,anImg do repeatπ counter:=width;π repeatπ if img[src]<>0 then scrn[offs]:=img[src];π inc(src);π inc(offs);π dec(counter);π until counter=0;π inc(offs,320-width);π dec(height);π until height=0;π end;πππThose arrays-pretending-to-be-records above so they'll work with the WITHπstatement should end up making BP keep the address in registers, making itπfaster. In any case it won't be slower than yours. I'd appreciate youπtiming them and letting me know the results. Actually, let me know if itπeven compiles and works... 8)π 41 11-02-9305:55ALL STEFAN XENOS Loading Images from Disk SWAG9311 27 ╓ {πSTEFAN XENOSππ> I am able to load an image into a buffer and display it with PutImage ect.,π> but I would like to load the image from disk instead of with getimage.ππName: ImageStuff.PasπPurpose: ImageStuff is a unit for storing bitmaps in dynamic variables andπ writing them to disk.πProgger: Stefan XenosππThis unit is public domain.}ππUnit ImageStuff;ππinterfaceππUsesπ Graph;ππTypeπ Image = Recordπ BitMap : Pointer;π Size : Word;π end;ππProcedure Get(X1, Y1, X2, Y2 : Word; Var aImage : Image);πProcedure Put(X, Y : Word; aImage : Image; BitBlt : Word);πProcedure Kill(Var aImage : Image);πProcedure Save(Var F : File; aImage : Image);πProcedure Load(Var F : File; Var aImage : Image);ππimplementationππProcedure Get(X1, Y1, X2, Y2 : Word; Var aImage : Image);π{Clips an image from the screen and store it in a dynamic variable}πBeginπ aImage.bitmap := nil;π aImage.size := ImageSize(X1, Y1, X2, Y2);π GetMem(aImage.BitMap,aImage.Size); {Ask for some memory}π GetImage(X1, Y1, X2, Y2, aImage.BitMap^); {Copy the image}πEnd;ππProcedure Put(X, Y : Word; aImage : Image; BitBlt : Word);πBeginπ PutImage(X, Y, aImage.BitMap^, BitBlt); {Display image}πEnd;ππProcedure Kill(Var aImage : Image);π{Frees up the memory used by an unwanted image}πBeginπ FreeMem (aImage.BitMap, aImage.Size); {Free up memory used by image}π aImage.Size := 0;π aImage.BitMap := Nil;πEnd;ππProcedure Save(Var F : File; aImage : Image);π{Saves an image to disk. File MUST already be opened for write}πBeginπ BlockWrite(F, aImage.Size, 2); {Store the image's size so thatπ it may be correctly loaded later}π BlockWrite(F, aImage.BitMap^, aImage.Size); {Write image itself to disk}πEnd;ππProcedure Load (Var F : File; Var aImage : Image);π{Loads an image off disk and stores it in a dynamic variable}πBeginπ BlockRead(F, aImage.Size, 2); {Find out how big the image is}π GetMem(aImage.BitMap, aImage.Size); {Allocate memory for it}π BlockRead(F, aImage.BitMap^, aImage.Size) {Load the image}πEnd;ππBeginπEnd.ππ{πHere's some source which should help you figure out how to use the unit Iπjust sent.π}ππ{By Stefan Xenos}πProgram ImageTest;ππUsesπ Graph,π ImageStuff;ππVarπ Pic : Image;π LineNum : Byte;π DataFile : File;π GrDriver,π GrMode : Integer;ππConstπ FileName = 'IMAGE.DAT';π MaxLines = 200;ππBeginπ {Initialise}π DetectGraph(GrDriver, GrMode);π InitGraph(GrDriver, GrMode, '');π Randomize;ππ {Draw some lines}π For LineNum := 1 to MaxLines doπ beginπ setColor(random (maxcolors));π line(random(getmaxx), random(getmaxy), random(getmaxx), random(getmaxy));π end;ππ {Copy image from screen}π Get(100, 100, 150, 150, Pic);ππ readLn;ππ {Clear screen}π ClearDevice;ππ {Display image}π Put(100, 100, Pic, NormalPut);ππ readLn;ππ {Clear screen}π ClearDevice;ππ {Save image to disk}π Assign(DataFile, FileName);π Rewrite(DataFile, 1);π Save(DataFile, Pic);π Close(DataFile);ππ {Kill image}π Kill(pic);ππ {Load image from disk}π Assign(DataFile, FileName);π Reset(DataFile, 1);π Load(DataFile, pic);π Close(DataFile);ππ {Display image}π Put(200, 200, Pic, NormalPut);ππ readLn;ππ CloseGraph;π WriteLn(Pic.size);πEnd.π 42 11-02-9304:50ALL STEVE BOUTILIER Simple & QUICK Graphics SWAG9311 8 ╓ { STEVE BOUTILIER }ππUsesπ Dos,π Crt;ππProcedure OpenGraphics; Assembler;πAsmπ Mov Ah, 00hπ Mov Al, 13hπ Int $10πend;ππProcedure CloseGraphics; Assembler;πAsmπ Mov Ah, 00hπ Mov Al, 03hπ Int $10πend;ππProcedure PutXY(X, Y : Byte); Assembler;πAsmπ Mov Ah, 02hπ Mov Dh, Y - 1π Mov Dl, X - 1π Mov Bh, 0π Int $10πend;ππProcedure OutChar(S : Char; Col : Byte); Assembler;πAsmπ Mov Ah, 0Ehπ Mov Al, Sπ Mov Bh, 0π Mov Bl, Colπ Int $10πend;ππProcedure OutString(S : String; Col : Byte);πVarπ I : Integer;π Ch : Char;πbeginπ For I := 1 to Length(s) doπ beginπ Ch := S[I];π OutChar(Ch, Col);π end;πend;ππbeginπ OpenGraphics;π OutString('HELLO WORLD!' + #13#10, 14);π Repeat Until KeyPressed;π CloseGraphics;πend.ππ{πBTW: This code is Public Domain! Do what you want With it! most of youπ probably already have routines that are even better than this.π}ππ 43 11-02-9305:52ALL VINCE LAURENT Scalable HEX Screen SWAG9311 25 ╓ {πVINCE LAURENTππI wrote some code to draw a scalable hex field on the screen. Canπanyone give me a hand in optimizing it? There is a lot of redundantπline drawing and positioning... I would also like to be able to haveπa fexible amount of hexigons showing. For example, if the scale is,πsay 40, show 19 hexs, if it is smaller, show more (like as many thatπcould have fit in the area occupied by 19).ππBTW, this code can be freely used and distributed or completely ignored :-) }ππProgram HexzOnScreen;πUsesπ Graph, Crt;πTypeπ PtArray = Array [1..6, 1..2] of Real;πVarπ s1, s2,π side,π i, j,π Gd, Gm : Integer;π Pts : PtArray;π ErrCode : Integer;π Sqrt3,π sts : Real;ππbeginπ Sqrt3 := Sqrt(3);π Side := 40; { initial hex side length ( min = 8 ) }π sts := Side * Sqrt3;π s1 := 200;π s2 := 60; { starting point For hex field }π InitGraph(Gd, Gm, 'e:\bp\bgi\');π ErrCode := GraphResult;π if not ErrCode = grOk thenπ beginπ Writeln('Error: ', GraphErrorMsg(ErrCode));π Halt(0);π end;π SetColor(LightGray);π Delay(10); { give the screen a chance to toggle to Graph mode }π For j := 1 to 17 DOπ beginπ Pts[1, 1] := s1;π Pts[1, 2] := s2;π Pts[2, 1] := Pts[1, 1] - side;π Pts[2, 2] := Pts[1, 2];π Pts[3, 1] := Pts[1, 1] - side - (side / 2);π Pts[3, 2] := Pts[1, 2] + (sts / 2);π Pts[4, 1] := Pts[1, 1] - side;π Pts[4, 2] := Pts[1, 2] + sts ;π Pts[5, 1] := Pts[1, 1];π Pts[5, 2] := Pts[4, 2];π Pts[6, 1] := Pts[1, 1] + (side / 2);π Pts[6, 2] := Pts[1, 2] + (sts / 2);π For I := 1 to 6 DOπ beginπ if i <> 6 thenπ Line(Round(Pts[i, 1]), Round(Pts[i, 2]),π Round(Pts[i + 1, 1]), Round(Pts[i + 1, 2]))π elseπ Line(Round(Pts[i, 1]), Round(Pts[i, 2]),π Round(Pts[1, 1]), Round(Pts[1, 2]));π end;π Case j OFπ 1..2 :π beginπ s1 := Round(Pts[6, 1] + side);π s2 := Round(Pts[6, 2]);π end;π 3..4 :π beginπ s1 := Round(Pts[5, 1]);π s2 := Round(Pts[5, 2]);π end;π 5..6 :π beginπ s1 := Round(Pts[3, 1]);π s2 := Round(Pts[3, 2]);π end;π 7..8 :π beginπ s1 := Round(Pts[3, 1]);π s2 := Round(Pts[3, 2] - sts);π end;π 9..10 :π beginπ s1 := Round(Pts[1, 1]);π s2 := Round(Pts[1, 2] - sts);π end;π 11 :π beginπ s1 := Round(Pts[6, 1] + side);π s2 := Round(Pts[6, 2] - sts);π end;π 12..13 :π beginπ s1 := Round(Pts[6, 1] + side);π s2 := Round(Pts[6, 2]);π end;π 14 :π beginπ s1 := Round(Pts[5, 1]);π s2 := Round(Pts[5, 2]);π end;π 15 :π beginπ s1 := Round(Pts[3, 1]);π s2 := Round(Pts[3, 2]);π end;π 16 :π beginπ s1 := Round(Pts[3, 1]);π s2 := Round(Pts[3, 2] - sts);π end;π end;π end;π Line(s1, s2, Round(s1 + (side / 2)), Round(s2 - sts / 2));π Readln;π CloseGraph;πend.π 44 11-21-9309:44ALL WILLIAM PLANKE Writing PCX files SWAG9311 94 ╓ {πFrom: WILLIAM PLANKEπSubj: Write PCX example 1/4ππAs I follow this forum, many requests are made for PCX graphicsπfile routines. Those that are looking for Read_PCX info canπfind it on the ZSoft BBS in a wonderful Pascal example: ShowPCX.ππOn the other hand, there is next to zilch out there on how toπWrite_PCX files. I know.... I searched and searched and couldn'tπfind a thing! So with a little brute force and a few ZSoftπC language snippets <groan>, I got this together:π}πππ{ =================== TPv6.0 P C X _ W ======================== }ππ{$R-} {Range checking, turn off when debugged}ππunit PCX_W;ππ{ --------------------- Interface ----------------- }ππinterfaceππtypeπ Str80 = string [80];ππprocedure Write_PCX (Name:Str80);πππ{ ===================== Implementation ============ }ππimplementationππusesπ Graph;πππ{-------------- Write_PCX --------------}ππprocedure Write_PCX (Name:Str80);ππconstπ RED1 = 0;π GREEN1 = 1;π BLUE1 = 2;ππtypeπ ArrayPal = array [0..15, RED1..BLUE1] of byte;ππconstπ MAX_WIDTH = 4000; { arbitrary - maximum width (in bytes) ofπ a PCX image }π INTENSTART = $5;π BLUESTART = $55;π GREENSTART = $A5;π REDSTART = $F5;ππtypeπ Pcx_Header = recordπ {comments from ZSoft ShowPCX pascal example}ππ Manufacturer: byte; { Always 10 for PCX file }ππ Version: byte; { 2 - old PCX - no palette (not usedπ anymore),π 3 - no palette,π 4 - Microsoft Windows - no paletteπ (only in old files, new Windowsπ version uses 3),π 5 - with palette }ππ Encoding: byte; { 1 is PCX, it is possible that we mayπ add additional encoding methods in theπ future }ππ Bits_per_pixel: byte; { Number of bits to represent a pixelπ (per plane) - 1, 2, 4, or 8 }ππ Xmin: integer; { Image window dimensions (inclusive) }π Ymin: integer; { Xmin, Ymin are usually zero (not always)}π Xmax: integer;π Ymax: integer;ππ Hdpi: integer; { Resolution of image (dots per inch) }π Vdpi: integer; { Set to scanner resolution - 300 isπ default }ππ ColorMap: ArrayPal;π { RGB palette data (16 colors or less)π 256 color palette is appended to endπ of file }ππ Reserved: byte; { (used to contain video mode)π now it is ignored - just set to zero }ππ Nplanes: byte; { Number of planes }ππ Bytes_per_line_per_plane: integer; { Number of bytes toπ allocate for a scanlineπ plane. MUST be an an EVENπ number! Do NOT calculateπ from Xmax-Xmin! }ππ PaletteInfo: integer; { 1 = black & white or color image,π 2 = grayscale image - ignored in PB4,π PB4+ palette must also be set toπ shades of gray! }ππ HscreenSize: integer; { added for PC Paintbrush IV Plusπ ver 1.0, }π VscreenSize: integer; { PC Paintbrush IV ver 1.02 (and later)}π { I know it is tempting to use theseπ fields to determine what video modeπ should be used to display the imageπ - but it is NOT recommended since theπ fields will probably just containπ garbage. It is better to have theπ user install for the graphics mode heπ wants to use... }ππ Filler: array [74..127] of byte; { Just set to zeros }π end;ππ Array80 = array [1..80] of byte;π ArrayLnImg = array [1..326] of byte; { 6 extra bytes atπ beginng of line that BGI uses for size info}π Line_Array = array [0..MAX_WIDTH] of byte;π ArrayLnPCX = array [1..4] of Array80;ππvarπ PCXName : File;π Header : Pcx_Header; { PCX file header }π ImgLn : ArrayLnImg;π PCXLn : ArrayLnPCX;π RedLn,π BlueLn,π GreenLn,π IntenLn : Array80;π Img : pointer;πππ{-------------- BuildHeader- -----------}ππprocedure BuildHeader;ππconstπ PALETTEMAP: ArrayPal=π { R G B }π (($00, $00, $00), { black }π ($00, $00, $AA), { blue }π ($00, $AA, $00), { green }π ($00, $AA, $AA), { cyan }π ($AA, $00, $00), { red }π ($AA, $00, $AA), { magenta }π ($AA, $55, $00), { brown }π ($AA, $AA, $AA), { lightgray }π ($55, $55, $55), { darkgray }π ($55, $55, $FF), { lightblue }π ($55, $FF, $55), { lightgreen }π ($55, $FF, $FF), { lightcyan }π ($FF, $55, $55), { lightred }π ($FF, $55, $FF), { lightmagenta }π ($FF, $FF, $55), { yellow }π ($FF, $FF, $FF) );{ white }ππvarπ i : word;ππbeginπ with Header doπ beginπ Manufacturer := 10;π Version := 5;π Encoding := 1;π Bits_per_pixel := 1;π Xmin := 0;π Ymin := 0;π Xmax := 639;π Ymax := 479;π Hdpi := 640;π Vdpi := 480;π ColorMap := PALETTEMAP;π Reserved := 0;π Nplanes := 4; { Red, Green, Blue, Intensity }π Bytes_per_line_per_plane := 80;π PaletteInfo := 1;π HscreenSize := 0;π VscreenSize := 0;π for i := 74 to 127 doπ Filler [i] := 0;π end;πend;πππ{-------------- GetBGIPlane ------------}ππprocedure GetBGIPlane (Start:word; var Plane:Array80);ππvarπ i : word;ππbeginπ for i:= 1 to Header.Bytes_per_line_per_plane doπ Plane [i] := ImgLn [Start +i -1]πend;ππ{-------------- BuildPCXPlane ----------}ππprocedure BuildPCXPlane (Start:word; Plane:Array80);ππvarπ i : word;ππbeginπ for i := 1 to Header.Bytes_per_line_per_plane doπ PCXLn [Start] [i] := Plane [i];πend;πππ{-------------- EncPCXLine -------------}ππprocedure EncPCXLine (PlaneLine : word); { Encode a PCX line }ππvarπ This,π Last,π RunCount : byte;π i,π j : word;πππ {-------------- EncPut -----------------}ππ procedure EncPut (Byt, Cnt :byte);ππ constπ COMPRESS_NUM = $C0; { this is the upper two bits thatπ indicate a count }ππ varπ Holder : byte;ππ beginπ {$I-}π if (Cnt = 1) and (COMPRESS_NUM <> (COMPRESS_NUM and Byt)) thenπ blockwrite (PCXName, Byt,1) { single occurance }π {good place for file error handler!}π elseπ beginπ Holder := (COMPRESS_NUM or Cnt);π blockwrite (PCXName, Holder, 1); { number of times theπ following colorπ occurs }π blockwrite (PCXName, Byt, 1);π end;π {$I+}π end;πππbeginπ i := 1; { used in PCXLn }π RunCount := 1;π Last := PCXLn [PlaneLine][i];π for j := 1 to Header.Bytes_per_line_per_plane -1 doπ beginπ inc (i);π This := PCXLn [PlaneLine][i];π if This = Last thenπ beginπ inc (RunCount);π if RunCount = 63 then { reached PCX run lengthπ limited max yet? }π beginπ EncPut (Last, RunCount);π RunCount := 0;π end;π endπ elseπ beginπ if RunCount >= 1 thenπ Encput (Last, RunCount);π Last := This;π RunCount := 1;π end;π end;π if RunCount >= 1 then { any left over ? }π Encput (Last, RunCount);πend;ππ { - - -W-R-I-T-E-_-P-C-X- - - - - - - - }ππconstπ XMAX = 639;π YMAX = 479;ππvarπ i, j, Size : word;ππbeginπ BuildHeader;π assign (PCXName,Name);π{$I-}π rewrite (PCXName,1);π blockwrite (PCXName,Header,sizeof (Header));π {good place for file error handler!}π{$I+}π setviewport (0,0,XMAX,YMAX, ClipOn);π Size := imagesize (0,0,XMAX,0); { size of a single row }π getmem (Img,Size);ππ for i := 0 to YMAX doπ beginπ getimage (0,i,XMAX,i,Img^); { Grab 1 line from theπ screen store in Imgπ buffer }π move (Img^,ImgLn,Size {326});πππ GetBGIPlane (INTENSTART, IntenLn);π GetBGIPlane (BLUESTART, BlueLn );π GetBGIPlane (GREENSTART, GreenLn);π GetBGIPlane (REDSTART, RedLn );π BuildPCXPlane (1, RedLn );π BuildPCXPlane (2, GreenLn);π BuildPCXPlane (3, BlueLn );π BuildPCXPlane (4, IntenLn); { 320 bytes/lineπ uncompressed }π for j := 1 to Header.NPlanes doππ EncPCXLine (j);π end;π freemem (Img,Size); (* Release the memory *)π{$I-}π close (PCXName); (* Save the Image *)π{$I+}πend;ππend {PCX.TPU} .πππ{ -----------------------Test Program -------------------------- }ππprogram WritePCX;ππusesπ Graph, PCX_W;ππ{-------------- DrawHorizBars ----------}ππprocedure DrawHorizBars;ππvarπ i, Color : word;ππbeginπ cleardevice;π Color := 15;π for i := 0 to 15 doπ beginπ setfillstyle (solidfill,Color);π bar (0,i*30,639,i*30+30); { 16*30 = 480 }π dec (Color);π end;πend;ππ{-------------- Main -------------------}ππvarπ NameW : Str80;π Gd,π Gm : integer;ππbeginπ writeln;π if (ParamCount = 0) then { no DOS command lineπ parameters }π beginπ write ('Enter name of PCX picture file to write: ');π readln (NameW);π writeln;π endπ elseπ beginπ NameW := paramstr (1); { get filename from DOSπ command line }π end;ππ if (Pos ('.', NameW) = 0) then { make sure the filenameπ has PCX extension }π NameW := Concat (NameW, '.pcx');ππ Gd:=VGA;π Gm:=VGAhi; {640x480, 16 colors}π initgraph (Gd,Gm,'..\bgi'); { path to your EGAVGA.BGI }ππ DrawHorizBars;ππ readln;π Write_PCX (NameW); { PCX_W.TPU }π closegraph; { Close graphics }π textmode (co80); { back to text mode }πend. { Write_PCX }π 45 01-27-9411:51ALL PETER M. GRUHN 3D Rotation SWAG9402 49 ╓ program BoxRot;ππ{PUBLIC DOMAIN 1993 Peter M. GruhnππProgram draws a box on screen. Allows user to rotate the box aroundπthe three primary axes. Viewing transform is simple ignore z.ππI used _Computer_Graphics:_Principles_and_Practice_, Foley et alπISBN 0-201-12110-7 as a referenceππRUNNING:πBorland Pascal 7. Should run on any graphics device supported by BGI.πIf you have smaller than 280 resolution, change '+200' to somethingπsmaller and/or change 75 to something smaller.ππSince this machine isπnot really set up for doing DOS graphics, I hard coded my BGI path, soπyou have to find 'initgraph' and change the bgi path to something thatπworks on your machine. Try ''.ππOkey dokey. This is kinda slow, and does a nice job of demonstrating theπproblems of repeatedly modifying the same data set. That is, the more andπmore you rotate the box, the more and more distorted it gets. This isπbecause computers are not perfect at calculations, and all of those littleπerrors add up quite quickly.ππIt's because of that that I used reals, not reals. I used floating pointπbecause the guy doesn't know what is going on at all with 3d, so better toπlook at only the math that is really happening. Besides, I still have toπthink to use fixed point. Whaddaya want for .5 hour programming.ππ DIRECTIONS:π ',' - rotates around the x axisπ '.' - rotates around the y axisπ '/' - rotates around the z axisπ 'q' - quitsππ All rotations are done around global axes, not object axes.π}ππusesπ graph,π crt;ππconstπ radtheta = 1 {degrees} * 3.1415926535 {radians} / 180 {per degrees};π { sin and cos on computers are done in radians. }ππtypeπ tpointr = record { Just a record to hold 3d points }π x, y, z : real;π end;ππvarπ box : array [0..7] of tpointr; { The box we will manipulate }π c : char; { Our input mechanism }ππprocedure init;πvarπ gd, gm : integer;π{ turns on graphics and creates a cube. Since the rotation routinesπ rotate around the origin, I have centered the cube on the origin, soπ that it stays in place and only spins. }πbeginπ gd := detect;π initgraph(gd, gm, 'e:\bp\bgi');π box[0].x := -75; box[0].y := -75; box[0].z := -75;π box[1].x := 75; box[1].y := -75; box[1].z := -75;π box[2].x := 75; box[2].y := 75; box[2].z := -75;π box[3].x := -75; box[3].y := 75; box[3].z := -75;π box[4].x := -75; box[4].y := -75; box[4].z := 75;π box[5].x := 75; box[5].y := -75; box[5].z := 75;π box[6].x := 75; box[6].y := 75; box[6].z := 75;π box[7].x := -75; box[7].y := 75; box[7].z := 75;πend;ππprocedure myline(x1, y1, z1, x2, y2, z2 : real);π{ Keeps the draw routine pretty. Pixels are integers, so I round. Since theπ cube is centered around 0,0 I move it over 200 to put it on screen. }πbeginπ{ if you think those real mults are slow, here's some rounds too... hey, youπ may wonder, what happened to the stinking z coordinate? Ah, says I, thisπ is the simplest of 3d viewing transforms. You just take the z coord out ofπ things and boom. Looking straight down the z axis on the object. If I getπ inspired, I will add simple perspective transform to these. There, gotπ inspired. Made mistakes. Foley et al are not very good at tutoringπ perspective and I'm kinda ready to be done and post this. }π line(round(x1) + 200, round(y1) + 200, round(x2) + 200, round(y2) + 200);πend;ππprocedure draw;π{ my model is hard coded. No cool things like vertex and edge and face lists.}πbeginπ myline(box[0].x, box[0].y, box[0].z, box[1].x, box[1].y, box[1].z);π myline(box[1].x, box[1].y, box[1].z, box[2].x, box[2].y, box[2].z);π myline(box[2].x, box[2].y, box[2].z, box[3].x, box[3].y, box[3].z);π myline(box[3].x, box[3].y, box[3].z, box[0].x, box[0].y, box[0].z);ππ myline(box[4].x, box[4].y, box[4].z, box[5].x, box[5].y, box[5].z);π myline(box[5].x, box[5].y, box[5].z, box[6].x, box[6].y, box[6].z);π myline(box[6].x, box[6].y, box[6].z, box[7].x, box[7].y, box[7].z);π myline(box[7].x, box[7].y, box[7].z, box[4].x, box[4].y, box[4].z);ππ myline(box[0].x, box[0].y, box[0].z, box[4].x, box[4].y, box[4].z);π myline(box[1].x, box[1].y, box[1].z, box[5].x, box[5].y, box[5].z);π myline(box[2].x, box[2].y, box[2].z, box[6].x, box[6].y, box[6].z);π myline(box[3].x, box[3].y, box[3].z, box[7].x, box[7].y, box[7].z);ππ myline(box[0].x, box[0].y, box[0].z, box[5].x, box[5].y, box[5].z);π myline(box[1].x, box[1].y, box[1].z, box[4].x, box[4].y, box[4].z);πend;ππprocedure rotx;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x [ 1 0 0 0 [x',y',z',1]π y 0 c -s 0 =π z 0 s c 0π 1] 0 0 0 1]π}πvarπ i : integer;πbeginπ setcolor(0);π draw;π for i := 0 to 7 doπ beginπ box[i].x := box[i].x;π box[i].y := box[i].y * cos(radTheta) + box[i].z * sin(radTheta);π box[i].z := -box[i].y * sin(radTheta) + box[i].z * cos(radTheta);π end;π setcolor(15);π draw;πend;ππprocedure roty;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x [ c 0 s 0 [x',y',z',1]π y 0 1 0 0 =π z -s 0 c 0π 1] 0 0 0 1]π}πvarπ i : integer;πbeginπ setcolor(0);π draw;π for i := 0 to 7 doπ beginπ box[i].x := box[i].x * cos(radTheta) - box[i].z * sin(radTheta);π box[i].y := box[i].y;π box[i].z := box[i].x * sin(radTheta) + box[i].z * cos(radTheta);π end;π setcolor(15);π draw;πend;ππprocedure rotz;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x [ c -s 0 0 [x',y',z',1]π y s c 0 0 =π z 0 0 1 0π 1] 0 0 0 1]π}πvarπ i : integer;πbeginπ setcolor(0);π draw;π for i := 0 to 7 doπ beginπ box[i].x := box[i].x * cos(radTheta) + box[i].y * sin(radTheta);π box[i].y := -box[i].x * sin(radTheta) + box[i].y * cos(radTheta);π box[i].z := box[i].z;π end;π setcolor(15);π draw;πend;πππbeginπ init;π setcolor(14);π draw;π repeatπ c := readkey;π case c ofπ ',' : rotx;π '.' : roty;π '/' : rotz;π else {who gives a};π end; {case}π until c = 'q';π closegraph;πend.πππ 46 01-27-9411:58ALL SEAN PALMER Bresenham's Line SWAG9402 20 ╓ {π>> I was wondering if anyone could show me the equations (and perhaps aπ>> demo in standard pascal) of the following shapes. What I need to know isπ>> where to plot the point.π>> Circle. (I've tried using the equation taught to me at school, but itπ>> Line (What I would like would be to be able to plot a line by giving itππThere seems yet again to be enough interest/need so I'll post this stuff justπONCE more.... somebody put this in SWAG or something.... PLEASE!!!ππ [Okay Sean, here you go! -Kerry]ππYou need a plot(x,y) procedure and a global color variable to use these asπposted.π}ππ{bresenham's line}π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;πππ{filled ellipse}πprocedure disk(xc, yc, a, b : integer);πvarπ x, y : integer;π aa, aa2,π bb, bb2,π d, dx, dy : longint;πbeginπ x := 0;π y := b;π aa := longint(a) * a;π aa2 := 2 * aa;π bb := longint(b) * b;π bb2 := 2 * bb;π d := bb - aa * b + aa div 4;π dx := 0;π dy := aa2 * b;π vLin(xc, yc - y, yc + y);ππ while (dx < dy) doπ beginπ if (d > 0) thenπ beginπ dec(y);π dec(dy, aa2);π dec(d, dy);π end;π inc(x);π inc(dx, bb2);π inc(d, bb + dx);π vLin(xc - x, yc - y, yc + y);π vLin(xc + x, yc - y, yc + y);π end;ππ inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);π while (y >= 0) doπ beginπ if (d < 0) thenπ beginπ inc(x);π inc(dx, bb2);π inc(d, bb + dx);π vLin(xc - x, yc - y, yc + y);π vLin(xc + x, yc - y, yc + y);π end;π dec(y);π dec(dy, aa2);π inc(d, aa - dy);π end;πend;ππ 47 01-27-9412:05ALL LIOR BAR-ON Gif Source 1 SWAG9402 98 ╓ {π> Can you post the gif source and any other graphic source for doing thisππHere is gif format (it doesn't get to full 768·1024·256)πor even less, but it is ok.π}ππ{$R-}{$S-}{$B-}πprogram GIF4TP;ππusesπ crt, GRAPH;ππconstπ ProgramName = 'TP4GIF';π ProgramRevision = '2';ππtypeπ BufferArray = array[0..63999] of byte;π BufferPointer = ^BufferArray;ππvarπ GifFile : file of BufferArray;π InputFileName : string;π RawBytes : BufferPointer; { The heap array to hold it, raw }π Buffer : BufferPointer; { The Buffer data stream, unblocked }π Buffer2 : BufferPointer; { More Buffer data stream if needed }π Byteoffset, { Computed byte position in Buffer array }π BitIndex { Bit offset of next code in Buffer array }π : longint;ππ Width, {Read from GIF header, image width}π Height, { ditto, image height}π LeftOfs, { ditto, image offset from left}π TopOfs, { ditto, image offset from top}π RWidth, { ditto, Buffer width}π RHeight, { ditto, Buffer height}π ClearCode, {GIF clear code}π EOFCode, {GIF end-of-information code}π OutCount, {Decompressor output 'stack count'}π MaxCode, {Decompressor limiting value for current code size}π CurCode, {Decompressor variable}π OldCode, {Decompressor variable}π InCode, {Decompressor variable}π FirstFree, {First free code, generated per GIF spec}π FreeCode, {Decompressor, next free slot in hash table}π RawIndex, {Array pointers used during file read}π BufferPtr,π XC,YC, {Screen X and Y coords of current pixel}π ReadMask, {Code AND mask for current code size}π I {Loop counter, what else?}π :word;ππ Interlace, {true if interlaced image}π AnotherBuffer, {true if file > 64000 bytes}π ColorMap {true if colormap present}π : boolean;ππ ch : char;π a, {Utility}π Resolution, {Resolution, read from GIF header}π BitsPerPixel, {Bits per pixel, read from GIF header}π Background, {Background color, read from GIF header}π ColorMapSize, {Length of color map, from GIF header}π CodeSize, {Code size, read from GIF header}π InitCodeSize, {Starting code size, used during Clear}π FinChar, {Decompressor variable}π Pass, {Used by video output if interlaced pic}π BitMask, {AND mask for data size}π R,G,Bπ :byte;ππ {The hash table used by the decompressor}π Prefix: array[0..4095] of word;π Suffix: array[0..4095] of byte;ππ {An output array used by the decompressor}π PixelValue : array[0..1024] of byte;ππ {The color map, read from the GIF header}π Red,Green,Blue: array [0..255] of byte;π MyPalette : PaletteType;ππ TempString : String;ππConstπ MaxCodes: Array [0..9] of Word = (4,8,16,$20,$40,$80,$100,$200,$400,$800);π CodeMask:Array [1..4] of byte= (1,3,7,15);π PowersOf2: Array [0..8] of word=(1,2,4,8,16,32,64,128,256);π Masks: Array [0..9] of integer = (7,15,$1f,$3f,$7f,$ff,$1ff,$3ff,$7ff,$fff);π BufferSize : Word = 64000;ππfunction NewExtension(FileName,Extension : string) : string;π{πPlaces a new extension on to the file name.π}πvarπ I : integer;πbeginπ if (Extension[1] = '.') then delete(Extension,1,1);π delete(Extension,4,251);π I := pos('.',FileName);π if (I = 0) thenπ beginπ while (length(FileName) > 0) and (FileName[length(FileName)] = ' ')π do delete(FileName,length(FileName),1);π NewExtension := FileName + '.' + Extension;π end else beginπ delete(FileName,I + 1,254 - I);π NewExtension := FileName + Extension;π end;πend; { NewExtension }ππfunction Min(I,J : longint) : longint;πbeginπ if (I < J) then Min := I else Min := J;πend; { Min }ππprocedure AllocMem(var P : BufferPointer);πvarπ ASize : longint;πbeginπ ASize := MaxAvail;π if (ASize < BufferSize) then beginπ Textmode(15);π writeln('Insufficient memory available!');π halt;π end else getmem(P,BufferSize);πend; { AllocMem }ππfunction Getbyte : byte;πbeginπ if (RawIndex >= BufferSize) then exit;π Getbyte := RawBytes^[RawIndex];π inc(RawIndex);πend;ππfunction Getword : word;πvarπ W : word;πbeginπ if (succ(RawIndex) >= BufferSize) then exit;π move(RawBytes^[RawIndex],W,2);π inc(RawIndex,2);π Getword := W;πend; { GetWord }ππprocedure ReadBuffer;πvarπ BlockLength : byte;π I,IOR : integer;πbeginπ BufferPtr := 0;π Repeatπ BlockLength := Getbyte;π For I := 0 to Blocklength-1 doπ beginπ if RawIndex = BufferSize thenπ beginπ {$I-}π Read (GIFFile,RawBytes^);π {$I+}π IOR := IOResult;π RawIndex := 0;π end;π if not AnotherBufferπ then Buffer^[BufferPtr] := Getbyteπ else Buffer2^[BufferPtr] := Getbyte;π BufferPtr := Succ (BufferPtr);π if BufferPtr=BufferSize then beginπ AnotherBuffer := true;π BufferPtr := 0;π AllocMem (Buffer2);π end;π end;π Until Blocklength=0;πend; { ReadBuffer }ππprocedure InitEGA;πvarπ Driver,Mode : integer;πbeginπ DetectGraph(Driver,Mode);π InitGraph(Driver,Mode,'e:\bp\bgi');π SetAllPalette(MyPalette);π if (Background <> 0) then beginπ SetFillStyle(SolidFill,Background);π bar(0,0,Width,Height);π end;πend; { InitEGA }ππprocedure DetColor(var PValue : byte; MapValue : Byte);π{πDetermine the palette value corresponding to the GIF colormap intensityπvalue.π}πvarπ Local : byte;πbeginπ PValue := MapValue div 64;π if (PValue = 1)π then PValue := 2π else if (PValue = 2)π then PValue := 1;πend; { DetColor }ππprocedure Init;πvarπ I : integer;πbeginπ XC := 0; {X and Y screen coords back to home}π YC := 0;π Pass := 0; {Interlace pass counter back to 0}π BitIndex := 0; {Point to the start of the Buffer data stream}π RawIndex := 0; {Mock file read pointer back to 0}π AnotherBuffer := false; {Over 64000 flag off}π AllocMem(Buffer);π AllocMem(RawBytes);π InputFileName := NewExtension(InputFileName,'GIF');π {$I-}π Assign(giffile,InputFileName);π Reset(giffile);π I := IOResult;π if (I <> 0) then beginπ textmode(15);π writeln('Error opening file ',InputFileName,'. Press any key ');π readln;π halt;π end;π read(GIFFile,RawBytes^);π I := IOResult;π{$I+}πend; { Init }ππprocedure ReadGifHeader;πvarπ I : integer;πbeginπ TempString := '';π for I := 1 to 6 do TempString := TempString + chr(Getbyte);π if (TempString <> 'GIF87a') then beginπ textmode(15);π writeln('Not a GIF file, or header read error. Press enter.');π readln;π halt;π end;π{πGet variables from the GIF screen descriptorπ}π RWidth := Getword; {The Buffer width and height}π RHeight := Getword;π{πGet the packed byte immediately following and decode itπ}π B := Getbyte;π Colormap := (B and $80 = $80);π Resolution := B and $70 shr 5 + 1;π BitsPerPixel := B and 7 + 1;π ColorMapSize := 1 shl BitsPerPixel;π BitMask := CodeMask[BitsPerPixel];π Background := Getbyte;π B := Getbyte; {Skip byte of 0's}π{πCompute size of colormap, and read in the global one if there. Computeπvalues to be used when we set up the EGA paletteπ}π MyPalette.Size := Min(ColorMapSize,16);π if Colormap then beginπ for I := 0 to pred(ColorMapSize) do beginπ Red[I] := Getbyte;π Green[I] := Getbyte;π Blue[I] := Getbyte;π DetColor(R,Red[I]);π DetColor(G,Green [I]);π DetColor(B,Blue [I]);π MyPalette.Colors[I] := B and 1 +π ( 2 * (G and 1)) + ( 4 * (R and 1)) + (8 * (B div 2)) +π (16 * (G div 2)) + (32 * (R div 2));π end;π end;π{πNow read in values from the image descriptorπ}π B := Getbyte; {skip image seperator}π Leftofs := Getword;π Topofs := Getword;π Width := Getword;π Height := Getword;π A := Getbyte;π Interlace := (A and $40 = $40);π if Interlace then beginπ textmode(15);π writeln(ProgramName,' is unable to display interlaced GIF pictures.');π halt;π end;πend; { ReadGifHeader }ππprocedure PrepDecompressor;πbeginπ Codesize := Getbyte;π ClearCode := PowersOf2[Codesize];π EOFCode := ClearCode + 1;π FirstFree := ClearCode + 2;π FreeCode := FirstFree;π inc(Codesize); { since zero means one... }π InitCodeSize := Codesize;π Maxcode := Maxcodes[Codesize - 2];π ReadMask := Masks[Codesize - 3];πend; { PrepDecompressor }ππprocedure DisplayGIF;π{πDecompress and display the GIF data.π}πvarπ Code : word;ππ procedure DoClear;π beginπ CodeSize := InitCodeSize;π MaxCode := MaxCodes[CodeSize-2];π FreeCode := FirstFree;π ReadMask := Masks[CodeSize-3];π end; { DoClear }ππ procedure ReadCode;π varπ Raw : longint;π beginπ if (CodeSize >= 8) then beginπ move(Buffer^[BitIndex shr 3],Raw,3);π Code := (Raw shr (BitIndex mod 8)) and ReadMask;π end else beginπ move(Buffer^[BitIndex shr 3],Code,2);π Code := (Code shr (BitIndex mod 8)) and ReadMask;π end;π if AnotherBuffer then beginπ ByteOffset := BitIndex shr 3;π if (ByteOffset >= 63000) then beginπ move(Buffer^[Byteoffset],Buffer^[0],BufferSize-Byteoffset);π move(Buffer2^[0],Buffer^[BufferSize-Byteoffset],63000);π BitIndex := BitIndex mod 8;π FreeMem(Buffer2,BufferSize);π end;π end;π BitIndex := BitIndex + CodeSize;π end; { ReadCode }ππ procedure OutputPixel(Color : byte);π beginπ putpixel(XC,YC,Color); { about 3x faster than using the DOS interrupt! }π inc(XC);π if (XC = Width) then beginπ XC := 0;π inc(YC);π if (YC mod 10 = 0) and keypressed and (readkey = #27) then beginπ textmode(15); { let the user bail out }π halt;π end;π end;π end; { OutputPixel }ππππbegin { DisplayGIF }π CurCode := 0; { not initted anywhere else... don't know why }π OldCode := 0; { not initted anywhere else... don't know why }π FinChar := 0; { not initted anywhere else... don't know why }π OutCount := 0;π DoClear; { not initted anywhere else... don't know why }π repeatπ ReadCode;π if (Code <> EOFCode) then beginπ if (Code = ClearCode) then begin { restart decompressor }π DoClear;π ReadCode;π CurCode := Code;π OldCode := Code;π FinChar := Code and BitMask;π OutputPixel(FinChar);π end else begin { must be data: save same as CurCode and InCode }π CurCode := Code;π InCode := Code;π{ if >= FreeCode, not in hash table yet; repeat the last character decoded }π if (Code >= FreeCode) then beginπ CurCode := OldCode;π PixelValue[OutCount] := FinChar;π inc(OutCount);π end;π{πUnless this code is raw data, pursue the chain pointed to by CurCodeπthrough the hash table to its end; each code in the chain puts itsπassociated output code on the output queue.π}π if (CurCode > BitMask) then repeatπ PixelValue[OutCount] := Suffix[CurCode];π inc(OutCount);π CurCode := Prefix[CurCode];π until (CurCode <= BitMask);π{πThe last code in the chain is raw data.π}π FinChar := CurCode and BitMask;π PixelValue[OutCount] := FinChar;π inc(OutCount);π{πOutput the pixels. They're stacked Last In First Out.π}π for I := pred(OutCount) downto 0 do OutputPixel(PixelValue[I]);π OutCount := 0;π{πBuild the hash table on-the-fly.π}π Prefix[FreeCode] := OldCode;π Suffix[FreeCode] := FinChar;π OldCode := InCode;π{πPoint to the next slot in the table. If we exceed the current MaxCodeπvalue, increment the code size unless it's already 12. if it is, doπnothing: the next code decompressed better be CLEARπ}π inc(FreeCode);π if (FreeCode >= MaxCode) then beginπ if (CodeSize < 12) then beginπ inc(CodeSize);π MaxCode := MaxCode * 2;π ReadMask := Masks[CodeSize - 3];π end;π end;π end; {not Clear}π end; {not EOFCode}π until (Code = EOFCode);πend; { DisplayGIF }ππbegin { TP4GIF }π writeln(ProgramName,' Rev ',ProgramRevision);π if (paramcount > 0)π then TempString := paramstr(1)π else beginπ write(' > ');π readln(TempString);π end;π InputFileName := TempString;π Init;π ReadGifHeader;π PrepDecompressor;π ReadBuffer;π FreeMem(RawBytes,BufferSize);π InitEGA;π DisplayGIF;π SetAllPalette(MyPalette);π close(GifFile);π Ch := readkey;π textmode(15);π freemem(Buffer,BufferSize); { totally pointless, but it's good form }πend.π 48 01-27-9412:07ALL THORSTEN BARTH GIF Code SWAG9402 42 ╓ {π> Does anyone have ANY source, on how to display a gif in VGA modeππIt's as bad as ... but it works.ππ--- VGA gif loader part 1 of 3 ---π}ππ{$X+}ππUses Graph,Dos;ππVarπ Gd,Gm: Integer;π Datei: File;π palette: array[0..767] of byte;π buffer: array[0..1279] of byte;π prefix,tail: array[0..4095] OF WORD;π keller: array[0..640] of Word;ππFunction LoadGif(N: String; VersX,VersY: Word): Integer;ππFunction GetChar: Char;πVar C: Char;πBeginπ BlockRead(Datei,C,1);π GetChar:=C;πEnd;ππFunction GetByte: Byte;πVar B: Byte;πBeginπ BlockRead(Datei,B,1);π GetByte:=B;πEnd;ππFunction GetWord: Word;πVar W: Word;πBeginπ BlockRead(Datei,W,2);π Getword:=W;πEnd;ππProcedure AGetBytes(Anz: Word);πBeginπ BlockRead(Datei,Buffer,Anz);πEnd;ππVarπ lokal_farbtafel: Integer;π mask,restbytes,pp,lbyte,blocklen,code,oldcode,sonderfall,π incode,freepos,kanz,pass,clearcode,eofcode,maxcode,infobyte,π globalfarbtafel,backcolor,interlace,bilddef,abslinks,absoben: word;π bits,restbits,codesize: Byte;π rot,gruen,blau,by,bpp: Byte;π z,i,x1,y1,x2,y2: integer;π bem: string[6];π farben: integer;π x,y,xa,ya,dy: word;πbeginπ loadgif:=0;π Assign(Datei,N);π reset(Datei,1);π if ioresult>0 then begin loadgif:=1; exit; end;π bem:='';π for i:=1 to 6 do bem:=bem+getchar;π if copy(bem,1,3)<>'GIF' then begin loadgif:=2; exit; end;π x2:=getword;π y2:=getword;π infobyte:=getbyte;π globalfarbtafel:=infobyte and 128;π bpp:=(infobyte and 7)+1;π farben:=1 shl bpp;π backcolor:=getbyte;π by:=getbyte;π if globalfarbtafel<>0 thenπ for i:=0 to (3*farben)-1 doπ palette[i]:=getbyte shr 2;π bilddef:=getbyte;π while bilddef=$21 do beginπ by:=getbyte; z:=getbyte;π for i:=1 to z do by:=getbyte;π by:=getbyte;π bilddef:=getbyte;π end;πππ if bilddef<>$2c then begin loadgif:=3; exit; end;π abslinks:=getword+VersX;π absoben:=getword+VersY;π x2:=getword;π y2:=getword;π by:=getbyte;π lokal_farbtafel:=by and 128;π interlace:=by and 64;π by:=getbyte;π x1:=0; y1:=0; xa:=x2; Ya:=Y2;π if farben<16 then begin loadgif:=4; exit; end;π if lokal_farbtafel<>0 thenπ for i:=0 to 3*Farben-1 doπ palette[I]:=getbyte shr 2;π asmπ mov ax,$1012π push dsπ pop esπ xor bx,bxπ mov cx,256π lea dx,paletteπ int $10π mov pass,0π MOV CL,bppπ MOV AX,1π SHL AX,CLπ MOV clearcode,AXπ INC AXπ MOV eofcode,AXπ INC AXπ MOV freepos,AXπ MOV AL,bppπ MOV AH,0π INC AXπ MOV codesize,ALπ MOV CX,AXπ MOV AX,1π SHL AX,CLπ DEC AXπ MOV maxcode,AXπ MOV kanz,0π MOV dy,8π MOV restbits,0π MOV restbytes,0π MOV x,0π MOV y,0π@gif0: CALL FAR PTR @getgifbyteπ CMP AX,eofcodeπ je @ende1π@gif1: CMP AX,clearcodeπ je @reset1π@gif3: MOV AX,codeπ MOV incode,AXπ CMP ax,freeposπ jb @gif4π MOV AX,oldcodeπ MOV code,AXπ MOV BX,kanzπ MOV CX,sonderfallπ SHL BX,1π MOV [OFFSET keller+BX],CXπ INC kanzπ@gif4: CMP AX,clearcodeπ JB @gif6π@gif5: MOV BX,codeπ SHL BX,1π PUSH BXπ MOV AX,[Offset tail+BX]π MOV BX,kanzπ SHL BX,1π MOV [OFFSET keller+BX],AXπ INC kanzπ POP BXπ MOV AX,[Offset prefix+BX]π MOV code,AXπ CMP AX,clearcodeπ ja @gif5π@gif6: MOV BX,kanzπ SHL BX,1π MOV [Offset keller+BX],AXπ MOV sonderfall,AXπ INC kanzπ@gif7: MOV AX,[Offset keller+BX]π CALL FAR PTR @pixelπ CMP BX,0π JE @gif8π DEC BXπ DEC BXπ JMP @gif7ππ@gif8: MOV kanz,0π MOV BX,freeposπ SHL BX,1π MOV AX,oldcodeπ MOV [Offset prefix+BX],AXπ MOV AX,codeπ MOV [Offset tail+BX],AXπ MOV AX,incodeπ MOV oldcode,AXπ INC freeposπ MOV AX,freeposπ CMP AX,maxcodeπ JBE @gif2π CMP codesize,12π JAE @gif2π INC codesizeπ MOV CL,codesizeπ MOV AX,1π SHL AX,CLπ DEC AXπ MOV maxcode,AXπ@gif2: JMP @gif0π@ende1: JMP @endeπ@reset1: MOV AL,bppπ MOV AH,0π INC AXπ MOV codesize,ALπ MOV CX,AXπ MOV AX,1π SHL AX,CLπ DEC AXπ MOV maxcode,AXπ MOV AX,clearcodeπ ADD AX,2π MOV freepos,AXπ CALL FAR PTR @getgifbyteπ MOV sonderfall,AXπ MOV oldcode,AXπ CALL FAR PTR @pixelπ JMP @gif2π@getgifbyte: MOV DI,0π MOV mask,1π MOV bits,0π@g1: MOV AL,bitsπ CMP AL,codesizeπ JAE @g0π CMP restbits,0π JA @g2π CMP restbytes,0π JNE @l2π PUSH DIπ CALL Getbyteπ POP DIπ MOV blocklen,AXπ MOV restbytes,AXπ PUSH DIπ PUSH AXπ CALL AGetbytesπ POP DIπ MOV pp,0π@l2: MOV BX,ppπ MOV AL,[BX+Offset Buffer]π XOR AH,AHπ INC ppπ DEC restbytesπ MOV lbyte,AXπ MOV restbits,8π@g2: SHR lbyte,1π JNC @nocarryπ OR DI,maskπ@nocarry: INC bitsπ DEC restbitsπ SHL mask,1π JMP @g1π@g0:MOV bits,0π MOV code,DIπ MOV AX,DIπ RETFπ@pixel:π PUSH BXπ MOV BX,xπ ADD BX,abslinksπ PUSH BXπ MOV BX,yπ ADD BX,absobenπ PUSH BXπ PUSH AXπ CALL Putpixelπ POP BXπ INC xπ MOV AX,xπ CMP AX,x2π JB @s0π MOV x,0π CMP interlace,0π JNE @s1π INC yπ JMP @s0π@s1: MOV AX,dyπ ADD y,AXπ MOV AX,yπ CMP AX,y2π JB @s0π INC passπ CMP pass,1π JNE @s3π JMP @s2π@s3: SHR dy,1π@s2: MOV AX,DYπ SHR AX,1π MOV Y,AXπ@s0: RETFπ@ende:π End;π Close(Datei);πEnd;πππbeginππend. 49 01-27-9412:07ALL BERNIE PALLEK VGA256 Unit SWAG9402 40 ╓ {π> I'm using 320x200x256. I use mainly assembly to do my procedures andπ> function in this library... but I can't manage to figure out a way to doπ> GET and PUTs ... have ny Idea how to do it? And yes, if you have any niceπ> graphic procedures/functions, well, I'm interrested...ππOk, if you want, I can post a bitmap scaler I got from Sean Palmer... it's inπassembler, so it's fast, and you could use it just like put, except it doesn'tπdo "transparency." If I ever figure out how to do it, I'll modify it and postπit. But for now, here are some other routines for mode 13h:π}ππTYPEπ RGBPalette = ARRAY[0..767] OF Byte;ππPROCEDURE SetVideoMode(desiredVideoMode : Byte);πBEGIN ASM MOV AH,0; MOV AL,desiredVideoMode; INT $10; END; END;ππFUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;πBEGIN GetPixel := Mem[$A000 : pix2get_y * 320 + pix2get_x]; END;ππPROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);πBEGIN Mem[$A000 : pix2set_y * 320 + pix2set_x] := pix2set_c; END;ππPROCEDURE Ellipse(exc, eyc, ea, eb : Integer);πVAR elx, ely : Integer;π aa, aa2, bb, bb2, d, dx, dy : LongInt;πBEGINπ elx:=0; ely:=eb; aa:=LongInt(ea)*ea; aa2:=2*aa;π bb:=LongInt(eb)*eb; bb2:=2*bb;π d:=bb-aa*eb+aa DIV 4; dx:=0; dy:=aa2*eb;π SetPixel(exc, eyc-ely, Colour); SetPixel(exc, eyc+ely, Colour);π SetPixel(exc-ea, eyc, Colour); SetPixel(exc+ea, eyc, Colour);π WHILE (dx < dy) DO BEGINπ IF (d > 0) THEN BEGINπ Dec(ely); Dec(dy, aa2); Dec(d, dy);π END;π Inc(elx); Inc(dx, bb2); Inc(d, bb+dx);π SetPixel(exc+elx, eyc+ely, Colour);π SetPixel(exc-elx, eyc+ely, Colour);π SetPixel(exc+elx, eyc-ely, Colour);π SetPixel(exc-elx, eyc-ely, Colour);π END;π Inc(d, (3*(aa-bb) DIV 2-(dx+dy)) DIV 2);π WHILE (ely > 0) DO BEGINπ IF (d < 0) THEN BEGINπ Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);π END;π Dec(ely); Dec(dy, aa2); Inc(d, aa-dy);π SetPixel(exc+elx, eyc+ely, Colour);π SetPixel(exc-elx, eyc+ely, Colour);π SetPixel(exc+elx, eyc-ely, Colour);π SetPixel(exc-elx, eyc-ely, Colour);π END;πEND;ππ{ these routines have been "compressed" to take up less line space; Iπ like spaces between addition, subtraction, etc, but I took them outπ to save space... you can add them again if you want }πππPROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);πVAR lndd, lndx, lndy, lnai, lnbi, lnxi, lnyi : Integer;πBEGINπ IF (lnx1 < lnx2) THEN BEGIN lnxi:=1; lndx:=lnx2-lnx1;π END ELSE BEGIN lnxi := (-1); lndx:= lnx1-lnx2; END;π IF (lny1 < lny2) THEN BEGIN lnyi:=1; lndy:=lny2-lny1;π END ELSE BEGIN lnyi := (-1); lndy:=lny1-lny2; END;π SetPixel(lnx1, lny1, Colour);π IF (lndx > lndy) THEN BEGINπ lnai:=(lndy-lndx)*2; lnbi:=lndy*2; lndd:=lnbi-lndx;π REPEATπ IF (lndd >= 0) THEN BEGINπ Inc(lny1, lnyi);π Inc(lndd, lnai);π END ELSE Inc(lndd, lnbi);π Inc(lnx1, lnxi);π SetPixel(lnx1, lny1, Colour);π UNTIL (lnx1 = lnx2);π END ELSE BEGINπ lnai := (lndx - lndy) * 2;π lnbi := lndx * 2;π lndd := lnbi - lndy;π REPEATπ IF (lndd >= 0) THEN BEGINπ Inc(lnx1, lnxi);π Inc(lndd, lnai);π END ELSE inc(lndd, lnbi);π Inc(lny1, lnyi);π SetPixel(lnx1, lny1, Colour);π UNTIL (lny1 = lny2);π END;πEND;ππPROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);π{ returns the r, g, and b values of a palette index }πBEGINπ Port[$3C7] := index2get;π r_inte := Port[$3C9];π g_inte := Port[$3C9];π b_inte := Port[$3C9];πEND;ππPROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);π{ sets the r, g, and b values of a palette index }πBEGINπ Port[$3C8] := index2set;π Port[$3C9] := r_inte;π Port[$3C9] := g_inte;π Port[$3C9] := b_inte;πEND;ππ{ oh, I'll give credit where credit is due: Sean Palmer supplied theπ Bresenham line and ellipse procedures }πππPROCEDURE BurstSetPalette(burstPalette : RGBPalette);πVARπ burstCount : Word;πBEGINπ Port[$3C8] := 0;π FOR burstCount := 0 TO 767 DO Port[$3C9] := burstPalette[burstCount];πEND;ππPROCEDURE WaitForRetrace;π{ waits for a vertical retrace to reduce flicker }πBEGINπ (* REPEAT UNTIL (Port[$3DA] AND $08) = 0; *)π { the above loop has been commented because it is only }π { necessary to wait until a retrace is in progress }π REPEAT UNTIL (Port[$3DA] AND $08) <> 0;πEND;ππPROCEDURE ClearScr;πBEGINπ FillChar(Mem[$A000:0000], 64000, 0);πEND;ππFUNCTION GetOverscan : Byte;πVARπ tmpOverscanByte : Byte;πBEGINπ ASMπ MOV AX,$1008π INT $10π MOV tmpOverscanByte,BHπ END;π GetOverscan := tmpOverscanByte;πEND;ππPROCEDURE SetOverscan(borderColour : Byte);πBEGINπ ASMπ MOV AX,$1001π MOV BH,borderColourπ INT $10π END;πEND;ππ{πWell, that's basically it, except for the bitmap scaler. If you want it, letπme know if you can receive NetMail, and I'll send it that way; otherwise, I'llπpost. The last two procedures/functions have not been tested. In fact, Iπcan't guarantee that any of the stuff will work. But try it out... :^)πC-YA.π} 50 01-27-9412:07ALL JASEN BETTS Line Drawing SWAG9402 14 ╓ {π> I used something like this:π> for x := 1 to 100 doπ> beginπ> y := slope*x;π> putpixel(x,y);π> end;ππthe slope method is a close cousin to bubble-sort an algorithm to use ifπyou can't be bothered to use a more efficient one for the job.ππhere's one. that only uses addition and subtraction in it's loop.π(FWIW it's based on the commutativity of multiplication.)ππI think It's got some fancy name which I forget, this code is 100% myπown (freeware) and reasonably well tested.π}ππ procedure myline(x1,y1,x2,y2,color:integer);ππ {Freeware: my bugs - your problem , 29 dec 1993 J.Betts,π PASCAL echo Fidonet. please keep this notice intact}ππ function sign(x:integer):integer; {like sgn(x) in basic}π begin if x<0 then sign:=-1 else if x>0 then sign:=1 else sign:=0 end;π varπ x,y,count,xs,ys,xm,ym:integer;π beginπ x:=x1;y:=y1;ππ xs:=x2-x1; ys:=y2-y1;ππ xm:=sign(xs); ym:=sign(ys);π xs:=abs(xs); ys:=abs(ys);ππ putpixel(x,y,color);ππ if xs > ysπ then begin {flat line <45 deg}π count:=-(xs div 2);π while (x <> x2 ) do beginπ count:=count+ys;π x:=x+xm;π if count>0 then beginπ y:=y+ym;π count:=count-xs;π end;π putpixel(x,y,color);π end;π endπ else begin {steep line >=45 deg}π count:=-(ys div 2);π while (y <> y2 ) do beginπ count:=count+xs;π y:=y+ym;π if count>0 then beginπ x:=x+xm;π count:=count-ys;π end;π putpixel(x,y,color);π end;π end;π end;ππ 51 01-27-9412:09ALL JORDAN PHILLIPS Graphics Images SWAG9402 21 ╓ {π Well, here are some image routines, I made it to where the WIDTH is storedπ in the first two bytes and the HEIGHT is stored in the 3rd and 4th bytes...π If you must really know... I guess it goes along with TP's get/put imageπ convention... This is for mode $13 ONLY of coarse...π}ππ Procedure GetImage ( X1, Y1, X2, Y2 : Integer; VAR DEST ) ;π Var Width,S,O : Word ;ππ BEGINπ S := SEG (DEST);π O := OFS (DEST);ππ ASMπ PUSH DSππ MOV DX, Video_Segπ MOV DS, DXπ MOV BX, 320π MOV AX, Y1; MUL BXπ ADD AX, X1; MOV SI, AXππ MOV DX, Sπ MOV ES, DXπ MOV DI, Oππ MOV DX, Y2; SUB DX, Y1; INC DXπ MOV BX, X2; SUB BX, X1; INC BXπ MOV WIDTH, BXππ MOV AX, WIDTHπ STOSWπ MOV AX, DXπ STOSWππ @LOOP:π MOV CX, WIDTHπ REP MOVSBπ ADD SI, 320; SUB SI, WIDTHπ DEC DXπ JNZ @LOOPππ POP DSπ End ;π End ;ππ Procedure PutImage ( X1, Y1 : Integer; VAR SOURCE ) ;π Var Width, S, O : Word ;π BEGINπ S := SEG (SOURCE);π O := OFS (SOURCE);ππ ASMπ PUSH DSππ MOV DX, Video_Segπ MOV ES, DXπ MOV BX, 320 { Setup Dest Addr }π MOV AX, Y1; MUL BXπ ADD AX, X1; MOV DI, AXππ MOV DX, S { Setup Source Addr }π MOV DS, DXπ MOV SI, Oππ LODSW { Get Width and Height }π MOV WIDTH, AXπ LODSWπ MOV DX, AXππ @LOOP:π MOV CX, WIDTHπ REP MOVSBπ ADD DI, 320; SUB DI, WIDTHπ DEC DXπ JNZ @LOOPππ POP DSπ End ;π End ;ππ Function SaveImage ( X1, Y1, X2, Y2 : Integer ; VAR Size : Word ) : Pointer ;π Var Img : Pointer ;π Beginπ FixInt ( X1, X2 ) ; { Put lesser in X1 }π FixInt ( Y1, Y2 ) ; { Put lesser in Y1 }π Size := WORD((X2-X1+1)*(Y2-Y1+1) +4);π GetMem ( Img, Size ) ;π GetImage ( X1, Y1, X2, Y2, Img^ ) ;π SaveImage := Img ;π End ;ππ Procedure CopyImage ( X1, Y1, X2, Y2, Dx, DY : Integer ) ;π Var Img : Pointer ;π Size : Word ;π Beginπ Img := SaveImage ( X1, Y1, X2, Y2, Size ) ;π PutImage ( Dx, Dy, Img^) ;π FreeMem ( Img, Size ) ;π End ;ππ Procedure LoadImage ( FileName : String ; VAR Img : Pointer ; Var Size : Wordπ Var F : File ;π Beginπ Img := NIL ;π Size := 0 ;π If Not Exist ( FileName ) Then Exit ;π Assign ( F, Filename ) ;π Reset ( F, 1 ) ;π Size := FileSize ( F ) ;π GetMem ( Img, Size ) ;π BlockRead ( F, Img^, Size ) ;π Close ( F ) ;π End ;π 52 01-27-9412:11ALL SEAN PALMER Flood Filling SWAG9402 13 ╓ {π> Does anyone have any code to flood fill an area? I need the code to doπ> both, a fill to a certain border colour, or a fill to ANYπ> colour other then the one the fill started on.π}ππvar fillVal:byte;π{This routine only called by fill}πfunction lineFill(x,y,d,prevXL,prevXR:integer):integer;π var xl,xr,i:integer;πbeginπ xl:=x;xr:=x;π repeat dec(xl); until(scrn(xl,y)<>fillVal)or(xl<0); inc(xl);π repeat inc(xr); until(scrn(xr,y)<>fillVal)or(xr>xMax); dec(xr);π hLin(xl,xr,y);π inc(y,d);π if word(y)<=yMax thenπ for x:=xl to xr doπ if(scrn(x,y)=fillVal)then beginπ x:=lineFill(x,y,d,xl,xr);π if word(x)>xr then break;π end;π dec(y,d+d); asm neg d;end;π if word(y)<=yMax then beginπ for x:=xl to prevXL doπ if(scrn(x,y)=fillVal)then beginπ i:=lineFill(x,y,d,xl,xr);π if word(x)>prevXL then break;π end;π for x:=prevXR to xr doπ if(scrn(x,y)=fillVal)then beginπ i:=lineFill(x,y,d,xl,xr);π if word(x)>xr then break;π end;π end;π lineFill:=xr;π end;ππprocedure fill(x,y:integer);beginπ fillVal:=scrn(x,y);if fillVal<>color then lineFill(x,y,1,x,x);π end;ππ{πThis one's too recursive for anything really complicated (blows the stack). Butπit works. You'll find that making it do a border fill instead isn't hard atπall. You'll need to provide your own hLin and scrn routines.ππhLin draws a horizontal line from X,to X2,at Y scrn reads the pixel at X,Y andπreturns its color color is a global byte variable in this incarnation. The fillπhappens in this color.π}π 53 01-27-9412:13ALL TIM JENSEN Masked Images SWAG9402 12 ╓ {π>Try converting it to use pointers instead of accessing the array withπ>indexes, and use a pointer to video memory for direct plotsπ>instead of using the putPixel routine. Also it's quicker toπ>check against 0 for the background than to check against 255.ππI found a copy of "The Visible Computer: 8088" in my bookshelves andπtried rewriting my assembly routines. Here's what I finally got:π}ππprocedure MaskPut(x,y: word; p: pointer); assembler;πvarπ XX,YY: byte;πasmπ LES SI,pπ MOV [XX],0π MOV [YY],0π MOV CX,256π XOR DX,DXπ CLDπ@Loopit:SEGES LODSBπ MOV DL,ALπ PUSH ESπ PUSH SIπ CMP DL,255π JZ @Doneπ MOV AX,0A000hπ MOV ES,AXπ MOV AX,320π MOV BX,[Y]π ADD BL,[YY]π PUSH DXπ MUL BXπ POP DXπ MOV BX,[X]π ADD BL,[XX]π ADD AX,BXπ MOV SI,AXπ MOV ES:[SI],DLπ@Done: INC [XX]π CMP [XX],16π JNZ @Okayπ MOV [XX],0π INC [YY]π@Okay: POP SIπ POP ESπ LOOP @Loopitπend;ππ{πIt works fine. I didn't notice much of a difference in speed though. Iπtested it and I can plot about 1103 sprites/second in ASM and 828πsprites/sec. with my original TP code. Please keep in mind I'm not muchπof an assembly programmer. Can anyone help me optimize this code (intoπ286 would be good too). Thanx for your help!π}π 54 01-27-9412:14ALL JENS LARSSON ModeX Scrolling SWAG9402 6 ╓ {π> does anyone know how to scroll up or down in 320*200*256 mode ??ππ Enter mode-x (look for source on any board, quite common), andπ then pan the screen like this:π}ππ Asmπ mov bx,StartMemπ mov ah,bhπ mov al,0chπ mov dx,3d4hπ out dx,axπ mov ah,blπ inc alπ out dx,axπ End;π{π To begin, zero StartMem and then increase it with 80 each time -π tada - the screen pans down. Oh, btw, If I were you I would callπ a sync just before running it...π} 55 01-27-9412:15ALL RICHARD MOREY Images SWAG9402 13 ╓ {π-> I'm trying to use the GetImage and PutImage commands from Turboπ-> PascalππOkay.. did you declare a varible that would hold the size you needed? Iπhave a little program I wrote to draw a musical staff and put the notesπup randomly so that I can practice reading music..π}ππProgram MusicNotes;ππUsesπ Crt,π Dos,π Graph,π XtraDos;ππconstπ NotePos : Array[1..11] Of Integer =π(164,179,194,209,224,239,254,269,284,299,314);π Note : Array[1..11] Of Char =π('G','F','E','D','C','B','A','G','F','E','D');ππProcedure Beep;ππbeginπ sound(600);π delay(100);π nosound;πend;ππvarπ CallUnit : CallH;π Key : Char;π P : Pointer;π Size : Word;π Y, X,π MaxX, MaxY,π grMode,π grDriver : Integer;ππBeginπgrDriver := Detect;πInitGraph(grDriver, grMode,'D:\bp\bgi');πMaxX:=GetMaxX;πMaxY:=GetMaxY;πSetColor(white);πCircle(15,15,15);πFloodFill(15,15,white);πSize:=ImageSize(0,0,30,30);πGetMem(P,Size);πgetImage(0,0,30,30,P^);πcleardevice;πY:=((MaxY Div 2)-60);πFor X:=1 To 5 Doπ Beginπ Line(0,Y,MaxX,Y);π Y:=Y+30;π End;πRandomize;πRepeatπX:=Random(11)+1;π PutImage(320,(NotePos[X]-15),P^,ORPut);π Repeatπ Key:=Char(CallUnit.KeyReturn);π Until Key=Note[X];π Beep;π PutImage(320,(NotePos[X]-15),P^,XOrPut);π If (X/2)=(X Div 2) Thenπ Line(290,NotePos[x],350,NotePos[x])π Elseπ If X>1 Thenπ Line(290,NotePos[x-1],350,NotePos[x-1]);πUntil 3=2;πEnd.ππThe important part is the SIZE=.. Use that line to create a varbibleπbuig enough to hold the image.π 56 01-27-9412:17ALL DAVID DAHL Palette Maniputlation SWAG9402 44 ╓ {$G+} { Enable 286 Instructions }πUnit Palette;ππ{ Programmed By David Dahl }ππ(* PUBLIC DOMAIN *)ππInterfaceππ Type PaletteRec = Recordπ Red,π Green,π Blue : Byte;π End;π PaletteType = Array[0..255] of PaletteRec;π PalettePtr = ^PaletteType;ππ Procedure SetPalette (Var PalBuf : PaletteType);π Procedure GetPalette (Var PalBuf : PaletteType);ππ Procedure BlackPalette;π Procedure FadeInFromBlack (Var Palin : PaletteType);π Procedure FadeInFromBlackQ (Var Palin : PaletteType;π Intensity : Word);π Procedure FadeOutToBlack (Var Palin : PaletteType);π Procedure FadeFromPalToPal (Var OldPal, NewPal : PaletteType);π Procedure FadeFromPalToPalQ (Var OldPal, NewPal : PaletteType;π Color : Word);πππ Var BlackP : PaletteType;π WhiteP : PaletteType;ππ TempPal : PaletteType;ππImplementationππ{-[ Set Value Of All DAC Registers ]--------------------------------------}πProcedure SetPalette (Var PalBuf : PaletteType); Assembler;πAsmπ PUSH DSππ XOR AX, AX { Palette Start = 0 }π MOV CX, 0300h / 2π LDS SI, PalBuf { Load DS:SI With Address Of PalBuf (For OUTSB) }ππ MOV DX, 03C8h { Tell VGA Card What DAC Color To Start With }π OUT DX, ALππ INC DX { Set DX To Equal DAC Data Port }π MOV BX, DXπ CLDππ { Wait For V-sync }π MOV DX, 03DAhπ @VSYNC0:π IN AL, DXπ TEST AL, 8π JZ @VSYNC0ππ MOV DX, BXπ REPπ OUTSBππ MOV BX, DXππ { Wait For V-sync }π MOV DX, 03DAhπ @VSYNC1:π IN AL, DXπ TEST AL, 8π JZ @VSYNC1ππ MOV DX, BXπ MOV CX, 0300h / 2π REPπ OUTSBππ POP DSπEnd;ππ{-[ Get Value Of All DAC Registers ]--------------------------------------}πProcedure GetPalette (Var PalBuf : PaletteType); Assembler;πAsmπ PUSH DSππ XOR AX, AX { Palette Start = 0 }π MOV CX, 0300hπ LES DI, PalBuf { Load ES:DI With Address Of PalBuf (For INSB) }ππ MOV DX, 03C7h { Tell VGA Card What DAC Color To Start With }π OUT DX, ALππ INC DX { Set DX To Equal DAC Data Port }π INC DXπ CLDππ REPπ INSBππ POP DSπEnd;πππProcedure BlackPalette;πBeginπ SetPalette (BlackP);πEnd;ππProcedure FadeInFromBlack (Var Palin : PaletteType);πVar DAC,π Intensity : Word;πBeginπ For Intensity := 0 to 32 doπ Beginπ For DAC := 0 to 255 doπ Beginπ TempPal[DAC].Red := (Palin[DAC].Red * Intensity) DIV 32;π TempPal[DAC].Green := (Palin[DAC].Green * Intensity) DIV 32;π TempPal[DAC].Blue := (Palin[DAC].Blue * Intensity) DIV 32;π End;ππ SetPalette (TempPal);π End;πEnd;ππProcedure FadeInFromBlackQ (Var Palin : PaletteType;π Intensity : Word);πConst DAC : Word = 0;πBeginπ For DAC := 0 to 255 doπ Beginπ TempPal[DAC].Red := (Palin[DAC].Red * Intensity) DIV 32;π TempPal[DAC].Green := (Palin[DAC].Green * Intensity) DIV 32;π TempPal[DAC].Blue := (Palin[DAC].Blue * Intensity) DIV 32;π End;ππ SetPalette (TempPal);πEnd;ππProcedure FadeOutToBlack (Var Palin : PaletteType);πVar DAC,π Intensity : Word;πBeginπ For Intensity := 32 downto 0 doπ Beginπ For DAC := 0 to 255 doπ Beginπ TempPal[DAC].Red := (Palin[DAC].Red * Intensity) DIV 32;π TempPal[DAC].Green := (Palin[DAC].Green * Intensity) DIV 32;π TempPal[DAC].Blue := (Palin[DAC].Blue * Intensity) DIV 32;π End;ππ SetPalette (TempPal);π End;πEnd;πππProcedure FadeFromPalToPal (Var OldPal, NewPal : PaletteType);πVar DAC,π Color : Word;πBeginπ For Color := 32 downto 0 doπ Beginπ For DAC := 0 to 255 doπ Beginπ TempPal[DAC].Red := ((OldPal[DAC].Red * Color) DIV 32) +π ((NewPal[DAC].Red * (32 - Color)) DIV 32);π TempPal[DAC].Green := ((OldPal[DAC].Green * Color) DIV 32) +π ((NewPal[DAC].Green * (32 - Color)) DIV 32);π TempPal[DAC].Blue := ((OldPal[DAC].Blue * Color) DIV 32) +π ((NewPal[DAC].Blue * (32 - Color)) DIV 32);π End;ππ SetPalette (TempPal);π End;πEnd;ππProcedure FadeFromPalToPalQ (Var OldPal, NewPal : PaletteType;π Color : Word);πConst DAC : Word = 0;πBeginπ For DAC := 0 to 255 doπ Beginπ TempPal[DAC].Red := ((OldPal[DAC].Red * (32 - Color)) DIV 32)+π ((NewPal[DAC].Red * Color) DIV 32);π TempPal[DAC].Green := ((OldPal[DAC].Green * (32 - Color)) DIV 32)+π ((NewPal[DAC].Green * Color) DIV 32);π TempPal[DAC].Blue := ((OldPal[DAC].Blue * (32 - Color)) DIV 32)+π ((NewPal[DAC].Blue * Color) DIV 32);π End;ππ SetPalette (TempPal);πEnd;ππVar Counter : Word;πBeginπ For Counter := 0 to 255 doπ Beginπ BlackP[Counter].Red := 0;π BlackP[Counter].Green := 0;π BlackP[Counter].Blue := 0;π End;ππ For Counter := 0 to 255 doπ Beginπ WhiteP[Counter].Red := 63;π WhiteP[Counter].Green := 63;π WhiteP[Counter].Blue := 63;π End;πEnd.ππ 57 01-27-9412:17ALL LIOR BAR-ON PCX Files SWAG9402 122 ╓ πunit PCX;ππ{ The following display modes are supported:ππ Mode TP GraphMode Resolution Colorsπ ~~~~ ~~~~~~~~~~~~ ~~~~~~~~~~ ~~~~~~π $04 CGAC0 to C3 320 x 200 4π $06 CGAHi 640 x 200 2π $0D --- 320 x 200 16π $0E EGALo/VGALo 640 x 200 16π $10 EGAHi/VGAMed 640 x 350 16π $12 VGAHi 640 x 480 16π $13 --- 320 x 200 256ππ Mode $13 is supported only for files containing palette information,π i.e. not those produced by versions of Paintbrush earlier than 3.0.}ππINTERFACEππuses DOS, GRAPH;ππtype RGBrec = recordπ redval, greenval, blueval: byte;π end;ππvar pcxfilename: pathstr;π file_error: boolean;π pal: palettetype;π RGBpal: array[0..15] of RGBrec;π RGB256: array[0..255] of RGBrec;π page_addr: word;π bytes_per_line: word;π buff0, buff1: pointer;ππ { CGA display memory banks: }π screenbuff0: array[0..7999] of byte absolute $b800:$0000;π screenbuff1: array[0..7999] of byte absolute $b800:$2000;ππconst page0 = $A000; { EGA/VGA display segment }ππprocedure SETMODE(mode: byte);πprocedure SETREGISTERS(var palrec);πprocedure READ_PCX_FILE(gdriver: integer; pfilename: pathstr);πprocedure READ_PCX256(pfilename: pathstr);ππ{========================================================================}ππIMPLEMENTATIONππvar scratch, abuff0, abuff1: pointer;π is_CGA, is_VGA: boolean;π repeatcount: byte;π datalength: word;π columncount, plane, video_index: word;π regs: registers;ππconst buffsize = 65521; { Largest possible }ππ{ -------------------------- BIOS calls --------------------------------- }ππ{ For modes not supported by the BGI, use SetMode to initialize theπ graphics. Since SetRGBPalette won't work if Turbo hasn't done theπ graphics initialization itself, use SetRegisters to change the colorsπ in mode $13. }ππprocedure SETMODE(mode: byte);ππbeginπregs.ah:= 0; { BIOS set mode function }πregs.al:= mode; { Display mode }πintr($10, regs); { Call BIOS }πend;ππprocedure SETREGISTERS(var palrec);ππ{ Palrec is any string of 768 bytes containing the RGB data. }ππbeginπregs.ah:= $10; { BIOS color register function }πregs.al:= $12; { Subfunction }πregs.es:= seg(palrec); { Address of palette info. }πregs.dx:= ofs(palrec);πregs.bx:= 0; { First register to change }πregs.cx:= $100; { Number of registers to change }πintr($10, regs); { Call BIOS }πend;ππ{ ====================== EGA/VGA 16-color files ========================= }ππprocedure DECODE_16; assembler;ππasmπpush bpππ{ ----------------- Assembler procedure for 16-color files -------------- }ππ{ The first section is initialization done on each run through theπ input buffer. }ππ@startproc:πmov bp, plane { plane in BP }πmov es, page_addr { video display segment }πmov di, video_index { index into video segment }πmov ah, byte ptr bytes_per_line { line length in AH }πmov dx, columncount { column counter }πmov bx, datalength { no. of bytes to read }πxor cx, cx { clean up CX for loop counter }πmov cl, repeatcount { count in CX }πpush ds { save DS }πlds si, scratch { input buffer pointer in DS:SI }πadd bx, siπcld { clear DF for stosb }πcmp cl, 0 { was last byte a count? }πjne @multi_data { yes, so next is data }πjmp @getbyte { no, so find out what next is }ππ{ -------------- Procedure to write EGA/VGA image to video -------------- }ππ@writebyte:πstosb { AL into ES:DI, inc DI }πinc dl { increment column }πcmp dl, ah { reached end of scanline? }πje @doneline { yes }πloop @writebyte { no, do another }πjmp @getbyte { or get more data }π@doneline:πshl bp, 1 { shift to next plane }πcmp bp, 8 { done 4 planes? }πjle @setindex { no }πmov bp, 1 { yes, reset plane to 1 but don't reset index }πjmp @setplaneπ@setindex:πsub di, dx { reset to start of line }π@setplane:πpush ax { save AX }πcli { no interrupts }πmov ax, bp { plane is 1, 2, 4, or 8 }πmov dx, 3C5h { sequencer data register }πout dx, al { mask out 3 planes }πsti { enable interrupts }πpop ax { restore AX }πxor dx, dx { reset column count }πloop @writebyte { do it again, or fetch more data }ππ@getbyte: { last byte was not a count }πcmp si, bx { end of input buffer? }πje @exit { yes, quit }πlodsb { get a byte from DS:SI into AL, increment SI }πcmp al, 192 { test high bits }πjb @one_data { not set, it's data to be written once }π { It's a count byte: }πxor al, 192 { get count from 6 low bits }πmov cl, al { store repeat count }πcmp si, bx { end of input buffer? }πje @exit { yes, quit }π@multi_data:πlodsb { get data byte }πjmp @writebyte { write it CL times }π@one_data:πmov cl, 1 { write byte once }πjmp @writebyteππ{ ---------------------- Finished with buffer --------------------------- }ππ@exit:πpop ds { restore Turbo's data segment }πmov plane, bp { save status for next run thru buffer }πmov repeatcount, clπmov columncount, dxπmov video_index, diπpop bpπend; { asm }ππ{ ===================== CGA 2- and 4-color files ======================== }ππprocedure DECODE_CGA; assembler;ππasmππpush bpπjmp @startprocππ{ ------------- Procedure to store CGA image in buffers ----------------- }ππ@storebyte:πstosb { AL into ES:DI, increment DI }πinc dx { increment column count }πcmp dl, ah { reached end of line? }πje @row_ends { yes }πloop @storebyte { not end of row, do another byte }πretπ@row_ends:πxor bp, 1 { switch banks }πcmp bp, 1 { is bank 1? }πje @bank1 { yes }πmov word ptr abuff1, di { no, save index into bank 1 }πles di, abuff0 { bank 0 pointer into ES:DI }πxor dx, dx { reset column counter }πloop @storebyteπretπ@bank1:πmov word ptr abuff0, di { save index into bank 0 }πles di, abuff1 { bank 1 pointer into ES:DI }πxor dx, dx { reset column counter }πloop @storebyteπretππ{ ---------------- Main assembler procedure for CGA --------------------- }ππ@startproc:πmov bp, 0 { bank in BP }πmov es, word ptr abuff0[2] { segment of bank 0 buffer }πmov di, word ptr abuff0 { offset of buffer }πmov ah, byte ptr bytes_per_line { line length in AH }πmov bx, datalength { no. of bytes to read }πxor cx, cx { clean up CX for loop counter }πxor dx, dx { initialize column counter }πmov si, dx { initialize input index }πcld { clear DF for stosb }ππ{ -------------------- Loop through input buffer ------------------------ }ππ@getbyte:πcmp si, bx { end of input buffer? }πje @exit { yes, quit }πpush es { save output pointer }πpush diπles di, scratch { get input pointer in ES:DI }πadd di, si { add current offset }πmov al, [es:di] { get a byte }πinc si { advance input index }πpop di { restore output pointer }πpop esπcmp cl, 0 { was previous byte a count? }πjg @multi_data { yes, this is data }πcmp al, 192 { no, test high bits }πjb @one_data { not set, not a count }π { It's a count byte: }πxor al, 192 { get count from 6 low bits }πmov cl, al { store repeat count }πjmp @getbyte { go get data byte }π@one_data:πmov cl, 1 { write byte once }πcall @storebyteπjmp @getbyteπ@multi_data:πcall @storebyte { CL already set }πjmp @getbyteππ{ ---------------------- Finished with buffer --------------------------- }ππ@exit:πpop bpπend; { asm }ππ{ ============= Main procedure for CGA and 16-color files =============== }ππprocedure READ_PCX_FILE(gdriver: integer; pfilename: pathstr);ππtype ptrrec = recordπ segm, offs: word;π end;ππvar entry, gun, pcxcode, mask, colorID: byte;π palbuf: array[0..66] of byte;π pcxfile: file;ππbegin { READ_PCX_FILE }πis_CGA:= (gdriver = CGA); { 2 or 4 colors }πis_VGA:= (gdriver = VGA); { 16 of 256K possible colors }π { Otherwise EGA - 16 of 64 possible colors }πassign(pcxfile, pfilename);π{$I-} reset(pcxfile, 1); {$I+}πfile_error:= (IOresult <> 0);πif file_error then exit;ππgetmem(scratch, buffsize); { Allocate scratchpad }πblockread(pcxfile, scratch^, 128); { Get header into scratchpad }ππmove(scratch^, palbuf, 67);πbytes_per_line:= palbuf[66];ππ{------------------------ Setup for CGA ---------------------------------}ππif is_CGA thenπbeginπ getmem(buff0, 8000); { Allocate memory for output }π getmem(buff1, 8000);π abuff0:= buff0; { Make copies of pointers }π abuff1:= buff1;πend elseππ{----------------------- Setup for EGA/VGA ------------------------------}ππbeginπ video_index:= 0;π port[$3C4]:= 2; { Index to map mask register }π plane:= 1; { Initialize plane }π port[$3C5]:= plane; { Set sequencer to mask out other planes }ππ for entry:= 0 to 15 doπ beginπ colorID:= 0;π for gun:= 0 to 2 doπ beginπ pcxcode:= palbuf[16 + entry * 3 + gun]; { Get primary color value }π if not is_VGA thenπ begin { Interpret for EGA }π case (pcxcode div $40) ofπ 0: mask:= $00; { 000000 }π 1: mask:= $20; { 100000 }π 2: mask:= $04; { 000100 }π 3: mask:= $24; { 100100 }π end;π colorID:= colorID or (mask shr gun); { Define two bits }π end { not is_VGA }π elseπ begin { is_VGA }π with RGBpal[entry] do { Interpret for VGA }π case gun ofπ 0: redval:= pcxcode div 4;π 1: greenval:= pcxcode div 4;π 2: blueval:= pcxcode div 4;π end;π end; { is_VGA }π end; { gun }π if is_VGA then pal.colors[entry]:= entryπ else pal.colors[entry]:= colorID;π end; { entry }π pal.size:= 16;πend; { not is_CGA }ππ{ ---------------- Read and decode the image data ----------------------- }ππrepeatcount:= 0; { Initialize assembler vars. }πcolumncount:= 0;πrepeatπ blockread(pcxfile, scratch^, buffsize, datalength);π if is_CGA then decode_CGA else decode_16; { Call assembler routine }πuntil eof(pcxfile);πclose(pcxfile);πif not is_CGA then port[$3C5]:= $F; { Reset mask map }πfreemem(scratch,buffsize); { Discard scratchpad }πend; { READ_PCX_FILE }ππ{ ========================= 256-color files ============================= }ππprocedure DECODE_PCX256; assembler;ππasmπmov es, page_addr { video segment }πmov di, video_index { index into video }πxor cx, cx { clean up loop counter }πmov cl, repeatcount { count in CL }πmov bx, datalength { end of input buffer }πpush ds { save DS }πlds si, scratch { pointer to input in DS:SI }πadd bx, si { adjust datalength - SI may not be 0 }πcld { clear DF }πcmp cl, 0 { was last byte a count? }πjne @multi_data { yes, so next is data }ππ{ --------------------- Loop through input buffer ----------------------- }ππ@getbyte: { last byte was not a count }πcmp si, bx { end of input buffer? }πje @exit { yes, quit }πlodsb { get byte into AL, increment SI }πcmp al, 192 { test high bits }πjb @one_data { not set, not a count }π{ It's a count byte }πxor al, 192 { get count from 6 low bits }πmov cl, al { store repeat count }πcmp si, bx { end of input buffer? }πje @exit { yes, quit }π@multi_data:πlodsb { get byte into AL, increment SI }πrep stosb { write byte CX times }πjmp @getbyteπ@one_data:πstosb { byte into video }πjmp @getbyteππ{ ------------------------- Finished with buffer ------------------------ }ππ@exit:πpop ds { restore Turbo's data segment }πmov video_index, di { save status for next run thru buffer }πmov repeatcount, clπend; { asm }ππ{ ================= Main procedure for 256-color files ================== }ππprocedure READ_PCX256(pfilename: pathstr);ππvar x, gun, pcxcode: byte;π pcxfile: file;π palette_start, total_read: longint;π palette_flag: byte;π version: word;ππprocedure CLEANUP;ππbeginπclose(pcxfile);πfreemem(scratch, buffsize);πend;ππbegin { READ_PCX256 }πassign(pcxfile, pfilename);π{$I-} reset(pcxfile, 1); {$I+}πfile_error:= (IOresult <> 0);πif file_error then exit;πgetmem(scratch, buffsize); { Allocate scratchpad }πblockread(pcxfile, version, 2); { Read first two bytes }πfile_error:= (hi(version) < 5); { No palette info. }πif file_error thenπbeginπ cleanup; exit;πend;πpalette_start:= filesize(pcxfile) - 769;ππseek(pcxfile, 128); { Scrap file header }πtotal_read:= 128;ππrepeatcount:= 0; { Initialize assembler vars. }πvideo_index:= 0;ππrepeatπ blockread(pcxfile, scratch^, buffsize, datalength);π inc(total_read, datalength);π if (total_read > palette_start) thenπ dec(datalength, total_read - palette_start);π decode_pcx256;πuntil (eof(pcxfile)) or (total_read>= palette_start);ππseek(pcxfile, palette_start);πblockread(pcxfile, palette_flag, 1);πfile_error:= (palette_flag <> 12);πif file_error thenπbeginπ cleanup; exit;πend;πblockread(pcxfile, RGB256, 768); { Get palette info. }πfor x:= 0 to 255 doπwith RGB256[x] doπbeginπ redval:= redval shr 2;π greenval:= greenval shr 2;π blueval:= blueval shr 2;πend;πcleanup;πend; { READ_PCX256 }ππ{ ========================== Initialization ============================= }ππBEGINπpage_addr:= page0; { Destination for EGA/VGA data }πEND.π 58 01-27-9412:18ALL DAVID DAHL Plasma SWAG9402 33 ╓ {$G+} { Enable 286 Instructions }π{$N+} { Enable Math Coprocessor - Delete This Line If You Don't Have One }πProgram FractalPlasma;ππ{ Programmed By David Dahl }ππ(* PUBLIC DOMAIN *)ππUsesπ CRT,π Palette;ππConstπ Rug = 0.2;ππTypeπ VGAPtr = ^VGAType;π VGAType = Array [0..199, 0..319] of Byte;ππVarπ Screen : VGAPtr;ππ PlasmaMap : VGAPtr;π PlasmaPal : PaletteType;ππProcedure GeneratePlasma(P : VGAPtr);π{ }π{ This procedure uses an algorithm to generate a fractal surface. }π{ }π{ Algorithm from page 359 of _Computer_Graphics:_the_Principles_ }π{ _Behind_the_Art_And_Science_ by Pokorny and Gerald. }π{ }π Procedure FractPlasma(il, jl, ih, jh : Integer);π Varπ im, jm : Integer;π Beginπ im := (il + ih + 1) DIV 2;π jm := (jl + jh + 1) DIV 2;ππ If jm < jh thenπ Beginπ If P^[il,jm] = 0 Thenπ P^[il,jm] := Trunc(((P^[il,jl] + P^[il,jh]) / 2) +π Random*Rug*(jh-jl));π If il < ih Thenπ P^[ih,jm] := Trunc(((P^[ih,jl] + P^[ih,jh]) / 2) +π Random*Rug*(jh-jl));π End;ππ If im < ih thenπ Beginπ If P^[im,jl] = 0 Thenπ P^[im,jl] := Trunc(((P^[il,jl] + P^[ih,jl]) / 2) +π Random*Rug*(ih-il));π If jl < jh Thenπ P^[im,jh] := Trunc(((P^[il,jh] + P^[ih,jh]) / 2) +π Random*Rug*(jh-jl));π End;ππ If (im < ih) AND (jm < jh) Thenπ P^[im,jm] := Trunc(((P^[il,jl] + P^[ih,jl] +π P^[il,jh] + P^[ih, jh]) / 4) +π Random*Rug*(ABS(ih-il)+abs(jh-jl)));π If (im < ih) OR (jm < jh) Thenπ Beginπ FractPlasma(il, jl, im, jm);π FractPlasma(il, jm, im, jh);π FractPlasma(im, jl, ih, jm);π FractPlasma(im, jm, ih, jh);π End;π End;ππBeginπ FractPlasma(0, 0, 199, 319);πEnd;ππProcedure InitVGA13h; Assembler;πAsmπ MOV AX, $0013π INT $10πEnd;ππProcedure CalculatePalette(Var PalOut : PaletteType);πVarπ RA, GA, BA : Integer;π RF, GF, BF : Integer;π RS, GS, BS : Integer;π Counter : Word;πBeginπ RA := 16 + Random(32-16);π GA := 16 + Random(32-16);π BA := 16 + Random(32-16);ππ RF := 2 + Random(5);π GF := 2 + Random(5);π BF := 2 + Random(5);ππ RS := Random(64);π GS := Random(64);π BS := Random(64);πππ For Counter := 0 to 255 doπ With PalOut[Counter] doπ Beginπ Red := 32 + Round(RA * Sin((RS + Counter * RF) * Pi / 128));π Green := 32 + Round(GA * Sin((GS + Counter * GF) * Pi / 128));π Blue := 32 + Round(BA * Sin((BS + Counter * BF) * Pi / 128));π End;πEnd;ππProcedure RotatePalette(Var PalIn : PaletteType);πVarπ TRGB : PaletteRec;πBeginπ TRGB := PalIn[0];π Move (PalIn[1], PalIn[0], 255 * 3);π PalIn[255] := TRGB;πEnd;ππVarπ Int : Integer;π Key : Char;πBeginπ DirectVideo := False;π Randomize;ππ InitVGA13h;ππ Screen := Ptr($A000,$0000);π New(PlasmaMap);ππ { Initialize Workspace }π FillChar(PlasmaMap^, 320 * 200 , 0);ππ { Calculate Smooth Random Colors }π CalculatePalette(PlasmaPal);ππ GotoXY(12, 12);π Writeln('Generating Plasma');π GotoXY(14, 14);π Writeln('Please Wait...');ππ GeneratePlasma(PlasmaMap);ππ { Set All Colors to Black }π BlackPalette;π { Copy Fractal To Screen }π Screen^ := PlasmaMap^;ππ { Rotate Palette And Fade It In Slowly }π For Int := 1 to 32 doπ Beginπ RotatePalette(PlasmaPal);π FadeInFromBlackQ(PlasmaPal, Int);π End;ππ { Rotate Full Intensity Palette And Wait For KeyPress }π Repeatπ RotatePalette(PlasmaPal);π SetPalette(PlasmaPal);π Until KeyPressed;ππ { Rotate Palette and Fade It Out Slowly }π For Int := 31 downto 0 doπ Beginπ RotatePalette(PlasmaPal);π FadeInFromBlackQ(PlasmaPal, Int);π End;ππ Dispose(PlasmaMap);ππ TextMode(C80);ππ { Flush Keyboard Buffer }π While KeyPressed doπ Key := ReadKey;πEnd.π 59 01-27-9412:18ALL SEAN PALMER Poly Drawing SWAG9402 30 ╓ (*π> It's not that slow. I can get about 60 good-sizedπ> poly's in a second on my dinky 386sx-20. It also doesπ> ^ ^ ^^ ^^ ^^^^^^^^^^^^^^^^^^^^^^^^π> I don't know what a good speed is for polyfills, but this sounds quiteπ> good! Thanks heaps (and stacks? :^) for the post!ππYou're welcome. I just now converted it to 99% assembler, 386+, just gottaπtest it out.ππ> One question to follow:ππ> { fillWord(mem[$A000:0],64000,0); {clear}π> ^^^ ^stick closer ("}") hereππ> You'll probably recognize the above as the main routine of the polygonπ> fill snippet (the tester part). Please note the part I under-caretedπ> (or -caretted). There is no closing comment before the next openingπ> comment. Should the closer be placed where indicated by me? Orπ> was the opener a typo?π> Not a big deal, but I want this to work so I can be impressed! :^)ππIt works like that, at least in TP/BP. The open comment in effect keeps theπcompiler from ever seeing the next open brace. So the second brace's closingπbrace actually closes the first one. A trick I learned since I started atπdeltaComm. No, I actually wanted that commented out, because clearing theπscreen between each one slows it down.ππActually, I noticed a strange behaviour in the fill, where if you have oneπvertex = (x,y) and the next vertex = (x+40,y+1) then you'll end up with a dotπon one line and the next line entirely filled. Not what was intended. I came upπwith a fix for it:ππIt basically just centers the stairstep zigzag by adding half a step before itπstarts.π*)ππfunction lSar(L:longint):longint;assembler;asmπ db $66; mov ax,L {mov eax,L}π db $66; sar ax,1 {sar eax,1}π db $66,$0F,$A4,$C2,$10 {shld edx,eax,16}π end;πππprocedure draw(color:byte);πvar i,l,r,lv,rv,top,bottom,topVert:integer; var lstep,lpos,rstep,rpos:fixed;πvar ldest,rdest:tPoint; beginπ {find top and bottom vertices}π topVert:=numVerts-1;π top:=vertex[topVert].y; bottom:=top;π for i:=numVerts-2 downto 0 doπ if (vertex[i].Y < top) then beginπ top:=vertex[i].Y;π topVert:=i;π endπ else if (vertex[i].Y > bottom) thenπ bottom:=vertex[i].Y;π if bottom>maxY then bottom:=maxY; {clip bottom}π if top>bottom then exit;π lv:=topVert; rv:=topVert;π ldest:=vertex[topVert]; rdest:=ldest;π i:=top;π repeatπ if i<bottom then beginππ{π^^^^^^^^^^^^^^^^^^^^^^^^^ keep from getting wierd effects from theπ adjustment on the last row.π}π if i>=ldest.y then beginπ lpos.f:=0; lpos.i:=ldest.x;π dec(lv); if lv<0 then lv:=numVerts-1;π ldest:=vertex[lv];π if ldest.y=i then beginπ if ldest.x<lpos.i then lpos.i:=ldest.x;π lstep.l:=0;π endπ else beginπ lstep.l:=fixedDiv(ldest.x-lpos.i,ldest.y-i);π inc(lpos.l,lSar(lstep.l));ππ ^^^^^^^^^^^^^^^^^^^^^^^^^^ Center the stairstep patternππ end;π end;π if i>=rdest.y then beginπ rpos.f:=0; rpos.i:=rdest.x;π inc(rv); if rv>=numVerts then rv:=0;π rdest:=vertex[rv];π if rdest.y=i then beginπ if rdest.x>rpos.i then rpos.i:=rdest.x;π rstep.l:=0;π endπ else beginπ rstep.l:=fixedDiv(rdest.x-rpos.i,rdest.y-i);π inc(rpos.l,lSar(rStep.l));ππ ^^^^^^^^^^^^^^^^^^^^^^^^^^ Center the stairstep patternππ end;π end;π end;π if i>=minY then begin {clip top}π if lpos.i>minX then l:=lpos.i else l:=minX; {clip left}π if rpos.i<maxX then r:=rpos.i else r:=maxX; {clip right}π if (l<=r) thenπ fillWord(mem[$A000:i*320+l],r-l+1,color);π end;π inc(lpos.l,lstep.l);π inc(rpos.l,rstep.l);π inc(i);π until i>bottom;π end;π 60 01-27-9412:20ALL KAI ROHRBACHER COD Images SWAG9402 16 ╓ {π> This doesn't have anything to do with the flicker problem, but I wasπ> wondering if you could tell me how to scale and rotate .COD images.ππAlthough I posted some code to flip COD's horizontally & verticallyπsome time ago, I won't make it a regular feature of AniVGA, as I'mπworking on compiled bitmaps and thus, altering the "data" after havingπit compiled into a procedure is close to impossible...πHowever, if you are speaking about scaling & rotation in MAKES: yes,πone could include it. To be honest, I was just to lazy to code allπthat matrix crap necessary.πFor the interested reader: to scale the points (x,y) of a matrix byπsome factor f, you just have to apply the matrixπ(f 0)π(0 f)πto all its points.πA rotation by an angle of z degrees counterclockwise about theπrotation center (u,v) is more complex: one first has to transform theπpoint coordinates to homogeneous coordinates (that is: append a one asπthe 3rd component: (x,y) -> (x,y,1); if during computations this 3rdπcomponent "c" of a vector (a,b,c) becomes <>1, then renormalize theπvector to (a/c,b/c,1)).πHaving done so, the rotation consists of three steps:πa) make (u,v) the new origin of your pixels (instead of (0,0))πb) rotate the data by z degrees about the new origin (0,0)πc) retransform the true (0,0) originππStep a) consists of applying the following matrix M1 to the pixelsπ(x,y,1):π( 1 0 0)π( 0 1 0)π(-u -v 1)ππLikewise, step b) is done by the matrix M2:π( cos(z) sin(z) 0 )π(-sin(z) cos(z) 0 )π( 0 0 1 )ππAnd step c) is done by M3:π( 1 0 0)π( 0 1 0)π(+u +v 1)ππThese three steps can be squeezed into one matrix application byπcombining the three matrices into one matrix M=M1*M2*M3 (with "*" =πmatrix multiplication operator from linear algebra).ππ 61 01-27-9412:21ALL BAS VAN GAALEN Shade Bobs SWAG9402 26 ╓ {π>> 1. Scrolling 256c fonts Fast and Smooth.π>> 2. Now to do it on top of graphics...π>> 3. 3D object engine - If someone can post me one or direct meπ>> to build one.π>> 4. Shade Bobs/Whatever it called - Taking a shape and moving itπ>> across the screen when it leaves trail. Then, moving againπ>> on the trail will couse a stronger color to appear. n' on...π>> 5. Moving floor that is NOT a couse of a palette rotetion.π>> 6. 2D Scale procedure.π>> 7. Centered Stars. And SMOOTH ones.π>> 8. Vector BallsππI don't want to give it all away, but I just made some Shaded-bobs (orπwhatever). It realy isn't difficult. It worked right away. Now YOU make a nicerπsin-curve and palette. Here's some source:π}ππ{$G+}ππprogram ShadingBobs;πconstπ Gseg : word = $a000;π Sofs = 75; Samp = 75; Slen = 255;π SprPic : array[0..15,0..15] of byte = (π (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0),π (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),π (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),π (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),π (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),π (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),π (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),π (1,1,1,1,2,2,3,4,4,3,2,2,1,1,1,1),π (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),π (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),π (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),π (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),π (0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0),π (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),π (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),π (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0));πtype SinArray = array[0..Slen] of word;πvar Stab : SinArray;ππprocedure CalcSinus; var I : word; beginπ for I := 0 to Slen do Stab[I] := round(sin(I*4*pi/Slen)*Samp)+Sofs; end;ππprocedure SetGraphics(Mode : word); assembler; asmπ mov ax,Mode; int 10h end;ππfunction keypressed : boolean; assembler; asmπ mov ah,0bh; int 21h; and al,0feh; end;ππprocedure DrawSprite(X,Y : integer; W,H : byte; Sprite : pointer); assembler;πasmπ push dsπ lds si,[Sprite]π mov es,Gsegπ cldπ mov ax,[Y]π shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,[X]π mov bh,[H]π mov cx,320π sub cl,[W]π sbb ch,0π @L:π mov bl,[W]π @L2:π lodsbπ or al,alπ jz @Sπ mov dl,[es:di]π add dl,alπ mov [es:di],dlπ @S:π inc diπ dec blπ jnz @L2π add di,cxπ dec bhπ jnz @Lπ pop dsπend;ππprocedure Retrace; assembler; asmπ mov dx,3dah;π @l1: in al,dx; test al,8; jnz @l1;π @l2: in al,dx; test al,8; jz @l2; end;ππprocedure Setpalette;πvar I : byte;πbeginπ for I := 0 to 255 do beginπ port[$3c8] := I;π port[$3c9] := I div 3;π port[$3c9] := I div 2;π port[$3c9] := I;π end;πend;ππprocedure Bobs;πvar X,Y : integer; I,J : byte;πbeginπ I := 0; J := 25;π repeatπ X := 2*Stab[I]; Y := Stab[J];π inc(I); inc(J);π Retrace;π DrawSprite(X,Y,16,16,addr(SprPic));π until keypressed;πend;ππbeginπ CalcSinus;π SetGraphics($13);π{ SetPalette;}π Bobs;π SetGraphics(3);πend.ππ{ DrawSprite procedure taken from Sean Palmer (again).π It contained some minor bugs: [X] was added to AX, should be DI, andπ jz @S was jnz @S, so the sprite wasn't drawn. Now it is...π And of course it was changed to INCREASE the video-mem, not to poke it.ππ If you get rid of the Retrace it goes a LOT faster. }ππ 62 01-27-9412:22ALL SEAN PALMER Sprite Talk SWAG9402 22 ╓ {π>Try converting it to use pointers instead of accessing the array withπ>indexes, and use a pointer to video memory for direct plotsπ>instead of using the putPixel routine. Also it's quicker toπ>check against 0 for the background than to check againstπ>255.ππ> I found a copy of "The Visible Computer: 8088" in my bookshelves andπ> tried rewriting my assembly routines. Here's what I finally got:ππ> procedure MaskPut(x,y: word; p: pointer); assembler;π> varπ> XX,YY: byte;π> asmπ> LES SI,pπ> MOV [XX],0π> MOV [YY],0π> MOV CX,256π> XOR DX,DXπ> CLDπ> @Loopit:SEGES LODSBπ> MOV DL,ALπ> PUSH ESπ> PUSH SIπ> CMP DL,255π> JZ @Doneπ> MOV AX,0A000hπ> MOV ES,AXπ> MOV AX,320π> MOV BX,[Y]π> ADD BL,[YY]π> PUSH DXπ> MUL BXπ> POP DXπ> MOV BX,[X]π> ADD BL,[XX]π> ADD AX,BXπ> MOV SI,AXπ> MOV ES:[SI],DLπ> @Done: INC [XX]π> CMP [XX],16π> JNZ @Okayπ> MOV [XX],0π> INC [YY]π> @Okay: POP SIπ> POP ESπ> LOOP @Loopitπ> end;ππ> It works fine. I didn't notice much of a difference in speed though.π> I tested it and I can plot about 1103 sprites/second in ASM and 828π> sprites/sec. with my original TP code. Please keep in mind I'm notπ> much of an assembly programmer. Can anyone help me optimize this codeπ> (into 286 would be good too). Thanx for your help!ππI'll try. I notice you're using memory variables for loop counters in thatπcode. Also seem to be reloading the segment registers each time through theπloop, and general sundry pushes, pops, and such which are unnecesary. I don'tπhave time to rewrite your code from scratch today but I'll post my transparentπbitmap routine for Mode 13 for you to use/learn from. K?ππthis is untested, I was fixing it up after I found it my optimization getsπbetter over time, and it's been a while since I've worked on this Mode 13hπstuff.π}ππ{$G+}ππprocedure drawSprite(x, y : integer; w, h : byte; sprite : pointer); assembler;πasmπ push dsπ lds si,[sprite]π mov ax,$A000π mov es,axπ cldπ mov ax,[y] {y * 320}π shl ax,6π mov di,axπ shl ax,2π add di,axπ add ax,[x] {+ x}π mov bh,[h]π mov cx,320 {dif between rows}π sub cl,[w]π sbb ch,0π@L:π mov bl,[w]π@L2:π lodsbπ or al,al {test for 0. For 255 you'd use inc al here instead}π {heck dx and ah are free, you could store theπ comparison value in one of those}π jnz @Sπ {for 255 you'd also need a dec al here}π mov [es:di],alπ@S:π inc diπ dec blπ jnz @L2π add di,cxπ dec bhπ jnz @Lπ pop dsπ end;ππ{πAnd I'll bet you notice a difference in speed with this puppy. 8)ππIf you could guarantee that the width would be an even number you couldπoptimize it to use word moves, otherwise it wouldn't be worth it.π}π 63 01-27-9412:22ALL HARALDS JAKOVELS Sprite Info SWAG9402 24 ╓ {π> Another problem is plotting sprites with "invisible" pixels. In otherπ> words, all pixels in the sprite are plotted except for ones with a colorπ> of 255 (I think I've heard that Origin used this method in Ultima 6).π> Because of my unsuccessful try with asm earlier, I didn't even bother toπ> try this in asm. Unfortunately, the following is MUCH too slow:ππtry this!π}πuses crt;πtype SpriteType = array[0..15,0..15] of byte;ππvar sprite : spritetype;π f : file of spritetype; {sprite's image is stored in file}π x, y : word;ππprocedure putinvspriteinasm(x, y : word; sprite : spritetype);πvar p : pointer;π segm, offs : word;π {these are used to calculate destination addressπ in video memory}ππbeginπ p := addr(sprite[0,0]);π {this pointer is used only to cheat tp. tp doesn't allow to use addr orπ @ operators in inline asm - or i don't know how to do it}π segm := $a000 + (320 * y) div 16;π offs := x;π {segm:offs is address of upper left corner of sprite in video RAM}π asmπ push dsπ {ds is one of the important registers in tp and must be saved}π lds si, pπ {ds:si now is source address for sprite's array}π mov es, segmπ mov di, offsπ {es:di now is target address in VRAM}π mov bh, 16π {counter for outer loop}π@loop2: mov bl, 16π@loop1: mov al, [ds:si]π {innner loop (marked with label @loop1) is used to draw each line ofπ sprite}π cmp al, $ffπ {make sure if pixel is $ff or not}π je @skipπ {it is - so we don't draw it}π mov [es:di], alπ {no, it's not - draw!}π@skip: inc siπ inc diπ dec blπ jnz @loop1π {we haven't finished to draw this line if bl > 0}π dec bhπ {we haven't finished to draw all image if bh > 0}π jz @endπ add di, 320 - 16π {calculate beginning of next line}π jmp @loop2π@end:π pop dsππ endπend;ππbeginπ asm mov ax, 0013hπ int 10hπ end;π assign(f, 'sprite');π reset(f);π read(f, sprite);π close(f);π randomize;π repeatπ x := random(320);π y := random(200);π putinvspriteinasm(x, y, sprite);π until keypressed;πend.π{πi added into code some quick'n'dirty comments to let you understandπhow assembly works. i've tested this code and found that it won't work withπMicrosoft's workgrp.sys driver - the programm simply crashes when you press aπkey. (workgrp.sys driver is one of the Windows for Workgroups drivers).πstrange... with all other things (qemm386, lan drivers etc.) programm seems toπwork fine. one more thing i must add that better is to pass to procedureπputsprite not array with sprite's data but only pointer to it - because tpπmoves all this data around memory - and in this case it's 256 bytes.π}π 64 01-27-9412:23ALL VARIOUS - SEE BELOW Textures SWAG9402 51 ╓ π{πANDREW FORTπ> That's fast, but that's just one bitmap. I really need to sit down andπ> optimize my texture mapper...ππ> You have to use 386 instructions cuz 32-bit division is way too slowπ> otherwise. I'd have to see the code to tell if it's efficient or not. It'sπ> a simple algorithm, just figuring out where in the bitmap to start andπ> what the step value is for each scan line is the hard part. Then just doπ> 320 pixels real quick... don't worry, cuz with 256x256 bitmaps, everythingπ> just works itself out real nice.ππyes i realize it works out real nice with 256x256 bitmaps, because you canπshift/carry or whatever to get the particular point in the bitmap you wantπeasily.ππyes it uses 32 bit instructions, but since it's so short, it's not a problemπcoding it in BASM.. and here it is:ππ** this code was written by The Faker of Aardvark **π}ππPROCEDURE PutTexture(IncX, IncY : Integer; P : Pointer);πVARπ Y, PosX,π PosY,π PX, PY : Integer;πBEGINπ PosX := -(ScreenX SHR 1) * IncX; { ScreenX,-Y are size of screen }π PosY := -(ScreenY SHR 1) * IncY; { PosX,y set so rotation is around }π FOR Y := 0 TO ScreenY-1 DO { the middle (of 'p') }π BEGINπ PX := PosX; { PosX,-Y is updated every line, PX,-y derived }π PY := PosY;π ASMπ push dsπ mov ax, 0a000hπ mov es, axπ mov ax, yπ xchg al, ahπ mov di, axπ shr di, 2π add di, axπ lds si, p { in P there should be a 256x256 bitmap }π mov cx, screenx shr 1π cldπ mov ax, incxπ shl eax, 16π mov ax, incyπ mov esi, eaxπ mov dx, pxπ shl edx, 16π mov dx, pyπ @1:π add edx, esiπ mov ebx, edxπ shr ebx, 16π mov bl, dhπ mov al, [bx]π add edx, esiπ mov ebx, edxπ shr ebx, 16π mov bl, dhπ mov ah, [bx]π stoswπ dec cxπ jnz @1π pop dsπ END;π Inc(PosX, IncY);π Inc(PosY, -IncX);π END;πEND;ππ{πas you can see, very methodical coding, but it's quite fast, and does theπjob....ππ>> It was coded before 2nd reality was released, but didn't get releasedπ>> till after because of distribution problems..ππ> Second Reality was ok, but they coulda done better. I did like theπ> bubbling landscape demo (voxel stuff)ππtry, although i was disappointed that they didn't really do much new (thoseπblue bolls were nice though, although they flickered quite alot.. but hey! i'mπhardly paying for the demo, am i!)ππbut yeah, the voxel stuff was nice.. after reciving email from Lord Logics (ofπAvalanche), he says that he's been working on some voxel stuff, although heπdidn't get it finished because of getting a job, although he intends to finishπit and release it in a demo for avalanche.. so that'd be nice to see..ππtell me if the code is efficent or not! :-)π}ππ(*πSEAN PALMERππ> yes i realize it works out real nice with 256x256 bitmaps, because youπ> can shift/carry or whatever to get the particular point in theπ> bitmap you want easily.ππNo, you don't have to do diddly squat to extract it. Just move the byte out.πSince one's in the hi byte of a 32-bit register though, it's harder to extract.ππ> yes it uses 32 bit instructions, but since it's so short, it's not aπ> problem coding it in BASM.. and here it is:ππOf course you know that BP 7.0 won't do 386 instructions. So this wouldn'tπcompile as is. Needs a lot of DB $66's, etc.ππ> ** this code was written by The Faker of Aardvark **ππHi Faker! Sorry to botch your code below. 8)ππ> PROCEDURE PutTexture(IncX,IncY:Integer; P:Pointer);π> VARπ> Y,PosX,PosY,PX,PY:Integer;π> BEGINπ> PosX:=-(ScreenX SHR 1)*IncX; { ScreenX,-Y are size of screen}π> PosY:=-(ScreenY SHR 1)*IncY; { PosX,y set so rotation is around}π> FOR Y:=0 TO ScreenY-1 DO { the middle (of 'p')}π> BEGINπ> PX:=PosX; { PosX,-Y is updated every line, PX,-y derived}π> PY:=PosY;π> ASMπ> push dsπ> mov ax,0a000hπ> mov es,axπ> mov ax,yπ shl ax,8 {this is same speed, but cleaner}π> mov di,ax {lessee... ends up y*320. Faster than MUL. But should}π> shr di,2 {be incrementally calculated instead.}π> add di,axπ> lds si,p { in P there should be a 256x256 bitmap }π> mov cx,screenx shr 1π> cldπ {cleaned out the intermediate use of eax}π mov si,incxπ shl esi,16π mov si,incyπ> mov dx,pxπ> shl edx,16π> mov dx,pyπ> @1: add edx,esiπ shld ebx,edx,16 {do move and shift all at once. Save 2 cycles}π> mov bl,dhπ> mov al,[bx]π> add edx,esiπ shld ebx,edx,16 {ditto. I like this unrolled loop! 8) }π> mov bl,dhπ> mov ah,[bx]π> stosw {word access. Sweet.}π> dec cx {better than LOOP on a 386+}π> jnz @1π> pop dsπ> END;π> Inc(PosX,IncY);π Dec(PosY,IncX); {avoid neg operation}π> END;π> END;ππ> as you can see, very methodical coding, but it's quite fast, and doesπ> the job....ππYep. I haven't coded it up where it'll compile and run it yet, but Should BeπPretty Darn Quick. Seems like it's gonna have a problem with the carry from dxπto the hi word of edx (your position will be off, barely, every time itπwraps.... shouldn't matter much)ππ> but yeah, the voxel stuff was nice.. after reciving email from Lordπ> Logics (of Avalanche), he says that he's been working on someπ> voxel stuff, although he didn't get it finished because ofπ> getting a job, although he intends to finish it and release itπ> in a demo for avalanche.. so that'd be nice to see..ππI'm gonna have to code something like that up for a BattleTech type game. Bestπidea I've seen so far for terrain... If you see any code to get me started,πplease route it my way.ππ> tell me if the code is efficent or not! :-)ππOnly one optimization I can spot right now (aside from coding the outer loop inπASM as well...) Is that he has to shift the 32-bit registers around to get atπthe upper word. (the 386 needs more data registers!!!!!! ARE YOU LISTENINGπINTEL!!!) So using the SHLD instruction like I re-coded above should speed itπup some. Avoid the intermediate register move.ππI've commented above. You could put alot of the setup stuff outside the loop ifπyou wrote it all in BASM. Wouldn't have to push/pop for each scan line, etc.πBut that's a minor speedup.ππIn the future, try to gain access to the FIDO 80XXX echo. It's a much betterπplace to talk about (mostly) assembly stuff.ππ*) 65 01-27-9412:25ALL WILLIAM PLANKE PCX Writing SWAG9402 99 ╓ {πAs I follow this forum, many requests are made for PCX graphicsπfile routines. Those that are looking for Read_PCX info canπfind it on the ZSoft BBS in a wonderful Pascal example: ShowPCX.ππOn the other hand, there is next to zilch out there on how toπWrite_PCX files. I know.... I searched and searched and couldn'tπfind a thing! So with a little brute force and a few ZSoftπC language snippets <groan>, I got this together:ππPCX_W.Write_PCX (Name:Str80);πgiven to the public domain and commonweal.πpseudocode:π set 640x480x16 VGAhi graphics mode only for nowπ getimage 1 row at a timeπ reorganize the BGI color planes into PCX format orderπ encode the raw PCX line into a run length limitedπ compressed PCX lineπ blockwrite the compressed PCX line to your.PCX fileπ}ππ{$R-} {Range checking, turn off when debugged}ππunit PCX_W;ππ{ --------------------- Interface ----------------- }ππinterfaceππtypeπ Str80 = string [80];ππprocedure Write_PCX (Name:Str80);πππ{ ===================== Implementation ============ }ππimplementationππusesπ Graph;πππ{-------------- Write_PCX --------------}ππprocedure Write_PCX (Name:Str80);ππconstπ RED1 = 0;π GREEN1 = 1;π BLUE1 = 2;ππtypeπ ArrayPal = array [0..15, RED1..BLUE1] of byte;ππconstπ MAX_WIDTH = 4000; { arbitrary - maximum width (in bytes) ofπ a PCX image }π INTENSTART = $5;π BLUESTART = $55;π GREENSTART = $A5;π REDSTART = $F5;ππtypeπ Pcx_Header = recordπ {comments from ZSoft ShowPCX pascal example}ππ Manufacturer: byte; { Always 10 for PCX file }ππ Version: byte; { 2 - old PCX - no palette (not usedπ anymore),π 3 - no palette,π 4 - Microsoft Windows - no paletteπ (only in old files, new Windowsπ version uses 3),π 5 - with palette }ππ Encoding: byte; { 1 is PCX, it is possible that we mayπ add additional encoding methods in theπ future }ππ Bits_per_pixel: byte; { Number of bits to represent a pixelπ (per plane) - 1, 2, 4, or 8 }ππ Xmin: integer; { Image window dimensions (inclusive) }π Ymin: integer; { Xmin, Ymin are usually zero (not always)}π Xmax: integer;π Ymax: integer;ππ Hdpi: integer; { Resolution of image (dots per inch) }π Vdpi: integer; { Set to scanner resolution - 300 isπ default }ππ ColorMap: ArrayPal;π { RGB palette data (16 colors or less)π 256 color palette is appended to endπ of file }ππ Reserved: byte; { (used to contain video mode)π now it is ignored - just set to zero }ππ Nplanes: byte; { Number of planes }ππ Bytes_per_line_per_plane: integer; { Number of bytes toπ allocate for a scanlineπ plane. MUST be an an EVENπ number! Do NOT calculateπ from Xmax-Xmin! }ππ PaletteInfo: integer; { 1 = black & white or color image,π 2 = grayscale image - ignored in PB4,π PB4+ palette must also be set toπ shades of gray! }ππ HscreenSize: integer; { added for PC Paintbrush IV Plusπ ver 1.0, }π VscreenSize: integer; { PC Paintbrush IV ver 1.02 (and later)}π { I know it is tempting to use theseπ fields to determine what video modeπ should be used to display the imageπ - but it is NOT recommended since theπ fields will probably just containπ garbage. It is better to have theπ user install for the graphics mode heπ wants to use... }ππ Filler: array [74..127] of byte; { Just set to zeros }π end;ππ Array80 = array [1..80] of byte;π ArrayLnImg = array [1..326] of byte; { 6 extra bytes atπ beginng of line that BGI uses for size info}π Line_Array = array [0..MAX_WIDTH] of byte;π ArrayLnPCX = array [1..4] of Array80;ππvarπ PCXName : File;π Header : Pcx_Header; { PCX file header }π ImgLn : ArrayLnImg;π PCXLn : ArrayLnPCX;π RedLn,π BlueLn,π GreenLn,π IntenLn : Array80;π Img : pointer;πππ{-------------- BuildHeader- -----------}ππprocedure BuildHeader;ππconstπ PALETTEMAP: ArrayPal=π { R G B }π (($00, $00, $00), { black }π ($00, $00, $AA), { blue }π ($00, $AA, $00), { green }π ($00, $AA, $AA), { cyan }π ($AA, $00, $00), { red }π ($AA, $00, $AA), { magenta }π ($AA, $55, $00), { brown }π ($AA, $AA, $AA), { lightgray }π ($55, $55, $55), { darkgray }π ($55, $55, $FF), { lightblue }π ($55, $FF, $55), { lightgreen }π ($55, $FF, $FF), { lightcyan }π ($FF, $55, $55), { lightred }π ($FF, $55, $FF), { lightmagenta }π ($FF, $FF, $55), { yellow }π ($FF, $FF, $FF) );{ white }ππvarπ i : word;ππbeginπ with Header doπ beginπ Manufacturer := 10;π Version := 5;π Encoding := 1;π Bits_per_pixel := 1;π Xmin := 0;π Ymin := 0;π Xmax := 639;π Ymax := 479;π Hdpi := 640;π Vdpi := 480;π ColorMap := PALETTEMAP;π Reserved := 0;π Nplanes := 4; { Red, Green, Blue, Intensity }π Bytes_per_line_per_plane := 80;π PaletteInfo := 1;π HscreenSize := 0;π VscreenSize := 0;π for i := 74 to 127 doπ Filler [i] := 0;π end;πend;πππ{-------------- GetBGIPlane ------------}ππprocedure GetBGIPlane (Start:word; var Plane:Array80);ππvarπ i : word;ππbeginπ for i:= 1 to Header.Bytes_per_line_per_plane doπ Plane [i] := ImgLn [Start +i -1]πend;ππ{-------------- BuildPCXPlane ----------}ππprocedure BuildPCXPlane (Start:word; Plane:Array80);ππvarπ i : word;ππbeginπ for i := 1 to Header.Bytes_per_line_per_plane doπ PCXLn [Start] [i] := Plane [i];πend;πππ{-------------- EncPCXLine -------------}ππprocedure EncPCXLine (PlaneLine : word); { Encode a PCX line }ππvarπ This,π Last,π RunCount : byte;π i,π j : word;πππ {-------------- EncPut -----------------}ππ procedure EncPut (Byt, Cnt :byte);ππ constπ COMPRESS_NUM = $C0; { this is the upper two bits thatπ indicate a count }ππ varπ Holder : byte;ππ beginπ {$I-}π if (Cnt = 1) and (COMPRESS_NUM <> (COMPRESS_NUM and Byt)) thenπ blockwrite (PCXName, Byt,1) { single occurance }π {good place for file error handler!}π elseπ beginπ Holder := (COMPRESS_NUM or Cnt);π blockwrite (PCXName, Holder, 1); { number of times theπ following colorπ occurs }π blockwrite (PCXName, Byt, 1);π end;π {$I+}π end;πππbeginπ i := 1; { used in PCXLn }π RunCount := 1;π Last := PCXLn [PlaneLine][i];π for j := 1 to Header.Bytes_per_line_per_plane -1 doπ beginπ inc (i);π This := PCXLn [PlaneLine][i];π if This = Last thenπ beginπ inc (RunCount);π if RunCount = 63 then { reached PCX run lengthπ limited max yet? }π beginπ EncPut (Last, RunCount);π RunCount := 0;π end;π endπ elseπ beginπ if RunCount >= 1 thenπ Encput (Last, RunCount);π Last := This;π RunCount := 1;π end;π end;π if RunCount >= 1 then { any left over ? }π Encput (Last, RunCount);πend;ππ { - - -W-R-I-T-E-_-P-C-X- - - - - - - - }ππconstπ XMAX = 639;π YMAX = 479;ππvarπ i, j, Size : word;ππbeginπ BuildHeader;π assign (PCXName,Name);π{$I-}π rewrite (PCXName,1);π blockwrite (PCXName,Header,sizeof (Header));π {good place for file error handler!}π{$I+}π setviewport (0,0,XMAX,YMAX, ClipOn);π Size := imagesize (0,0,XMAX,0); { size of a single row }π getmem (Img,Size);ππ for i := 0 to YMAX doπ beginπ getimage (0,i,XMAX,i,Img^); { Grab 1 line from theπ screen store in Imgπ buffer }π move (Img^,ImgLn,Size {326});ππ GetBGIPlane (INTENSTART, IntenLn);π GetBGIPlane (BLUESTART, BlueLn );π GetBGIPlane (GREENSTART, GreenLn);π GetBGIPlane (REDSTART, RedLn );π BuildPCXPlane (1, RedLn );π BuildPCXPlane (2, GreenLn);π BuildPCXPlane (3, BlueLn );π BuildPCXPlane (4, IntenLn); { 320 bytes/lineπ uncompressed }π for j := 1 to Header.NPlanes doππ EncPCXLine (j);π end;π freemem (Img,Size); (* Release the memory *)π{$I-}π close (PCXName); (* Save the Image *)π{$I+}πend;ππend {PCX.TPU} .πππ{ -----------------------Test Program -------------------------- }ππprogram WritePCX;ππusesπ Graph, PCX_W;ππ{-------------- DrawHorizBars ----------}ππprocedure DrawHorizBars;ππvarπ i, Color : word;ππbeginπ cleardevice;π Color := 15;π for i := 0 to 15 doπ beginπ setfillstyle (solidfill,Color);π bar (0,i*30,639,i*30+30); { 16*30 = 480 }π dec (Color);π end;πend;ππ{-------------- Main -------------------}ππvarπ NameW : Str80;π Gd,π Gm : integer;ππbeginπ writeln;π if (ParamCount = 0) then { no DOS command lineπ parameters }π beginπ write ('Enter name of PCX picture file to write: ');π readln (NameW);π writeln;π endπ elseπ beginπ NameW := paramstr (1); { get filename from DOSπ command line }π end;ππ if (Pos ('.', NameW) = 0) then { make sure the filenameπ has PCX extension }π NameW := Concat (NameW, '.pcx');ππ Gd:=VGA;π Gm:=VGAhi; {640x480, 16 colors}π initgraph (Gd,Gm,'..\bgi'); { path to your EGAVGA.BGI }ππ DrawHorizBars;ππ readln;π Write_PCX (NameW); { PCX_W.TPU }π closegraph; { Close graphics }π textmode (co80); { back to text mode }πend. { Write_PCX }ππ{πOK, everybody, I hope this gets you started. I had a lot ofπfun setting it up. There are some obvious places that needπoptimization... especially the disk intensive blockwrites. Ifπsomeone could please figure out holding about 4k or so in pointersπof the encoded PCX file before writing, I'd sure appreciate it!.π(please post for everyone, if you do.)ππ} 66 01-27-9413:32ALL GREG ESTABROOKS Mode 13 Demo SWAG9402 12 ╓ PROGRAM Mode13Demo; { Oct 10/93, Greg Estabrooks. }πVARπ CurCol,π OldMode:BYTE;π CurPos,π X,Y :WORD;π ScrBuff :ARRAY[1..64000] OF 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;ππBEGINπ SetVidMode($13); { Set Mode to 320x200x256. }π FOR Y := 0 To 199 DO { Loop through all lines. }π FOR X := 0 To 319 DO { Loop through all columns. }π PutPixel(X,Y,Random(255));π CurCol := 0;π CurPos := 0;π FOR Y := 0 To 199 DO { Loop through all lines. }π BEGINπ Inc(CurCol);π FOR X := 0 To 319 DO { Loop through all columns. }π BEGINπ Inc(CurPos);π ScrBuff[CurPos] := CurCol;π END;π END;π Writeln('Press Enter to see the Faster way!');π Readln;π Move(ScrBuff,Mem[$A000:0],SizeOf(ScrBuff));π Readln;π SetVidMode(3); { Set Mode 3,80x25. }πEND.π 67 01-27-9413:32ALL GREG ESTABROOKS Misc Graphic Functions SWAG9402 46 ╓ UNIT GrStuff; { Misc Graphic Functions, Last Updated Nov 11/93 }π { Copyright (C), Greg Estabrooks, 1993 }ππINTERFACEπ(***********************************************************************)ππFUNCTION MonitorType :BYTE; { Determines Monitor In Use }πPROCEDURE SetVidMode( Mode :BYTE ); { Set video mode }πPROCEDURE SetPage( Page :BYTE ); { Set current screen page }πPROCEDURE BiosPutPix( Col,Page :BYTE;X,Y :WORD ); { Plot pixel at X,Y }πFUNCTION TSeng :BOOLEAN; { Determine if graph card a TSENG labs }πFUNCTION GetVideoMode :BYTE;π { Routine to determine current video mode }πPROCEDURE Set80x30Mode;πPROCEDURE DrawBar( X1,Y1,X2,Y2 :WORD; Color :BYTE );πPROCEDURE SetColor( Color2Set, Red, Green, Blue :BYTE );πPROCEDURE GetColor( Color2Get :BYTE; VAR Red,Green,Blue :BYTE );ππIMPLEMENTATIONπ(***********************************************************************)πFUNCTION MonitorType :BYTE; ASSEMBLER;π { Determines Type of Monitor In Use. }πASMπ Mov AH,$1A { Function Determine Display Code }π Mov AL,0 { AL,0 = Read Code AL,1 = Set Code }π Int $10 { Call Dos }π Mov AL,BL; { Move result to proper register }π { 0 - no Display 4 - Ega Standard Color 7 - VGA MONO }π { 1 - MDA 5 - Ega MonoChrome 8 - VGA }π { 2 - CGA 6 - PGA }πEND;{MonitorType}ππ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 SetPage( Page :BYTE ); ASSEMBLER;π { Routine to change screen pages }πASMπ Mov AH,$05 { Function to change pages }π Mov AL,Page { Page to change to }π Int $10 { Call dos }πEND;{SetPage}ππPROCEDURE BiosPutPix( Col,Page :BYTE; X,Y :WORD ); ASSEMBLER;π { Routine to plot a pixel on the screen using INT 10h. }πASMπ Mov AH,$0C { Function to plot a pixel }π Mov AL,Col { Color to make it }π Mov BH,Page; { Page to write it to }π Mov CX,X { Column to put it at }π Mov DX,Y { Row to place it }π Int $10 { call dos }πEND;{BiosPutPix}ππFUNCTION TSeng :BOOLEAN;π { Routine to determine if Graphics card is a TSENG labs}πVARπ Old,New :BYTE;πBEGINπ Old := Port[$3CD]; { Save original card register value }π Port[$3CD] := $55; { change it }π New := Port[$3CD]; { read in new value }π Port[$3CD] := Old; { restore old value }π TSENG := ( New = $55 ); { if value same as what we sent (TRUE) }πEND;ππFUNCTION GetVideoMode :BYTE; ASSEMBLER;π { Routine to determine current video mode }πASMπ Mov AX,$0F00 { SubFunction Return Video Info }π Int $10 { Call Dos }πEND;{GetVideoMode}ππ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}ππPROCEDURE DrawBar( X1,Y1,X2,Y2 :WORD; Color :BYTE );π { Bar drawing routine. Specifically set up for mode }π { 13h. Much faster than the BGI one. }πVARπ Row :WORD;πBEGINπ FOR Row := Y1 TO Y2 DOπ FillChar(MEM[$A000:(320*Row)+X1],X2-X1,Color);πEND;πππPROCEDURE SetColor( Color2Set, Red, Green, Blue :BYTE );π { Routine to Change the palette value of Color2Set. }πBEGINπ PORT[$3C8] := Color2Set;π PORT[$3C9] := Red;π PORT[$3C9] := Green;π PORT[$3C9] := Blue;πEND;ππPROCEDURE GetColor( Color2Get :BYTE; VAR Red,Green,Blue :BYTE );π { Routine to determine the Palette value of Color2Get}πBEGINπ PORT[$3C8] := Color2Get;π Red := PORT[$3C9];π Green := PORT[$3C9];π Blue := PORT[$3C9];πEND;ππBEGINπEND.π 68 01-27-9417:32ALL PETER KOLDING 3D Graphics Box SWAG9402 52 ╓ {πFrom: PETER KOLDINGπSubj: 3D GraphicsππMB> Hello, I'm trying to write a simple program that will plot points in threeπMB> dimensions and allow you to rotate them,or view them from differentπangles.πMB> need a lot of help. I'm trying to make a data file of points in the formatπMB> (x,y,z) and then have the program read the points in to display. So far noπMB> luck. If anyone has any code that is simple enough for me to understand IπMB> would appreciate it. Also if anyone has any code for doing fast vgaπMB> animations(in assembly) could they please post it? Thanks in advance.π}ππprogram boxrot;ππ{PUBLIC DOMAIN 1993 Peter M. Gruhn}ππ{Program draws a box on screen. Allows user to rotate the box aroundπ the three primary axes. Viewing transform is simple ignore z.}ππ{I used _Computer_Graphics:_Principles_and_Practice_, Foley et alπ ISBN 0-201-12110-7 as a reference}ππ{RUNNING:π Borland Pascal 7. Should run on any graphics device supported by BGI.π If you have smaller than 280 resolution, change '+200' to somethingπ smaller and/or change 75 to something smaller.ππ Since this machine isπ not really set up for doing DOS graphics, I hard coded my BGI path, soπ you have to find 'initgraph' and change the bgi path to something thatπ works on your machine. Try ''.πππ{Okey dokey. This is kinda slow, and does a nice job of demonstrating theπ problems of repeatedly modifying the same data set. That is, the more andπ more you rotate the box, the more and more distorted it gets. This isπ because computers are not perfect at calculations, and all of those littleπ errors add up quite quickly.ππ It's because of that that I used reals, not reals. I used floating pointπ because the guy doesn't know what is going on at all with 3d, so better toπ look at only the math that is really happening. Besides, I still have toπ think to use fixed point. Whaddaya want for .5 hour programming.ππ DIRECTIONS:π ',' - rotates around the x axisπ '.' - rotates around the y axisπ '/' - rotates around the z axisπ 'q' - quitsππ All rotations are done around global axes, not object axes.}ππuses graph,crt;ππconst radtheta=1{degrees}*3.1415926535{radians}/180{per degrees};π {sin and cos on computers are done in radians.}ππtype tpointr=record {Just a record to hold 3d points}π x,y,z:real;π end;ππvar box:array[0..7] of tpointr; {The box we will manipulate}π c:char; {Our input mechanism}ππprocedure init;πvar gd,gm:integer;π{turns on graphics and creates a cube. Since the rotation routinesπ rotate around the origin, I have centered the cube on the origin, soπ that it stays in place and only spins.} beginπ gd:=detect; initgraph(gd,gm,'d:\turbo\tp\');π box[0].x:=-75; box[0].y:=-75; box[0].z:=-75;π box[1].x:=75; box[1].y:=-75; box[1].z:=-75;π box[2].x:=75; box[2].y:=75; box[2].z:=-75;π box[3].x:=-75; box[3].y:=75; box[3].z:=-75;π box[4].x:=-75; box[4].y:=-75; box[4].z:=75;π box[5].x:=75; box[5].y:=-75; box[5].z:=75;π box[6].x:=75; box[6].y:=75; box[6].z:=75;π box[7].x:=-75; box[7].y:=75; box[7].z:=75; end;ππprocedure myline(x1,y1,z1,x2,y2,z2:real); {Keeps the draw routine pretty.πPixels are integers, so I round. Since theπ cube is centered around 0,0 I move it over 200 to put it on screen.} beginπ{if you think those real mults are slow, here's some rounds too...}ππ{hey, you may wonder, what happened to the stinking z coordinate? Ah, says I,π this is the simplest of 3d viewing transforms. You just take the z coord outπ of things and boom. Looking straight down the z axis on the object. If I getπ inspired, I will add simple perspective transform to these.} {There, gotπinspired. Made mistakes. Foley et al are not very good atπ tutoring perspective and I'm kinda ready to be done and post this.}π line(round(x1)+200,round(y1)+200,π round(x2)+200,round(y2)+200);πend;ππprocedure draw;π{my model is hard coded. No cool things like vertex and edge and faceπ lists.}ππbeginπ myline(box[0].x,box[0].y,box[0].z, box[1].x,box[1].y,box[1].z);π myline(box[1].x,box[1].y,box[1].z, box[2].x,box[2].y,box[2].z);π myline(box[2].x,box[2].y,box[2].z, box[3].x,box[3].y,box[3].z);π myline(box[3].x,box[3].y,box[3].z, box[0].x,box[0].y,box[0].z);ππ myline(box[4].x,box[4].y,box[4].z, box[5].x,box[5].y,box[5].z);π myline(box[5].x,box[5].y,box[5].z, box[6].x,box[6].y,box[6].z);π myline(box[6].x,box[6].y,box[6].z, box[7].x,box[7].y,box[7].z);π myline(box[7].x,box[7].y,box[7].z, box[4].x,box[4].y,box[4].z);ππ myline(box[0].x,box[0].y,box[0].z, box[4].x,box[4].y,box[4].z);π myline(box[1].x,box[1].y,box[1].z, box[5].x,box[5].y,box[5].z);π myline(box[2].x,box[2].y,box[2].z, box[6].x,box[6].y,box[6].z);π myline(box[3].x,box[3].y,box[3].z, box[7].x,box[7].y,box[7].z);ππ myline(box[0].x,box[0].y,box[0].z, box[5].x,box[5].y,box[5].z);π myline(box[1].x,box[1].y,box[1].z, box[4].x,box[4].y,box[4].z); end;ππprocedure rotx;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x [ 1 0 0 0 [x',y',z',1]π y 0 c -s 0 =π z 0 s c 0π 1] 0 0 0 1]π}πvar i:integer;πbeginπ setcolor(0);π draw;π for i:=0 to 7 doπ beginπ box[i].x:= box[i].x;π box[i].y:= box[i].y*cos(radTheta) + box[i].z*sin(radTheta);π box[i].z:=-box[i].y*sin(radTheta) + box[i].z*cos(radTheta);π end;π setcolor(15);π draw;πend;ππprocedure roty;π{if you know your matrix multiplication, the following equationsπ are derived fromπ [x [ c 0 s 0 [x',y',z',1]π y 0 1 0 0 =π z -s 0 c 0π 1] 0 0 0 1]π}πvar i:integer;πbeginπ setcolor(0);π draw;π for i:=0 to 7 doπ beginπ box[i].x:= box[i].x*cos(radTheta) - box[i].z*sin(radTheta);π box[i].y:= box[i].y;π box[i].z:= box[i].x*sin(radTheta) + box[i].z*cos(radTheta);π end;π setcolor(15);π draw;πend;ππprocedure rotz;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x [ c -s 0 0 [x',y',z',1]π y s c 0 0 =π z 0 0 1 0π 1] 0 0 0 1]π}πvar i:integer;πbeginπ setcolor(0);π draw;π for i:=0 to 7 doπ beginπ box[i].x:= box[i].x*cos(radTheta) + box[i].y*sin(radTheta);π box[i].y:=-box[i].x*sin(radTheta) + box[i].y*cos(radTheta);π box[i].z:= box[i].z;π end;π setcolor(15);π draw;πend;πππbeginπ init;π setcolor(14); draw;π repeatπ c:=readkey;π case c ofπ ',' : rotx;π '.' : roty;π '/' : rotz;π else {who gives a};π end; {case}π until c='q';π closegraph;πend.π 69 01-27-9417:37ALL BAS VAN GAALEN Moving a Shape across CRTSWAG9402 28 ╓ {πFrom: BAS VAN GAALENπSubj: Sin-curver Spritesπ---------------------------------------------------------------------------ππ OB>> 1. Scrolling 256c fonts Fast and Smooth.π OB>> 2. Now to do it on top of graphics...π OB>> 3. 3D object engine - If someone can post me one or direct meπ OB>> to build one.π OB>> 4. Shade Bobs/Whatever it called - Taking a shape and moving itπ OB>> across the screen when it leaves trail. Then, moving againπ OB>> on the trail will couse a stronger color to appear. n' on...π OB>> 5. Moving floor that is NOT a couse of a palette rotetion.π OB>> 6. 2D Scale procedure.π OB>> 7. Centered Stars. And SMOOTH ones.π OB>> 8. Vector BallsππI don't want to give it all away, but I just made some Shaded-bobs (orπwhatever). It realy isn't difficult. It worked right away. Now YOU make a nicerπsin-curve and palette. Here's some source:ππ{ --- cut here --- }ππ{$G+}ππprogram ShadingBobs;πconstπ Gseg : word = $a000;π Sofs = 75; Samp = 75; Slen = 255;π SprPic : array[0..15,0..15] of byte = (π (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0),π (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),π (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),π (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),π (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),π (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),π (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),π (1,1,1,1,2,2,3,4,4,3,2,2,1,1,1,1),π (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),π (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),π (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),π (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),π (0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0),π (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),π (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),π (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0));πtype SinArray = array[0..Slen] of word;πvar Stab : SinArray;ππprocedure CalcSinus; var I : word; beginπ for I := 0 to Slen do Stab[I] := round(sin(I*4*pi/Slen)*Samp)+Sofs; end;ππprocedure SetGraphics(Mode : word); assembler; asmπ mov ax,Mode; int 10h end;ππfunction keypressed : boolean; assembler; asmπ mov ah,0bh; int 21h; and al,0feh; end;ππprocedure DrawSprite(X,Y : integer; W,H : byte; Sprite : pointer); assembler;πasmπ push dsπ lds si,[Sprite]π mov es,Gsegπ cldπ mov ax,[Y]π shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,[X]π mov bh,[H]π mov cx,320π sub cl,[W]π sbb ch,0π @L:π mov bl,[W]π @L2:π lodsbπ or al,alπ jz @Sπ mov dl,[es:di]π add dl,alπ mov [es:di],dlπ @S:π inc diπ dec blπ jnz @L2π add di,cxπ dec bhπ jnz @Lπ pop dsπend;ππprocedure Retrace; assembler; asmπ mov dx,3dah;π @l1: in al,dx; test al,8; jnz @l1;π @l2: in al,dx; test al,8; jz @l2; end;ππprocedure Setpalette;πvar I : byte;πbeginπ for I := 0 to 255 do beginπ port[$3c8] := I;π port[$3c9] := I div 3;π port[$3c9] := I div 2;π port[$3c9] := I;π end;πend;ππprocedure Bobs;πvar X,Y : integer; I,J : byte;πbeginπ I := 0; J := 25;π repeatπ X := 2*Stab[I]; Y := Stab[J];π inc(I); inc(J);π Retrace;π DrawSprite(X,Y,16,16,addr(SprPic));π until keypressed;πend;ππbeginπ CalcSinus;π SetGraphics($13);π SetPalette;π Bobs;π SetGraphics(3);πend.ππ{ DrawSprite procedure taken from Sean Palmer (again).π It contained some minor bugs: [X] was added to AX, should be DI, andπ jz @S was jnz @S, so the sprite wasn't drawn. Now it is...π And of course it was changed to INCREASE the video-mem, not to poke it.ππ If you get rid of the Retrace it goes a LOT faster. }ππ 70 01-27-9417:46ALL SEAN PALMER 3D Landscape Source SWAG9402 23 ╓ {πFrom: SEAN PALMERπSubj: 3d Landscape srcπ---------------------------------------------------------------------------πCheck it out! Clean-room reverse-engineering of something pretty damnπsimilar to Comanche's patented Voxel-space technology... In Turbo!!ππ{by Sean Palmer}π{use I,J,K,L to look around, ESC ends}ππuses crt;ππconstπ xSize=256; {90 degrees}π ySize=128; {60 degrees}π angleMask=xSize*4-1; {xSize must be power of 2 or and's won't work}π mapSize=128;ππvarπ sinTab:array[0..angleMask]of integer; {sin(xyAngle)*$7FFF}π tanTab:array[0..ySize-1]of integer; {tan(zAngle)*$7FFF}ππ map:array[0..mapSize-1,0..mapSize-1]of byte;ππtypeπ fixed=record case boolean ofπ false:(l:longint);π true:(f:word;i:integer);π end;ππprocedure drawScene(x,y,z,rot:integer);πvar lastTan,lastAngle,h:integer;π mapTan:longint;πvar scrn:word;πvar color,height:byte;πvar xs,ys,ds:longint;πvar xp,yp,dp:fixed;πbeginπ fillchar(mem[$A000:0],320*200,0);π for h:=0 to xSize-1 do beginπ lastAngle:=0;π scrn:=h+320*(ySize-1);π lastTan:=tanTab[lastAngle];π xp.i:=x; xp.f:=0;π yp.i:=y; yp.f:=0;π dp.l:=0;π xs:=longint(sinTab[(h+rot-(xSize shr 1))and angleMask])*2;π ys:=longint(sinTab[(h+rot-(xSize shr 1)+xSize)and angleMask])*2; {cos}π ds:=$FFFE;π inc(xp.l,xs*16);π inc(yp.l,ys*16);π inc(dp.l,ds*16);π while lastAngle<ySize do beginπ inc(xp.l,xs*2);π inc(yp.l,ys*2);π inc(dp.l,ds*2);π inc(xs,xs div 32);π inc(ys,ys div 32);π inc(ds,ds shr 5);π if word(xp.i)>mapSize-1 thenπ break;π if word(yp.i)>mapSize-1 thenπ break;π height:=map[xp.i,yp.i];π mapTan:=(longint(height-z)*$7FFF)div dp.i;π color:=32+(z-height);π while(lastTan<=mapTan)and(lastAngle<ySize)do beginπ mem[$A000:scrn]:=color;π dec(scrn,320);π inc(lastAngle);π lastTan:=tanTab[lastAngle];π end;π end;π end;π end;πππprocedure initTables; var i:integer; r:real; beginπ for i:=0 to angleMask doπ sinTab[i]:=round(sin(i*pi/512)*$7FFF);π for i:=0 to ySize-1 do beginπ r:=(i-64)*pi/(3*ySize);π tanTab[i]:=round(sin(r)/cos(r)*$7FFF);π end;π end;ππprocedure initMap; var x,y:integer; beginπ for x:=0 to 127 doπ for y:=0 to 127 doπ map[x,y]:=((longint(sinTab[(y*21-12)and angleMask])+sinTab[(x*31+296)and angleMask]div 2)shr 12)+120;π end;πππvar c:char;π x,y,z,r,a:integer;π i:word;ππbeginπ asm mov ax,$13; int $10; end;π initTables;π initMap;π randomize;π x:=50+random(29);π y:=50+random(29);π z:=125+random(10);π r:=random(angleMask);π a:=64;π repeatπ drawScene(x,y,z,r);π c:=upcase(readkey);π case c ofπ 'I':if tanTab[ySize-1]<30000 then for i:=0 to ySize-1 do inc(tanTab[i],500);π 'K':if tanTab[0]>-30000 then for i:=0 to ySize-1 do dec(tanTab[i],500);π 'J':r:=(r-32)and angleMask;π 'L':r:=(r+32)and angleMask;π end;π until c=^[;π textMode(lastMode);π end.ππ 71 01-27-9417:46ALL BERNIE PALLEK MODE 13H Graphics Unit SWAG9402 60 ╓ {πFrom: BERNIE PALLEKπSubj: GRAF_13H.PASπ---------------------------------------------------------------------------π}π(**************************************************)π(* *)π(* GRAPHICS ROUTINES FOR MODE 13H *)π(* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *)π(* 320x200x256 (linearly-addressed) *)π(* Collected from routines in the Public Domain *)π(* Assembled by Bernie Pallek *)π(* *)π(**************************************************)ππ{ DISCLAIMER: Use this unit at your own risk. I will not be liableπ for anything negative resulting from use of this unit. }ππUNIT Graf_13h;ππINTERFACEππCONSTπ Color : Byte = 0;ππTYPEπ RGBPalette = Array[0..767] of Byte;ππFUNCTION GetVideoMode : Byte;πPROCEDURE SetVideoMode(desiredVideoMode : Byte);πFUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;πPROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);πPROCEDURE Ellipse(exc, eyc, ea, eb : Integer);πPROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);πPROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);πPROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);πPROCEDURE BurstSetPalette(burstPalette : RGBPalette);πPROCEDURE ScaleBitmap(VAR bmp2scale; bwidth, bheight : Byte;π bstrtx, bstrty, bendx, bendy : Word);πPROCEDURE WaitForRetrace;πPROCEDURE ClearScr;πππIMPLEMENTATIONπππ{ private type used by ScaleBitmap() }πTYPEπ Fixed = RECORD CASE Boolean OFπ True : (w : LongInt);π False : (f, i : Word);π END;ππFUNCTION GetVideoMode : Byte;πVARπ tempVMode : Byte;πBEGINπ ASMπ mov ah,$0fπ int $10π mov tempvmode,alπ END;π GetVideoMode := tempVMode;πEND;ππPROCEDURE SetVideoMode(desiredVideoMode : Byte);π{ desiredVideoMode = $03 : 80x25 colour textπ $13 : 320x200x256 monoplanedπ video data from $A000:0000 to $A000:FFFFπ}πBEGINπ ASMπ mov ah,0π mov al,desiredvideomode;π int $10π END;πEND;ππFUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;πBEGINπ GetPixel := Mem[$A000 : pix2get_y * 320 + pix2get_x];πEND;ππPROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);πBEGINπ Mem[$A000 : pix2set_y * 320 + pix2set_x] := pix2set_c;πEND;ππ{ originally by Sean Palmer, I just mangled it :^) }πPROCEDURE Ellipse(exc, eyc, ea, eb : Integer);πVARπ elx, ely : Integer;π aa, aa2, bb, bb2, d, dx, dy : LongInt;πBEGINπ elx := 0; ely := eb; aa := LongInt(ea) * ea; aa2 := 2 * aa;π bb := LongInt(eb) * eb; bb2 := 2 * bb;π d := bb - aa * eb + aa DIV 4; dx := 0; dy := aa2 * eb;π SetPixel(exc, eyc - ely, Color); SetPixel(exc, eyc + ely, Color);π SetPixel(exc - ea, eyc, Color); SetPixel(exc + ea, eyc, Color);ππ WHILE (dx < dy) DO BEGINπ IF (d > 0) THEN BEGIN Dec(ely); Dec(dy, aa2); Dec(d, dy); END;π Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);π SetPixel(exc + elx, eyc + ely, Color);π SetPixel(exc - elx, eyc + ely, Color);π SetPixel(exc + elx, eyc - ely, Color);π SetPixel(exc - elx, eyc - ely, Color);π END;π Inc(d, (3 * (aa - bb) DIV 2 - (dx + dy)) DIV 2);π WHILE (ely > 0) DO BEGINπ IF (d < 0) THEN BEGIN Inc(elx); Inc(dx, bb2); Inc(d, bb + dx); END;π Dec(ely); Dec(dy, aa2); Inc(d, aa - dy);π SetPixel(exc + elx, eyc + ely, Color);π SetPixel(exc - elx, eyc + ely, Color);π SetPixel(exc + elx, eyc - ely, Color);π SetPixel(exc - elx, eyc - ely, Color);π END;πEND;ππ{ originally by Sean Palmer, I just mangled it }πPROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);πVARπ lndd, lndx, lndy, lnai, lnbi, lnxi, lnyi : Integer;πBEGINπ IF (lnx1 < lnx2) THEN BEGIN lnxi := 1; lndx := lnx2 - lnx1;π END ELSE BEGIN lnxi := (-1); lndx := lnx1 - lnx2; END;π IF (lny1 < lny2) THEN BEGIN lnyi := 1; lndy := lny2 - lny1;π END ELSE BEGIN lnyi := (-1); lndy := lny1 - lny2; END;π SetPixel(lnx1, lny1, Color);π IF (lndx > lndy) THEN BEGIN lnai := (lndy - lndx) * 2;π lnbi := lndy * 2;π lndd := lnbi - lndx;π REPEAT IF (lndd >= 0) THEN BEGIN Inc(lny1, lnyi);π Inc(lndd, lnai); END ELSE Inc(lndd, lnbi);π Inc(lnx1, lnxi); SetPixel(lnx1, lny1, Color);π UNTIL (lnx1 = lnx2);π END ELSE BEGIN lnai := (lndx - lndy) * 2; lnbi := lndx * 2;π lndd := lnbi - lndy;π REPEAT IF (lndd >= 0) THEN BEGIN Inc(lnx1, lnxi);π Inc(lndd, lnai); END ELSE Inc(lndd, lnbi);π Inc(lny1, lnyi); SetPixel(lnx1, lny1, Color);π UNTIL (lny1 = lny2);π END;πEND;ππPROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);π{ returns the r, g, and b values of a palette index }πBEGINπ Port[$3C7] := index2get;π r_inte := Port[$3C9];π g_inte := Port[$3C9];π b_inte := Port[$3C9];πEND;ππPROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);π{ sets the r, g, and b values of a palette index }πBEGINπ Port[$3C8] := index2set;π Port[$3C9] := r_inte;π Port[$3C9] := g_inte;π Port[$3C9] := b_inte;πEND;ππPROCEDURE BurstSetPalette(burstPalette : RGBPalette);πVARπ burstCount : Word;πBEGINπ Port[$3C8] := 0;π FOR burstCount := 0 TO 767 DO Port[$3C9] := burstPalette[burstCount];πEND;ππ{ originally by Sean Palmer, I just mangled it }πPROCEDURE ScaleBitmap(VAR bmp2scale; bwidth, bheight : Byte;π bstrtx, bstrty, bendx, bendy : Word);π{ - bmp2scale is an array [0..bwidth, 0..bheight] of byte }π{ which contains the original bitmap }π{ - bwidth and bheight are the actual width - 1 and the actual }π{ height - 1 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); }π{ - to create an array for the bitmap, make it like this: }π{ VAR myBitmap : Array[0..bmpHeight, 0..bmpWidth] of Byte; }π{ where bmpHeight is the actual height of the normal-size }π{ bitmap less one, and bmpWidth is the actual width less one }π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 := bwidth * $10000 DIV bmp_w;π bmp_sy.w := bheight * $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 bwidth; 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;ππPROCEDURE WaitForRetrace;π{ waits for a vertical retrace to reduce flicker }πBEGINπ REPEAT UNTIL (Port[$3DA] AND 8) = 8;πEND;ππPROCEDURE ClearScr;πBEGINπ FillChar(Mem[$A000:0000], 64000, 0);πEND;ππEND. { of unit }ππThat's it! It's not complete, but it's meant as a starter for all who areπinterested in VGA graphics. Happy programming!ππBernie.πππ--- Maximus/2 2.01wbπ * Origin: * idiot savant * +1 905 935 6628 * (1:247/128)π 72 02-03-9409:18ALL SEAN PALMER RIP Bezier Curves SWAG9402 23 ╓ {πFrom: SEAN PALMERπSubj: RIP Bezier Curveπ---------------------------------------------------------------------------π NO> Does anyone have any code for constructing a RIP Bezier curve that isπ NO> exactly the same as the one used by Telegrafix developers. I have someπ NO> code that comes close, but close isn't good enough. I need this to beπ NO> dead on accurate.π NO> PS. I'm willing to share my code with others that are interested inπ NO> RIP.ππ{Public domain by Sean Palmer}π{converted from Steve Enns' original Basic subroutines by Sean Palmer}ππvar color:byte;πprocedure plot(x,y:word);beginπ mem[$A000:y*320+x]:=color;π end;ππtypeπ coord=record x,y:integer; end;π CurveDataRec=array[0..65521 div sizeof(coord)]of coord;ππprocedure drawBSpline(var d0:coord;nPoints,nSteps:word);π const nsa=1/6; nsb=2/3;π varπ i,i2,xx,yy:integer;π t,ta,t2,t2a,t3,t3a,nc1,nc2,nc3,nc4,step:real;π d:curveDataRec absolute d0;πbeginπ step:=1/nSteps;π for i:=0 to nPoints-4 do beginπ color:=i+32+2;π t:=0.0;π for i2:=pred(nSteps)downto 0 do beginπ t:=t+step;π ta:=t*0.5; t2:=t*t; t2A:=t2*0.5; t3:=t2*t; t3A:=t3*0.5;π nc1:=-nsa*t3+t2A-ta+nsa;π nc2:=t3a-t2+nsb;π nc3:=-t3a+t2a+ta+nsa;π nc4:=nsa*t3;π xx:=round(nc1*d[i].x+nc2*d[succ(i)].x+nc3*d[i+2].x+nc4*d[i+3].x);π yy:=round(nc1*d[i].y+nc2*d[succ(i)].y+nc3*d[i+2].y+nc4*d[i+3].y);π plot(xx,yy);π end;π end;π end;ππprocedure drawBezier(var d0:coord;nPoints,nSteps:word);π const nsa=1/6; nsb=2/3;π varπ i,i2,i3,xx,yy:integer;π t,tm3,t2,t2m3,t3,t3m3,nc1,nc2,nc3,nc4,step:real;π d:curveDataRec absolute d0;πbeginπ step:=1/nSteps;π for i2:=0 to pred(nPoints) div 4 do beginπ i:=i2*4;π t:=0.0;π for i3:=pred(nSteps) downto 0 do beginπ t:=t+step;π tm3:=t*3.0; t2:=t*t; t2m3:=t2*3.0; t3:=t2*t; t3m3:=t3*3.0;π nc1:=1-tm3+t2m3-t3;π nc2:=t3m3-2.0*t2m3+tm3;π nc3:=t2m3-t3m3;π nc4:=t3;ππ xx:=round(nc1*d[i].x+nc2*d[succ(i)].x+nc3*d[i+2].x+nc4*d[i+3].x);π yy:=round(nc1*d[i].y+nc2*d[succ(i)].y+nc3*d[i+2].y+nc4*d[i+3].y);π plot(xx,yy);π end;π end;π end;ππconst numpoints=40;ππvar c:array[-1..2+numPoints]of coord;πvar i:integer;πbeginπ asm mov ax,$13; int $10; end; {init vga/mcga graphics}π randomize;π for i:=1 to numPoints do with c[i] do beginπ x:=i*(319 div numPoints); {for precision demo}π {x:=random(320);} {for fun demo}π y:=random(200);π end;π for i:=1 to numPoints div 2 do c[i*2+1].y:=c[i*2].y; {fit closer}π for i:=1 to numPoints do with c[i] do begin color:=i+32; plot(x,y); end;π c[-1]:=c[1]; c[0]:=c[1]; {replicate end points so curves fit to input}π c[numPoints+1]:=c[numPoints]; c[numPoints+2]:=c[numPoints];π drawBSpline(c[-1],numPoints+4,256); {set third parm to 256 for precision, 64 f}π readln;π asm mov ax,3; int $10; end; {text mode again}π end.ππ 73 02-03-9409:19ALL SCOTT BRADSHAW More RIP Bezier Curves SWAG9402 11 ╓ {πFrom: SCOTT BRADSHAWπSubj: RIP BEZIER CURVESπ---------------------------------------------------------------------------πWell, I had a whole RIP unit I made for Turbo Pascal over the modem,πbut it got lost in a HD crash. I am really not that interested inπRIP anymore, but I will give you mu source to the Bezier Curve. Itπshould be pretty close to what your looking for...π}πprogram bezier;πuses graph,crt;ππprocedure Bezier_2D_Curve( x, y, cx,cy,a,b,ca,cb:integer;incr:real);πvarπ qx, qy :real;π q1, q2, q3, q4:real;π plotx, ploty:integer;π t:real;ππ beginπ t := 0;π while (t <= 1) do beginπ q1 := t*t*t*-1 + t*t*3 + t*-3 + 1;π q2 := t*t*t*3 + t*t*-6 + t*3;π q3 := t*t*t*-3 + t*t*3;π q4 := t*t*t;π qx := q1*x + q2*cx + q3*a + q4*ca;π qy := q1*y + q2*cy + q3*b + q4*cb;π plotx := round(qx);π ploty := round(qy);π putpixel( plotx, ploty, 15);π t := t + incr;π end;πend;ππvar gd,gm:integer;π c:char;πbeginπ gd := VGA;π gm := VGAHI;π initgraph(gd,gm,'\turbo\tp');π setcolor( BLUE );π Bezier_2D_Curve( 100, 400, 25, 450, 120, 275, 300, 455,0.003 );π c:=readkey;π Bezier_2D_Curve( 310, 200, 360, 150, 510, 200, 460, 250,0.003 );π c:=readkey;πend.ππ 74 02-03-9409:19ALL NICK ONOUFRIOU Another Bezier Curve SWAG9402 12 ╓ {πFrom: NICK ONOUFRIOUπSubj: RIP Bezier Curvesπ---------------------------------------------------------------------------πSP> I can't post the code I have that IS Telegrafix-compatible (for obviousπSP> reasons) but if you post your code I can try and modify it to make itπSP> work correctly.ππHere it is. It comes close, but can't get it to create the same curves thatπTelegrafix creates. Thanks for any help Sean. Are you writing the RIP codeπfor TELIX?π}ππprocedure DrawBezierCurve(px1,py1,px2,py2,px3,py3,px4,py4,count : integer);ππfunction pow(x : real; y : word) : real;πvarπ nt : word;π result : real;πbeginπ result := 1;π for nt := 1 to y doπ result := result * x;π pow := result;πend;ππprocedure Bezier(t : real; var x, y : integer);πbeginπ x := round(pow(1 - t, 3) * px1 + 3 * t * pow(1 - t, 2) * px2 +π 3 * t * t * (1 - t) * px3 + pow(t, 3) * px4);π y := round(pow(1 - t, 3) * py1 + 3 * t * pow(1 - t, 2) * py2 +π 3 * t * t * (1 - t) * py3 + pow(t, 3) * py4);πend;ππvarπ resolution,t : real;π xc, yc : integer;πbeginπ if count = 0 then exit;π resolution:=1/count;ππ Moveto(px1,py1);π t := 0;π while t < 1 do beginπ Bezier(t, xc, yc);π lineto(xc, yc);π t := t + resolution;π end;π LineTo(px4,py4);πend;ππ 75 02-03-9410:55ALL FIASAL JUMA Fire Graphic SWAG9402 89 ╓ {π---------------------------------------------------------------------------ππ This is a PD source that I came across not too long ago.. It displays aπsimulation of flames or fire.. Its pretty good..π}ππ{* 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. *}π{* *}π{*************************************************************************}πππuses crt;πtype bigarr=array[0..102,0..159] of integer;πvar f:bigarr;π i,j,k,l:word;π delta:integer;π pal:array[0..255,1..3] of byte;π ch:char;ππprocedure setmode13;πassembler;πasmπ mov ax,13hπ int 10hπend;ππprocedure setpalette;πvar mapfile:text;π i,j:integer;ππbeginπ assign(mapfile,'flames5.map'); {kludgy, but it works!}π reset(mapfile);π for i:=0 to 255 doπ for j:=1 to 3 doπ beginπ read(mapfile,pal[i,j]);π pal[i,j]:=pal[i,j] shr 2;π end;π asmπ mov si,offset palπ mov cx,768 {no of colour registers}π mov dx,03c8hπ xor al,al {First colour to change pal for = 0}π out dx,alπ inc dxπ@1: outsbπ dec cx {safer than rep outsb}π jnz @1π end;πend;ππbeginπ setmode13;π setpalette;π randomize;π ch:=' ';π for i:=0 to 102 doπ for j:=0 to 159 doπ f[i,j]:=0; {initialise array}ππ repeatπ asm {move lines up, averaging}π mov cx,16159; {no. elements to change}π mov di,offset fπ add di,320 {di points to 1st element of f in upper row (320 bytes/row)}π@1:π mov ax,ds:[di-2]π add ax,ds:[di]π add ax,ds:[di+2]π add ax,ds:[di+320]π shr ax,2 {divide by 4: average 4 elements of f}π jz @2π sub ax,1π@2: mov word ptr ds:[di-320],axπ add di,2π dec cxπ jnz @1 {faster than _loop_ on 486}π end;πππ for j:=0 to 159 do {set new bottom line}ππ--- Maximus 2.01wbπ * Origin: *THE K-W AMATEUR RADIO BBS-(VE3MTS)* ->DS16.8<- (1:221/177)π===========================================================================π BBS: Canada Remote SystemsπDate: 12-02-93 (17:42) Number: 46962πFrom: FIASAL JUMA Refer#: NONEπ To: ALL Recvd: NO πSubj: Fire Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πππ This is a PD source that I came across a while ago.. It simulates flamesπor fire.. its pretty good source..ππprogram flames;π{**************************************************************************}π{* *}π{* 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. *}π{* *}π{**************************************************************************}πππuses crt;ππConst pal : 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,ππ--- Maximus 2.01wbπ * Origin: *THE K-W AMATEUR RADIO BBS-(VE3MTS)* ->DS16.8<- (1:221/177)π===========================================================================π BBS: Canada Remote SystemsπDate: 12-02-93 (17:45) Number: 46963πFrom: FIASAL JUMA Refer#: NONEπ To: ALL Recvd: NO πSubj: Fire II Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πContinue.....ππ 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);πππtype bigarr=array[0..102,0..159] of integer;πvar f:bigarr;π i,j,k,l:word;π delta:integer;π pal:array[0..255,1..3] of byte;π ch:char;ππprocedure setmode13;πassembler;πasmπ mov ax,13hπ int 10hπend;ππprocedure setpalette;πvar mapfile:text;π i,j:integer;ππbeginπ for j:=1 to 768 doπ beginπ pal[j]:=pal[j] shr 2;π end;ππ asmπ mov si,offset palπ mov cx,768π mov dx,03c8hπ xor al,alπ out dx,alπ inc dxπ@1:π outsbπ dec cxπ jnz @1π end;πend;ππbeginπ setmode13;π setpalette;π randomize;π ch:=' ';π for i:=0 to 102 doπ for j:=0 to 159 doπ f[i,j]:=0; {initialise array}ππ repeatπ asm {move lines up, averaging}π mov cx,16159; {no. elements to change}π mov di,offset fπ add di,320 {di points to 1st element of f in upper row (320 bytes/row)}π@1:π mov ax,ds:[di-2]π add ax,ds:[di]π add ax,ds:[di+2]π add ax,ds:[di+320]π shr ax,2 {divide by 4: average 4 elements of f}π jz @2π sub ax,1π@2: mov word ptr ds:[di-320],axπ add di,2π dec cxπ jnz @1 {faster than _loop_ on 486}π end;πππ for j:=0 to 159 do {set new bottom line}π beginπ if random<0.4 thenπ delta:=random(2)*255;π f[101,j]:=delta;π f[102,j]:=delta;π end;ππ--- Maximus 2.01wbπ * Origin: *THE K-W AMATEUR RADIO BBS-(VE3MTS)* ->DS16.8<- (1:221/177)π===========================================================================π BBS: Canada Remote SystemsπDate: 12-02-93 (17:47) Number: 46964πFrom: FIASAL JUMA Refer#: NONEπ To: ALL Recvd: NO πSubj: Fire III Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πContinue..ππ asm {output to screen}π mov si,offset fπ mov ax,0a000hπ mov es,axπ mov di,0π mov dx,100π@3:π mov bx,2π@2:π mov cx,160π@1:π mov al,[si]π mov ah,alπ mov es:[di],ax {word aligned write to display mem}π add di,2π add si,2π dec cxπ jnz @1ππ sub si,320π dec bxπ jnz @2ππ add si,320π dec dxπ jnz @3π end;π if keypressed then ch:=readkey;π until ch=#27;π asm {restore text mode}π mov ax,03hπ int 10hπ end;πend.ππ There is a million things you can do to modify that code to look betterπor run faster.. Making it work in modex is one good possibility and its notπthat hard.. laterπ 76 02-03-9410:58ALL SWAG SUPPORT TEAM Writing Text in Graphics SWAG9402 31 ╓ (*πWrite a unit, that assigns an text file to the Graphics Screen and thenπassign output with this proc, then use rewrite(output) and you canπuse write/writeln in Graphics mode as well. Don't forgetπAssign(output,'');rewrite(output) orπCrtAssign(output);rewrite(output) when back in Text Mode!πYou can even implement read/readln in graphics mode, but this is moreπ complicated.πOne difference to text mode: use MoveTo instead of GotoXY!ππI've neither my unit nor the TP manual available just now,πbut it works like this (output only!):π*)πunit GrpWrite;ππinterfaceππuses Graph,Dos,BGIFont,BGIDriv;ππprocedure GraphAssign(var F:text);ππimplementationπ{$R-,S-}ππvarπ GraphDriver, GraphMode, Error : integer;π a : string;ππprocedure Abort(Msg : string);πbeginπ Writeln(Msg, ': ', GraphErrorMsg(GraphResult));π Halt(1);πend;ππ{$F+} {DO NOT FORGET}ππfunction GraphFlush(var F:TextRec):integer;πbeginπ GraphFlush := 0;πend;ππfunction GraphClose(var F:TextRec):integer;π beginπ GraphClose := 0;π end; {There's nothing to close}πππfunction GraphWrite(var F:TextRec):integer;π varπ s : string;π P : word;π beginπ with F doπ beginπ P := 0;π while P<BufPos doπ beginπ OutText(BufPtr^[P]);π Inc(P);π end;π BufPos := 0;π end;π{ (may need more than one OutText...)}π (*... {Clear buffer}*)π GraphWrite := 0;π end;πππfunction GraphOpen(var F:TextRec):integer;π beginπ { Register all the drivers }π if RegisterBGIdriver(@CGADriverProc) < 0 thenπ Abort('CGA');π if RegisterBGIdriver(@EGAVGADriverProc) < 0 thenπ Abort('EGA/VGA');π if RegisterBGIdriver(@HercDriverProc) < 0 thenπ Abort('Herc');π if RegisterBGIdriver(@ATTDriverProc) < 0 thenπ Abort('AT&T');π if RegisterBGIdriver(@PC3270DriverProc) < 0 thenπ Abort('PC 3270');πππ { Register all the fonts }π if RegisterBGIfont(@GothicFontProc) < 0 thenπ Abort('Gothic');π if RegisterBGIfont(@SansSerifFontProc) < 0 thenπ Abort('SansSerif');π if RegisterBGIfont(@SmallFontProc) < 0 thenπ Abort('Small');π if RegisterBGIfont(@TriplexFontProc) < 0 thenπ Abort('Triplex');ππ GraphDriver := Detect; { autodetect the hardware }π InitGraph(GraphDriver, GraphMode, ''); { activate graphics }π if GraphResult <> grOk then { any errors? }π beginπ Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));π Halt(1);π end;π with F doπ beginπ Closefunc:=@GraphClose;π InOutFunc:=@GraphWrite;π FlushFunc:=@GraphFlush;π end;π GraphOpen := 0;π(* ... {Initialisations, see your TP manual}*)π end;π{$F-}πprocedure GraphAssign;π beginπ with TextRec(F) doπ beginπ Mode := fmClosed;π BufSize := SizeOf(Buffer);π BufPtr := @Buffer;π Name[0] := #0;π OpenFunc:= @GraphOpen;π {You can make some initialisations already here}π endπ end;πend.π=================WRTGRTST.PAS follows==================π{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}π{$M 16384,0,655360}πuses Crt,π Graph, { library of graphics routines }π GrWrite;πvarπ GraphDriver, GraphMode, Error : integer;π a : string;π GrOutput:Text;ππprocedure Abort(Msg : string);πbeginπ Writeln(Msg, ': ', GraphErrorMsg(GraphResult));π Halt(1);πend;ππbeginπ GraphAssign(Output); {Standard output to graphics screen}π {$I-}π rewrite(Output); {actually calls GraphOpen}π {$I+}π if IoResult <> 0 then halt;ππ(* ....*)π MoveTo(65,90);π a := 'this is a string';π write('this is an embedded string'); {write to graphics screen}π MoveTo(65,120);π write(' and this is the second');π Close(Output); {nothing shows on the screen until this is executed}π ReadLn(a);π CloseGraph;π {Standard output to text screen}π Assign(output,'');π rewrite(output);π GotoXY(5,20); {THIS WORKS}π write(a);{nothing happens here} {write to textscreen}πend.ππ 77 02-03-9416:17ALL OLAF BARTELT Loading PCX Files SWAG9402 24 ╓ {ππ SL> Does someone has a pascalsource for showing a PCX file with a resolutionπ SL> of 640x400x256 /or a automatic build-in convertor who wil let the drawingππSure thing, the following code will load PCX files with 256 colors and variableπheight and width (it looks into the header): (Sorry about the german comments,πbut I've got no time to erase them right now :-(( ) }ππUNIT uVESAPcx; { (c) 1993 by NEBULA-Software }π { PCX-Darstellungsroutinen f. VESA } { Olaf Bartelt & Oliver Carow }ππINTERFACE { Interface-Teil der Unit }ππ{ ───────────────────────────────── Typen ───────────────────────────────── }πTYPE pVESAPcx = ^tVESAPcx; { Zeiger auf Objekt }π tVESAPcx = OBJECT { Objekt für PCX-Dateien }π PROCEDURE load(f : STRING; dx, dy : WORD);π END;ππ{ ──────────────────────────────── Variablen ────────────────────────────── }πVAR vVESAPcx : pVESAPcx; { Instanz des Objekts tPcx }πππIMPLEMENTATION { Implementation-Teil d. Unit }ππUSES uVesa; { Einbinden der Units }π{ CAN BE FOUND IN SWAG }ππ{ ──────────────────────────────── tVESAPcx ─────────────────────────────── }πPROCEDURE tVESAPcx.load(f : STRING; dx, dy : WORD);πVAR q : FILE;π b : ARRAY[0..2047] OF BYTE;π anz, pos, c, w, h, e, pack : WORD;π x, y : WORD;ππLABEL ende_background;ππBEGINπ x := 0; y := 0;ππ ASSIGN(q, f); {$I-} RESET(q, 1); {$I+}π IF IORESULT <> 0 THENπ GOTO ende_background;ππ BLOCKREAD(q, b, 128, anz);π IF (b[0] <> 10) OR (b[3] <> 8) THENπ BEGINπ CLOSE(q);π EXIT;π END;π w := SUCC((b[9] - b[5]) SHL 8 + b[8] - b[4]);π h := SUCC((b[11] - b[7]) SHL 8 + b[10] - b[6]);π pack := 0; c := 0; e := y + h;π REPEATπ BLOCKREAD(q, b, 2048, anz);π pos := 0;π WHILE (pos < anz) AND (y < e) DOπ BEGINπ IF pack <> 0 THENπ BEGINπ FOR c := c TO c + pack DOπ vVesa^.putpixel(x + c+dx, y+dy, b[pos]);π pack := 0;π ENDπ ELSEπ IF (b[pos] AND $C0) = $C0 THENπ pack := b[pos] AND $3Fπ ELSEπ BEGINπ vVesa^.putpixel(x + c+dx, y+dy, b[pos]);π INC(c);π END;π INC(pos);π IF c = w THENπ BEGINπ c := 0;π INC(y);π END;π END;π UNTIL (anz = 0) OR (y = e);π SEEK(q, FILESIZE(q) - 3 SHL 8 - 1);π BLOCKREAD(q, b, 3 SHL 8 + 1);π IF b[0] = 12 THENπ FOR x := 1 TO 3 SHL 8 + 1 DOπ b[x] := b[x] SHR 2;π CLOSE(q);ππ ende_background:πEND;πππ{ ────────────────────────────── Hauptprogramm ──────────────────────────── }πBEGINπ NEW(vVESAPcx);πEND.ππRemember to put in *your* putpixel routines there!ππscroll from top till bottom.(VGA/SVGAcompat./TPASCAL6.0)ππ 78 02-03-9416:18ALL DON LABARRE Making VGA Rain SWAG9402 13 ╓ {πIt's not often that I post anything but since I started getting into it Iπfigured I'd post something worth while. Heres some code I wrote to produce someπ"blood" rain. It isn't much but it's cool to look at :)ππ{This code is release freely to anyone that wants it. I couldn't care lessπ what you do with it. It is being used in my demo so if I see it in yoursπ i will find you and kill you. Nemesis 1994}ππprogram rain;πvar p:integer;ππfunction keypressed : boolean; assembler; asmπ mov ah,0bh; int 21h; and al,0feh; end;ππProcedure RotatePal;πVar a:Word;πBeginπ inc(p);π port[968]:=35;π a:=100;ππ while port[$3da] and 8 <> 0 do;π while port[$3da] and 8 = 0 do;ππ while a>1 doπ beginπ port[969]:=1-((a+p) and 60);π port[969]:=0;π {If you want a better palette selection and more play then removeπ the above line and replace with the one below. It will allow youπ to get to the blues and greens and yellows but I made mine red soπ did not require those}π {port[969]:=1-((a+p) and 60);}π port[969]:=1-((a+p) and 65);π dec(a);π end;πend;ππProcedure makerain;πVarπ x,y,c,d:word;πbeginπ d:=1;π randomize;π for x:=0 to 320 doπ Beginπ c:=random(65);π for y:=0 to 200 doπ Beginπ if c>64 then c:=1;π mem[$a000:x+320*y]:=c+35;π inc(c,d);π end;π d:=random(5)+1;π end;πend;πππbeginπasmπ mov ax,$0013π int 10hπ end;πmakerain;πrepeatπRotatePal;πuntil keypressed;πasmπ mov ax,$0002π int 10hπend;πend.ππ 79 02-03-9416:19ALL BAS VAN GAALEN Vector coding SWAG9402 39 ╓ π{$g+}πprogram rotationalfield;π{ Source by Bas van Gaalen, Holland, PD }πuses crt,dos;πconstπ gseg : word = $a000;π dots = 459;π dist : word = 250;π sintab : array[0..255] of integer = (π 0,3,6,9,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,60,63,66,68,π 71,74,76,79,81,84,86,88,91,93,95,97,99,101,103,105,106,108,110,111,π 113,114,116,117,118,119,121,122,122,123,124,125,126,126,127,127,127,π 128,128,128,128,128,128,128,127,127,127,126,126,125,124,123,122,122,π 121,119,118,117,116,114,113,111,110,108,106,105,103,101,99,97,95,93,π 91,88,86,84,81,79,76,74,71,68,66,63,60,58,55,52,49,46,43,40,37,34,31,π 28,25,22,19,16,13,9,6,3,0,-3,-6,-9,-13,-16,-19,-22,-25,-28,-31,-34,π -37,-40,-43,-46,-49,-52,-55,-58,-60,-63,-66,-68,-71,-74,-76,-79,-81,π -84,-86,-88,-91,-93,-95,-97,-99,-101,-103,-105,-106,-108,-110,-111,π -113,-114,-116,-117,-118,-119,-121,-122,-122,-123,-124,-125,-126,π -126,-127,-127,-127,-128,-128,-128,-128,-128,-128,-128,-127,-127,π -127,-126,-126,-125,-124,-123,-122,-122,-121,-119,-118,-117,-116,π -114,-113,-111,-110,-108,-106,-105,-103,-101,-99,-97,-95,-93,-91,π -88,-86,-84,-81,-79,-76,-74,-71,-68,-66,-63,-60,-58,-55,-52,-49,π -46,-43,-40,-37,-34,-31,-28,-25,-22,-19,-16,-13,-9,-6,-3);πtypeπ dotrec = record x,y,z : integer; end;π dotpos = array[0..dots] of dotrec;πvar dot : dotpos;ππ{----------------------------------------------------------------------------}ππprocedure setpal(col,r,g,b : byte); assembler; asmπ mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,rπ out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;ππprocedure setvideo(mode : word); assembler; asmπ mov ax,mode; int 10h end;ππfunction esc : boolean; beginπ esc := port[$60] = 1; end;ππ{----------------------------------------------------------------------------}ππprocedure init;πvar i : word; x,z : integer;πbeginπ i := 0;π z := -100;π while z < 100 do beginπ x := -100;π while x < 100 do beginπ dot[i].x := x;π dot[i].y := -45;π dot[i].z := z;π inc(i);π inc(x,10);π end;π inc(z,9);π end;π for i := 0 to 63 do setpal(i,0,i,i);πend;ππ{----------------------------------------------------------------------------}ππprocedure rotation;πconst yst = 1;πvarπ xp : array[0..dots] of word;π yp : array[0..dots] of byte;π x,z : integer; n : word; phiy : byte;πbeginπ asm mov phiy,0; mov es,gseg; cli; end;π repeatπ asmπ mov dx,03dahπ @l1:π in al,dxπ test al,8π jnz @l1π @l2:π in al,dxπ test al,8π jz @l2π end;π setpal(0,0,0,10);π for n := 0 to dots do beginπ asmπ mov si,nπ mov al,byte ptr yp[si]π cmp al,200π jae @skipπ shl si,1π mov bx,word ptr xp[si]π cmp bx,320π jae @skipπ shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,bxπ xor al,alπ mov [es:di],alπ @skip:π end;ππ x := (sintab[(phiy+192) mod 255] * dot[n].xπ {^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^ ^ ^^^^^^^^π 9 1 3 2 }ππ - sintab[phiy] * dot[n].z) div 128;π { ^ ^^^^^^^^^^^^ ^ ^^^^^^^^ ^^^^^^^π 7 4 6 5 8 }ππ (*π asmπ xor ah,ah { 1 }π mov al,phiyπ add al,192π mov si,axπ mov ax,word ptr sintab[si]π mov si,n { 2 }π mov dx,word ptr dot[si].xπ mul dx { 3 }π mov cx,axπ mov dx,word ptr dot[si].z { 5 }π mov al,phiy { 4 }π mov si,axπ mov ax,word ptr sintab[si]π mul dx { 6 }π sub cx,ax { 7 }π shr cx,7 { 8 }π mov x,cx { 9 }π end;π *)ππ z := (sintab[(phiy+192) mod 255]*dot[n].z+sintab[phiy]*dot[n].x) div 128;π xp[n] := 160+(x*dist) div (z-dist);π yp[n] := 100+(dot[n].y*dist) div (z-dist);ππ {π asmπ mov ax,xπ mov dx,distπ mul dxπ mov dx,zπ sub dx,distπ div dxπ add ax,160ππ (* can't assign ax to xp[n] !? *)ππ end;π }ππ asmπ mov si,nπ mov al,byte ptr yp[si]π cmp al,200π jae @skipπ shl si,1π mov bx,word ptr xp[si]π cmp bx,320π jae @skipπ shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,bxπ mov ax,zπ shr ax,3π add ax,30π mov [es:di],alπ @skip:π end;π end;π asm inc phiy end;π setpal(0,0,0,0);π until esc;π asm sti end;πend;ππ{----------------------------------------------------------------------------}ππbeginπ setvideo($13);π Init;π rotation;π textmode(lastmode);πend.π 80 02-05-9407:56ALL BAS VAN GAALEN Moving landscape SWAG9402 41 ╓ π{ NEEDS A MOUSE !!!πAnd here as promised to several fellows, the moving landscape!πIt needs a mouse, as you can see...πAgain nothing realy nifty (imho), no bankswitching, no mode-x, no virtualπscreens, no palette tricks, just some hard math! ;-) Have fun with it...ππ--- cut here ---}ππprogram landscape_2d;π{ 2D landscape (without rotating). Made by Bas van Gaalen, Holland, PD }πconstπ vseg = $a000;π a_density = 4;π roughness = 20;π maxx_scape = 320; maxy_scape = 200;π maxh = 128;π maxx = 250 div a_density; maxy = 110 div a_density;πvar landscape : array[0..maxx_scape*maxy_scape] of byte;ππ{ mouse routines ------------------------------------------------------------}ππfunction mouseinstalled : boolean; assembler; asmπ xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;ππfunction getmousex : word; assembler; asmπ mov ax,3; int 33h; mov ax,cx end;ππfunction getmousey : word; assembler; asmπ mov ax,3; int 33h; mov ax,dx end;ππfunction leftpressed : boolean; assembler; asmπ mov ax,3; int 33h; and bx,1; mov ax,bx end;ππprocedure mousesensetivity(x,y : word); assembler; asmπ mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;ππprocedure mousewindow(l,t,r,b : word); assembler; asmπ mov ax,7; mov cx,l; mov dx,r; int 33h; mov ax,8π mov cx,t; mov dx,b; int 33h end;ππ{ lowlevel video routines ---------------------------------------------------}ππprocedure setvideo(m : word); assembler; asmπ mov ax,m; int 10h end;ππprocedure putpixel(x,y : word; c : byte); assembler; asmπ mov ax,vseg; mov es,ax; mov ax,y; mov dx,320; mul dxπ mov di,ax; add di,x; mov al,c; mov [es:di],al end;ππfunction getpixel(x,y : word) : byte; assembler; asmπ mov ax,vseg; mov es,ax; mov ax,y; mov dx,320; mul dxπ mov di,ax; add di,x; mov al,[es:di] end;ππprocedure setpal(c,r,g,b : byte); assembler; asmπ mov dx,03c8h; mov al,c; out dx,al; inc dx; mov al,rπ out dx,al; mov al,g; out dx,al; mov al,b; out dx,al end;ππprocedure retrace; assembler; asmπ mov dx,03dah; @l1: in al,dx; test al,8; jnz @l1π @l2: in al,dx; test al,8; jz @l2 end;ππ{ initialize palette colors -------------------------------------------------}ππprocedure initcolors;πvar i : byte;πbeginπ for i := 0 to 63 do beginπ setpal(i+1,21+i div 3,21+i div 3,63-i);π setpal(i+65,42-i div 3,42+i div 3,i div 3);π end;πend;ππ{ landscape generating routines ---------------------------------------------}ππprocedure adjust(xa,ya,x,y,xb,yb : integer);πvar d,c : integer;πbeginπ if getpixel(x,y) <> 0 then exit;π d := abs(xa-xb)+abs(ya-yb);π c := (50*(getpixel(xa,ya)+getpixel(xb,yb))+trunc((10*random-5)*d*roughness))πdiv 100;π if c < 1 then c := 1;π if c >= maxh then c := maxh;π putpixel(x,y,c);πend;ππprocedure subdivide(l,t,r,b : integer);πvar x,y : integer; c : integer;πbeginπ if (r-l < 2) and (b-t < 2) then exit;π x := (l+r) div 2; y := (t+b) div 2;π adjust(l,t,X,t,r,t);π adjust(r,t,r,Y,r,b);π adjust(l,b,X,b,r,b);π adjust(l,t,l,Y,l,b);π if getpixel(x,y) = 0 then beginπ c := (getpixel(l,t)+getpixel(r,t)+getpixel(r,b)+getpixel(l,b)) div 4;π putpixel(x,y,c);π end;π subdivide(l,t,x,y);π subdivide(x,t,r,y);π subdivide(l,y,x,b);π subdivide(x,y,r,b);πend;ππprocedure generatelandscape;πvar image : file; vidram : byte absolute vseg:0000; i : word;πbeginπ assign(image,'plasma.img');π {$I-} reset(image,1); {$I+}π if ioresult <> 0 then beginπ randomize;π putpixel(0,0,random(maxh));π putpixel(maxx_scape-1,0,random(maxh));π putpixel(maxx_scape-1,maxy_scape-1,random(maxh));π putpixel(0,maxy_scape-1,random(maxh));π subdivide(0,0,maxx_scape,maxy_scape);π rewrite(image,1);π blockwrite(image,mem[vseg:0],maxx_scape*maxy_scape);π end else blockread(image,mem[vseg:0],maxx_scape*maxy_scape);π close(image);π move(vidram,landscape,sizeof(landscape));π fillchar(vidram,maxx_scape*maxy_scape,0);π for i := 0 to maxx_scape*maxy_scape-1 do landscape[i] := 110+Landscape[i] divπ2;πend;ππ{ the actual displaying of the whole thing! ---------------------------------}ππprocedure displayscape;πvar i,j,previ,prevj,n : word; x : integer;πbeginπ i := 0; j := 0;π repeatπ {retrace;}π previ := i; i := getmousex; prevj := j; j := getmousey;π for n := 0 to maxx*maxy-1 do beginπ x := -(a_density*(integer(n mod maxx)-(maxx shr 1)-1)*45) div (integer(nπdiv maxx)-45)-90;π if (x >= -250) and (X <= 60) then beginπ mem[vseg:320*(a_density*integer(n div maxx)-landscape[n modπmaxx+previ+(n div maxx+prevj)*maxx_scape])+x] := 0;π mem[vseg:320*(a_density*integer(n div maxx)-landscape[n mod maxx+i+(nπdiv maxx+j)*maxx_scape])+x] :=π landscape[(integer(n mod maxx)+i)+(integer(n divπmaxx)+j)*maxx_scape]-100;π end;π end;π until leftpressed;πend;ππ{ main routine --------------------------------------------------------------}ππbeginπ if mouseinstalled then beginπ setvideo($13);π initcolors;π generatelandscape;π mousewindow(0,0,maxx_scape-maxx,maxy_scape-maxy);π mousesensetivity(25,25);π displayscape;π setvideo(3);π end else writeln('This interactive thing realy needs a mouse...');πend.ππ 81 02-09-9411:50ALL DAVID DAHL CheckerBoard SWAG9402 46 ╓ πProgram CheckerBoard;ππ{=============================================ππ CheckerBoard Exampleπ Programmed by David Dahlπ 01/06/94π This program and source are PUBLIC DOMAINππ ---------------------------------------------ππ This program is an example of how to makeπ a moving 3D checkerboard pattern on theπ screen like many demos do.ππ This program requires VGA.ππ =============================================}ππUses CRT;ππConst TileMaxX = 10; { Horiz Size Of Tile }π TileMaxY = 10; { Vert Size Of Tile }ππ ViewerDist = 400; { Distance Of Viewer From Screen }ππType TileArray = Array [0..TileMaxX-1, 0..TileMaxY-1] of Byte;ππ PaletteRec = Recordπ Red,π Green,π Blue : Byte;π End;π PaletteType = Array[0..255] of PaletteRec;πππVar Tile : TileArray;π TilePal : PaletteType;ππProcedure GoMode13; Assembler;πASMπ MOV AX, $0013π INT $10πEnd;ππ{-[ Set Value Of All DAC Registers ]--------------------------------------}πProcedure SetPalette (Var PalBuf : PaletteType); Assembler;πAsmπ PUSH DSππ XOR AX, AXπ MOV CX, 0300h / 2π LDS SI, PalBufππ MOV DX, 03C8hπ OUT DX, ALππ INC DXπ MOV BX, DXπ CLDππ MOV DX, 03DAhπ @VSYNC0:π IN AL, DXπ TEST AL, 8π JZ @VSYNC0ππ MOV DX, BXπ repπ OUTSBππ MOV BX, DXπ MOV CX, 0300h / 2πππ MOV DX, 03DAhπ @VSYNC1:π IN AL, DXπ TEST AL, 8π JZ @VSYNC1ππ MOV DX, BXπ REPπ OUTSBππ POP DSπEnd;π{-[ Get Value Of All DAC Registers ]--------------------------------------}πProcedure GetPalette (Var PalBuf : PaletteType); Assembler;πAsmπ PUSH DSππ XOR AX, AXπ MOV CX, 0300hπ LES DI, PalBufππ MOV DX, 03C7hπ OUT DX, ALπ INC DXππ REPπ INSBππ POP DSπEnd;π{-[ Only Set DAC Regs 1 Through (TileMaxX * TileMaxY) ]-------------------}πProcedure SetTileColors (Var PalBuf : PaletteType); Assembler;πASMπ PUSH DSππ MOV CX, TileMaxX * TileMaxY * 3π MOV AX, 1π LDS SI, PalBufπ INC SIπ INC SIπ INC SIπ MOV DX, 03C8hπ OUT DX, ALπ INC DXπ MOV BX, DXππ MOV DX, 03DAhπ @VSYNC0:π IN AL, DXπ TEST AL, 8π JZ @VSYNC0ππ MOV DX, BXπ REPπ OUTSBππ POP DSπEnd;π{-[ Define The Bitmap Of The Tile ]---------------------------------------}πProcedure DefineTile;πVar CounterX,π CounterY : Word;πBeginπ For CounterY := 0 to TileMaxY-1 doπ For CounterX := 0 to TileMaxX-1 doπ Tile[CounterX, CounterY] := 1 + CounterX +π (CounterY * TileMaxX);πEnd;π{-[ Define The Colors Of The Tile ]---------------------------------------}πProcedure DefinePalette;πVar PalXCounter : Byte;π PalYCounter : Byte;π PalSize : Byte;πBeginπ GetPalette (TilePal);ππ PalSize := (TileMaxX * TileMaxY);ππ For PalYCounter := 1 to PalSize doπ With TilePal[PalYCounter] doπ Beginπ Red := 0;π Green := 0;π Blue := 63;π End;ππ For PalYCounter := 0 to ((TileMaxY - 1) DIV 2) doπ For PalXCounter := 0 to ((TileMaxX - 1) DIV 2) doπ Beginπ With TilePal[1 + PalXCounter + (PalYCounter*TileMaxX)] doπ Beginπ Red := 63;π Green := 63;π Blue := 63;π End;ππ With TilePal[1 + (TileMaxX DIV 2) +π PalXCounter +π ((TileMaxY DIV 2) * TileMaxX) +π (PalYCounter*TileMaxX)] doπ Beginπ Red := 63;π Green := 63;π Blue := 63;π End;π End;ππEnd;π{-[ Display Tiles On Screen ]---------------------------------------------}πProcedure DisplayCheckerBoard;πVar CounterX,π CounterY : Integer;ππ X,π Y,π Z : LongInt;πBeginπ For CounterY := 110 to 199 doπ Beginπ Z := -1600 + (CounterY * 16) + ViewerDist;ππ If Z = 0 THEN Z :=1;ππ For CounterX := 0 to 319 doπ Beginππ X := 159 + (longInt(CounterX - 159 ) * ViewerDist) DIV Z;ππ Y := (LongInt(CounterY + 100) * ViewerDist) DIV Z;ππ MEM[$A000:CounterX + (CounterY * 320)] :=π Tile[X MOD TileMaxX, Y MOD TileMaxY]π End;π End;ππEnd;π{-[ Rotate The Palette Of The Board To Give Illusion Of Movement Over It ]-}πProcedure MoveForwardOverBoard;πType TempPalType = Array[1..TileMaxX] of PaletteRec;πVar TempPal : TempPalType;π CounterX,π CounterY : Word;πBeginπ For CounterX := 1 to TileMaxX doπ TempPal[CounterX] := TilePal[CounterX];ππ For CounterY := 0 to (TileMaxY-1) doπ For CounterX := 0 to (TileMaxX-1) doπ TilePal[1 + CounterX + (CounterY * TileMaxX)] :=π TilePal[1 + CounterX + ((CounterY+1) * TileMaxX)];ππ For CounterX := 1 to TileMaxX doπ TilePal[CounterX + ((TileMaxY-1) * TileMaxX)] :=π TempPal[CounterX];πEnd;π{-[ Flush the Keyboard Buffer ]--------------------------------------------}πProcedure FlushKeyboard;πVar Key : Char;πBeginπ While KeyPressed doπ Key := ReadKey;πEnd;ππ{=[ Main Program ]=========================================================}πBeginππ GoMode13;π DefineTile;π DefinePalette;ππ SetPalette(TilePal);ππ DisplayCheckerboard;ππ FlushKeyboard;ππ Repeatπ MoveForwardOverBoard;π SetTileColors(TilePal);π Until KeyPressed;ππ FlushKeyboard;ππ TextMode(C80);πEnd.π 82 02-18-9406:59ALL LENNERT BAKKER Textmode Effects SWAG9402 128 ╓ π{Hi Dudes...ππDunno if you can do anything with this code; It sure is crappy!πAnywayzz, this kinda looks nice on my computer but I'm not sureπon how the timing will be on other systems... Might cause aπhelluvalot of flicker...ππWell, what can I say? Have Phun 8-)}ππProgram LooksLikeSomeTextModeEffectsToMe_YeahIGuessSo;ππ{$X+,E-,N-,I-,S-,R-,O-}ππType BigChar=Array[1..3,1..3] of Byte;π MoveRecord = Recordπ XPos,YPos : Integer;π XSpeed,YSpeed : Integer;π Counter : Word;π End;ππConst BigFont : Array[1..40] of BigChar = (π ((192,196,182),(195,196,191),(188,032,188)), {A}π ((192,196,182),(195,196,191),(193,196,183)), {B}π ((192,196,190),(187,032,032),(193,196,190)), {C}π ((192,190,187),(187,032,187),(193,196,183)), {D}π ((192,196,190),(195,190,032),(193,196,190)), {E}π ((192,196,190),(195,190,032),(188,032,032)), {F}π ((192,196,190),(187,194,182),(193,196,183)), {G}π ((189,032,189),(195,196,191),(188,032,188)), {H}π ((194,196,190),(032,187,032),(194,196,190)), {I}π ((192,196,182),(195,196,191),(188,032,198)), {J}π ((192,196,182),(195,196,191),(188,032,198)), {K}π ((189,032,032),(187,032,032),(193,196,190)), {L}π ((192,196,182),(187,189,187),(188,188,188)), {M}π ((192,196,182),(187,032,187),(188,032,188)), {N}π ((192,196,182),(187,032,187),(193,196,183)), {O}π ((192,196,182),(187,032,187),(187,194,183)), {P}π ((192,196,182),(195,196,191),(188,032,198)), {Q}π ((192,196,182),(195,196,198),(188,032,197)), {R}π ((192,196,190),(193,196,182),(194,196,183)), {S}π ((194,196,190),(032,187,032),(032,188,032)), {T}π ((189,032,189),(187,032,187),(193,196,183)), {U}π ((189,032,187),(188,032,187),(194,196,183)), {V}π ((189,189,189),(187,188,187),(193,196,183)), {W}π ((189,032,189),(192,196,183),(188,032,187)), {X}π ((189,032,189),(193,196,183),(032,188,032)), {Y}π ((192,196,182),(195,196,191),(188,032,198)), {Z}π ((032,032,032),(032,032,032),(185,185,185)), {...}π ((032,187,032),(032,188,032),(032,185,032)), {!}π ((192,196,182),(187,186,187),(193,196,183)), {0}π ((194,182,032),(032,187,032),(194,196,190)), {1}π ((194,196,182),(192,196,183),(193,196,190)), {2}π ((194,196,182),(032,194,191),(194,196,183)), {3}π ((189,032,189),(193,196,191),(032,032,188)), {4}π ((192,196,190),(193,196,182),(194,196,183)), {5}π ((192,196,190),(195,196,182),(193,196,183)), {6}π ((194,196,182),(032,032,187),(032,032,188)), {7}π ((192,196,182),(195,196,191),(193,196,183)), {8}π ((192,196,182),(193,196,191),(194,196,183)), {9}π ((032,032,032),(194,196,190),(032,032,032)), {-}π ((032,032,032),(032,032,032),(032,032,032)));{ }ππ ScrWidth : Word = 160;π StartDat : Array[0..15] of Byte = (8,0,1,2,3,4,5,6,7,6,5,4,3,2,1,0);π BarRes = 270;π BarRad = 260 Div 2;π Mes : String = '';ππ ScrollMessage : String = 'Hi there possoms! howst hanging. How about some simple TextMode Scroller. ';π ScrollOfs : Byte = 9;π ScrollPos : Byte = 0;π CharOfs : Byte = 2;πππVar BarCols : Array[0..399] of Byte;π Bars : Array[1..4] of Recordπ StartCol : Byte;π YPos : Integer;π End;π BarPos : Array[1..BarRes] of Integer;π MyPal : Array[0..767] of Byte;π MoveMes,MoveSplit : MoveRecord;ππProcedure CharMap; Assembler;πAsmπ db 0,0,0,0,0,0,192,240,248,252,252,60,60,60,60,60 {┐}π db 60,60,60,60,60,252,252,248,240,192,0,0,0,0,0,0 {┘}π db 24,60,60,60, 60,60,60,60, 60,60,60,24, 0,0,0,0π db 0,0,0,0, 60,126,255,255, 255,255,126,60, 0,0,0,0π db 96,240,240,248, 248,120,124,60, 60,62,30,31, 31,15,15,6π db 60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60π db 60,60,60,60,60,60,60,60,60,60,60, 24, 0,0,0,0π db 0,0,0,0, 24,60,60,60,60,60,60,60,60,60,60,60π db 0,0,0,0,0,0,254,255,255,254,0,0,0,0,0,0 {->}π db 60,60,60,60,60,124,252,252,252,252,124,60,60,60,60,60π db 0,0,0,0,0,0,3,15,31,63,62,62,60,60,60,60 {┌}π db 60,60,60,60,62,62,63,31,15,3,0,0,0,0,0,0 {└}π db 0,0,0,0,0,0,127,255,255,127,0,0,0,0,0,0 {<-}π db 60,60,60,60,60,62,63,63, 63,63,62,60, 60,60,60,60 {├}π db 0,0,0,0,0,0,255,255,255,255,0,0,0,0,0,0 {─}π db 240,120,120,120,120,120,60,60, 60,60,60,24, 0,0,0,0 {\}π db 60,60,60,60,60,252,252,248,240,224,224,240,240,240,240,240πEnd;ππProcedure SetCharset; Assembler;πAsmπ Push Bpπ mov ax,cs { Set character set for logo }π mov es,axπ mov bp,cs:offset charmapπ mov ax,1100hπ mov bx,1000hπ mov cx,17π mov dx,182π int 10hπ Pop BpπEnd;ππProcedure Standard_Palette; Assembler; { DP ][ Ext. Compatible }πAsmπdb 0,0,0,0,0,42,0,42,0,0,42,42,42,0,0,42,0,42,42,21,0,42,42πdb 42,21,21,21,21,21,63,21,63,21,21,63,63,63,21,21,63,21,63,63,63,21,63πdb 63,63,59,59,59,55,55,55,52,52,52,48,48,48,45,45,45,42,42,42,38,38,38πdb 35,35,35,31,31,31,28,28,28,25,25,25,21,21,21,18,18,18,14,14,14,11,11πdb 11,8,8,8,63,0,0,59,0,0,56,0,0,53,0,0,50,0,0,47,0,0,44πdb 0,0,41,0,0,38,0,0,34,0,0,31,0,0,28,0,0,25,0,0,22,0,0πdb 19,0,0,16,0,0,63,54,54,63,46,46,63,39,39,63,31,31,63,23,23,63,16πdb 16,63,8,8,63,0,0,63,42,23,63,38,16,63,34,8,63,30,0,57,27,0,51πdb 24,0,45,21,0,39,19,0,63,63,54,63,63,46,63,63,39,63,63,31,63,62,23πdb 63,61,16,63,61,8,63,61,0,57,54,0,51,49,0,45,43,0,39,39,0,33,33πdb 0,28,27,0,22,21,0,16,16,0,52,63,23,49,63,16,45,63,8,40,63,0,36πdb 57,0,32,51,0,29,45,0,24,39,0,54,63,54,47,63,46,39,63,39,32,63,31πdb 24,63,23,16,63,16,8,63,8,0,63,0,0,63,0,0,59,0,0,56,0,0,53πdb 0,1,50,0,1,47,0,1,44,0,1,41,0,1,38,0,1,34,0,1,31,0,1πdb 28,0,1,25,0,1,22,0,1,19,0,1,16,0,54,63,63,46,63,63,39,63,63πdb 31,63,62,23,63,63,16,63,63,8,63,63,0,63,63,0,57,57,0,51,51,0,45πdb 45,0,39,39,0,33,33,0,28,28,0,22,22,0,16,16,23,47,63,16,44,63,8πdb 42,63,0,39,63,0,35,57,0,31,51,0,27,45,0,23,39,54,54,63,46,47,63πdb 39,39,63,31,32,63,23,24,63,16,16,63,8,9,63,0,1,63,0,0,63,0,0πdb 59,0,0,56,0,0,53,0,0,50,0,0,47,0,0,44,0,0,41,0,0,38,0πdb 0,34,0,0,31,0,0,28,0,0,25,0,0,22,0,0,19,0,0,16,60,54,63πdb 57,46,63,54,39,63,52,31,63,50,23,63,47,16,63,45,8,63,42,0,63,38,0πdb 57,32,0,51,29,0,45,24,0,39,20,0,33,17,0,28,13,0,22,10,0,16,63πdb 54,63,63,46,63,63,39,63,63,31,63,63,23,63,63,16,63,63,8,63,63,0,63πdb 56,0,57,50,0,51,45,0,45,39,0,39,33,0,33,27,0,28,22,0,22,16,0πdb 16,63,58,55,63,56,52,63,54,49,63,53,47,63,51,44,63,49,41,63,47,39,63πdb 46,36,63,44,32,63,41,28,63,39,24,60,37,23,58,35,22,55,34,21,52,32,20πdb 50,31,19,47,30,18,45,28,17,42,26,16,40,25,15,39,24,14,36,23,13,34,22πdb 12,32,20,11,29,19,10,27,18,9,23,16,8,21,15,7,18,14,6,16,12,6,14πdb 11,5,10,8,3,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,49,10,10,49,19,10,49,29,10,49,39,10,49,49,10,39,49πdb 10,29,49,10,19,49,10,10,49,12,10,49,23,10,49,34,10,49,45,10,42,49,10πdb 31,49,10,20,49,11,10,49,22,10,49,33,10,49,44,10,49,49,10,43,49,10,32πdb 49,10,21,49,10,10,63,63,63πEnd;ππFunction KeyPressed : Boolean; Assembler;πAsmπ Mov Ah,0Bhπ Int 21hπEnd;ππProcedure WriteBigMessage(X,Y,Color:Byte; Message:String);πVar B,D : Byte;π ScrOfs : Word;ππConst TransTab : Array[0..255] of Byte =π (32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32, {15}π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32, {31}π 40,28,32,32,32,32,32,32,32,32,32,32,32,39,27,32, {47}π 29,30,31,32,33,34,35,36,37,38,32,32,32,32,32,32, {63}π 32, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, {79}π 16,17,18,19,20,21,22,23,24,25,26,32,32,32,32,32, {95}π 32, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, {111}π 16,17,18,19,20,21,22,23,24,25,26,32,32,32,32,32, {127}π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32);ππBeginπ Mes:=Message;π D:=Length(Mes);π If D=0 then Exit;π ScrOfs:=(Y-1)*ScrWidth+2*X+2;ππ Asmπ Mov Ax,$B800 { Set starting address on screen }π Mov Es,Axπ Mov Di,ScrOfsππ Mov B,1 { Start with first character ;-) }π @StringLoop:π Xor Bh,Bhπ Mov Bl,Bπ Mov Al,Ds:[Offset Mes+Bx] { Get Next Character from String }π Mov Bx,Offset TransTabπ XLat { And translate into real value }ππ Dec Alπ Mov Bl,9π Mul Blπ Mov Si,Offset BigFont { Character offset in Font-Table }π Add Si,Axππ Mov Ah,Colorπ Mov Dx,3π @FontColumn: { Loop three Rows... }π Mov Cx,3π @FontRow: { and three columns }π LodsBπ StosWπ Loop @FontRowπ Add Di,ScrWidthπ Sub Di,6π Dec Dxπ Jnz @FontColumnππ Mov Ax,3 { prepare screen address for next character }π Mul ScrWidthπ Sub Di,Axπ Add Di,8ππ Inc Bπ Mov Al,Dπ Cmp B,Alπ Jng @StringLoopπ End;πEnd;ππProcedure WriteCenteredBig(Y,Color:Byte; Message:String);πBeginπ WriteBigMessage(((ScrWidth Div 4)+2)-(Length(Message)*2),Y,Color,Message);πEnd;ππProcedure MakePal;πVar A:Word;πBeginπ For A:=0 to 255 doπ Beginπ Mypal[A]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3];π Mypal[A+256]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3+1];π Mypal[A+512]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3+2];π End;πEnd;ππProcedure SetupBars;πVar V : Integer;πBeginπ For V:=1 To BarRes Doπ BarPos[V]:=Round(BarRad*Sin((2*Pi/BarRes)*V))+BarRad+1;π For V:=1 to 4 doπ With Bars[V] doπ Beginπ StartCol:=V*16;π if v=3 then startcol:=96;π if v=4 then startcol:=144;π if v=5 then startcol:=160;π YPos:=14*V;π End;π For V:=304 to 319 do Barcols[V]:=(15-(V mod 16))+160;π For V:=320 to 335 do Barcols[V]:=V mod 16+160;πEnd;ππProcedure UpdateBars;πVar V,U,Y : Integer;πBeginπ For V:=1 To 4 doπ For U:=0 to 31 do BarCols[barpos[Bars[V].YPos]+U]:=0;π For V:=1 To 4 doπ Beginπ Inc(Bars[V].YPos);π If Bars[V].YPos>BarRes then Bars[V].YPos:=1;π Y:=BarPos[Bars[V].YPos];π For U:=0 to 15 do BarCols[Y+U]:=Bars[V].StartCol+15-U;π For U:=16 to 31 do BarCols[Y+U]:=Bars[V].StartCol+U-16;π End;πEnd;ππProcedure ColorBars; Assembler;πAsmπ 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ππ 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 Bl,[Offset BarCols+Si]π Mov Di,Offset MyPalπ Add Di,Bxππ MOV DX,$03C8 { point to DAC[0] }π MOV AL,0π OUT DX,ALππ 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 }ππ Inc Si { line counter }π { prepare For color effect }ππ MOV DX,$03C9π Mov Al,[Di]π OUT DX,Al { Dynamic Red }π Mov Al,[Di+256]π OUT DX,AL { Dynamic Green }π mov Al,[Di+512]π OUT DX,AL { Dynamic Blue }ππ CMP SI,296 { Paint just about 3/4 screen }π JBE @dolineπ STIπEnd;ππPROCEDURE Split(Row:Integer);πBEGINπ ASMπ mov dx,$3d4π mov ax,rowπ mov bh,ahπ mov bl,ahπ and bx,201hπ mov cl,4π shl bx,clπ mov ah,alπ mov al,18hπ out dx,axπ mov al,7π cliπ out dx,alπ inc dxπ in al,dxπ stiπ dec dxπ mov ah,alπ and ah,0efhπ or ah,blπ mov al,7π out dx,axπ mov al,9π cliπ out dx,alπ inc dxπ in al,dxπ stiπ dec dxπ mov ah,alπ and ah,0bfhπ shl bh,1π shl bh,1π or ah,bhπ mov al,9π out dx,axπ END;πEND;ππProcedure FastWrite(Col,Row,Attrib:Byte; Str:String);πVar MemPos : Word;π A : Byte;πBeginπ MemPos:=(Col*2)+(Row*ScrWidth)-ScrWidth-2;π A:=Length(Str);π For A:=1 to Length(Str) doπ Beginπ MemW[$B800:MemPos]:=Ord(Str[A])+Attrib*256;π MemPos:=MemPos+2;π End;πEnd;ππProcedure CenterWrite(Y,Color:Byte;Mes:String);πBeginπ FastWrite(41-((Length(Mes)-1) Div 2),Y,Color,Mes);πEnd;ππProcedure CursorOff; Assembler;πAsmπ Mov Ax,0100hπ Mov Cx,2000hπ Int 10hπEnd;ππProcedure CursorOn; Assembler;πAsmπ Mov Ax,0100hπ Mov Cx,0607hπ Int 10hπEnd;ππProcedure ScrollText(Nr:Word); Assembler;πAsmπ mov ax,nrπ mov cx,$40π mov es,cxπ mov cl,es:[$85]π div clπ mov cx,axπ mov dx,es:[$63]π push dxπ mov al,$13π cliπ out dx,alπ inc dxπ in al,dxπ stiπ mul clπ shl ax,1π mov es:[$4e],axπ pop dxπ mov cl,alπ mov al,$cπ out dx,axπ mov al,$dπ mov ah,clπ out dx,axπ mov ah,chπ mov al,8π out dx,axπEnd;πππFunction ReadKey : Char; Assembler;πAsmπ Mov Ah,07hπ Int 21hπEnd;ππProcedure SetHorizOfs(Count:Byte);πVar I : Byte;πBeginπ I:=Port[$3DA];π Port[$3C0]:=$33;π Port[$3C0]:=StartDat[Count Mod 16];πEnd;ππProcedure Sync; Assembler;πAsmπ Mov Dx,3DAhπ@LoopIt:π In Al,Dxπ Test Al,8π Jz @LoopItπEnd;ππProcedure DoubleWidth; Assembler;πAsmπ Mov Dx,3D4hπ Mov Ax,5013hπ Out Dx,Axπ Mov ScrWidth,320πEnd;ππProcedure SetPELReset; Assembler;πAsmπ Mov Dx,3DAhπ In Al,Dxπ Mov Dx,3C0hπ Mov Al,30hπ Out Dx,Alπ Mov Al,2Chπ Out Dx,AlπEnd;ππProcedure SetView(X,Y:Word);πVar PelPos:Byte;πBeginπ PelPos:=StartDat[X Mod 9];π X:=(X Div 9)+(Y Div 16)*160;π Asmπ Mov Dx,3D4h { Set Screen offset in bytes:}π Mov Bx,Xπ Mov Ah,Bhπ Mov Al,0Chπ Out Dx,Axπ Mov Ah,Blπ Inc Alπ Out Dx,Axππ Mov Al,8 { Set Y-Offset within Character-Row: }π Mov Bx,Yπ And Bl,15π Mov Ah,Blπ Out Dx,Axππ Mov Dx,3C0h { Set X-Offset within Character-Column: }π Mov Al,33hπ Out Dx,Alπ Mov Al,PelPosπ Out Dx,Alπ End;πEnd;ππProcedure UpDateScroller;πBeginπ If ScrollOfs=9 thenπ Beginπ ScrollOfs:=0;ππ Move(Mem[$B800:14*320+2],Mem[$B800:14*320],3*320-2);π Inc(CharOfs);π If CharOfs=4 thenπ Beginπ Inc(ScrollPos);π WriteBigMessage(84-CharOfs,15,14,ScrollMessage[ScrollPos]);π If ScrollPos=Length(ScrollMessage) Then ScrollPos:=0;π CharOfs:=0;π End;π Endπ elseπ Inc(ScrollOfs,9);π SetHorizOfs(ScrollOfs);πEnd;ππππBeginπ CursorOff;π FillChar(Mem[$B800:0000],4000,0);ππ With MoveMes doπ Beginπ YPos:=110;π YSpeed:=2;π XPos:=40*8;π XSpeed:=3;π Counter:=0;π End;ππ With MoveSplit Doπ Beginπ YPos:=295;π YSpeed:=2;π End;ππ DoubleWidth;π SetPelReset;π ScrollText(MoveMes.YPos);π Split(MoveSplit.YPos);π Setupbars;π MakePal;π SetCharSet;π Sync;π CenterWrite(1,14,#194'─────────────────────────────────────────────────────────────────────────────'#190);π WriteBigMessage(1,2,4,'GAME - Gotta Get it!');π CenterWrite(5,14,#194'─────────────────────────────────────────────────────────────────────────────'#190);ππ Repeatπ With MoveMes doπ Beginπ If (YPos>80) and (YPos<200) thenπ Inc(YPos,YSpeed)π elseπ Beginπ YSpeed:=-YSpeed;π YPos:=YPos+YSpeed;π End;π Counter:=1-Counter;π If Odd(Counter) thenπ Beginπ If (XPos<40*8) or (XPos>40*8+150) then XSpeed:=-XSpeed;π Inc(XPos,XSpeed);π End;π End;ππ With MoveSplit doπ Beginπ If (YPos>290) and (YPos<325) thenπ Inc(YPos,YSpeed)π elseπ Beginπ YSpeed:=-YSpeed;π YPos:=YPos+YSpeed;π End;π End;ππ UpdateBars;π ScrollText(MoveMes.YPos);π UpDateScroller;π Split(MoveSplit.YPos);π ColorBars;π Until KeyPressed;ππ While KeyPressed do Readkey;π Split(400);π SetView(0,0);π ScrollText(0);π Asmπ Mov Ax,3π Int 10hπ End;π FastWrite(1,1,15,'Bye from World of Wonders!');π Writeln;π CursorOn;πEnd.π