SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00137 GRAPHICS ROUTINES 1 05-28-9313:47ALL SEAN PALMER 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 ╓S 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 ╓U╜ {π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 ╓0╘ {π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 ╓Q╦ {π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 ╓ S {π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 ╓h# {π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 ╓êX {π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 ╓s {π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 ╓ r {π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 routine IMPORT 29 ╓¼E {π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 ╓Tâ {π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 ╓gµ {π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 ╓p─ {π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:35ALL NORMAN YEN View PCX File IMPORT 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.ππ 31 10-28-9311:39ALL BAS VAN GALLEN Another STARS IMPORT 29 ╓dn {===========================================================================π 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.ππ 32 11-02-9304:50ALL STEVE BOUTILIER Simple & QUICK Graphics IMPORT 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.π}ππ 33 11-02-9305:30ALL NORMAN YEN Display PCX Files IMPORT 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.π 34 11-02-9305:31ALL DAVE FOSTER Display PIC Files IMPORT 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).π}ππ 35 11-02-9305:49ALL RANDY PARKER Writing to Graphic Pages IMPORT 9 ╓r {π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.ππ 36 11-02-9305:52ALL VINCE LAURENT Scalable HEX Screen IMPORT 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.π 37 11-02-9305:54ALL NICK ONOUFRIOU Quick PutImage IMPORT 22 ╓╨a {π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.π 38 11-02-9305:55ALL STEFAN XENOS Loading Images from Disk IMPORT 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.π 39 11-02-9305:56ALL SEAN PALMER Another QUICK PutImage IMPORT 18 ╓py (*π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...)π}π 40 11-02-9306:11ALL KEVIN OTTO Fading IMPORT 11 ╓Q { 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.π 41 11-02-9317:24ALL SEAN PALMER Transparent PutImage IMPORT 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)π 42 11-02-9317:44ALL SEAN PALMER Bresenham Line IMPORT 12 ╓n {π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;π 43 11-21-9309:28ALL MICHAEL HOENIE Create Chars in Graphics IMPORT 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.ππ 44 11-21-9309:44ALL WILLIAM PLANKE Writing PCX files IMPORT 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 11-26-9317:01ALL RAPHAEL VANNEY DISPLAY Text in Graphics IMPORT 11 ╓h# {π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.π}ππ 46 01-27-9411:51ALL PETER M. GRUHN 3D Rotation IMPORT 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.πππ 47 01-27-9411:58ALL SEAN PALMER Bresenham's Line IMPORT 20 ╓─j {π>> 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;ππ 48 01-27-9412:05ALL LIOR BAR-ON Gif Source 1 IMPORT 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.π 49 01-27-9412:07ALL THORSTEN BARTH GIF Code IMPORT 42 ╓ÄQ {π> 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. 50 01-27-9412:07ALL BERNIE PALLEK VGA256 Unit IMPORT 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.π} 51 01-27-9412:07ALL JASEN BETTS Line Drawing IMPORT 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;ππ 52 01-27-9412:09ALL JORDAN PHILLIPS Graphics Images IMPORT 21 ╓Ç0 {π 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 ;π 53 01-27-9412:11ALL SEAN PALMER Flood Filling IMPORT 13 ╓5& {π> 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.π}π 54 01-27-9412:13ALL TIM JENSEN Masked Images IMPORT 12 ╓0▀ {π>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!π}π 55 01-27-9412:14ALL JENS LARSSON ModeX Scrolling IMPORT 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...π} 56 01-27-9412:15ALL RICHARD MOREY Images IMPORT 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.π 57 01-27-9412:17ALL DAVID DAHL Palette Maniputlation IMPORT 44 ╓Mö {$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.ππ 58 01-27-9412:17ALL LIOR BAR-ON PCX Files IMPORT 122 ╓2V π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.π 59 01-27-9412:18ALL DAVID DAHL Plasma IMPORT 33 ╓O¼ {$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.π 60 01-27-9412:18ALL SEAN PALMER Poly Drawing IMPORT 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;π 61 01-27-9412:20ALL KAI ROHRBACHER COD Images IMPORT 16 ╓╛j {π> 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).ππ 62 01-27-9412:21ALL BAS VAN GAALEN Shade Bobs IMPORT 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. }ππ 63 01-27-9412:22ALL SEAN PALMER Sprite Talk IMPORT 22 ╓0▀ {π>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.π}π 64 01-27-9412:22ALL HARALDS JAKOVELS Sprite Info IMPORT 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.π}π 65 01-27-9412:23ALL VARIOUS - SEE BELOW Textures IMPORT 51 ╓Zg π{π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.ππ*) 66 01-27-9412:25ALL WILLIAM PLANKE PCX Writing IMPORT 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.)ππ} 67 01-27-9413:32ALL GREG ESTABROOKS Mode 13 Demo IMPORT 12 ╓úN 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.π 68 01-27-9413:32ALL GREG ESTABROOKS Misc Graphic Functions IMPORT 45 ╓ùf 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.π 69 01-27-9417:32ALL PETER KOLDING 3D Graphics Box IMPORT 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.π 70 01-27-9417:37ALL BAS VAN GAALEN Moving a Shape across CRTIMPORT 28 ╓═W {π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. }ππ 71 01-27-9417:46ALL SEAN PALMER 3D Landscape Source IMPORT 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.ππ 72 01-27-9417:46ALL BERNIE PALLEK MODE 13H Graphics Unit IMPORT 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)π 73 02-03-9409:18ALL SEAN PALMER RIP Bezier Curves IMPORT 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.ππ 74 02-03-9409:19ALL SCOTT BRADSHAW More RIP Bezier Curves IMPORT 11 ╓═W {π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.ππ 75 02-03-9409:19ALL NICK ONOUFRIOU Another Bezier Curve IMPORT 12 ╓═W {π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;ππ 76 02-03-9410:55ALL FIASAL JUMA Fire Graphic IMPORT 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π 77 02-03-9410:58ALL SWAG SUPPORT TEAM Writing Text in Graphics IMPORT 31 ╓p╩ (*π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.ππ 78 02-03-9416:17ALL OLAF BARTELT Loading PCX Files IMPORT 24 ╓rΓ {ππ 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)ππ 79 02-03-9416:18ALL DON LABARRE Making VGA Rain IMPORT 13 ╓c
{π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.ππ 80 02-03-9416:19ALL BAS VAN GAALEN Vector coding IMPORT 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.π 81 02-05-9407:56ALL BAS VAN GAALEN Moving landscape IMPORT 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.ππ 82 02-09-9411:50ALL DAVID DAHL CheckerBoard IMPORT 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.π 83 02-18-9406:59ALL LENNERT BAKKER Textmode Effects IMPORT 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.π 84 05-25-9408:02ALL WIM VAN DER VEGT 7 Segment clock SWAG9405 94 ╓ {πHere's the source of a seven segment display useful to place at the endπof your autoexec if you also have the habit of turning your computer onπlong before using it or want an expensive clock (works then best on aπ66Mhz DX2 or Pentium).πππThe BGI_01 unit just links in the BGI driver. If removed you'll have toπsupply EGAVGA.BGI in the current directory (Or get the source of theπunit from a previous message).πππStart it with SEGMENT 15 and a bright yellow clock will appear.πππ-------------------------<cut hereππ{---------------------------------------------------------}π{ Project : Seven Segment Display }π{ Auteur : Ir. G.W. van der Vegt }π{---------------------------------------------------------}π{ Datum .tijd Revisie }π{ 901025.2000 Creatie. }π{---------------------------------------------------------}ππPROGRAM Segment(INPUT,OUTPUT);ππUSESπ CRT,π DOS,π GRAPH,π BGI_01;ππVARπ cl : INTEGER;ππ{---------------------------------------------------------}π{----Routine to display ASCII as seven segment LED display}π{---------------------------------------------------------}ππPROCEDURE Segments(nch,och : CHAR;xc,yc : INTEGER;scale : REAL);ππ{---------------------------------------------------------}π{----Types & const for graphical LED segment definition }π{---------------------------------------------------------}ππTYPEπ seg = ARRAY[1..7] OF Pointtype;ππCONSTπ Ver : seg = ((x : 1; y : 0),(x : 0; y : 1),π (x : 0; y : 9),(x : 1; y : 10),π (x : 2; y : 9),(x : 2; y : 1),π (x : 1; y : 0) );ππ Hor : seg = ((x : 0; y : 1),(x : 1; y : 0),π (x : 9; y : 0),(x : 10; y : 1),π (x : 9; y : 2),(x : 1; y : 2),π (x : 0; y : 1) );ππ DPdot : seg = ((x : 1; y : 1),(x : 2; y : 0),π (x : 2; y : 1),(x : 2; y : 2),π (x : 1; y : 2),(x : 0; y : 2),π (x : 1; y : 1) );ππ SCDot : seg = ((x : 4; y : 4),(x : 4; y : 6),π (x : 6; y : 6),(x : 6; y : 4),π (x : 4; y : 4),(x : 4; y : 4),π (x : 4; y : 4) );ππTypeπ dir = (vertical,horizontal,decimal,dot);ππ{---------------------------------------------------------}π{----Routine to hide/display a segment }π{---------------------------------------------------------}ππPROCEDURE Dispsegm(dir : dir;show : BOOLEAN; m,dx,dy : REAL);ππVARπ segm : seg;π i : INTEGER;ππBEGINπ CASE dir OFπ vertical : segm:=ver;π horizontal : segm:=hor;π decimal : segm:=DPdot;π dot : segm:=SCdot;π END;ππ FOR i:=1 TO 7 DOπ BEGINπ segm[i].x:=TRUNC((segm[i].x+dx)*m)+xc;π segm[i].y:=TRUNC((segm[i].y+dy)*m)+yc;π END;ππ IF showπ THEN setfillstyle(solidfill,cl)π ELSE setfillstyle(solidfill,black);ππ Fillpoly(7,segm);πEND;ππ{---------------------------------------------------------}π{----Types & Const for 7 segment display codes definitions}π{---------------------------------------------------------}ππTYPEπ leds = (a,b,c,d,e,f,g,dp,dl,dh);π offst = RECORDπ dx,dy : REAL;π d : dir;π END;π disp = SET OF leds;ππCONSTπ rel : ARRAY[leds] OF offst =π ((dx : 1.0;dy : 0.0; d : horizontal),π (dx : 0.0;dy : 1.0; d : vertical ),π (dx : 0.0;dy :11.0; d : vertical ),π (dx : 1.0;dy :20.0; d : horizontal),π (dx :10.0;dy :11.0; d : vertical ),π (dx :10.0;dy : 1.0; d : vertical ),π (dx : 1.0;dy :10.0; d : horizontal),π (dx :11.0;dy :21.0; d : decimal ),π (dx : 1.0;dy : 1.0; d : dot ),π (dx : 1.0;dy :11.0; d : dot ));ππ{---------------------------------------------------------}π{----Routine to convert ASCII to 7 segments }π{---------------------------------------------------------}ππPROCEDURE Calcleds(ch : CHAR;VAR sseg : disp);ππBEGINπ CASE ch OFπ '0' : sseg:=[a,b,c,d,e,f];π '1' : sseg:=[e,f];π '2' : sseg:=[a,c,d,f,g];π '3' : sseg:=[a,d,e,f,g];π '4' : sseg:=[b,e,f,g];π '5' : sseg:=[a,b,d,e,g];π '6' : sseg:=[a,b,c,d,e,g];π '7' : sseg:=[a,e,f];π '8' : sseg:=[a,b,c,d,e,f,g];π '9' : sseg:=[a,b,d,e,f,g];π '-' : sseg:=[g];π '-' : sseg:=[d];π '^' : sseg:=[a];π ':' : sseg:=[dl,dh];π '≡' : sseg:=[a,d,g];π '.' : sseg:=[dp];π ELSE sseg:=[];π END;πEND;ππVARπ led : leds;π oseg,π nseg,π offseg,π onseg : disp;ππBEGINπ Setcolor(DarkGray);ππ IF (nch=#0) AND (och=#0)π THENπ BEGINπ offseg:=[a,b,c,d,e,f,g,dp,dl,dh];π onseg :=[];π ENDπ ELSEπ BEGINπ Calcleds(och,oseg);π Calcleds(nch,nseg);ππ onseg :=nseg-oseg-oseg*nseg; {----Leds to turn on }π offseg:=oseg-nseg-oseg*nseg; {----Leds to turn off}π END;ππ FOR led:=a TO dh DOπ WITH rel[led] DOπ BEGINπ IF led IN onseg THEN Dispsegm(d, true,scale,dx,dy);π IF led IN offseg THEN Dispsegm(d,false,scale,dx,dy);π END;πEND;ππ{---------------------------------------------------------}π{----Prints error msg & halts program }π{---------------------------------------------------------}ππPROCEDURE Error(s : STRING);ππBEGINπ CLRSCR;π WRITELN;π WRITELN('SYNTAX : Segment <color>');π WRITELN;π WRITELN('ERROR ',s);π WRITELN;π HALT;πEND;ππ{---------------------------------------------------------}π{----Main Program }π{---------------------------------------------------------}ππVARπ tmp,π h,m,s,ms : WORD;π i,e : INTEGER;ππ c1,c2,c3 : STRING[2];ππ olds,π news : STRING;ππ grdriver,π grmode,π errcode : INTEGER;ππ r : REGISTERS;π oldstate: BYTE;ππ{---------------------------------------------------------}ππBEGINππ Grdriver:=detect;π DetectGraph(grdriver,grmode);ππ{----Allow segment color to be chosen by user}π IF (PARAMCOUNT=1)π THENπ BEGINπ VAL(PARAMSTR(1),cl,e);π IF (e<>0) THEN Error('Incorrcet Parameter');π ENDπ ELSEπ CASE grdriver OFπ mcga,π egamono : cl:=1;π ega64 : cl:=3;π ega,π vga : cl:=15;π END;ππ CASE grdriver OFπ mcga : IF NOT (cl IN [1])π THEN Error('With MCGA only color 1 is allowed');π ega64 : IF NOT (cl IN [1..3])π THEN Error('With 64 K EGA only colors 1..4 are allowed');π egamono : IF NOT (cl IN [1])π THEN Error('With EGA mono only color 1 is allowed');π ega : IF NOT (cl IN [1..15])π THEN Error('With 256 K EGA only colors 1..15 are allowed');π vga : IF NOT (cl IN [1..15])π THEN Error('With VGA only colors 1..15 are allowed');π ELSE Error('Graphics Adapter NOT Supported');π END;ππ Initgraph(grdriver,grmode,'');π errcode:=Graphresult;ππ news:=' ';π olds:=' ';ππ FOR i:=1 TO LENGTH(news) DO Segments(#0,#0,80*(i-1),80,6.0);ππ r.ah:=$02;π INTR($16,r);ππ REPEATπ oldstate:=r.al;ππ GETTIME(h,m,s,ms);ππ STR(h:2,c1);π STR(m:2,c2);π STR(s:2,c3);ππ IF Odd(s)π THEN news:=c1+':'+c2+':'+c3π ELSE news:=c1+' '+c2+' '+c3;ππ IF (news[1]=' ') THEN news[1]:='0';π IF (news[4]=' ') THEN news[4]:='0';π IF (news[7]=' ') THEN news[7]:='0';ππ {----Write only the changed segments in all displays}π FOR i:=1 TO LENGTH(news) DO Segments(news[i],olds[i],80*(i-1),80,6.0);ππ olds:=news;ππ Delay(100);ππ{----Not only wait for normal keypressed but also forπ shift/alt/ctrl or insert/numlock/scrollock keys pressed}π r.ah:=$02;π INTR($16,r);ππ UNTIL (r.al<>oldstate) OR (KEYPRESSED AND (READKEY<>#255));ππ Closegraph;ππEND. {of segment}πππ> I would like to include a clock in my current project which will beπ> updated once a minute. Instead of constantly checking the computer's clockπ> and waiting for it to change, I would like to use an interrupt.ππThis one has even a hot key handler. If you want to update it once perπminute, bump a counter within the interrupt 1Ch handler till it reaches theπvalue 60*18.2. Then refresh the screen.π}ππProgram Clock;ππ{$G+,R-,S-,M 1024, 0, 0 }ππusesπ Dos;ππConstπ x = 71; { x location on screen }π y = 1; { y location on screen }π Keyboard = 9; { Hardware keyboard interrupt }π TimerTick = $1C; { Gets called 18.2 / second }π VideoOffset = 160 * (y - 1) + 2 * x;{ Offset in display memory }π yellow = 14;π blue = 1;π attribute = blue * 16 + yellow; { Clock colours }π VideoBase : Word = $B800; { Segment of display memory }π ActiveFlag : ShortInt = -1; { 0: on, -1: off }ππVarπ OrgInt9, { Saved interrupt 9 vector }π OrgInt1Ch : Pointer; { Saved interrupt 1Ch vector }π VideoMode : Byte absolute $0000:$0449;ππ{ Display a string using Dos services (avoid WriteLn, save memory) }ππProcedure DisplayString(s : String); Assembler;ππASMπ PUSH DSπ XOR CX, CXπ LDS SI, sπ LODSBπ MOV CL, ALπ JCXZ @EmptyStringπ CLDπ @NextChar:π LODSBπ XCHG AX, DXπ MOV AH, 2π INT 21hπ LOOP @NextCharπ @EmptyString:π POP DSπend;ππ{ Returns True if a real time clock could be found }πFunction HasRTClock : Boolean; Assembler;ππASMπ XOR AL, ALπ MOV AH, 2π INT 1Ahπ JC @NoRTClockπ INC AXπ @NoRTCLock:πend;ππ{ Release Dos environment }πProcedure ReleaseEnvironment; Assembler;πASMπ MOV ES, [PrefixSeg]π MOV ES, ES:[002Ch]π MOV AH, 49hπ INT 21hπend;ππ{ INT 9 handler intercepting Alt-F11 }πProcedure ToggleClock; Interrupt; Assembler;πConstπ F11 = $57; { 'F11' make code }π BiosSeg = $40; { Segment of BIOS data area }π AltMask = $08; { Bitmask of Alt key }π KbdFlags = $17; { Byte showing keyboard status }ππASMπ STIπ IN AL, 60hππ { F11 pressed? }π CMP AL, F11π JNE @PassThruππ { Alt-key pressed? }π PUSH BiosSegπ POP ESπ MOV AL, ES:[KbdFlags]π AND AL, AltMaskπ CMP AL, AltMaskπ JNE @PassThruππ { Flip status flag, force EOI and leave routine }π NOT [ActiveFlag]π IN AL, 61hπ MOV AH, ALπ OR AL, 80hπ OUT 61h, ALπ MOV AL, AHπ OUT 61h, ALπ CLIπ MOV AL, 20hπ OUT 20h, ALπ STIπ JMP @Exitππ @PassThru:π CLIπ PUSHFπ CALL DWord Ptr [OrgInt9]π @Exit:πend; { ToggleClock }ππ{ Convert a packed BCD byte to ASCII character }πProcedure Digit; Assembler;πASMπ PUSH AXπ CALL @HiNibbleπ POP AXπ CALL @LoNibbleπ RETNππ @HiNibble:π SHR AL, 4π JMP @MakeAsciiπ @LoNibble:π AND AL, 0Fhπ @MakeAscii:π OR AL, '0'π STOSWπend;ππ{ INT 1Ch handler that displays a clock on the right hand side of the screen }πProcedure DisplayClock; Interrupt; Assembler;πASMπ CMP [ActiveFlag], 0π JNE @Exitπ CLDπ MOV AH, 2π INT 1Ahπ MOV ES, [VideoBase]π MOV DI, VideoOffsetπ MOV AH, attributeπ MOV AL, CHπ CALL Digitπ MOV AL, ':'π STOSWπ MOV AL, CLπ CALL Digitπ MOV AL, ':'π STOSWπ MOV AL, DHπ CALL Digitπ PUSHFπ CALL DWord Ptr [OrgInt1Ch]π @Exit:πend;ππBeginπ If VideoMode = 7 Thenπ VideoBase := $B000;π GetIntVec(TimerTick, OrgInt1Ch);π SetIntVec(TimerTick, @DisplayClock);π GetIntVec(Keyboard, OrgInt9);π SetIntVec(Keyboard, @ToggleClock);π SwapVectors;π ReleaseEnvironment;π DisplayString('CLOCK installed. <Alt-F11> toggles on/off');π Keep(0);πend.π 85 05-25-9408:02ALL RYAN PETRIE Virtual Screens SWAG9405 10 ╓ {ππWS>Hello! I've thought about writing my own 3D games or just any high graphicsπWS>program and am in the process of writing a unit that handles virtual screensπWS>have 6 virtual screens (0..5, where 0 will be MOVEd to $A000:0000) that areπWS>type pointer with 64000 bytes each. They are designed for Mode 13h, of coursπWS>I have a procedure called CopyScreen. Basically,ππJust FYI: You might want to consider using Mode-X. Matt Pritchard hasπwritten a great freeware library for such (MODEX10?.ZIP) with a Pascalπexample. With Mode-X, you can use the VGA's memory instead of preciousπconventional (if in real mode) memory, and the page switching is a lotπfaster than copying 64k from memory.π}ππprocedure copyscreen(source,dest : pointer; mask : byte); assembler;ππasmπ push dsπ lds si,sourceπ les di,destπ mov cx,64000π cldπ@loop:π lodsbπ cmp mask,alπ je @nodrawπ mov es:[di],alπ@nodraw:π inc diπ loop @loopπ pop dsπend;ππYou need to call it like this (note the '@'):ππ copyscreen(@virtualscreen[first],@virtualscreen[second],mask);π 86 05-25-9408:13ALL FLORIAN ANSORGE Fading UNIT SWAG9405 18 ╓ UNIT FadeUnit; { This unit does some fading (I hope!) }π { The SetCol procedure lets you change individual}π { palette entries , for an easier way, try }π { the TP setrgbpalette procedure...}π { Regards Florian Ansorge :-) }πINTERFACEππProcedure InitCol; {gets the current palette and saves it}ππProcedure FadeOUT(Duration:Byte); { lowers/increases the brightness,}πProcedure FadeIN(Duration:Byte); { duration determines the time it takes}ππProcedure SetBrightness(Brightness :Byte);π {sets the brightness to brightness / 63 }πIMPLEMENTATIONππUSES Crt, Dos;ππCONST PelIdxR = $3c7; {Port to read}π PelIdxW = $3c8; {Port to write}π PelData = $3c9; {Dataport}π Maxreg = 255; {Set to 63 for textmode}π MaxInten = 63;ππVAR col : ARRAY[0..MaxReg] of RECORDπ r, g, b : Byteπ END;ππPROCEDURE GetCol(ColNr :Byte; var r, g, b :Byte);πBEGINπ Port[PelIdxR] := ColNr;π r := Port[PelData];π g := Port[PelData];π b := Port[PelData];;πEND;ππPROCEDURE SetCol(ColNr, r, g, b :Byte); {Change just one colour}πBEGINπ Port[PelIdxW] := ColNr;π Port[PelData] := r;π Port[PelData] := g;π Port[PelData] := b;πEND;ππPROCEDURE InitCol; {save initial palette}ππVAR i :Byte;ππBEGINπ FOR i := 0 to MaxReg DOπ GetCol(i,col[i].r,col[i].g,col[i].b);πEND;ππPROCEDURE SetBrightness(Brightness :Byte);ππVAR i :Byte;π fr, fg, fb :Byte;ππBEGINπ FOR i := 0 to MaxReg DOπ BEGINπ fr := col[i].r * Brightness DIV MaxInten;π fg := col[i].g * Brightness DIV MaxInten;π fb := col[i].b * Brightness DIV MaxInten;π SetCol(i,fr,fg,fb);π END;πEND;ππPROCEDURE FadeOUT(Duration :Byte);ππVAR i :Byte;ππBEGINπ FOR i := MaxInten downto 0 DOπ BEGINπ SetBrightness(i);π Delay(Duration);π END;πEND;ππPROCEDURE FadeIN(Duration :Byte);ππVAR i :Byte;ππBEGINπ FOR i := 0 to MaxInten DOπ BEGINπ SetBrightness(i);π Delay(Duration);π END;πEND;ππBEGINπEND.π 87 05-25-9408:20ALL WIM VAN DER VEGT Delux Paint II LBM decodeSWAG9405 90 ╓ {πHere a program to display files from deLux Paint II (*.LBM files)πdrawings. It uses a PD BGI driver for 320x200x256 color mode. Otherπdrivers can also be used. Otherwise look in the SWAG lib for routines toπenter this graphics mode and set a pixel in a certain color.ππCode isn't optimal and can be made much faster but works. It doesn'tπdisplay some brushes because of some undocumented sections in the LBMπfile. If the defines are made active the file is decoded and dumpedπtextual to the screen. After the program a part of a small PD text fileπI found and used as base for this program. It contained some bugs butπone evening works does a lot.ππBtw. Does anybody know how to distinguish deLux Paint II and deLux PaintπII Enhanced files?π}ππ{---------------------------------------------------------}π{ Written by : Ir. G.W. van der Vegt }π{ Purpose : a Delux Paint II LBM file displayer/decoder}π{ displays 16 and 256 color bitmaps but no }π{ brushes and Delux Paint IIe files yet }π{ }π{ Displays at the moment only }π{ 320x200 or smaller pictures. }π{ }π{ Uses a PD SVGA driver to access MCGA mode. }π{ Substitute your own if you havn't got it. }π{ }π{ File format info by Bob Montgomery 9-21-90, although }π{ it wasn't very accurate (he forgot Motorola swaps }π{ lo & hi byes of words) and didn't cover the }π{ DPPV, CRNG & GRAB sections. }π{ }π{ Use the verbose (and rle) defines to get a dump of the }π{ lbm file. }π{---------------------------------------------------------}ππPROGRAM lbm(INPUT,OUTPUT);ππUSESπ crt,π dos,π graph;π routines;ππ{ DEFINE verbose}π{ DEFINE rle }π{$I SVGA256.INC}ππTYPEπ rgb = (r,g,b);π dp2l = ARRAY[0..3] OF BYTE; {read left to right}π dp2m = ARRAY[1..4] OF CHAR;π dp2t = ARRAY[rgb] OF BYTE;π dp2h = RECORDπ msg1 : dp2m; { "FORM" }π flen : dp2l; { File length - 8 }π msg2, { "ILBM" }π msg3 : dp2m; { "BMHD" }π hlen : dp2l; { Length of header }π width,π Length,π xoff,π yoff : WORD;π planes,π masking,π compression,π pad : BYTE;π tansparent : INTEGER;π x_aspect,π y_aspect : BYTE;π screenwidth,π screenheight : WORD;π END;ππCONSTπ max = 1023;ππVARπ f : FILE;π dp2 : dp2h;π msg : dp2m;π len : dp2l;π col : dp2t;ππ i,π j,π k,π y : INTEGER;π c : BYTE;π bl,π h,π l : LONGINT;π w : WORD;π grmode,π grdriver : INTEGER;π lin : ARRAY[0..max] OF BYTE;ππCONSTπ form : dp2m = ('F','O','R','M');π ilbm : dp2m = ('I','L','B','M');π bmhd : dp2m = ('B','M','H','D');π cmap : dp2m = ('C','M','A','P');π body : dp2m = ('B','O','D','Y');ππ{$F+}πFUNCTION Detectvga256 : INTEGER;ππBEGINπ Detectvga256 := svga320x200x256;πEND;π{$F-}πFUNCTION Len2long(a : dp2l) : LONGINT;ππBEGINπ Len2long:=(((a[0]*256+a[1])*256+a[2])*256+a[3]);πEND;ππFUNCTION Msg2str(a : dp2m) : STRING;ππBEGINπ Msg2str:=a[1]+a[2]+a[3]+a[4];πEND;ππFUNCTION Readnext : BYTE;ππVARπ w : WORD;π c : BYTE;ππBEGINπ Blockread(f,c,1,w);π IF (w<>1)π THENπ BEGINπ Closegraph;π Writeln('Unexpected EOF encountered');π Halt(3);π ENDπ ELSE Readnext:=c;πEND;ππCONSTπ cnt : BYTE = 0;π rle : BOOLEAN = false;π dat : BYTE = 0;π vir : LONGINT = 0;π rel : LONGINT = 0;ππFUNCTION Getnext : BYTE;ππVARπ c : BYTE;π w : WORD;ππBEGINπ(*πget a code BYTE from the data stream.πIF the msb is 1, the 'count' is (1 - code), max = 127. get the nextπ BYTE from the data stream, AND REPEAT it 'count' times.πIF the msb is 0, the 'count' is (1 + code), max = 128. get the nextπ 'count' bytes from the data stream.π*)π IF (dp2.compression=0)π THEN Getnext:=Readnextπ ELSEπ IF (cnt=0)π THENπ BEGINπ c:=Readnext;π rle:=(c>127);π IF rleπ THENπ BEGINπ cnt :=SHORTINT(1-c);π dat :=Readnext;π Getnext:=dat;π{$IFDEF rle}π Delay(500);π Writeln;π Write('RLE : ',byte2hex(c),' = ',cnt:3,'x',byte2hex(dat));π{$ENDIF}π ENDπ ELSEπ BEGINπ cnt :=1+c;π dat :=Readnext;π Getnext:=dat;π{$IFDEF rle}π Delay(500);π Writeln;π Write('UNC : ',byte2hex(c),' : ',byte2hex(dat));π{$ENDIF}π END;π ENDπ ELSEπ BEGINπ IF NOT(rle)π THEN dat:=Readnext;π Getnext:=dat;π{$IFDEF rle}π IF NOT(rle) THEN Write(' ',byte2hex(dat));π{$ENDIF}π END;ππ Dec(cnt);π rel:=Filepos(f)-h;π Inc(vir);πEND;ππBEGINπ Assign(f,Paramstr(1)+'.lbm');π Reset(f,1);ππ Blockread(f,dp2,Sizeof(dp2));ππ WITH dp2 DOπ BEGINπ{$IFDEF verbose}π FOR i:=1 TO Sizeof(msg1) DO Write(msg1[i]); Writeln;π FOR i:=1 TO Sizeof(msg2) DO Write(msg2[i]); Writeln;π{$ENDIF}π IF (msg1<>form) OR (msg2<>ilbm) OR (msg3<>bmhd)π THENπ BEGINπ Writeln('No DeLux Paint LBM file.');π Halt(1);π END;ππ{$IFNDEF verbose}π grdriver:=Installuserdriver('SVGA256',@detectvga256);π grmode :=svga320x200x256;π grdriver:=detect;π Initgraph(grdriver,grmode,'');π{$ENDIF}ππ {----Low & high words/bytes are swapped (Motorola 680x0 convention)}π{$IFDEF verbose}π Writeln('filelength : ',Len2long(flen));π Writeln('headlength : ',Len2long(hlen));π{$ENDIF}ππ {----Low & high bytes are swapped (Motorola 680x0 convention)}π width :=Swap(width);π Length :=Swap(Length);π xoff :=Swap(xoff);π yoff :=Swap(yoff);π screenwidth :=Swap(screenwidth);π screenheight:=Swap(screenheight);ππ{$IFDEF verbose}π Writeln('W .L : ',width ,'x',Length);π Writeln('Xo.Yo : ',xoff ,'x',yoff );π Writeln('Xa.Ya : ',x_aspect ,'x',y_aspect);π Writeln('W. H : ',screenwidth,'x',screenheight);π Writeln('Planes: ',planes);π Writeln('Pad : ',pad);π{$ENDIF}ππ Blockread(f,msg,Sizeof(msg));π Blockread(f,len,Sizeof(len));ππ{$IFDEF verbose}π Writeln(Msg2str(msg));π Delay(1000);π{$ENDIF}ππ IF (msg=cmap)π THENπ BEGINπ l:=Len2long(len);π{$IFDEF verbose}π Writeln('CMAPlen : ',l);π{$ENDIF}π FOR i:=1 TO l DIV 3 DOπ BEGINπ Blockread(f,col,Sizeof(col));π{$IFDEF verbose}π Delay(100);π Writeln(i-1:4,col[r]:4,col[g]:4,col[b]:4);π{$ELSE}π Setrgbpalette(i-1,col[r] DIV 4,col[g] DIV 4,col[b] DIV 4);π{$ENDIF}π END;π Blockread(f,msg,Sizeof(msg));π END;ππ{----dump unkown sections dppvπ the 4 bytes Length is mostly 104 bytesπ}π{----dump unkown sections grabπ the 4 bytes Length is 4, section found IN a brush only,π}π{----dump 4 unkown sections crng :π seems each TO consist OF two entries WITH :π 00 00 0a aa,00 00 01 0eπ 00 00 0a aa,00 00 00 00π 00 00 0a aa,00 00 00 00π 00 00 0a aa,00 00 00 00π brushes contain different values.π}π WHILE (msg<>body) DOπ BEGINπ Blockread(f,len,Sizeof(len));π l:=Len2long(len);π Writeln(Msg2str(msg)+' : ',l);π FOR h:=1 TO l DOπ BEGINπ Blockread(f,c,1);π Write(' ',byte2hex(c));π END;π Blockread(f,msg,Sizeof(msg));π Writeln;π END;ππ IF (msg=body)π THENπ BEGINπ{$IFDEF verbose}π Writeln(Msg2str(msg));π{$ENDIF}π Blockread(f,len,Sizeof(len));π l:=Len2long(len);π h :=Filepos(f);π{$IFDEF verbose}π Writeln('BODYlen : ',l);π{$ENDIF}π IF compression=0π THEN bl:=l DIV Length DIV planesπ ELSE bl:=width DIV 8;π{$IFDEF verbose}π Writeln('Bytew : ',bl);π{$ENDIF}π FOR y:=1 TO Length DOπ BEGINπ FOR i:=0 TO max DO lin[i]:=0;π{$R-}π FOR j:=0 TO planes-1 DOπ FOR i:=0 TO bl-1 DOπ BEGINπ c:=Getnext;π FOR k:=0 TO 7 DOπ IF (c AND (128 SHR k))>0π THEN lin[(i*8)+k]:=lin[(i*8)+k] OR 1 SHL j;π END;π{$R+}π{$IFNDEF verbose}π FOR i:=1 TO width DOπ Putpixel(i,y,lin[i])π{$ENDIF}π END;ππ END;ππ{$IFNDEF verbose}π WHILE NOT Keypressed DO;π Closegraph;π{$ELSE}π Writeln('image ',LONGINT(width)*Length*planes DIV 8);π Writeln('bodys ',h);π Writeln('files ',Filesize(f));π Writeln('filep ',Filepos(f));π Writeln('heads ',Sizeof(dp2h));π Writeln('virtu ',vir);π{$ENDIF}π Close(f);π END;ππEND.ππ(*πdeluxe paint ii lbm & iff filesππthe deluxe paint lbm (AND iff) FILE header (40 bytes) has the followingπcontent:π struct dp2π { CHAR msg1[4]; "form"π BYTE a3, a2, a1, a0; FILE Length - 8 (Read left TO right)π CHAR msg2[8]; "ilbmbmhd"π BYTE b3, b2, b1, b0; Length OF header (Read left TO right)π Int width, Length, xoff, yoff;π BYTE planes, masking, compression, pad;π Int tansparent;π BYTE x_aspect, y_aspect;π Int screenwidth, screenheight;π } ;π there may be a color map following a STRING "cmap" IN the FILE. after cmapπ is the Length OF the color map (4 bytes, Read left TO right). the colorπ map is BYTE triples (r, g, b) FOR each colors. the number OF colors isπ 1 shifted left by planes (1 << planes).π the actual picture data follows a STRING "body" AND Length OF the pictureπ data (4 bytes Read left TO right). the picture data is organized on aπ color plane basis FOR dp2, AND on a pixel basis FOR dp2e (enhanced).π thus, FOR dp2:π there are (width / 8) bytes per row.π the data stream FOR each row consists OF all the bytes FOR plane 0,π followed by all the bytes FOR plane 1, etc.π AND FOR dp2e:π there are (width) bytes/row, where each BYTE is a pixel color.π IF the data is uncomperessed (compression flag = 0), the data stream bytesπ are fed TO the OUTPUT unmodified. IF it is compressed, it is run Lengthπ encoded as follows:π get a code BYTE from the data stream.π IF the msb is 1, the 'count' is (1 - code), max = 127. get the nextπ BYTE from the data stream, AND REPEAT it 'count' times.π IF the msb is 0, the 'count' is (1 + code), max = 128. get the nextπ 'count' bytes from the data stream.π*)π 88 05-25-9408:20ALL RICKY BOOTH PCX *IN* Pascal! SWAG9405 34 ╓ ππ > Does anyone have a program (not necessarily source) that willπ > take a fullπ > screen GIF or PCX or whatever graphic format and convert it intoπ > something I can load in Pascal? Or even a graphic editor thatππYou can load a .PCX in pascal! No conversion needed. Here is some source.ππ{ MCGA PCX decode by Bas van Gaalen, Holland, PD }π{ Modified to use virtual screen/pointers by Ricky Booth, USA, PD }πππ{$M 65520, 4096, 655360}π{$I-}ππprogram pcx_view;ππusesπ crt;ππtypeπ pcxheader = recordπ manufacturer,version,encoding,bits_per_pixel : byte;π xmin,ymin,xmax,ymax,hres,vres : word;π palette : array[0..47] of byte;π reserved : byte;π color_planes : byte;π bytes_per_line : word;π palette_type : word;π filler : array[0..57] of byte;π end;ππvarπ pcxfile : file;π header : pcxheader;ππ{----------------------------------------------------------------------------}ππprocedure error(errstr : string);πbeginπ writeln(errstr);π halt;πend;ππ{----------------------------------------------------------------------------}ππfunction validpcx : boolean;πbeginπ seek(pcxfile,0);π blockread(pcxfile,header,sizeof(header));π with header do validpcx := (manufacturer = 10) and (version = 5) andπ (bits_per_pixel = 8) and (color_planes = 1);πend;ππ{----------------------------------------------------------------------------}ππfunction validpal : boolean;πvar v : byte;πbeginπ seek(pcxfile,filesize(pcxfile)-769);π blockread(pcxfile,v,1);π validpal := v = $0c;πend;ππ{----------------------------------------------------------------------------}ππprocedure setvideo(md : word); assembler;πasmπ mov ax,mdπ int 10hπend;ππ{----------------------------------------------------------------------------}ππCONST VGA = $a000; (* This sets the constant VGA to the segment of theπ VGA screen. *)ππType Virtual = Array [1..64000] of byte; { The size of our Virtual Screen }π VirtPtr = ^Virtual; { Pointer to the virtual screen }ππVAR Virscr : VirtPtr; { Our first Virtual screen }π Vaddr : word; { The segment of our virtual screen}ππprocedure setpal;πvar pal : array[0..767] of byte;πbeginπ seek(pcxfile,filesize(pcxfile)-768);π blockread(pcxfile,pal,768);π asmπ cldπ xor di,diπ xor bx,bxπ @L1:π mov dx,03c8hπ mov ax,bxπ out dx,alπ inc dxπ mov cx,3π @L2:π mov al,byte ptr pal[di]π shr al,1π shr al,1π out dx,alπ inc diπ loop @L2π inc bxπ cmp bx,256π jne @L1π end;πend;ππ{----------------------------------------------------------------------------}ππProcedure SetUpVirtual;πBEGINπ GetMem (VirScr,64000);π vaddr := seg (virscr^);πEND;ππprocedure unpack;πvar gofs,j : word; i,k,v,loop : byte;πbeginπ seek(pcxfile,128);π gofs := 0;π for i := 0 to header.ymax-header.ymin+1 do beginπ j := 0;π while j < header.bytes_per_line do beginπ blockread(pcxfile,v,1);π if (v and 192) = 192 then beginπ loop := v and 63;π inc(j,loop);π blockread(pcxfile,v,1);π for k := 1 to loop do beginπ Mem[Vaddr:gofs] := v;π inc(gofs);π end;π endπ else beginπ Mem[Vaddr:gofs] := v;π inc(gofs);π inc(j);π end;π end;π end;πend;ππProcedure WaitRetrace; assembler;πlabelπ l1, l2;πasmπ mov dx,3DAhπl1:π in al,dxπ and al,08hπ jnz l1πl2:π in al,dxπ and al,08hπ jz l2πend;ππ{----------------------------------------------------------------------------}ππbeginπ SetUpVirtual; (*initilizes the pointers*)π if paramstr(1) = '' then error('Enter filename on commandline.');π assign(pcxfile,paramstr(1));π reset(pcxfile,1);π if ioresult <> 0 then error(paramstr(1)+' not found.');π if not validpcx then error('Not a 256 color PCX file.');π if not validpal then error('Palette corrupt.');π Writeln('Decoding Image...');π Unpack;π Setvideo($13);π Setpal;π Move(Virscr^,MEM[VGA:0],64000); (*Stick the virtual page to the vga mem*)π repeat until keypressed;π While keypressed do readln;π setvideo(3);π close(pcxfile);π FreeMem (VirScr,64000); (*Free up virtual memory*)πend.π 89 05-25-9408:20ALL PETER GRUHN Plasma SWAG9405 51 ╓ {πThis is my plasma code. Written here for windows 24bit mode. There'sπsome comments in it. It had a problem. I tried to fix it. Couldn't.πDeleted some POSITIVELY ABSOLUTELY ESSENTIAL bits of code, and theπproblem went away. Don't ask me, I just wrote it.ππYou should be able to put it to palette based code pretty easy. Itπstarted out that way and then got converted to RGB. Probably all you'dπneed to do, is kill red and green, and just use blue as the paletteπentry. Your problem to make sure your palette has nice colours.ππIt still tends to be a little ridgy on the primary axes. If anybody canπget rid of that, that would be cool. Let me know.ππIt's also a fractal terrain generator. Same alg. This is just 3 fractalπterrain altitude maps overlaid in rgb.ππ(Oh, yeah, it's not really windows code. All the real windows codeπshould be separate from the useful code, just in case you don't doπwindows, don't be scared.)ππ--8<--------------------------------------------------------π}ππprogram plasma;π{integer version of cloud.π Only works 24bit. Change resolutionπ constants width, height if you need.}π{Left button starts drawing.π CTRL-ALT-DEL to stop. Or wait for it to finish, andπ right button}πuses OWindows, ODialogs, WinTypes, WinProcs;ππconstπ{integer version of old real constant.π For calm versions, try FUZZ1/FUZZ2=0.3π For wild versions, try FUZZ1/FUZZ2=10}π FUZZ1=1;π FUZZ2=6;ππ width= 800;π height= 600;ππtypeπ TMyApp=object (TApplication)π procedure InitMainWindow; virtual;π end;ππ PMyWindow=^TPlasmaWindow;π TPlasmaWindow=object (TWindow)π r,g,b:byte;π w,h:integer;π constructor init(AParent:PWindowsObject; ATitle:PChar);π procedure SetUpWindow; virtual;π procedure WMLButtonDown(var Msg:TMessage); virtual wm_First+wm_LButtonDown;π procedure WMRButtonDown(var Msg:TMessage); virtual wm_First+wm_RButtonDown;π function getclassname:pchar; virtual;π procedure getwindowclass(var awndclass:twndclass); virtual;π end;ππvar maxx,maxy:integer;π backg:TColorRef;π i:integer;ππfunction clamp(x:integer):byte;πbeginπ{ if x<0 then x:=0π else if x>255 then x:=255;π clamp:=x;}π case x ofπ -32767..0 : clamp:=0;π 0..255 : clamp:=x;π 256..32767: clamp:=255;π else {oops};π end; {case}πend;ππfunction randomcolour:TColorRef;πvar r,g,b:byte;πbeginπ randomcolour:=rgb(random(256),random(256),random(256));πend;ππprocedure TMyApp.InitMainWindow;πbeginπ MainWindow := New(PMyWindow, Init(NIL,'Plasma'));πend;ππconstructor TPlasmaWindow.init(AParent:PWindowsObject; ATitle:PChar);πbeginπ inherited init(AParent,ATitle);π r:=0; g:=0; b:=0;π w:=2;h:=2;π attr.x:=0; attr.y:=0;π attr.w:=width; attr.h:=height;π attr.style:=ws_popup + ws_visible;πend;ππprocedure TPlasmaWindow.SetUpWindow;πbeginπ inherited setupwindow;πend;ππprocedure TPlasmaWindow.WMLButtonDown(var Msg:TMessage);πvar ADC:HDC;π AP,TempP:HPen;π AB,TempB:HBrush;ππ function max(a,b:integer):integer;π beginπ if a<b then max:=b else max:=a;π end;ππ function mid(a,b:integer):integer;π beginπ mid:=(a + b) div 2;π end;ππ function ridge(a,b,c,d:integer):TColorref;π {Take two endpoints, shift the mid point, based on how far apart they are.}π var variance:integer;π r,g,l:byte;π m,n:TColorref;π vd2:integer;π beginπ variance:=max(c-a,d-b) * FUZZ1 div FUZZ2;π vd2:=variance div 2;π m:=getpixel(adc,(a),(b));π n:=getpixel(adc,(c),(d));π r:=clamp(((getrvalue(m) + getrvalue(n)) div 2{ + (random(variance))-vd2}));π g:=clamp(((getgvalue(m) + getgvalue(n)) div 2{ + (random(variance))-vd2}));π l:=clamp(((getbvalue(m) + getbvalue(n)) div 2{ + (random(variance))-vd2}));π ridge:=rgb(r,g,l);π end;ππ function shift(a,b,c,d:integer; col:tcolorref):tcolorref;π var variance:integer;π r,g,l:byte;π vd2:integer;π beginπ{ variance:=max(d-b,c-a) * FUZZ1 div FUZZ2;}π variance:=(c-a) * FUZZ1 div FUZZ2;π vd2:=variance div 2;π r:=clamp(getrvalue(col) + (random(variance))-vd2);π g:=clamp(getgvalue(col) + (random(variance))-vd2);π l:=clamp(getbvalue(col) + (random(variance))-vd2);π shift:=rgb(r,g,l);π end;ππ procedure quarter(l,t,r,b:integer);π var mx,my,width,colour,variance:integer;π mzr,mzg,mzb:byte;π c:char;π m,n,o,p,tc:TColorRef;π vd2:integer;π abrush:hbrush;π beginπ width:=r-l;π if (width>1) or (b-t>1) thenπ beginπ variance:=width * FUZZ1 div fuzz2 ;π vd2:=variance div 2;π mx:=mid(l,r);π my:=mid(t,b);π m:=getpixel(adc,l,t);π n:=getpixel(adc,l,b);π o:=getpixel(adc,r,t);π p:=getpixel(adc,r,b);π mzr:=clamp((getrvalue(m) + getrvalue(n) + getrvalue(o) + getrvalue(p)) div 4 + random(variance)-vd2);π mzg:=clamp((getgvalue(m) + getgvalue(n) + getgvalue(o) + getgvalue(p)) div 4 + random(variance)-vd2);π mzb:=clamp((getbvalue(m) + getbvalue(n) + getbvalue(o) + getbvalue(p)) div 4 + random(variance)-vd2);ππ setpixel(adc,mx,my,rgb(mzr,mzg,mzb));π setpixel(adc,(l),(my),ridge(l,t,l,b));π setpixel(adc,(r),(my),ridge(r,t,r,b));π setpixel(adc,(mx),(t),ridge(l,t,r,t));π setpixel(adc,(mx),(b),ridge(l,b,r,b));ππ quarter(l,t,mx,my);π quarter(l,my,mx,b);π quarter(mx,t,r,my);π quarter(mx,my,r,b);π end;π end;ππbeginπ ADC:=getdc(HWindow);π randomize;π maxx:=width-1; maxy:=height-1;π backg:=getpixel(ADC,10,10);π setpixel(adc,0,0,randomcolour);π setpixel(adc,0,maxy,randomcolour);π setpixel(adc,maxx,0,randomcolour);π setpixel(adc,maxx,maxy,randomcolour);π setpixel(adc,mid(0,maxx),0,randomcolour);π setpixel(adc,mid(0,maxx),maxy,randomcolour);π setpixel(adc,0,mid(0,maxy),randomcolour);π setpixel(adc,maxx,mid(0,maxy),randomcolour);π quarter(0,0,maxx,maxy);π end;ππprocedure TPlasmaWindow.WMRButtonDown(var Msg:TMessage);πbeginπ destroy;πend;ππfunction TPlasmaWindow.getclassname:pchar;πbeginπ getclassname:='Cloud Window';πend;ππprocedure TPlasmaWindow.getwindowclass(var awndclass:twndclass);πbeginπ inherited getwindowclass(awndclass);π awndclass.hbrbackground:=getstockobject(white_brush);πend;ππvar DitherApp:TMyApp;ππbeginπ DitherApp.init('Cloud');π DitherApp.run;π DitherApp.done;πend.π 90 05-25-9408:20ALL KAARE BOEEGH RE: PLASMA (revisited) SWAG9405 31 ╓ {π{TITLE: Plasma FROM: Kaare Boeegh DATE: Sun Apr 17 1994 08:25 pm}π{$A+,B-,D-,E-,F+,G+,I-,L-,N-,O-,R-,S-,V-,X-}πPROGRAM plasma;ππCONST ys : BYTE = 0;π yt : BYTE = 255;ππVAR ft : ARRAY [0..512] OF BYTE;π sint : ARRAY [0..256] OF BYTE;π i1,a,b,d,c,od,color,e,y : BYTE;π x,k,i : WORD;ππPROCEDURE do_tables;π VAR i : WORD;π BEGINπ FOR i := 0 TO 512 DO FT [i] := ROUND(64+63*SIN(i/40.74));π FOR i := 0 TO 256 DO SINT [i] := ROUND(128+127*SIN(i/40.74))-1;π END;ππPROCEDURE do_palette;π VAR i : WORD;π BEGINπ PORT[$3C8] := 0;π FOR i := 0 TO 255 DOπ BEGINπ PORT[$3C9] := i DIV 4;π PORT[$3C9] := i DIV 6;π PORT[$3C9] := i DIV 8;π END;π END;ππBEGINπ ASMπ mov al,ysπ mov y,alπ mov ax,0013h;π int 10h; {Set Mode $13}ππ mov dx,3d4h {Go into Double Height Pixel Mode}π mov al,9π out dx,alπ inc dxπ in al,dxπ and al,0e0hπ add al,3π out dx,alππ call do_palette;π call do_tables;ππ@3: inc i1 {Main Loop} {Grid Counter}π sub c,2π inc odπ mov al,odπ mov d,alππ mov al,ys {Alternate Starting Position every pass}π mov ah,ytπ xchg al,ahπ mov ys,alπ mov ah,ytπ mov y,alππ @2: mov al,y {Calculate Offset and add one every second line}π mov bx,320π mul bxπ mov bx,axπ mov al,yπ mov ah,0π and al,1π add ax,bxπ mov k,axππ mov al,i1 {move grid one pixel down every second frame}π mov ah,0π and al,1π mov ah,0π mov bx,320π mul bxππ mov bx,kπ sub bx,axπ mov k,bxππ mov al,dπ add al,2π mov d,alππ mov al,c {[(c}π add al,y {+y)}π and ax,255 {and 255]}π mov di,offset sint {get sint mem location}π add di,ax {[c+y] and 255}π mov al,ds:[di] {sint[(c+y) and 255]}π mov a,alππ mov di,offset sintπ mov al,dπ and al,255π add di,axπ mov al,ds:[di]π mov b,alππ mov ax,0π mov bx,0π mov cx,0ππ @1: mov di,offset ft {get ft mem location}π mov al,a {a}π add al,b {+b}π add di,ax {[a+b]}π mov al,ds:[di] {ft[a+b]}π mov bx,ax {Store}π inc bx {+1}π mov di,offset ft {get ft mem location}π mov al,y {y}π add al,b {+b}π add di,ax {[y+b]}π mov ax,ds:[di] {ft[y+b]}π add ax,bx {+}π mov color,al {color:=}ππ mov bx,0a000h {screen memory location}π mov es,bx {mov it to es}π mov di,k {k is screen offset}πππ mov es:[di+80],al {plot color to screen}π { ^^ center}π mov al,bπ add al,2π mov b,alππ mov ax,k {Ofs of Plasma Pixel, Increased by 2 to Create the Grid}π add ax,2π mov k,axππ mov ah,0 {INC(a,1+color SHR 7);}π mov al,colorπ shr al,7π add al,1π mov ah,0π mov bl,alπ mov al,aπ add al,blπ mov a,alππ inc cxπ cmp cx,80 {160}π jnz @1 {inner loop}ππ inc yπ cmp y,101π jnz @2 {outer loop, number of lines}ππ mov ah,01hπ int 16hπ jz @3 {get keypress}ππ mov ax,03h {mode 3}π int 10hπ END;πEND.π-----------------------------------------------------------------------------πShipleyπ--- Synchronetπ * Origin: The Brook Forest Inn [714] 951-5282 (1:103/950)π 91 05-25-9408:21ALL JOHN SHIPLEY Re: Virtual Reality. SWAG9405 26 ╓ {πRE: Re: Virtual Reality.πBY: Bas van Gaalen to John Shipley on Fri Mar 25 1994 02:26 pmππ > John Shipley wrote in a message to Bas van Gaalen:π > π > > I posted it recently, so you must have seen it passing by...π > JS> You did? I read just about every post you write, I didn'tπ > JS> see any program by that name come by here.π > π > I suppose it got lost. You're the second... Anyway, I posted it again. Checkπ > previous message... It should be there.ππHello Bas!ππYes, I got it today... basically the problem I saw with the code was lack ofπoptimization and it also looked like you were trying to do too much. Youπdidn't need all the asm. But it could be even faster if you included it. I'mπsending back my modified version of your DYCP program. The "writecharasm"πprocedure was screwed up so I removed it and I will check it out at a laterπtime. I modified the "writechar" procedure which you had commented out.ππ-------8<---------Snip---------8<---------Snip---------8<--------Snip---------ππ{$G+}πPROGRAM different_y_char_position;ππ(* Programmed by Bas van Gaalen, Holland, PD *)π(* Modified by John Shipley, USA, PD 03/30/94 *)ππUSES CRT;ππCONST vseg : WORD = $a000;π txt : STRING = '**** Well... 38 chars, let''s see. ****';π (* 12345678901234567890123456 78901234567890 *)π txt1 : STRING = 'This is another Strng of 38 Characters';πVAR stab : ARRAY[0..255] OF BYTE;π fseg,fofs : WORD;ππPROCEDURE getfont; ASSEMBLER;π ASMπ mov ax,1130h;π mov bh,1;π int 10h;π mov fseg,es;π mov fofs,bp;π END;ππPROCEDURE csin;π VAR i : BYTE;π BEGINπ for i := 0 to 255 do stab[i] := round(sin(6*i*pi/255)*25)+40;(*150*)π END;ππPROCEDURE clear(x,y: WORD); ASSEMBLER;π ASMπ mov es,vsegπ mov dx,0π @lout:π mov cx,0π @lin:π mov ax,yπ add ax,dxπ shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,xπ add di,cxπ xor ax,axπ mov [es:di],axπ add cx,2π cmp cx,8π jne @linπ inc dxπ cmp dx,2 (* Was 8 *)π jne @loutπ END;ππPROCEDURE writechar(ch: CHAR; x,y: WORD; col: BYTE);π VAR j,k : BYTE;π pre : WORD;π opt : WORD;π BEGINπ pre := BYTE(ch)*8; (* Opt *)π clear(x,y-2); (* Key *)π FOR j:=0 TO 7 DOπ FOR k:=0 TO 7 DOπ BEGINπ opt := (y+j)*320+x+k; (* Opt *)π IF ((MEM[fseg:fofs+pre+j] SHL k) AND 128)=0 THENπ MEM[$a000:opt] := 0 (* Key *)π ELSEπ MEM[$a000:opt] := col;π END;π INC(y,8); (* Opt *)π clear(x,y); (* Key *)π END;ππPROCEDURE dodycp;π VAR sctr,i,l: BYTE;π a,b,c : WORD;π BEGINπ sctr := 0;π l := LENGTH(txt); (* Opt *)π REPEATπ WHILE (PORT[$3da] AND 8)<>0 DO;π WHILE (PORT[$3da] AND 8)=0 DO;π FOR i := 1 TO l DOπ BEGINπ a := i*8;π b := stab[(sctr+2*i) MOD 255];π c := stab[sctr+i] MOD 64;π INC(c,32);π writechar(txt[i],a,b,c);π INC(b,110);π writechar(txt1[i],a,b,c);π END;π INC(sctr);π UNTIL KEYPRESSED;π END;ππBEGINπ getfont;π csin;π ASMπ mov ax,13h;π int 10h;π END;π dodycp;π TEXTMODE(lastmode);πEND.π 92 05-25-9408:22ALL GLEN JEH Ribbon scroll.. SWAG9405 21 ╓ π{Ribbon scroller...programmed by Glen Jeh in Turbo Pascal 7.0, 4/24/94π Use freely}ππ{$R+}πprogram RibbonScroll; {this is IT}πuses Crt, Dos;ππ { I turned on range checking to slow it down :) }ππconstπ YLocation = 100; {position on the screen...}π Constant = 8; {mess with this to use different parts of the curve}π Radius = 30; {this is how big of a curve you want}π Width = 10; {wrong name..this is actually the waviness of the curve}π Spacing = 4; {this is how fat the chars will be..or something}π Height = 1.5; {this is how tall each character will be}π DispStr : string = 'Adjust the above constants <WRAP>... ';ππ Rows = 8; {don't change this}ππ{testing}πtypeπ CharType = array[1..8] of Byte;π PathType = array[1..320 div Spacing] ofπ recordπ Pos : Word; {position in memory}π On : Boolean; {on or off?}π end;π {this keeps track of the Y-Pos of the dot at X}πvarπ CharSet : array[0..255] of CharType absolute $F000:$FA6E;π PathArray : array[1..Rows] of PathType;π I,π I2,π DispLine : Integer;ππfunction GetNext(Row : Integer) : Boolean;πvarπ CharNum,π ColumnNum : Integer;πbeginπ CharNum := DispLine div 8 + 1;π ColumnNum := DispLine mod 8 + 1;π GetNext := CharSet[Ord(DispStr[CharNum])][Row] shr (8 - ColumnNum) and 1 = 1;πend;πππfunction F(X:Real): Real;πbeginπ F := (Sin ((X + Constant) / Width) * Radius + YLocation)πend;πππprocedure Mode(B : Byte);πvarπ Regs : Registers;πbeginπ Regs.ah := 0;π Regs.al := B;π Intr($10,Regs);πend;ππprocedure BuildPath;πbeginπ for I := 1 to Rows doπ for I2 := 1 to 320 div Spacing doπ beginπ PathArray[I][I2].Pos := Round(F(I2+Height*I));π {compute Y location first}ππ PathArray[I][I2].Pos :=π (PathArray[I][I2].Pos - 1) * 320 + (I2 * Spacing) - 1;π {compute memory location}π endπend;πππbeginπ Mode($13);π BuildPath;π DispLine := 1;π repeatπ repeat until (Port[$3DA] and $08) <> 0;π for I := 1 to 8 doπ beginπ for I2 := 1 to (320 div Spacing) - 1 doπ PathArray[I][I2].On := PathArray[I][I2 + 1].On;π PathArray[I][320 div Spacing].On := GetNext(I);π for I2 := 1 to 320 div Spacing doπ if PathArray[I][I2].On thenπ Mem[$A000:PathArray[I][I2].Pos] := I2 mod (100 - 50) + 50π elseπ Mem[$A000:PathArray[I][I2].Pos] := 0;π end;π Inc(DispLine);π if DispLine = 8 * Length(DispStr) thenπ DispLine := 1;π until KeyPressed;π Mode($3);πend.π 93 05-25-9408:22ALL OSCAR WAHLBERT Multicolour Text Scroll SWAG9405 17 ╓ πprogram multicolourtextscroll;πuses crt;πconst sseg : word = $b800; hi = 16; wideness = 1;π txt : string = 'Multicoloured smooth text scroller! ';π maxcols = 17; cols : array[0..maxcols] of byte =π (8, 8, 8, 7, 8, 7, 7, 15, 7, 15, 15, 15, 7, 15, 7, 7, 8, 7);πvar idx : word; i, cur, line, bitpos : byte;π ccol : byte; colw : byte; ch : char;ππ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 movecharsleft(startingrow : word); assembler;πasmπ push ds;π mov ax,$b800;π mov ds,ax;π mov di,2π @@MoveByte:π add di,startingrow;π mov al,[ds:di];π sub di,2π mov [ds:di],al;π sub di,startingrow;π add di,4π cmp di,160π jl @@MoveByte;π pop dsπend;ππprocedure movecolsright(startingrow : word); assembler;πasmπ push dsπ mov ax,$b800π mov ds,axπ mov di,161π @@MoveByte:π add di,startingrowπ sub di,4π mov al,[ds:di]π add di,2π mov [ds:di],alπ sub di,startingrowπ cmp di,0001π ja @@MoveByteπ pop dsπend;πππbeginπ textattr := 7; clrscr; ccol := 1; idx := 1; colw := 0;π repeatπ inc(colw);π retrace;π mem[$b800:hi*160+158] := ord(txt[idx]);π movecharsleft(hi*160);π if (colw > 1) then beginπ colw := 0; inc(ccol);π mem[$b800:hi*160+1] := cols[ccol mod (maxcols+1)];π movecolsright(hi*160);π end;π if not keypressed then idx := 1 + idx mod length(txt);π until keypressed;π while keypressed do ch := readkey; textattr := 7; clrscr;πend.ππThe push/pop ds might be superfluous... I don't know if you need them or not...πI'm just starting assembly, you know. :^)πIt's kinda like the one you made, but it doesn't lock up on my computer -- youπcan't check port[$60] on XTs. :^)πAnd in this, the colours move one way, and the text, the other. It's kindaπdistracting when you're trying to read the scroll, but oh well...πC-YA.ππ 94 05-25-9408:23ALL PIETER KIRKHAM Faster Sprites SWAG9405 32 ╓ {π For the people who requested a faster sprite drawing program, here it is.πThis program is just Bas van Gaalen's sprite program with a few modificationsπto make it run quicker. I am currently working on this program, so that itπwill be able to handle more sprites than one..ππ------------------- CUT HERE ----------------------π}ππPROGRAM Game_sprites;π{ By Bas van Gaalen, Holland, PD }π{$G+}ππUSES crt;ππCONST w=16; h=16; sega000= $0A000;ππTYPEπ SPRBUF = Array[1..256] of Byte;ππVARπ Bckbuf,Sprite : SPRBUF;π px,py : Word;π CCOS,CSIN : Array [0..360] of WORD;ππCONSTπ SegS : Word = SEG(Sprite);π OfsS : Word = OFS(Sprite);π SegB : Word = SEG(BckBuf);π OfsB : Word = OFS(BckBuf);πππ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 retrace; assembler;πASMπ mov dx,03dahπ@l2:π in al,dxπ test al,8π jz @l2πEND;ππPROCEDURE putsprite(x,y:word);πBEGINπ ASMπ CLIπ PUSH DSπ MOV AX,0A000hπ MOV ES,AXπ MOV DS,SegBπ MOV AX,PYπ SHL AX,6π MOV DI,AXπ SHL AX,2π ADD DI,AXπ ADD DI,PXπ MOV DX,1010hπ MOV AX,OfsBπ MOV SI,AXπ XOR AX,AXπ@1:π MOV AL,[DS:SI] { Display the sprite buffer over the old sprite }π MOV [ES:DI],ALπ INC DIπ INC SIπ DEC DLπ JNZ @1π ADD DI,304π MOV DL,16π DEC DHπ JNZ @1π MOV AX,Yπ SHL AX,6π MOV DI,AXπ SHL AX,2π ADD DI,AXπ ADD DI,Xπ MOV DX,1010hπ MOV AX,OfsBπ MOV SI,AXπ XOR AX,AXπ@2: { Store the background into the Sprite Buffer }π MOV AL,[ES:DI]π MOV [DS:SI],ALπ INC DIπ INC SIπ DEC DLπ JNZ @2π ADD DI,304π MOV DL,16π DEC DHπ JNZ @2π MOV AX,Yπ SHL AX,6π MOV DI,AXπ SHL AX,2π ADD DI,AXπ ADD DI,Xπ MOV DX,1010hπ MOV AX,OfsSπ MOV SI,AXπ XOR AX,AXπ@3:π CMP [DS:SI],AH { Display the Sprite at it's new location }π JZ @4π MOV AL,[DS:SI]π MOV [ES:DI],ALπ@4:π INC DIπ INC SIπ DEC DLπ JNZ @3π ADD DI,304π MOV DL,16π DEC DHπ JNZ @3π POP DSπ STIπ END;π px:=x; py:=y;πEND;ππ(* This procedure I added to speed up the rotation used when displaying theπsprite. This is not nessary, but usefull *)ππPROCEDURE Calc_Cos_Sin;πVAR I : word;πBEGINπ FOR I := 0 to 360 DOπ BEGINπ CCOS[I] := ROUND(COS(PI*I/180)*150);π CSIN[I] := ROUND(SIN(PI*I/180)*75);π END;πEND;ππvar i,j:word;ππBEGINπ ASMπ mov ax,13hπ int 10hπ END;π Calc_Cos_Sin;π for i:=1 to 255 do setpal(i,255-i div 6,255-i div 4,20);π fillchar(bckbuf,sizeof(bckbuf),0);π { create background }π for i:=0 to 319 doπ for j:=0 to 199 doπ mem[sega000:j*320+i]:=round(5+0.4*i+0.4*j)+random(10);π { create random sprite }π randomize;π for i:=1 to 256 doπ sprite[i]:=random(255);π { clear middle part }π for i:=6 to 10 doπ for j:=6 to 10 doπ sprite[j*w+i]:=0;π i:=0;π { save first old backup screen }π px:=0; py:=0;ππ(* The following assembly code is required to save the sprites background whenπit is first displayed. I am still trying to figure how to incorperate thisπinto the main assembly code for displaying the sprite *)ππ ASMπ CLIπ PUSH BPπ PUSH DSππ MOV AX,SegA000π MOV ES,AXπ MOV DS,SegBππ MOV AX,0π SHL AX,6π MOV DI,AXπ SHL AX,2π ADD DI,AXπ ADD DI,0ππ MOV DX,1010hπ MOV AX,OfsBπ MOV BP,AXπ XOR AX,AXπ@2:π MOV AL,[ES:DI]π MOV [DS:BP],ALπ INC DIπ INC BPπ DEC DLπ JNZ @2π ADD DI,304π MOV DL,16π DEC DHπ JNZ @2ππ POP DSπ POP BPπ STIπ END;π { move sprite over background }π repeatπ retrace;π putsprite(150+CCOS[I],100+CSIN[I]);π i:=1+i mod 360;π until keypressed;π ASMπ mov ax,3hπ int 10hπ END;πEND.ππ 95 05-25-9408:23ALL ANDREW GOLOVIN Starry night simulation SWAG9405 43 ╓ πProgram StarryNight;ππ{ Looks like some late evening in the summer before starry night }π{ But i guess that stars goes brighter much faster than dimmer }π{ Can you advise me on that fenomenon? }ππConstπ NumberOfStars = 55; { Number of Stars. Can't be greater than 55 }πtypeπ StarMapArray = Array [0..6,0..4] of Word;π { Each star allocate rectangle 4 pixels width and 6 pixels height }πconstπ StarMap : StarMapArray =π ((0,0,1,0,0),π (0,0,2,0,0),π (0,0,3,0,0),π (1,3,4,3,1),π (0,0,3,0,0),π (0,0,2,0,0),π (0,0,1,0,0));π { This is picture of one star }πTypeππ RGBRec = Recordπ r,g,b: byte;π end;π { Palette record }ππ PStar = ^TStar; { Star itself }π TStar = objectπ Delta: byte; { Step for brightness change }π Brightest: RGBRec; { The very brightest color of the star }π Brighten: Boolean; { Do star go brighter? }π Number: byte; { Personal star number }π Xloc,Yloc: word; { X,Y location }π Colors: Array [1..4] of RGBRec; { Star colors }π constructor Init(ANumber: Byte);π procedure Relocate; { Move star to new position }π procedure Rotate; { Change colors step by step }π end;ππ{..$DEFINE Mono}π{ Define MONO if you whant to see gray-scaled stars }ππfunction keypressed : boolean; assembler;π asmπ Mov AH,01hπ Int 16hπ JNZ @0π XOR AX,AXπ Jmp @1π@0: Mov AL,1π@1:π end;ππconstructor TStar.Init(ANumber: Byte);π varπ cx,cy: word;π beginπ Number:=ANumber;π XLoc:=0;YLoc:=0;π Relocate;π end;ππprocedure TStar.Relocate;π varπ cx,cy: word;π cc: byte;π {$IFDEF Mono}π mc: byte;π {$ENDIF}π beginπ For cy:=0 to 6 doπ For cx:=0 to 4 doπ Mem[$A000:(cx+XLoc)+(cy+Yloc)*320]:=(224+(cy+YLoc) div 8);π { Restore old background }π Brighten:=True;π {$IFDEF Mono}π mc:=Random(64);π With Brightest doπ beginπ r:=mc;π g:=mc;π b:=mc;π end;π {$ELSE}π With Brightest doπ beginπ r:=Random(64);π g:=Random(64);π b:=Random(64);π end;π {$ENDIF}π Port[968]:=Number*4;π For cc:=1 to 4 doπ beginπ with Colors[cc] doπ beginπ r:=0; g:=0; b:=0;π end;π Port[969]:=0;π Port[969]:=0;π Port[969]:=0;π end;π XLoc:=Random(320-5);π YLoc:=Random(200-7);π Delta:=Random(5)+1;π { Delta:=(YLoc Div 40)+1;}π { Stars near horizont blink rapidly }π For cx:=0 to 4 doπ For cy:=0 to 6 doπ if StarMap[cy,cx]<>0π thenπ Mem[$A000:(cx+XLoc)+(cy+Yloc)*320]:=π StarMap[cy,cx]+(Number ShL 2)-1;π { Put star to screen }π end;ππprocedure TStar.Rotate;π varπ cc: byte;π cx,cy: word;π beginπ If Brightenπ thenπ beginπ For cc:=1 to 4 doπ beginπ If Colors[5-cc].r+Delta<=Brightest.r div ccπ thenπ Inc(Colors[5-cc].r,Delta)π elseπ Colors[5-cc].r:=Brightest.r div cc;π If Colors[5-cc].g+Delta<=Brightest.g div ccπ thenπ Inc(Colors[5-cc].g,Delta)π elseπ Colors[5-cc].g:=Brightest.g div cc;π If Colors[5-cc].b+Delta<=Brightest.b div ccπ thenπ Inc(Colors[5-cc].b,Delta)π elseπ Colors[5-cc].b:=Brightest.b div cc;π end;π if (Colors[4].r=Brightest.r) andπ (Colors[4].g=Brightest.g) andπ (Colors[4].b=Brightest.b)π thenπ Brighten:=Falseπ endπ elseπ beginπ For cc:=1 to 4 doπ beginπ If Colors[cc].r>=Deltaπ thenπ Dec(Colors[cc].r,Delta)π elseπ Colors[cc].r:=0;π If Colors[cc].g>=Deltaπ thenπ Dec(Colors[cc].g,Delta)π elseπ Colors[cc].g:=0;π If Colors[cc].b>=Deltaπ thenπ Dec(Colors[cc].b,Delta)π elseπ Colors[cc].b:=0;π end;π if (Colors[4].r=0) and (Colors[4].g=0) and (Colors[4].b=0)π thenπ Relocate;π end;π Port[968]:=Number*4;π For cc:=1 to 4 doπ beginπ Port[969]:=Colors[cc].r;π Port[969]:=Colors[cc].g;π Port[969]:=Colors[cc].b;π end;π end;ππvarπ StarArray: Array [1..NumberOfStars] of PStar;π sc: byte;π c: char;π ccx,ccy: word;ππbeginπ asm mov ax,13h; int 10h end;π port[968]:=224;π for ccx:=1 to 255-224 doπ beginπ port[969]:=ccx div 2;π port[969]:=0;π port[969]:=ccx;π end;π For ccx:=0 to 319 doπ For ccy:=0 to 199 doπ Mem[$A000:(ccx+ccy*320)]:=(224+ccy div 8);π { This make a background or backsky as you like }ππ for sc:=1 to NumberOfStars doπ beginπ StarArray[sc]:=New(PStar,Init(sc));π end;π sc:=1;π repeatπ StarArray[sc]^.Rotate;π If sc=NumberOfStarsπ thenπ sc:=1π elseπ Inc(sc);π until keypressed;πend.π 96 05-25-9408:25ALL ALEX CHALFIN Wormhole SWAG9405 14 ╓ {πMSGID: 1:108/180 868965DBπWell, here is the cool wormhole program that everybody has been awaiting.ππIt consists of three programs, WGEN, PGEN, and WORMHOLE. The WGen programπgenerates the data file for the wormhole. PGen generates a palette fileπfor the wormhole. WORMHOLE actually runs the program once everything is done.ππ************ Listing of WGEN.PASπ}ππ{$N+,E+,G+}πProgram WGen;π{actually generates the Wormhole, SLOW}π{ math co-processor HIGHLY recommended }ππUses Crt;ππConstπ Stretch = 25; XCenter = 160;π YCenter = 50; DIVS = 1200;π SPOKES = 2400;ππProcedure TransArray;ππVarπ x, y, z : Real;π i, j, color : Integer;ππBeginπ For j := 1 to DIVS doπ Beginπ For i := 0 to (Spokes-1) doπ Beginπ z := (-1.0)+(Ln(2.0*j/DIVS));π x := (320.0*j/DIVS*cos(2*Pi*i/SPOKES));π y := (240.0*j/DIVS*sin(2*Pi*i/Spokes));π y := y-STRETCH*z;π x := x + XCenter;π y := y + YCenter;π Color := (Round(i/8) Mod 15)+15*(Round(j/6) MOD 15)+1;π if ((X>=0)and(x<320)and(Y>=0)and(y<200))π Then Mem[$A000:Round(x) + (Round(y) * 320)] := Color;π End;π End;πEnd;ππProcedure SaveImage;ππVarπ i, j : Integer;π Diskfile : File of Byte;ππBeginπ Assign(Diskfile, 'Ln.DAT');π Rewrite(Diskfile);π For i := 0 to 199 doπ For j := 0 to 319 doπ Write(Diskfile, Mem[$A000:j + (320 * i)]);π Close(Diskfile);πEnd;ππBeginπ Asm MOV AX,$13; INT $10; End;π FillChar(Mem[$A000:$0000], 64000, 0);π transarray;π SaveImage;π Asm MOV AX,3; INT $10; End;πEnd.π 97 05-26-9406:18ALL PAUL BROMAN Image to File IMPORT 11 ╓ {πS> Hi all.. I need some help.. I'm using GetImage to grab a portionπAS> of the graphics screen - so I can use PutImaget to "Paste" it onπAS> the screen later. My question is : Can this GetImage be saved toπAS> a file & loaded later.. If so how do I save and load it? I wouldπAS> appreciate any help you can give me ... Angel Sanchez.ππIt sure can. Take a look at this code:ππTo Save: }ππprogram SaveImage;ππvarπ upx, lefty, downx, righty: word;π ScreenCapSize : longint;π ScreenLoc : pointer;π CapFile : file;ππScreenCapSize := ImageSize(upx, lefty, downx, righty);πGetMem(ScreenLoc, ScreenCapSize);πGetImage(upx, lefty, downX, rightY, ScreenLoc^);πAssign(CapFile, 'FILENAME.FIL');πRewrite(CapFile, ImageSize(0,0,60,60));πBlockWrite(CapFile, ScreenLoc^, ScreenCapSize);πClose(CapFile);πend.ππprogram LoadImage;ππvarπ X, Y: word;π ScreenCapSize : longint;π ScreenLoc : pointer;π CapFile : file;ππbeginπScreenCapSize := {Original Size of capture pic}πGetMem(ScreenLoc, ScreenCapSize);πAssign(CapFile, 'FILENAME.FIL');πReset(CapFile, ScreenCapSize);πSeek(CapFile, 1 {Or whichever image to read});πBlockRead(CapFile, ScreenLoc^, ScreenCapSize);πClose(CapFile);πPutImage(X, Y, ScreenLoc^);πend.ππ 98 05-26-9406:18ALL MARTIN RICHARDSON Screen Dump To File IMPORT 9 ╓ {π DUMPSCR.PASπ Demo to dump a 25 line screen to disk and then restore itπ By Martin Richardsonπ (This code is Public Domain... Enjoy!)π }π USES CRT;ππ TYPEπ ScreenArray = ARRAY[1..25 * 80] OF WORD;π ScreenPtr = ^ScreenArray;ππ VARπ _Screen: ScreenPtr;π fHandle: FILE;π ScreenRows: BYTE;ππ BEGINπ IF (LastMode = Mono) THENπ _Screen := PTR( $B000, 0 )π ELSEπ _Screen := PTR( $B800, 0 );ππ ASSIGN( fHandle, 'DUMP.SCR' );ππ { First we save the screen to the file DUMP.SCR }π REWRITE( fHandle, 1 );π BLOCKWRITE( fHandle, _Screen^, SIZEOF( _Screen^ ) );π CLOSE( fHandle );ππ { Now a little pause as we catch our breath }π CLRSCR;π WRITELN( 'Press any key...' );π WHILE READKEY = #0 DO;ππ { And finally we restore the screen from the file DUMP.SCR }π RESET( fHandle, 1 );π BLOCKREAD( fHandle, _Screen^, SIZEOF( _Screen^ ) );π CLOSE( fHandle );ππ { Another pause to view our handiwork }π WHILE READKEY = #0 DO;π END.ππ 99 05-26-9406:20ALL SEAN MARTENS Pascal Image IMPORT 18 ╓ {π BK> Could someone tell me how to view this image in Turbo Pascal 7.0 ??ππ Take your data and put it above the following code.π compile and see your image.π Please note graphics functions kept a simple as possible. Crux of matterπ image not programing.ππ Your data was 1028 bytes long.π The first four bytes lead to two integer with value 31. ( dimensions)ππ 31*31 = 961.π 1028 - 961 - 4(for dimensions) = 64.ππ 64 = ?ππ Your image says "Thanks in advance" . Its a pleasure.πππ_________o/_________π o\π}ππprogram demo;ππUses dos;ππ{cut and paste your data here }ππtypeππ rgbx_type = recordπ red,green,blue,blank : byte;π end;ππ rgb_type = recordπ red,green,blue,blank : byte;π end;ππ img_type = recordπ width, { dimentions }π height : integer;π data : array [0..31,0..31] of byte; { image data }π pallete : array [0..15] of rgbx_type; { no supporting evidence }π { some indexes bigger than 16 }π end;ππ screen_type = array [0..199,0..319] of byte;ππvarπ screen : screen_type absolute $a000:$0000;π colours : array [0..255] of rgb_type;ππprocedure SetPallete(first_colour,num_colours : word);πvarπ regs : registers;πbeginπ regs.ax := $1012;π regs.cx := num_colours;π regs.bx := first_colour;π regs.dx := ofs(colours);π regs.es := seg(colours);π intr($10,regs);πend;ππprocedure GraphicsMode;πvarπ regs : registers;πbeginπ regs.ax := $13;π intr($10,regs);πend;ππprocedure TextMode;πvarπ regs : registers;πbeginπ regs.ax := $3; { should use a saved mode }π intr($10,regs);πend;ππprocedure SetPixel(x,y : integer; colour : byte);πbeginπ screen[y,x] := colour;πend;ππvarπ i,j : integer;π img : img_type absolute image;π dump : char;πbeginπ graphicsMode;π for i := 0 to 15 doπ beginπ colours[i].red := img.pallete[i].red;π colours[i].green := img.pallete[i].green;π colours[i].blue := img.pallete[i].blue;π end;ππ SetPallete(0,16);π for i := 1 to 31 doπ for j := 1 to 31 doπ SetPixel(i,j,img.data[j,i]);ππ dump := readkey;π Textmode;πend.π 100 05-26-9406:20ALL KAARE BOEEGH PLASMA IMPORT 15 ╓ {π15 minutes ago I suddenly got a idea to a fullscreen plasma (320*200). ButπI have promised my group mates to do no more plasmas so here it is and itπis all yours. It is not 320*200, because I did not do it in assembler since Iπam not going to use the routine myself, but it should be pretty easy toπconvert.ππ -+--+--+--- CUT -+--+--+--- }ππ PROGRAM _320_100_PLASMA;ππ VARπ FT :ARRAY [0..511] OF BYTE;π SINT :ARRAY [0..255] OF BYTE;π I1,A,B,D,C,OD,COLOR :BYTE;π X,Y,K,I :WORD;ππ BEGINπ {SET 320*200*256}π ASMπ MOV AX,0013H; INT 10H;π {THIS THINGGY DOUBLES THE HEIGT OF THE PIXELS}π mov dx,3d4hπ mov al,9π out dx,alπ inc dxπ in al,dxπ and al,0e0hπ add al,3π out dx,alπ END;ππ {DO PALETTE}π PORT [$3C8]:=0;π FOR I:=0 TO 255 DOπ BEGINπ PORT [$3C9]:=I DIV 4;π PORT [$3C9]:=I DIV 5;π PORT [$3C9]:=I DIV 6π END;ππ {DO TABLES}π FOR I:=0 TO 511 DO FT [I]:=ROUND (64+63*SIN (I/40.74));π FOR I:=0 TO 255 DO SINT [I]:=ROUND (128+127*SIN (I/40.74));ππ {MAIN LOOP}π REPEATπ INC (I1); {GRID COUNTER}π DEC (C,2);π INC (OD,1);π D:=OD;π FOR Y:=0 TO 100 DOπ BEGINπ K:=Y*320+Y AND 1; {CALCULATE OFFSET AND ADD ONE EVERY SECOND LINE}πK:=K-(I1 AND 1)*320; {MOVE GRID ONE PIXEL DOWN EVERY SECOND FRAME}π INC (D,2);π A:=SINT [(C+Y) AND 255];π B:=SINT [(D) AND 255];π FOR X:=0 TO 159 DOπ BEGINπ COLOR:=FT [A+B]+FT [Y+B];π MEM [$A000:K]:=COLOR;π INC (A,1+COLOR SHR 7);π INC (B,2); INC (K,2);π {OFFSET OF PLASMA PIXEL, INCREASED BY TWO TO CREATE THE GRID}π END;π END;π UNTIL PORT [$60]<128; {EXIT IF KEY PRESSED} END.ππ 101 05-26-9410:58ALL SEAN WENZEL GIF Viewing IMPORT 176 ╓ unit GifUtil;π{ GifUtl.pas - (c)Copyright 1993 Sean Wenzelπ Users are given the right to use/modify and distribute this source code asπ long as credit is given where due. I would also ask that anyone who makesπ use of this source/program drop me a line at my CompuServe address ofπ 71736,1245. Just curious...ππ The unit was written using Borland Pascal v7.0 but I think it should workπ with Turbo Pascal down to 5.5 at the most (or least?).π This unit has only been tested on my system - an Everex Tempo 386DXπ with its built in SVGA adapter. If anyone finds/fixes any bugs pleaseπ let me know. (Feel free to send a copy of any code too)π I have also only tested 3 or 4 256,16, and 2 color interlaced and non-π interlaced images. (was enough for my needs)πππ Some of the code is very loosely based on DECODER.C (availble online)π so credit should be given to Steven A. Bennett and Steve Wilhiteππ The unit is set up to use BGI256.BGI (inlcuded) which is available on CISπ in the BPASCAL forum library. The graphics initialization tries to startπ up in 640 by 480 mode. If an error occurs it'll go down to 320x200π automatically (well - it should). For higher res modes change the variableπ GraphMode in the InitGraphics procedure to 3 for 800x600 and 4 for 1024x768.ππ A sample program (GIF.PAS) is provided to demostrate the use of this unit.π Basically declare a pointer to the TGIF object then initialize it using aπ line such as TheGif := New(PGif, Init('agif')); You can then checkπ TheGif^.Status for any errors and/or view the GIF headers and ColorTables.π To switch to Graphics mode and show the GIF image use TheGif^.Decode(True)π True tells it to beep when done(or boop if some sort of error occured). π When finished use Dispose(TheGif, Done) to switch back to textmode and get π rid of the object.πππ If anyone cares to speed up the image decoding I'd suggest writingπ TGIF.NextCode in assembler. The routine is the most heavily called in theπ unit while decoding and on my sytem took up about 5 seconds out of 12 whenπ I profiled it. (send me a copy if you can)ππ I have practically commented every line so that the source should be veryπ readable and easy to follow. Great for learning about GIF's and LZW π decompression.πππ Any problems or suggestions drop me a lineππ Good luck...π -Seanππ (almost forgot)π "The Graphics Interchange Format(c) is the Copyright property ofπ CompuServe Incorporated. GIF(sm) is a Service Mark property ofπ CompuServe Incorporated."ππ}πππ{$R-} { range checking off } { Put them on if you like but it slows down the}π{$S-} { stack checking off } { decoding (almost doubles it!) }π{$I-} { i/o checking off }ππinterfaceππuses Objects;ππtypeπ TDataSubBlock = recordπ Size: byte; { size of the block -- 0 to 255 }π Data: array[1..255] of byte; { the data }π end;ππconstπ BlockTerminator: byte = 0; { terminates stream of data blocks }ππtypeπ THeader = recordπ Signature: array[0..2] of char; { contains 'GIF' }π Version: array[0..2] of char; { '87a' or '89a' }π end;ππ TLogicalScreenDescriptor = recordπ ScreenWidth: word; { logical screen width }π ScreenHeight: word; { logical screen height }π PackedFields: byte; { packed fields - see below }π BackGroundColorIndex: byte; { index to global color table }π AspectRatio: byte; { actual ratio = (AspectRatio + 15) / 64 }π end;ππconstπ{ logical screen descriptor packed field masks }π lsdGlobalColorTable = $80; { set if global color table follows L.S.D. }π lsdColorResolution = $70; { Color resolution - 3 bits }π lsdSort = $08; { set if global color table is sorted - 1 bit }π lsdColorTableSize = $07; { size of global color table - 3 bits }π { Actual size = 2^value+1 - value is 3 bits }ππtypeπ TColorItem = record { one item a a color table }π Red: byte;π Green: byte;π Blue: byte;π end;ππ TColorTable = array[0..255] of TColorItem; { the color table }ππconstπ ImageSeperator: byte = $2C;ππtypeπ TImageDescriptor = recordπ Seperator: byte; { fixed value of ImageSeperator }π ImageLeftPos: word; {Column in pixels in respect to left edge of logical screen }π ImageTopPos: word;{row in pixels in respect to top of logical screen }π ImageWidth: word; { width of image in pixels }π ImageHeight: word; { height of image in pixels }π PackedFields: byte; { see below }π end;πconstπ { image descriptor bit masks }π idLocalColorTable = $80; { set if a local color table follows }π idInterlaced = $40; { set if image is interlaced }π idSort = $20; { set if color table is sorted }π idReserved = $0C; { reserved - must be set to $00 }π idColorTableSize = $07; { size of color table as above }ππ Trailer: byte = $3B; { indicates the end of the GIF data stream }ππ{ other extension blocks not currently supported by this unitπ - Graphic Control extensionπ - Comment extension I'm not sure what will happen if these blocksπ - Plain text extension are encountered but it'll be interestingπ - application extension }ππconstπ ExtensionIntroducer: byte = $21;π MAXSCREENWIDTH = 800;ππtypeπ TExtensionBlock = recordπ Introducer: byte; { fixed value of ExtensionIntroducer }π ExtensionLabel: byte;π BlockSize: byte;π end;ππ PCodeItem = ^TCodeItem;π TCodeItem = recordπ Code1, Code2: byte;π end;ππconstπ MAXCODES = 4095; { the maximum number of different codes 0 inclusive }ππππtypeπ { This is the actual gif object }π PGif = ^TGif;π TGif = object(TObject)π Stream: PBufStream; { the file stream for the gif file }π Header: THeader; { gif file header }π LogicalScreen: TLogicalScreenDescriptor; { gif screen descriptor }π GlobalColorTable: TColorTable; { global color table }π LocalColorTable: TColorTable; { local color table }π ImageDescriptor: TImageDescriptor; { image descriptor }π UseLocalColors: boolean; { true if local colors in use }π Interlaced: boolean; { true if image is interlaced }π LZWCodeSize: byte; { minimum size of the LZW codes in bits }π ImageData: TDataSubBlock; { variable to store incoming gif data }π TableSize: word; { number of entrys in the color table }π BitsLeft, BytesLeft: integer;{ bits left in byte - bytes left in block }π BadCodeCount: word; { bad code counter }π CurrCodeSize: integer; { Current size of code in bits }π ClearCode: integer; { Clear code value }π EndingCode: integer; { ending code value }π Slot: word; { position that the next new code is to be added }π TopSlot: word; { highest slot position for the current code size }π HighCode: word; { highest code that does not require decoding }π NextByte: integer; { the index to the next byte in the datablock array }π CurrByte: byte; { the current byte }π DecodeStack: array[0..MAXCODES] of byte; { stack for the decoded codes }π Prefix: array[0..MAXCODES] of word; { array for code prefixes }π Suffix: array[0..MAXCODES] of byte; { array for code suffixes }π LineBuffer: array[0..MAXSCREENWIDTH] of byte; { array for buffer line output }π CurrentX, CurrentY: integer; { current screen locations }π Status: word; { status of the decode }π InterlacePass: byte; { interlace pass number }π constructor Init(AGIFName: string);π destructor Done; virtual;π procedure Error(What: integer);π procedure InitCompressionStream; { initializes info for decode }π procedure ReadSubBlock; { reads a data subblock from the stream }π function NextCode: word; { returns the next available code }π procedure Decode(Beep: boolean); { the actual LZW decoding routine }π procedure DrawLine; { writes the drawline buffer to screen }π procedure InitGraphics; { Initializes Graphics mode }π end;ππconstπ{ error constants }π geNoError = 0; { no errors found }π geNoFile = 1; { gif file not found }π geNotGIF = 2; { file is not a gif file }π geNoGlobalColor = 3; { no Global Color table found }π geImagePreceded = 4; { image descriptor preceeded by other unknown data }π geEmptyBlock = 5; { Block has no data }π geUnExpectedEOF = 6; { unexpected EOF }π geBadCodeSize = 7; { bad code size }π geBadCode = 8; { Bad code was found }π geBitSizeOverflow = 9; { bit size went beyond 12 bits }ππimplementationππuses Graph, Crt;ππfunction Power(A, N: real): real; { returns A raised to the power of N }πbeginπ Power := exp(N * ln(A));πend;πππ{ TGif }πconstructor TGif.Init(AGIFName: string);πbeginπ inherited Init;π if Pos('.',AGifName) = 0 then { if the filename has no extension add one }π AGifName := AGifName + '.gif';π Stream := New(PBufStream, Init(AGifName, stOpen, 2048));π Stream^.Read(Header, sizeof(Header)); { read the header }π if Header.Signature <> 'GIF' then Error(geNotGIF); { is vaild signature }π Stream^.Read(LogicalScreen, sizeof(LogicalScreen));π if LogicalScreen.PackedFields and lsdGlobalColorTable = lsdGlobalColorTable thenπ beginπ TableSize := trunc(Power(2,(LogicalScreen.PackedFields and lsdColorTableSize)+1));π Stream^.Read(GlobalColorTable, TableSize*sizeof(TColorItem)); { read Global Color Table }π endπ elseπ Error(geNoGlobalColor);π Stream^.Read(ImageDescriptor, sizeof(ImageDescriptor)); { read image descriptor }π if ImageDescriptor.Seperator <> ImageSeperator then { verify that it is the descriptor }π Error(geImagePreceded);π if ImageDescriptor.PackedFields and idLocalColorTable = idLocalColorTable thenπ begin { if local color table }π TableSize := trunc(Power(2,(ImageDescriptor.PackedFields and idColorTableSize)+1));π Stream^.Read(LocalColorTable, TableSize*sizeof(TColorItem)); { read Local Color Table }π UseLocalColors := True;π endπ elseπ UseLocalColors := false;π if ImageDescriptor.PackedFields and idInterlaced = idInterlaced thenπ beginπ Interlaced := true;π InterlacePass := 0;π end;π if (Stream = nil) or (Stream^.Status <> stOk) then{ check for stream error }π Error(geNoFile);π Status := 0;πend;ππdestructor TGif.Done;πbeginπ CloseGraph;π TextMode(LastMode);π if Stream <> nil thenπ Dispose(Stream, Done);π inherited Done;πend;ππprocedure TGif.Error(What: integer);πbeginπ Status := What;πend;ππprocedure TGif.InitCompressionStream;πvarπ I: integer;πbeginπ InitGraphics; { Initialize the graphics display }π Stream^.Read(LZWCodeSize, sizeof(byte));{ get minimum code size }π if not (LZWCodeSize in [2..9]) then { valid code sizes 2-9 bits }π Error(geBadCodeSize);ππ CurrCodeSize := succ(LZWCodeSize); { set the initial code size }π ClearCode := 1 shl LZWCodeSize; { set the clear code }π EndingCode := succ(ClearCode); { set the ending code }π HighCode := pred(ClearCode); { set the highest code not needing decoding }π BytesLeft := 0; { clear other variables }π BitsLeft := 0;π CurrentX := 0;π CurrentY := 0;πend;ππprocedure TGif.ReadSubBlock;πbeginπ Stream^.Read(ImageData.Size, sizeof(ImageData.Size)); { get the data block size }π if ImageData.Size = 0 then Error(geEmptyBlock); { check for empty block }π Stream^.Read(ImageData.Data, ImageData.Size); { read in the block }π NextByte := 1; { reset next byte }π BytesLeft := ImageData.Size; { reset bytes left }πend;ππconstπ CodeMask: array[0..12] of longint = ( { bit masks for use with Next code }π 0,π $0001, $0003,π $0007, $000F,π $001F, $003F,π $007F, $00FF,π $01FF, $03FF,π $07FF, $0FFF);ππfunction TGif.NextCode: word; { returns a code of the proper bit size }πvarπ Ret: longint; { temporary return value }πbeginπ if BitsLeft = 0 then { any bits left in byte ? }π begin { any bytes left }π if BytesLeft <= 0 then { if not get another block }π ReadSubBlock;π CurrByte := ImageData.Data[NextByte]; { get a byte }π inc(NextByte); { set the next byte index }π BitsLeft := 8; { set bits left in the byte }π dec(BytesLeft); { decrement the bytes left counter }π end;π ret := CurrByte shr (8 - BitsLeft); { shift off any previosly used bits}π while CurrCodeSize > BitsLeft do { need more bits ? }π beginπ if BytesLeft <= 0 then { any bytes left in block ? }π ReadSubBlock; { if not read in another block }π CurrByte := ImageData.Data[NextByte]; { get another byte }π inc(NextByte); { increment NextByte counter }π ret := ret or (CurrByte shl BitsLeft);{ add the remaining bits to the return value }π BitsLeft := BitsLeft + 8; { set bit counter }π dec(BytesLeft); { decrement bytesleft counter }π end;π BitsLeft := BitsLeft - CurrCodeSize; { subtract the code size from bitsleft }π ret := ret and CodeMask[CurrCodeSize];{ mask off the right number of bits }π NextCode := ret;πend;ππ{ this procedure initializes the graphics mode and actually decodes theπ GIF image }πprocedure TGif.Decode(Beep: boolean);πvarπ SP: integer; { index to the decode stack }ππ{ local procedure that decodes a code and puts it on the decode stack }πprocedure DecodeCode(var Code: word);πbeginπ while Code > HighCode do { rip thru the prefix list placing suffixes }π begin { onto the decode stack }π DecodeStack[SP] := Suffix[Code]; { put the suffix on the decode stack }π inc(SP); { increment decode stack index }π Code := Prefix[Code]; { get the new prefix }π end;π DecodeStack[SP] := Code; { put the last code onto the decode stack }π inc(SP); { increment the decode stack index }πend;ππvarπ TempOldCode, OldCode: word;π BufCnt: word; { line buffer counter }π Code, C: word;π CurrBuf: word; { line buffer index }πbeginπ InitGraphics; { Initialize the graphics mode and RGB palette }π InitCompressionStream; { Initialize decoding paramaters }π OldCode := 0;π SP := 0;π BufCnt := ImageDescriptor.ImageWidth; { set the Image Width }π CurrBuf := 0;ππ C := NextCode; { get the initial code - should be a clear code }π while C <> EndingCode do { main loop until ending code is found }π beginπ if C = ClearCode then { code is a clear code - so clear }π beginπ CurrCodeSize := LZWCodeSize + 1;{ reset the code size }π Slot := EndingCode + 1; { set slot for next new code }π TopSlot := 1 shl CurrCodeSize; { set max slot number }π while C = ClearCode doπ C := NextCode; { read until all clear codes gone - shouldn't happen }π if C = EndingCode thenπ beginπ Error(geBadCode); { ending code after a clear code }π break; { this also should never happen }π end;π if C >= Slot { if the code is beyond preset codes then set to zero }π then c := 0;π OldCode := C;π DecodeStack[sp] := C; { output code to decoded stack }π inc(SP); { increment decode stack index }π endπ else { the code is not a clear code or an ending code so it must }π begin { be a code code - so decode the code }π Code := C;π if Code < Slot then { is the code in the table? }π beginπ DecodeCode(Code); { decode the code }π if Slot <= TopSlot thenπ begin { add the new code to the table }π Suffix[Slot] := Code; { make the suffix }π PreFix[slot] := OldCode; { the previous code - a link to the data }π inc(Slot); { increment slot number }π OldCode := C; { set oldcode }π end;π if Slot >= TopSlot then { have reached the top slot for bit size }π begin { increment code bit size }π if CurrCodeSize < 12 then { new bit size not too big? }π beginπ TopSlot := TopSlot shl 1; { new top slot }π inc(CurrCodeSize) { new code size }π endπ elseπ Error(geBitSizeOverflow); { encoder made a boo boo }π end;π endπ elseπ begin { the code is not in the table }π if Code <> Slot then { code is not the next available slot }π Error(geBadCode); { so error out }ππ { the code does not exist so make a new entry in the code tableπ and then translate the new code }π TempOldCode := OldCode; { make a copy of the old code }π while OldCode > HighCode do { translate the old code and place it }π begin { on the decode stack }π DecodeStack[SP] := Suffix[OldCode]; { do the suffix }π OldCode := Prefix[OldCode]; { get next prefix }π end;π DecodeStack[SP] := OldCode; { put the code onto the decode stack }π { but DO NOT increment stack index }π { the decode stack is not incremented because because we are onlyπ translating the oldcode to get the first character }π if Slot <= TopSlot thenπ begin { make new code entry }π Suffix[Slot] := OldCode; { first char of old code }π Prefix[Slot] := TempOldCode; { link to the old code prefix }π inc(Slot); { increment slot }π end;π if Slot >= TopSlot then { slot is too big }π begin { increment code size }π if CurrCodeSize < 12 thenπ beginπ TopSlot := TopSlot shl 1; { new top slot }π inc(CurrCodeSize) { new code size }π endπ elseπ Error(geBitSizeOverFlow);π end;π DecodeCode(Code); { now that the table entry exists decode it }π OldCode := C; { set the new old code }π end;π end;π { the decoded string is on the decode stack so pop it off and put itπ into the line buffer }π while SP > 0 doπ beginπ dec(SP);π LineBuffer[CurrBuf] := DecodeStack[SP];π inc(CurrBuf);π dec(BufCnt);π if BufCnt = 0 then { is the line full ? }π beginπ DrawLine;π CurrBuf := 0;π BufCnt := ImageDescriptor.ImageWidth;π end;π end;π C := NextCode; { get the next code and go at is some more }π end; { now that wasn't all that bad was it? }π if Beep thenπ if Status = 0 thenπ beginπ Sound(660); { Beep if status is ok }π Delay(50);π NoSound;π endπ elseπ beginπ Sound(110); { Boop if status is not ok }π Delay(200);π NoSound;π end;πend;ππprocedure TGif.DrawLine;πvarπ I: integer;πbeginπ for I := 0 to ImageDescriptor.ImageWidth doπ PutPixel(I, CurrentY, LineBuffer[I]);π inc(CurrentY);ππ if InterLaced then { Interlace support }π beginπ case InterlacePass ofπ 0: CurrentY := CurrentY + 7;π 1: CurrentY := CurrentY + 7;π 2: CurrentY := CurrentY + 3;π 3: CurrentY := CurrentY + 1;π end;π if CurrentY >= ImageDescriptor.ImageHeight thenπ beginπ inc(InterLacePass);π case InterLacePass ofπ 1: CurrentY := 4;π 2: CurrentY := 2;π 3: CurrentY := 1;π end;π end;π end;πend;ππprocedure TGif.InitGraphics;πvarπ GraphDriver: integer;π GraphMode: integer;π ErrorCode: integer;π I: integer;πbeginπ GraphDriver := InstallUserDriver('bgi256', nil);π GraphMode := 2;π InitGraph(GraphDriver, GraphMode, '\dealer\bin');π ErrorCode := GraphResult;π if ErrorCode <> grOk thenπ beginπ Writeln('Graphics Error: ', GraphErrorMsg(ErrorCode));π Halt(99);π end;ππ { the following loop sets up the RGB palette }π if not UseLocalColors thenπ for I := 0 to TableSize - 1 doπ SetRGBPalette(I, GlobalColorTable[I].Red div 4, GlobalColorTable[i].Greenπ div 4, GlobalColorTable[I].Blue div 4)π elseπ for I := 0 to TableSize - 1 doπ SetRGBPalette(I, LocalColorTable[I].Red div 4, LocalColorTable[i].Greenπ div 4, LocalColorTable[I].Blue div 4);πend;πππend.ππ{ -------------------------- DEMO PROGRAM ------------------ }ππprogram Gif;π{ GifUtil sample programπ (c)Copyright 1993 Sean Wenzelπ Users are given the right to freely use and distibute the source code atπ will as long a credit is given where due }ππuses GifUtil, CRT, Dos;ππvarπ A: string;π TheGif: PGif;π Hours, Minutes, Seconds, Sec100: word;π H, M, S, S100: word;πbeginπ Writeln('Sample program for using GIFUTIL.PAS unit');π Writeln('(c) Copyright 1993 Sean Wenzel');π Writeln('');ππ if ParamCount <> 1 thenπ beginπ Writeln('use: C:>gif <gifname>[.gif] to run...');π Exit;π end;π TheGif := New(PGif, Init(paramstr(1)));ππ GetTime(Hours, Minutes, Seconds, Sec100);π TheGif^.Decode(True);π GetTime(H, M, S, S100);π Readln(A);π Dispose(TheGif, Done);ππ Writeln('Start: ',Hours,':',Minutes,':',Seconds,':',Sec100);π Writeln(' Stop: ',H,':',M,':',S,':',S100);π while not(KeyPressed) do;ππ writeln('"The Graphics Interchange Format(c) is the Copyright property of');π writeln('CompuServe Incorporated. GIF(sm) is a Service Mark property of ');π writeln('CompuServe Incorporated."');πend. 102 08-24-9412:55ALL DAVID ROZENBERG 3D Rotation Objects SWAG9408 Ü▐j╜ 61 ╓ π{ Here is a program to rotate any object in 3D. }ππ(********************************************************π * This program was written by David Rozenberg *π * *π * The program show how to convert a 3D point into a 2D *π * plane like the computer screen. So it will give you *π * the illusion of 3D shape. *π * *π * You can rotate it by the keyboard arrows, for nonstop*π * rotate press Shift+Arrow *π * *π * Please use the program as it is without changing it. *π * *π * Usage: *π * 3D FileName.Ext *π * *π * There are some files for example how to build them *π * the header " ; 3D by David Rozenberg " must be at the*π * beging of the file. *π * *π ********************************************************)ππProgram G3d;π{$E+,N+}πUsesπ Crt,Graph;ππTypeπ Coordinate = Array[1..7] of Real;π Point = Recordπ X,Y,Z : Real;π End;π LineRec = ^LineType;π LineType = Recordπ FPoint,TPoint : Point;π Color : Byte;π Next : LineRec;π End;πππVarπ FirstLine : LineRec;π Last : LineRec;ππProcedure Init;πVarπ GraphDriver,GraphMode,GraphError : Integer;ππBeginπ GraphDriver:=Detect;π initGraph(GraphDriver,GraphMode,'\turbo\tp'); { your BGI driver address }π GraphError:=GraphResult;π if GraphError<>GrOk then beginπ clrscr;π writeln('Error while turning to graphics mode.');π writeln;π halt(2);π end;πEnd;πππFunction DegTRad(Deg : Real) : real;πBeginπ DegTRad:=Deg/180*Pi;πEnd;ππProcedure ConvertPoint (P : Point;Var X,Y : Integer);πVarπ Dx,Dy : Real;ππBeginπ X:=GetMaxX Div 2;π Y:=GetMaxY Div 2;π Dx:=(P.Y)*cos(pi/6);π Dy:=-(P.Y)*Sin(Pi/6);π Dx:=Dx+(P.X)*Cos(pi/3);π Dy:=Dy+(P.X)*Sin(Pi/3);π Dy:=Dy-P.Z;π X:=X+Round(Dx);π Y:=Y+Round(Dy);πEnd;ππProcedure DrawLine(Lrec : LineRec);πVarπ Fx,Fy,Tx,Ty : Integer;ππBeginπ SetColor(Lrec^.Color);π ConvertPoint(LRec^.FPoint,Fx,Fy);π ConvertPoint(LRec^.TPoint,Tx,Ty);π Line(Fx,Fy,Tx,Ty);πEnd;ππProcedure ShowLines;πVarπ Lp : LineRec;ππBeginπ ClearDevice;π Lp:=FirstLine;π While Lp<>Nil do Beginπ DrawLine(Lp);π Lp:=Lp^.Next;π end;πEnd;ππProcedure Error(Err : Byte;S : String);πBeginπ Clrscr;π Writeln;π Case Err ofπ 1 : Writeln('File : ',S,' not found!');π 2 : Writeln(S,' isn''t a 3d file!');π 3 : Writeln('Error in line :',S);π 4 : Writeln('No file was indicated');π End;π Writeln;π Halt(Err);πEnd;ππProcedure AddLine(Coord : Coordinate);πVarπ Lp : LineRec;ππBeginπ New(Lp);π Lp^.Color:=Round(Coord[7]);π Lp^.FPoint.X:=Coord[1];π Lp^.FPoint.Y:=Coord[2];π Lp^.FPoint.Z:=Coord[3];π Lp^.TPoint.X:=Coord[4];π Lp^.TPoint.Y:=Coord[5];π Lp^.TPoint.Z:=Coord[6];π Lp^.Next:=Nil;π If Last=Nil then FirstLine:=Lp else Last^.Next:=Lp;π Last:=Lp;πend;ππProcedure LoadFile(Name : String);πVarπ F : Text;π Coord : Coordinate;π S,S1 : String;π I : Byte;π LineNum : Word;π Comma : Integer;ππBeginπ FirstLine:=Nil;π Last:=Nil;π Assign(F,Name);π {$I-}π Reset(f);π {$I+}π If IoResult<>0 then Error(1,Name);π Readln(F,S);π If S<>'; 3D by David Rozenberg' then Error(2,Name);π LineNum:=1;π While Not Eof(F) do Beginπ Inc(LineNum);π Readln(F,S);π while Pos(' ',S)<>0 do Delete(S,Pos(' ',S),1);π If (S<>'') and (S[1]<>';') then beginπ For I:=1 to 6 do Beginπ Comma:=Pos(',',S);π If Comma=0 then Beginπ Close(F);π Str(LineNum:4,S);π Error(3,S);π End;π S1:=Copy(S,1,Comma-1);π Delete(S,1,Comma);π Val(S1,Coord[i],Comma);π If Comma<>0 then Beginπ Close(F);π Str(LineNum:4,S);π Error(3,S);π End;π End;π Val(S,Coord[7],Comma);π If Comma<>0 then Beginπ Close(F);π Str(LineNum:4,S);π Error(3,S);π End;π AddLine(Coord);π End;π End;π Close(F);πEnd;ππProcedure RotateZ(Deg : Real);πVarπ Lp : LineRec;π Rad : Real;π Tx,Ty : Real;ππBeginπ Rad:=DegTRad(Deg);π Lp:=FirstLine;π While Lp<>Nil do Beginπ With Lp^.Fpoint Do Beginπ TX:=(X*Cos(Rad)-Y*Sin(Rad));π TY:=(X*Sin(Rad)+Y*Cos(Rad));π X:=Tx;π Y:=Ty;π End;π With Lp^.Tpoint Do Beginπ TX:=(X*Cos(Rad)-Y*Sin(Rad));π TY:=(X*Sin(Rad)+Y*Cos(Rad));π X:=Tx;π Y:=Ty;π End;π Lp:=Lp^.Next;π end;πEnd;ππProcedure RotateY(Deg : Real);πVarπ Lp : LineRec;π Rad : Real;π Tx,Tz : Real;ππBeginπ Rad:=DegTRad(Deg);π Lp:=FirstLine;π While Lp<>Nil do Beginπ With Lp^.Fpoint Do Beginπ TX:=(X*Cos(Rad)-Z*Sin(Rad));π TZ:=(X*Sin(Rad)+Z*Cos(Rad));π X:=Tx;π Z:=Tz;π End;π With Lp^.Tpoint Do Beginπ TX:=(X*Cos(Rad)-Z*Sin(Rad));π TZ:=(X*Sin(Rad)+Z*Cos(Rad));π X:=Tx;π Z:=Tz;π End;π Lp:=Lp^.Next;π end;πEnd;ππProcedure Rotate;πVarπ Ch : Char;ππBeginπ Repeatπ Repeatπ Ch:=Readkey;π If ch=#0 then Ch:=Readkey;π Until Ch in [#27,#72,#75,#77,#80,#50,#52,#54,#56];π Case ch ofπ #54 :Beginπ While Not keypressed do beginπ RotateZ(10);π ShowLines;π Delay(100);π End;π Ch:=Readkey;π If Ch=#0 then Ch:=ReadKey;π End;π #52:Beginπ While Not keypressed do beginπ RotateZ(-10);π ShowLines;π Delay(100);π End;π Ch:=Readkey;π If Ch=#0 then Ch:=ReadKey;π End;π #56:Beginπ While Not keypressed do beginπ RotateY(10);π ShowLines;π Delay(100);π End;π Ch:=Readkey;π If Ch=#0 then Ch:=ReadKey;π End;π #50:Beginπ While Not keypressed do beginπ RotateY(-10);π ShowLines;π Delay(100);π End;π Ch:=Readkey;π If Ch=#0 then Ch:=ReadKey;π End;π #72 : Beginπ RotateY(10);π ShowLines;π End;π #75 : Beginπ RotateZ(-10);π ShowLines;π End;π #77 : Beginπ RotateZ(10);π ShowLines;π End;π #80 : Beginπ RotateY(-10);π ShowLines;π End;π End;π Until Ch=#27;πEnd;ππBeginπ If ParamCount<1 then Error(4,'');π LoadFile(ParamStr(1));π Init;π ShowLines;π Rotate;π CloseGraph;π ClrScr;π Writeln;π Writeln('Thanks for using 3D');π Writeln;πEnd.ππThere is sample of some files that can be rotated:πcut out and save in specified file nameπCube.3D:ππ; 3D by David Rozenbergπ; Base of cubeπ-70,70,-70,70,70,-70,15π70,70,-70,70,-70,-70,15π70,-70,-70,-70,-70,-70,15π-70,-70,-70,-70,70,-70,15π; Top of cubeπ-70,70,70,70,70,70,15π70,70,70,70,-70,70,15π70,-70,70,-70,-70,70,15π-70,-70,70,-70,70,70,15π; Side of cubeπ-70,70,-70,-70,70,70,13π70,70,-70,70,70,70,13π70,-70,-70,70,-70,70,13π-70,-70,-70,-70,-70,70,13ππDavid.3D:ππ; 3D by David Rozenbergπ0,-120,45,0,-30,45,15π0,-60,45,0,-60,-45,15π; π0,-15,45,0,15,45,12π0,15,45,0,15,-45,12π;π0,30,45,0,120,45,11π0,90,45,0,90,-45,11π;π50,-45,-75,50,45,-75,10π50,45,-75,50,45,-165,10ππ 103 08-24-9413:26ALL JOHN HOWARD Bounce v1.1 SWAG9408 ░D p 61 ╓ (*π From: Christian Ramsvikπ Subj: bounce v1.0πOrigin: Hatlane Point #9 (2:211/10.9)ππHI! Got a bouncing procedure a while ago. It bounces a ball, and you canπincrease speed in X- and Y-axis by pressing the arrow keys. I'm sure you canπextract what you need from this one:πππ From: John Howard jhπ Subj: bounce v1.1πOrigin: Synergy (1:280/66)πUpgraded to vary the ball size with / and *. Compass directions use keypad inπnumlock mode or UIOJKNM, keys. The speed can be changed in each direction.πThe gravity effect can vary with + and - keys. Status report dialog box whenπeither space or 0 key pressed. Press 0 again will stop all motion. Pressπkeypad_5 will halt display and requires pressing ESCape key to continue. Aπperiod will reset the ball to default size.π*)ππprogram Bounce;πuses Crt, Graph;π{-$DEFINE solid}π{-$DEFINE bubble}π{ jhπconstπ MinBalls = 1;π MaxBalls = 2;π}πtypeπ TImage = recordπ XPos, {x} {horizontal position}π YPos : Integer; {y} {vertical position}π XSpeed, {dx} {actually a velocity}π YSpeed : Integer; {dy} {actually a velocity}π XAccel, {ddx} {jh unused acceleration}π YAccel : Integer; {ddy} {jh unused acceleration}ππ Radius : Byte; {Ball}π end;ππvarπ Ch : Char;π Gd, Gm : Integer;π Image : {array [MinBalls..MaxBalls] of} TImage; {jh}π FullSpeed, {jh}π HalfSpeed : Integer; { = FullSpeed div 2}π {BallNumber : byte;} {jh}ππ{ ******************* DRAW IMAGE ********************* }πprocedure DrawImage;πbeginπ SetColor( White );π{$IFDEF solid}π SetFillStyle( SolidFill, White );π{$ELSE}π SetFillStyle( HatchFill, White );π{$ENDIF}ππ with Image doπ beginπ{$IFDEF bubble}π Circle( XPos, YPos, Radius ); {jh Soap bubble}π{$ELSE}π PieSlice( XPos, YPos, 0, 360, Radius ); {jh Pattern ball}π{$ENDIF}π end;πend;ππ{ ******************* REMOVE IMAGE ******************** }πprocedure RemoveImage;πbeginπ SetColor( Black );π{$IFDEF solid}π SetFillStyle( SolidFill, Black );π{$ELSE}π SetFillStyle( HatchFill, Black );π{$ENDIF}ππ with Image doπ beginπ{$IFDEF bubble}π Circle( XPos, YPos, Radius ); {jh Soap bubble}π{$ELSE}π PieSlice( XPos, YPos, 0, 360, Radius ); {jh Pattern ball}π{$ENDIF}π end;πend;ππ{ ******************* UPDATE SPEED ******************** }πprocedure UpdateSpeed;ππ function IntToStr(I: Longint): String;π { convert any integer to a string }π var S: string[11];π beginπ Str(I,S);π IntToStr := S;π end;πbeginπ while KeyPressed doπ beginπ Ch := ReadKey;π Ch := Upcase(Ch);π case Ch of { Change speed with keypad numbers }π{jh Note: Keypad_5 causes a halt until escape key pressed}ππ '.': Image.Radius := 16; {Default}π '/': Image.Radius := Image.Radius shr 1; {Reduce}π '*': Image.Radius := Image.Radius shl 1; {Enlarge}π '+': beginπ Inc(FullSpeed);π HalfSpeed := FullSpeed div 2;π end;π '-': beginπ Dec(FullSpeed);π HalfSpeed := FullSpeed div 2;π end;π '8','I': Dec( Image.YSpeed, FullSpeed ); {N upwards}π '2','M': Inc( Image.YSpeed, FullSpeed ); {S downwards}π '4','J': Dec( Image.XSpeed, FullSpeed ); {W leftwards}π '6','K': Inc( Image.XSpeed, FullSpeed ); {E rightwards}π '0',' ': begin {Report statistics}π SetColor( White );π SetFillStyle( SolidFill, White );π Rectangle(8,8,8+160,8+56); {box}π SetViewPort(8,8,8+160,8+56, ClipOff); {dialog}π OutTextXY(2,2, '<ENTER> resumes');π OutTextXY(2,2+8, 'x = ' + IntToStr(Image.XPos));π OutTextXY(2,2+16, 'y = ' + IntToStr(Image.YPos));π OutTextXY(2,2+24, 'dx = '+ IntToStr(Image.XSpeed));π OutTextXY(2,2+32, 'dy = '+ IntToStr(Image.YSpeed));π OutTextXY(2,2+40, 'Full Speed = '+ IntToStr(FullSpeed));ππ Ch := ReadKey; {repeat until keypressed}π ClearViewPort;π SetViewPort(0,0,GetMaxX,GetMaxY, ClipOn); {window}π Rectangle(0,0,GetMaxX,GetMaxY); {border}π if (Ch = '0') then {Stop motion}π beginπ Image.XSpeed := 0;π Image.YSpeed := 0;π end;π end;π '7','U': begin {NW}π Dec(Image.XSpeed, HalfSpeed);π Dec(Image.YSpeed, HalfSpeed);π end;π '9','O': begin {NE}π Inc(Image.XSpeed, HalfSpeed);π Dec(Image.YSpeed, HalfSpeed);π end;π '1','N': begin {SW}π Dec(Image.XSpeed, HalfSpeed);π Inc(Image.YSpeed, HalfSpeed);π end;π '3',',': begin {SE}π Inc(Image.XSpeed, HalfSpeed);π Inc(Image.YSpeed, HalfSpeed);π end;ππ end; {case}π end;π Inc( Image.YSpeed, HalfSpeed ); { Gravitation } {jh Just so it can vary}πend;ππ{ ****************** UPDATE POSITIONS ****************** }πprocedure UpdatePositions;πbeginπ Inc( Image.XPos, Image.XSpeed );π Inc( Image.YPos, Image.YSpeed );πend;ππ{ ****************** CHECK COLLISION ******************* }πprocedure CheckCollision;πbeginπ with Image doπ beginπ if ( XPos - Radius ) <= 0 then { Hit left wall }π beginπ XPos := Radius +1;π XSpeed := -Trunc( XSpeed *0.9 );π end;ππ if ( XPos + Radius ) >= GetMaxX then { Hit right wall }π beginπ XPos := GetMaxX -Radius -1;π XSpeed := -Trunc( XSpeed *0.9 );π end;ππ if ( YPos -Radius ) <= 0 then { Hit roof }π beginπ YPos := Radius +1;π YSpeed := -Trunc( YSpeed *0.9 );π end;ππ if ( YPos +Radius ) >= GetMaxY then { Hit floor }π beginπ YPos := GetMaxY -Radius -1;π YSpeed := -Trunc( YSpeed *0.9 );π end;π end;πend;ππ{ ********************* PROGRAM ************************ }ππBEGINπ FullSpeed := 10;π HalfSpeed := FullSpeed div 2;π with Image doπ beginπ XPos := 30;π YPos := 30;π XSpeed := FullSpeed;π YSpeed := 0;π XAccel := 0; {jh unused}π YAccel := 10; {jh unused}ππ Radius := 16; {arbitrary}π end;ππ Gd := Detect;π InitGraph( Gd, Gm, ''); {BGI drivers in Current Work Dir (CWD)}π Gd := GraphResult;π if (Gd <> grOK) thenπ beginπ Gd := Detect;π InitGraph( Gd, Gm, '\TURBO\TP\'); {BGI drivers in default directory}π end;π Rectangle( 0, 0, GetMaxX, GetMaxY ); {border}π SetViewPort( 0, 0, GetMaxX, GetMaxY, ClipOn ); {window}ππ repeatπ DrawImage;π Delay( 30 ); {milliseconds Frame delay}π RemoveImage;ππ UpdateSpeed;π UpdatePositions;π CheckCollision;π until Ch = Chr( 27 );ππ CloseGraph;πEND.π 104 08-24-9413:27ALL LUIS MEZQUITA RAYA Cannon Ball Animation SWAG9408 ^¬fτ 20 ╓ {π JG> This coding works fine, I would like to make the ball travelπ JG> smoother. When it travels in the air, its kinda "Chunky"ππ JG> How could you make it so that the computer calculates the nextπ JG> point and make it travel the ball to that point one pixel at aπ JG> time? Cause with this structure, it kinda "Jumps there"ππ Try next code and tell me ...π}ππProgram FallingBall;ππ{ Written by Luis Mezquita Raya }ππ{$x+}ππuses Crt,π Graph;ππProcedure Init;πvar cg,mg:integer;πbeginπ cg:=Detect;π InitGraph(cg,mg,'\turbo\tp');πend;ππProcedure Wait(msk:byte); assembler;πasmπ mov dx,3dahπ@Loop1: in al,dxπ test al,mskπ jz @Loop1π@Loop2: in al,dxπ test al,mskπ jnz @Loop2πend;ππProcedure Calc;πvar angle,power,gravity,a1,a2,a3,y0,n:real;π size:word;π ball,mask,bkg:pointer;π x,y,ox,oy,pause:integer;πbeginππ ClearViewPort;ππ size:=ImageSize(0,0,20,20);π GetMem(ball,size);π GetMem(mask,size);π GetMem(bkg,size);ππ SetFillStyle(SolidFill,Yellow); { Draw a ball }π Circle(10,10,8);π FloodFill(10,10,White);π GetImage(0,0,20,20,ball^); { Get the ball }ππ SetFillStyle(SolidFill,White); { Draw ball's mask }π Bar(0,0,20,20);π SetFillStyle(SolidFill,Black);π SetColor(Black);π Circle(10,10,10);π FloodFill(10,10,Black);π GetImage(0,0,20,20,mask^); { Get the mask }ππ ClearViewPort; { Draw a background }π SetFillStyle(CloseDotFill,LightBlue);π Bar(0,0,GetMaxX,GetMaxY);ππ angle:=35; { Init vars }π power:=10;π gravity:=0.1;π y0:=200;π ox:=-1;π n:=0;ππ while n<80 do { Main loop }π beginπ a1:=cos(angle*pi/180)*power*n;π a2:=y0-sin(angle*pi/180)*power*n;π a3:=gravity*n*n;π x:=Round(a1);π y:=Round(a2+a3);π Wait(8); { Wait retrace }π for pause:=0 to 399 do Wait(1); { Wait scan line }π if ox<>-1 { Restore old background }π then PutImage(ox,oy,bkg^,CopyPut);π GetImage(x,y,x+20,y+20,bkg^); { Save background }π PutImage(x,y,mask^,AndPut); { Put mask }π PutImage(x,y,ball^,OrPut); { Put ball }π ox:=x;π oy:=y;π n:=n+0.2;π end;ππ FreeMem(ball,size);π FreeMem(mask,size);πend;πππbeginπ Init;π Calc;π ReadKey;π CloseGraph;πend.π 105 08-24-9413:28ALL JOHN HOWARD Coordinate Systems SWAG9408 Å∞┼W 70 ╓ {π -=> Quoting Sean Graham to All on 22 Jun 94 <=-π SG> some (efficient, I would hope) code in pascal that will allow me toπ SG> move in a 2D or 3D 'universe' (or more correctly, grid-system). Let meππ SG> Let's start out easy. For example, how would I write code to draw aπ SG> line on a 50x80 (yes, ascii chars) screen from pos A(10,5) to posπ SG> B(47,56)?π SG> Now imagine that my screen has magically grown a third dimention. Soπ SG> I now want to draw a line from pos A(47,34,7) to pos B(21,11,33). Howπ SG> would I write code to do that?ππ SG> Now picture this, I no longer have a screen, but a grid that worksπ SG> along the same principles as the screen did, except the points rangeπ SG> from -20 to +20 on (x,y,z). (That gives me a total of 68,921 (41^3)π SG> possible co-ordinates.)π SG> Pretend that Is a universe in space. I'm in a tiny escape pod andπ SG> must get from co-ordinate (-10,+05,+12) to co-ordinate (+07,+02,-11)ππIf you want to create an actual space, try :π}ππUNIT space;π{ Author: John Howard }π{πDefine a two-dimensional space representation which is used for Cartesian andπPolar coordinate systems. A three-dimensional space is for Spherical andπAzimuth-Elevation coordinate systems.π}π{ A vector is a one-dimensional array of real numbers. A matrix has twoπ dimensions m by n with m rows and n columns. Notice the row number alwaysπ comes first in the dimensions and the indices. Example square matrix A33 =π [ a11 a12 a13 ] or generally A[i, j]; i=rows, j=columns.π [ a21 a22 a23 ]π [ a31 a32 a33 ]π A matrix can be operated upon with appropriate column or row vectors.π}πINTERFACEπ{.$DEFINE D2} {remove period to use 2D}π{$IFNDEF D2}πconst N = 3; { Cardinality for Three_Vector}π M = 3; { Square matrix for invert routine}π{$ELSE}πconst N = 2; { Cardinality for Two_Vector}π M = 2; { Square matrix for invert routine}π{$ENDIF}π Size = M;πtypeπ Vector = array [1..N] of real; { 3D vector is the most common! }π Matrix = array [1..M, 1..N] of real; { 3x3 matrix is the most common! }ππ{Store all the components into a vector}π{$IFNDEF D2}π procedure Set_Value( var a: Vector; x_value, y_value, z_value: real);π{$ELSE}π procedure Set_Value( var a: Vector; x_value, y_value: real);π{$ENDIF}ππ{Retrieve the value of s from the ith element of a vector}π function Element( var a: Vector; i: integer): real;ππ{Retrieve the first element from a vector}π function X_Component( var a: Vector): real;ππ{Retrieve the second element from a vector}π function Y_Component( var a: Vector): real;ππ{Retrieve the third element from a vector}π{$IFNDEF D2}π function Z_Component( var a: Vector): real;π{$ENDIF}ππIMPLEMENTATIONππprocedure Set_Value; { Note: parameter list intentionally left off}πbeginπ a[1] := x_value;π a[2] := y_value;π{$IFNDEF D2}π a[3] := z_value;π{$ENDIF}πend;ππfunction Element( var a: Vector; i: integer): real;πbeginπ Element := a[i];πend;ππfunction X_Component( var a: Vector): real;πbeginπ X_Component := a[1];πend;ππfunction Y_Component( var a: Vector): real;πbeginπ Y_Component := a[2];πend;ππ{$IFNDEF D2}πfunction Z_Component( var a: Vector): real;πbeginπ Z_Component := a[3];πend;π{$ENDIF}πBEGINπEND.ππ(**********πIf you do not want to create an actual 3d space, just convert coordinates :ππYou could use a two dimensional X_Component and Y_Component calculation to getπyou to an approximate region based upon Z_Component. Example:ππFrom point A(x1,y1) to B(x2,y2) you travel a distance = sqrt(sqr(x2-x1) +π sqr(y2-y1)) at a slope of (y2-y1)/(x2-x1). That slope is called the Tangentπof the angle of inclination of the line AB.ππNow that you know where you are heading and how far away it is you can divideπthe total distance into sections say of unit length. That means a distance ofπ10 would have ten units. Every time your spaceship moves one unit in the knownπdirection you can reverse the calculation to find out where you are at. Whenπyou reach the final distance, you'd take approximations using the thirdπcomponent. This idea is simple but not very accurate in the interum space.ππYou can use the same idea but implement it with a proper coordinate conversion.π**********)ππUNIT coord;π{ Author: John Howard }π{ Original source: Jack Crenshaw, 1992 Embedded Systems Programming }π{ Space Conversion -- Angles are capitalized }π{ All axes are perpendicular to each other }πINTERFACEπconstπ Zero = 0.0;π One = 1.0;π TwoPi = Two * SYSTEM.Pi;π Pi_Over_Two = SYSTEM.Pi/Two;ππ{ 1 binary angular measure = 1 pirad = Pi radians = 180 degrees }π Degrees_Per_Radian = 180.0/SYSTEM.Pi;π Radians_Per_Degree = SYSTEM.Pi/180.0;ππ{ X-axis points east, y-axis north, and angle Theta is the heading measuredπ north of due east. If Theta is zero that corresponds to a line runningπ along the x-axis a radial distance of r.π}πProcedure To_Polar ( x, y: real; Var r, Theta: real);πProcedure From_Polar ( r, Theta: real; Var x, y: real);ππ{ X-axis points toward you, y-axis right, z-axis upward, angle Phi measuresπ directions in the horizontal (x-y plane) from the x-axis, and angle Thetaπ measures the direction in the vertical from the z-axis downward. If Thetaπ is zero that corresponds to a line pointed up the z-axis.π}πProcedure To_Spherical ( x, y, z: real; Var r, Phi, Theta: real);πProcedure From_Spherical ( r, Phi, Theta: real; Var x, y, z: real);ππ{ X-axis points east, y-axis north, z-axis upward, angle Phi corresponds to anπ azimuth measured clockwise from due north, and angle Theta is the elevationπ measured upwards from the horizon (x-y plane).π}πProcedure To_Azimuth_Elevation ( x, y, z: real; Var r, Phi, Theta: real);πProcedure From_Azimuth_Elevation ( r, Phi, Theta: real; Var x, y, z: real);ππFunction Sign ( x, y: real): real;πFunction Degrees ( A: real): real;πFunction Radians ( A: real): real;ππFunction Atan ( x: real): real; {ArcTangent}πFunction Atan2 ( s, c: real): real;ππIMPLEMENTATIONππ{ Convert from Cartesian to polar coordinates }πProcedure To_Polar ( x, y: real; Var r, Theta: real);πBeginπ r := Sqrt(Sqr(x) + Sqr(y));π Theta := Atan2(y, x);πEnd;ππ{ Convert from polar to Cartesian coordinates }πProcedure From_Polar ( r, Theta: real; Var x, y: real);πBeginπ x := r * Cos(Theta);π y := r * Sin(Theta);πEnd;ππ{ Convert from Cartesian to spherical polar coordinates }πProcedure To_Spherical ( x, y, z: real; Var r, Phi, Theta: real);πvar temp: real;πBeginπ To_Polar(x, y, temp, Phi);π To_Polar(z, temp, r, Theta);πEnd;ππ{ Convert from spherical polar to Cartesian coordinates }πProcedure From_Spherical ( r, Phi, Theta: real; Var x, y, z: real);πvar temp: real;πBeginπ From_Polar(r, Theta, z, temp);π From_Polar(temp, Phi, x, y);πEnd;ππ{ Convert from Cartesian to Az-El coordinates }πProcedure To_Azimuth_Elevation ( x, y, z: real; Var r, Phi, Theta: real);πvar temp: real;πBeginπ To_Polar(y, x, temp, Phi);π To_Polar(temp, z, r, Theta);πEnd;ππ{ Convert from Az-El to Cartesian coordinates }πProcedure From_Azimuth_Elevation ( r, Phi, Theta: real; Var x, y, z: real);πvar temp: real;πBeginπ From_Polar(r, Theta, temp, z);π From_Polar(temp, Phi, y, x);πEnd;ππ{ Returns Absolute value of x with Sign of y }πFunction Sign ( x, y: real): real;πBeginπ if y >= Zero thenπ Sign := Abs(x)π elseπ Sign := -Abs(x);πEnd;ππ{ Convert angle from radians to degrees }πFunction Degrees ( A: real): real;πBeginπ Degrees := Degrees_Per_Radian * A;πEnd;ππ{ Convert angle from degrees to radians }πFunction Radians ( A: real): real;πBeginπ Radians := Radians_Per_Degree * A;πEnd;ππ{ Inverse Trigonometric Tangent Function }πFunction Atan ( x: real): real;π{ Arctangent algorithm uses fifth-order rational fraction with optimizedπ coefficientsπ}π function _Atan ( x: real): real;π constπ a = 0.999999447;π b = 0.259455937;π c = 0.592716128;ππ var y: real;π beginπ y := x*x;π _Atan := a*x*( One + b*y) / ( One + c*y);π end;ππvar a, y: real;πBeginπ y := Abs(x);π if y <= One thenπ a := _Atan(y)π elseπ a := Pi_Over_Two - _Atan( One / y);π if x <= Zero thenπ a := -a;π Atan := a;πEnd;ππ{ Four-Quadrant Inverse Trigonometric Tangent Function }πFunction Atan2 ( s, c: real): real;πvar s1, c1, Theta: real;πBeginπ s1 := Abs(s);π c1 := Abs(c);π if c1 + s1 = Zero thenπ Theta := Zeroπ else if s1 <= c1 thenπ Theta := ArcTan(s1 / c1)π elseπ Theta := Pi_Over_Two - ArcTan(c1 / s1);π if c < Zero thenπ Theta := Pi - Theta;π Atan2 := Sign(Theta, s);πEnd;πBEGINπEND.π(*****END*****)π 106 08-24-9413:32ALL IAIN WHYTE DOT Matrix LED Effect SWAG9408 ╞≥I 218 ╓ unit dotmat; {written by Iain Whyte. (c) 1994 }ππ{ This unit generates a 'dot matrix' LED effect that is very effective. Ifπyou would like to use this code, all that I ask is that you mention itπin the credits somewhere, and let me know what you used it for. If you haveπany suggestions, or you want to talk to me or ask questions, I can beπcontacted at whytei@topaz.ucq.edu.au or ba022@cq-pan.cqu.edu.auπvia the Internet, or by snail-post :ππ Iain Whyteπ 141 Racecourse Roadπ Mt Morgan Q4714π Australia.ππor on the Rockhampton Computer Club BBS, via the programming, IBM/DOS, orπAMIGA conferences... RCC BBS: (079) 276200ππInstructions :ππSelf explanatary, really, there is a sample prog for using this unit at theπof this file..... }ππ{displays upto 10 characters at once, max string size (ATM) is 20 chars....}πππinterfaceππuses dos,crt,graph;ππππprocedure display_dotmat_screen(xpos,ypos:integer);πprocedure create_dotmat(inputstring:string);πprocedure straight_display;πprocedure left_right;πprocedure right_left;πprocedure top_bot;πprocedure bot_top;πprocedure italics;πprocedure random_fade_out;πprocedure random_fade_in;πprocedure fall_away;ππππimplementationπππtypeππletter_set=array[0..8,0..4] of integer;πdotmattype=array[0..8,0..119] of integer;ππconstπ pixelsize = 2; {size of each LED element i.e. 2 therfore LED is 2x2 pixels}π a : letter_set = ((0,1,1,1,0), {each letter is set up as a 5x9 array}π (1,0,0,0,1), {1 means LED is ON, 0 means LED OFF}π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1));π b : letter_set = ((1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0));π c : letter_set = ((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,1),π (0,1,1,1,0));π d : letter_set = ((1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0));π e : letter_set = ((1,1,1,1,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,1));π f : letter_set = ((1,1,1,1,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0));π g : letter_set = ((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,1,1,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π h : letter_set = ((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1));π i : letter_set = ((0,1,1,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,1,1,0));π j : letter_set = ((0,0,1,1,1),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,0,1,0),π (1,0,0,1,0),π (1,0,0,1,0),π (1,0,0,1,0),π (0,1,1,0,0));π k : letter_set = ((1,0,0,0,1),π (1,0,0,1,0),π (1,0,1,0,0),π (1,1,0,0,0),π (1,1,0,0,0),π (1,1,0,0,0),π (1,0,1,0,0),π (1,0,0,1,0),π (1,0,0,0,1));π l : letter_set = ((1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,1));π m : letter_set = ((1,0,0,0,1),π (1,1,0,1,1),π (1,1,1,1,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1));π n : letter_set = ((1,0,0,0,1),π (1,1,0,0,1),π (1,1,0,0,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,0,0,1,1),π (1,0,0,1,1),π (1,0,0,0,1));π o : letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π p : letter_set =((1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0));π q : letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,1,0,1),π (1,0,0,1,1),π (0,1,1,1,1));π r : letter_set =((1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0),π (1,1,0,0,0),π (1,0,1,0,0),π (1,0,0,1,0),π (1,0,0,0,1));π s : letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,0),π (1,0,0,0,0),π (0,1,1,1,0),π (0,0,0,0,1),π (0,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π t : letter_set =((1,1,1,1,1),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0));π u : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π v : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,0,1,0),π (0,1,0,1,0),π (0,0,1,0,0));π w : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,1,0,1),π (1,0,1,0,1),π (0,1,1,1,0),π (0,1,0,1,0));π x : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,0,1,0),π (0,0,1,0,0),π (0,1,0,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1));π y : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0));π z : letter_set =((1,1,1,1,1),π (0,0,0,0,1),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,1,0,0),π (0,1,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,1));π exc : letter_set =((0,0,1,0,0),π (0,1,1,1,0),π (0,1,1,1,0),π (0,1,1,1,0),π (0,1,1,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,0,0,0),π (0,0,1,0,0));π andm : letter_set =((0,0,1,1,0),π (0,1,0,0,1),π (0,0,1,1,0),π (0,1,1,1,0),π (1,0,0,1,0),π (1,0,0,0,1),π (1,0,0,1,1),π (1,0,0,1,0),π (0,1,1,0,1));π hat : letter_set =((0,1,0,1,0),π (0,1,0,1,0),π (1,1,1,1,1),π (0,1,0,1,0),π (0,1,0,1,0),π (1,1,1,1,1),π (0,1,0,1,0),π (0,1,0,1,0),π (0,1,0,1,0));π com : letter_set =((0,0,0,0,0),π (0,0,0,0,0),π (0,0,0,0,0),π (0,0,0,0,0),π (0,0,0,0,0),π (0,0,1,1,0),π (0,0,1,1,0),π (0,0,1,0,0),π (0,1,1,0,0));π ast : letter_set=((0,0,0,0,0),π (1,0,1,0,1),π (0,1,1,1,0),π (0,0,1,0,0),π (1,1,1,1,1),π (0,0,1,0,0),π (0,1,1,1,0),π (1,0,1,0,1),π (0,0,0,0,0));π la : letter_set =((0,0,0,0,1),π (0,0,0,1,0),π (0,0,1,0,0),π (0,1,0,0,0),π (1,0,0,0,0),π (0,1,0,0,0),π (0,0,1,0,0),π (0,0,0,1,0),π (0,0,0,0,1));π ra : letter_set =((1,0,0,0,0),π (0,1,0,0,0),π (0,0,1,0,0),π (0,0,0,1,0),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,1,0,0),π (0,1,0,0,0),π (1,0,0,0,0));π one :letter_set =((0,0,1,0,0),π (0,1,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,1,1,0));π two : letter_set=((0,1,1,1,0),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,1,0,0),π (0,1,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,1));π thr: letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,0,1),π (0,0,1,1,0),π (0,0,0,0,1),π (0,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π four:letter_set =((1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,1,0),π (1,0,0,1,0),π (1,0,0,1,0),π (1,0,0,1,0),π (1,1,1,1,1),π (0,0,0,1,0),π (0,0,0,1,0));π five:letter_set =((1,1,1,1,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,0),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π six :letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,0),π (1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π sev :letter_set =((1,1,1,1,1),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,0,0,0),π (0,1,0,0,0));π eight:letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π nine : letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,1),π (0,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π zer : letter_set =((0,1,1,1,0),π (1,0,0,1,1),π (1,0,0,1,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,1,0,0,1),π (1,1,0,0,1),π (0,1,1,1,0));ππ smil :letter_set =((0,1,1,1,0),π (1,1,1,1,1),π (1,0,1,0,1),π (1,1,1,1,1),π (1,1,0,1,1),π (1,1,1,1,1),π (1,0,0,0,1),π (1,1,0,1,1),π (0,1,1,1,0));π dol : letter_set =((0,0,1,0,0),π (0,1,1,1,0),π (1,0,1,0,1),π (1,0,1,0,0),π (0,1,1,1,0),π (0,0,1,0,1),π (1,0,1,0,1),π (0,1,1,1,0),π (0,0,1,0,0));π copyr: letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,1,0,1),π (1,1,0,1,1),π (1,1,0,0,1),π (1,1,0,1,1),π (1,0,1,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π lb: letter_set =((0,0,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,0,0,0),π (0,1,0,0,0),π (0,1,0,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,0,1,0));π rb: letter_set =((0,1,0,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,0,0,0));π quest: letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,0,0,0),π (0,0,1,0,0));πππvarπ letters:array[' '..'z']of letter_set;π outchars:array[0..19]of char;π mainxpos,mainypos:integer;π dotmatarray:dotmattype;π dotmatarraymove,dotmatempty:dotmattype;π counth,countv,lettercount:integer;π count,count2,countmove,countloop:integer;ππprocedure setup_chars;ππbeginπ letters['a']:=a;π letters['b']:=b;π letters['c']:=c;π letters['d']:=d;π letters['e']:=e;π letters['f']:=f;π letters['g']:=g;π letters['h']:=h;π letters['i']:=i;π letters['j']:=j;π letters['k']:=k;π letters['l']:=l;π letters['m']:=m;π letters['n']:=n;π letters['o']:=o;π letters['p']:=p;π letters['q']:=q;π letters['r']:=r;π letters['s']:=s;π letters['t']:=t;π letters['u']:=u;π letters['v']:=v;π letters['w']:=w;π letters['x']:=x;π letters['y']:=y;π letters['z']:=z;π letters['!']:=exc;π letters['&']:=andm;π letters['#']:=hat;π letters[',']:=com;π letters['*']:=ast;π letters['<']:=la;π letters['>']:=ra;π letters['1']:=one;π letters['2']:=two;π letters['3']:=thr;π letters['4']:=four;π letters['5']:=five;π letters['6']:=six;π letters['7']:=sev;π letters['8']:=eight;π letters['9']:=nine;π letters['0']:=zer;π letters['^']:=smil;π letters['$']:=dol;π letters['@']:=copyr;π letters['(']:=lb;π letters[')']:=rb;π letters['?']:=quest;πend;ππprocedure display_dotmat_screen(xpos,ypos:integer);ππvar countx,county:integer;ππbeginπ mainxpos:=xpos;π mainypos:=ypos;π setfillstyle(1,8);π for countx:=0 to 59 doπ beginπ for county:=-1 to 9 doπ beginπ bar((xpos+(countx*(pixelsize+1))),(ypos+(county*(pixelsize+1))),π ((xpos+(countx*(pixelsize+1)))+(pixelsize-1)),((ypos+(county*(pixelsize+1)))+(pixelsize-1)));ππ end;π end;πend;πππprocedure convertstring_to_chars(instr:string);ππvar count:integer;π dummys:string[1];π strcount:char;ππbeginπ for count:=1 to 20 doπ beginππ dummys:=copy(instr,count,1);π for strcount:=' ' to 'z' doπ beginπ if dummys = strcount then outchars[count-1]:=strcount;π end;π end;πend;πππprocedure create_dotmat(inputstring:string);ππbeginπ for countv:=0 to 8 doπ for counth:=0 to 119 doπ dotmatempty[countv,counth]:=0;ππ setup_chars;π convertstring_to_chars(inputstring);ππ for lettercount:=0 to 19 do {make array of dots from letter data}π beginππ for countv:=0 to 8 doπ beginππ for counth :=(lettercount*6) to ((lettercount*6)+6) doπ beginπ if counth<120 thenπ beginπ dotmatarray[countv,counth]:=letters[outchars[lettercount],countv,(counth-lettercount*6)];π if (counth-lettercount*6) > 4 then dotmatarray[countv,counth]:=0;π end;π end;π end;π end;ππππend;πππprocedure gen_display;ππbeginππ for counth:=0 to 59 doπ beginπ for countv:=0 to 8 doπ beginπ if (counth < 2) or (counth > 57) then setfillstyle(1,2)π else setfillstyle(1,10);π if dotmatarraymove[countv,counth] = 1 thenπ beginπ bar((mainxpos+(counth*(pixelsize+1))),(mainypos+(countv*(pixelsize+1))),π ((mainxpos+(counth*(pixelsize+1)))+(pixelsize-1)),((mainypos+(countv*(pixelsize+1)))+(pixelsize-1)));π end;π setfillstyle(1,8);π if dotmatarraymove[countv,counth] = 0 thenπ beginπ bar((mainxpos+(counth*(pixelsize+1))),(mainypos+(countv*(pixelsize+1))),π ((mainxpos+(counth*(pixelsize+1)))+(pixelsize-1)),((mainypos+(countv*(pixelsize+1)))+(pixelsize-1)));π end;π end;π end;ππend;πππprocedure straight_display;ππbeginπ dotmatarraymove:=dotmatarray;π gen_display;πend;ππππprocedure left_right;πbeginππ for count2:=0 to 119 doπ beginπ for count:=0 to 59 doπ beginπ countmove:=count+count2;π if countmove>119 then countmove:=countmove-120;π for countloop:=0 to 8 do dotmatarraymove[countloop,count]:=dotmatarray[countloop,countmove];ππ end;π gen_display;π delay(5);π end;πend;πππprocedure right_left;πbeginππ for count2:=119 downto 0 doπ beginππ for count:=0 to 59 doπ beginπ countmove:=count+count2;π if countmove>119 then countmove:=countmove-120;π for countloop:= 0 to 8 do dotmatarraymove[countloop,count]:=dotmatarray[countloop,countmove];ππ end;ππ gen_display;π delay(5);π end;πend;πππprocedure top_bot;πbeginπ dotmatarraymove:=dotmatempty;π for count2:=-9 to 9 doπ beginππ for count:=0 to 8 doπ beginπ countmove:=count+count2;π if countmove>8 then for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=0π else if countmove<0 then for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=0π else for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=dotmatarray[countmove,countloop];ππ end;ππ gen_display;π delay(50);π end;πend;πππprocedure bot_top;πbeginπ for count2:=9 downto -9 doπ beginππ for count:=0 to 8 doπ beginπ countmove:=count+count2;π if countmove>8 then for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=0π else if countmove<0 then for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=0π else for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=dotmatarray[countmove,countloop];ππππ end;ππ gen_display;π delay(50);π end;πππend;ππprocedure italics;πbeginπ for count:=0 to 8 doπ beginπ for count2:=0 to 119 doπ beginπ if (count mod 2) = 0 thenπ beginπ dotmatarraymove[count,count2]:=dotmatarray[count,count2+(count div 2)];π end elseπ dotmatarraymove[count,count2]:=dotmatarray[count,count2+((count-1) div 2)];π end;π end;π dotmatarray:=dotmatarraymove;πend;ππππprocedure random_fade_out;ππvarπv,h,rnd,countdots:integer;ππbeginπ randomize;π dotmatarraymove:=dotmatarray;π countdots:=0;π for v:=0 to 8 doπ beginπ for h:=0 to 119 doπ beginπ if dotmatarraymove[v,h]=1 thenππ countdots:=countdots+1;π end;π end;π repeatπ for v:=0 to 8 doπ beginπ for h:=0 to 119 doπ beginπ if dotmatarraymove[v,h]=1 thenπ beginπ rnd:=random(5);π if rnd = 1 thenπ beginπ countdots:=countdots-1;π dotmatarraymove[v,h]:=0;π end;π end;π end;π end;ππ gen_display;π until countdots<=0;ππend;πππprocedure random_fade_in;πvarπv,h,rnd,countdots:integer;πbeginπ randomize;π dotmatarraymove:=dotmatempty;π countdots:=0;π for v:=0 to 8 doπ beginπ for h:=0 to 119 doπ beginπ if dotmatarray[v,h]=1 thenππ countdots:=countdots+1;π end;π end;π repeatπ for v:=0 to 8 doπ beginπ for h:=0 to 119 doπ beginπ if (dotmatarray[v,h]=1)and (dotmatarraymove[v,h]=0) thenπ beginπ rnd:=random(5);π if rnd = 1 thenπ beginπ countdots:=countdots-1;π dotmatarraymove[v,h]:=1;π end;π end;π end;π end;ππ gen_display;π until countdots<=0;ππend;ππprocedure fall_away;πbeginπ dotmatarraymove:=dotmatarray;π for count:=8 downto 0 doπ beginπ count2:=count;π repeatπ for countloop:=0 to 119 doπ beginπ if count2=count thenπ beginπ dotmatarraymove[count2,countloop]:=dotmatarray[count,countloop];π endπ elseπ beginπ dotmatarraymove[count2,countloop]:=dotmatarray[count,countloop];π dotmatarraymove[count2-1,countloop]:=0;π end;π end;π gen_display;π delay(5);π count2:=count2+1;π until count2=10;ππ end;πend;πππend.ππ{------------------------------- DEMO ----------------------------------}πprogram test_dotmat_unit;ππuses dos,crt,graph,dotmat;ππππvarπ in1,in2:integer;πππbegin {12345678901234567890} {length guide}ππ initgraph(in1,in2,'c:\bp\bgi'); {initialise 640x480x16c mode bgi}π cleardevice;πππ display_dotmat_screen(50,50); {set_up, display blank LED matrix}ππ create_dotmat('this is a demo ! '); {loads string into matrix array}ππ straight_display; {display on matrix}π delay(1000);πππ left_right; {scroll from left to right}π delay(1000);ππ right_left; {scroll from right to left}ππ create_dotmat('fading in! '); {set up new msg}π random_fade_in; {randomised fade}π delay(1000);ππ create_dotmat('fade out!! ');π straight_display;π delay(1000);ππ random_fade_out;πππ create_dotmat('can scroll 4 ways!!! ');π left_right;π top_bot; {scroll from top to bottom}π right_left;π bot_top; {scroll from bottom to top}πππ create_dotmat('italics for the font!'); {create new msg}π italics; {generate italics}π random_fade_in;π left_right;π delay(1000);π random_fade_out;ππ create_dotmat('and a special effect '); {create new msg}π left_right;π delay(1000);π create_dotmat('called fall away! ');π left_right;π delay(1000);π fall_away; {demo Special FX}ππ create_dotmat('well, what dya think?');π left_right;π fall_away;ππ create_dotmat('@ iain whyte 1994 ');π random_fade_in;π left_right;π right_left;π random_fade_out;π top_bot;π bot_top;ππππ closegraph; {kill graphics mode}ππend.π 107 08-24-9413:37ALL JENS LARSSON Fast Line Drawing SWAG9408 òy┴ 9 ╓ {π SS> I'm looking for a qwick way to draw a line... All I need areπ SS> horizontal and vertical lines, so would it be easiest to use aπ SS> series of PutPixels?ππUnfortunately you don't specify which mode you're working in, soπI assume it is 320x200 (which tends to be the most popular mode here):π}ππProcedure DHL(x, y, Length : Word; Color : Byte); Assembler;π Asmπ mov ax,0a000hπ mov es,axπ mov ax,yπ shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,xπ mov cx,Lengthπ mov al,Colorπ cldπ rep stosb { I bet I'll get loads of replies which uses stosw instead :) }π End;ππProcedure DVL(x, y, Length : Word; Color : Byte); Assembler;π Asmπ mov ax,0a000hπ mov es,axπ mov ax,yπ shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,xπ mov al,Colorπ mov cx,Lengthπ@DVL1:π mov es:[di],alπ add di,320π dec cxπ jnz @DVL1π End;ππ 108 08-24-9413:37ALL DAAN DE HAAS Fast Polygons SWAG9408 ╠ΘM 105 ╓ {πThis unit draws polygons fast. It draws only polygons which are monotoneπvertical. That means only polygons which you can fill with continues horizontalπlines. Fortunately that are the polygons which are mostly used in 3d graphics.π}ππ{*****************************************************************}π{* UnitName : FASTPOLY.PAS *}π{* Purpose : Draw monotone vertical polygons fast *}π{* Version : 1.5 *}π{* Author : Daan de Haas *}π{* Date : 20/10/1993 *}π{* Last update : 9/06/1994 *}π{* Language : Borland Turbo Pascal 7.0 *}π{* Fidonet : Daan de Haas (2:500/104.6141) *}π{* Internet : Daan.de.Haas@p6141.f104.n500.z2.fidonet.org *}π{*****************************************************************}ππ{* VGA mode $13 and 386 processor *}π{* Literatur : Dr Dobb's XSharp *}ππ{$R-,S-,Q-,I-}ππUNIT FastPoly;ππ{**************************} INTERFACE {**************************}ππTYPEπ PPoint = ^TPoint;π TPoint = RECORDπ x,y:integer;π END;π PPolygon = ^TPolygon;π PPointsList = ^TPointsList;π TPointsList = ARRAY[0..9999] OF TPoint;π TPolygon = RECORDπ length,color:word;π PointPtr:PPointsList;π END;π PHLine = ^THLine;π THLine = RECORDπ XStart,XEnd:word;π END;π PHLineArray = ^THLineArray;π THLineArray = ARRAY[0..9999] OF THLine;π THLineList = RECORDπ length,YStart:integer;π HLinePtr : PHLineArray;π END;ππPROCEDURE HLine(x1,y1,x2:word; color:word);πPROCEDURE InitPoly(VAR p:TPolygon; len,col:word);πPROCEDURE DonePoly(VAR p:TPolygon);πPROCEDURE FillMonotoneVerticalPolygon(XOffset,YOffset:word;π VertexList:TPolygon);ππCONSTπ MaxX=320;π MaxY=200;π VidSegment=$A000;ππ{************************} IMPLEMENTATION {***********************}ππPROCEDURE HLine; ASSEMBLER;πASMπ mov ax,x1 { x1 < x2 }π cmp ax,x2π jl @@skip1π je @@lijnexitπ xchg ax,x2π mov x1,axπ@@skip1:π mov ax,maxX { calculate y1*maxX+x1 }π mul y1π add ax,x1π@@1:π mov di,ax { dx=segment, di=offset }π mov ax,VidSegmentππ@@skip2:π cld { forward direction }π mov cx,x2π sub cx,x1π inc cx { cx = number of pixels in line }π mov dx,diπ add dx,cxπ mov es,ax { load segment register }π mov ax,color { get color into 386 register eax }π mov ah,alπ mov dx,axπ db $66,$c1,$e0,$10 { shl eax,16 (386 code) }π mov ax,dxπ test di,00000011bπ jz @@skip { test for doubleword border, if so jump }π@@waitdd:π mov es:[di],al { put one pixel }π inc di { di:=next pixel address }π test di,00000011b { doubleword border ? }π loopnz @@waitdd { stop if cx=0 or zeroflag 1 }π or cx,cx { cx=0 ? }π jz @@lijnexit { if so, line is ready }π cmp cx,4 { is a stosd possible ? }π jl @@waitdd { no, then pixel after pixel }π@@skip:π mov dx,cxπ shr cx,2π db $f3,$66,$AB { rep stosd (386 code) }π mov cx,dxπ and cx,00000011b { line finished ? }π jnz @@waitddπ@@lijnexit:πEND;ππPROCEDURE ScanEdge(x1,y1,x2,y2,SetXStart,SkipFirst:integer;π VAR EdgePointPtr:PHLineArray); ASSEMBLER;π{ Scan converts an edge from (X1,Y1) to (X2,Y2), not including theπ point at (X2,Y2). If SkipFirst == 1, the point at (X1,Y1) isn'tπ drawn; if SkipFirst == 0, it is. For each scan line, the pixelπ closest to the scanned edge without being to the left of the scannedπ edge is chosen. Uses an all-integer approach for speed & precision.ππ Edges must not go bottom to top; that is, Y1 must be <= Y2.π Updates the pointer pointed to by EdgePointPtr to point to the nextπ free entry in the array of HLine structures. }ππVARπ AdvanceAmt,Height:word;ππASMπ les di,EdgePointPtrπ les di,es:[di] { point to the HLine array }π cmp SetXStart,1 { set the XStart field of each HLineπ { struc? }π jz @@HLinePtrSet { yes, DI points to the first XStart }π add di,2 { no, point to the XEnd field of the }π { first HLine struc }π@@HLinePtrSet:π mov bx,Y2π sub bx,Y1 { edge height }π jle @@ToScanEdgeExit{ guard against 0-length & horz edges }π mov Height,bx { Height = Y2 - Y1 }π sub cx,cx { assume ErrorTerm starts at 0 (true if }π { we're moving right as we draw) }π mov dx,1 { assume AdvanceAmt = 1 (move right) }π mov ax,X2π sub ax,X1 { DeltaX = X2 - X1 }π jz @@IsVertical { it's a vertical edge--special case it }π jns @@SetAdvanceAmt { DeltaX >= 0 }π mov cx,1 { DeltaX < 0 (move left as we draw) }π sub cx,bx { ErrorTerm = -Height + 1 }π neg dx { AdvanceAmt = -1 (move left) }π neg ax { Width = abs(DeltaX) }π@@SetAdvanceAmt:π mov AdvanceAmt,dxπ{ Figure out whether the edge is diagonal, X-major (more horizontal), }π{ or Y-major (more vertical) and handle appropriately. }π cmp ax,bx { if Width==Height, it's a diagonal edge }π jz @@IsDiagonal { it's a diagonal edge--special case }π jb @@YMajor { it's a Y-major (more vertical) edge }π { it's an X-major (more horz) edge }π sub dx,dx { prepare DX:AX (Width) for division }π div bx { Width/Height }π { DX = error term advance per scan line }π mov si,ax { SI = minimum # of pixels to advance X }π { on each scan line }π test AdvanceAmt,8000h { move left or right? }π jz @@XMajorAdvanceAmtSet { right, already set }π neg si { left, negate the distance to advance }π { on each scan line }π@@XMajorAdvanceAmtSet:π mov ax,X1 { starting X coordinate }π cmp SkipFirst,1 { skip the first point? }π jz @@XMajorSkipEntry { yes }π@@XMajorLoop:π mov es:[di],ax { store the current X value }π add di,4 { point to the next HLine struc }π@@XMajorSkipEntry:π add ax,si { set X for the next scan line }π add cx,dx { advance error term }π jle @@XMajorNoAdvance { not time for X coord to advance one }π { extra }π add ax,AdvanceAmt { advance X coord one extra }π sub cx,Height { adjust error term back }π@@XMajorNoAdvance:π dec bx { count off this scan line }π jnz @@XMajorLoopπ jmp @@ScanEdgeDoneπ@@ToScanEdgeExit:π jmp @@ScanEdgeExitπ@@IsVertical:π mov ax,X1 { starting (and only) X coordinate }π sub bx,SkipFirst { loop count = Height - SkipFirst }π jz @@ScanEdgeExit { no scan lines left after skipping 1st }π@@VerticalLoop:π mov es:[di],ax { store the current X value }π add di,4 { point to the next HLine struc }π dec bx { count off this scan line }π jnz @@VerticalLoopπ jmp @@ScanEdgeDoneπ@@IsDiagonal:π mov ax,X1 { starting X coordinate }π cmp SkipFirst,1 { skip the first point? }π jz @@DiagonalSkipEntry { yes }π@@DiagonalLoop:π mov es:[di],ax { store the current X value }π add di,4 { point to the next HLine struc }π@@DiagonalSkipEntry:π add ax,dx { advance the X coordinate }π dec bx { count off this scan line }π jnz @@DiagonalLoopπ jmp @@ScanEdgeDoneππ@@YMajor:π push bp { preserve stack frame pointer }π mov si,X1 { starting X coordinate }π cmp SkipFirst,1 { skip the first point? }π mov bp,bx { put Height in BP for error term calcs }π jz @@YMajorSkipEntry { yes, skip the first point }π@@YMajorLoop:π mov es:[di],si { store the current X value }π add di,4 { point to the next HLine struc }π@@YMajorSkipEntry:π add cx,ax { advance the error term }π jle @@YMajorNoAdvance { not time for X coord to advance }π add si,dx { advance the X coordinate }π sub cx,bp { adjust error term back }π@@YMajorNoAdvance:π dec bx { count off this scan line }π jnz @@YMajorLoopπ pop bp { restore stack frame pointer }π@@ScanEdgeDone:π cmp SetXStart,1 { were we working with XStart field? }π jz @@UpdateHLinePtr { yes, DI points to the next XStart }π sub di,2 { no, point back to the XStart field }π@@UpdateHLinePtr:π mov bx,word ptr EdgePointPtr { point to pointer to HLine array }π mov ss:[bx],di { update caller's HLine array pointer }π@@ScanEdgeExit:πEND;ππPROCEDURE DrawHorizontalLineList(VAR list:THLineList; color:word); ASSEMBLER;πASMπ les si,listπ mov cx,es:[si] { cx = number of lines }π mov ax,es:[si+2] { ax = startY }π les si,es:[si+4] { es:si points to pointlist }π@@loop:π mov bx,es:[si] { get startX }π mov dx,es:[si+2] { get endX }π push cx { save registers }π push axπ push siπ push esππ push bx { draw horizontal line }π push axπ push dxπ mov dx,color { get color }π push dxπ call HLineππ pop es { restore registers }π pop siπ pop axπ pop cxπ inc ax { y:=y+1 }π add si,4 { next points }π loop @@loop { if length=0 then stop }πEND;ππPROCEDURE FillMonotoneVerticalPolygon;πVARπ i,MinIndex,MaxIndex,MinPoint_y,MaxPoint_y,NextIndex,π CurrentIndex,PreviousIndex:integer;π WorkingHLineList:THLineList;π EdgePointPtr:PHLineArray;π VertexPtr:PPointsList;πBEGINπ IF VertexList.Length=0 THEN Exit;π VertexPtr:=VertexList.PointPtr;π MaxPoint_y:=VertexPtr^[0].y;π MinPoint_y:=MaxPoint_y;π MinIndex:=0;π MaxIndex:=0;π FOR i:=1 TO VertexList.Length-1 DOπ WITH VerTexPtr^[i] DOπ IF y<MinPoint_y THENπ BEGINπ MinPoint_y:=y;π MinIndex:=i;π ENDπ ELSEπ IF y>MaxPoint_y THENπ BEGINπ MaxPoint_y:=y;π MaxIndex:=i;π END;π WITH WorkingHLineList DOπ BEGINπ length:=MaxPoint_y-MinPoint_y;π IF length<=0 THEN Exit;π YStart:=YOffset+MinPoint_y;π GetMem(HLinePtr,SizeOf(THLine)*length);π EdgePointPtr:=HLinePtr;π END;π CurrentIndex:=MinIndex;π PreviousIndex:=MinIndex;π REPEATπ CurrentIndex:=(CurrentIndex+VertexList.length-1) MOD VertexList.length;π ScanEdge(VertexPtr^[PreviousIndex].x+XOffset,π VertexPtr^[PreviousIndex].y,π VertexPtr^[CurrentIndex].x+XOffset,π VertexPtr^[CurrentIndex].y,π 1,0,EdgePointPtr);π PreviousIndex:=CurrentIndex;π UNTIL CurrentIndex=MaxIndex;π EdgePointPtr:=WorkingHLineList.HLinePtr;π CurrentIndex:=MinIndex;π PreviousIndex:=MinIndex;π REPEATπ CurrentIndex:=(CurrentIndex+1) MOD VertexList.length;π ScanEdge(VertexPtr^[PreviousIndex].x+XOffset,π VertexPtr^[PreviousIndex].y,π VertexPtr^[CurrentIndex].x+XOffset,π VertexPtr^[CurrentIndex].y,π 0,0,EdgePointPtr);π PreviousIndex:=CurrentIndex;π UNTIL CurrentIndex=MaxIndex;π DrawHorizontalLineList(WorkingHLineList,VertexList.color);π WITH WorkingHLineList DO FreeMem(HLinePtr,SizeOf(THLine)*length);πEND;ππPROCEDURE InitPoly;πBEGINπ WITH p DOπ BEGINπ length:=len;π color:=col;π { No Error checking !}π GetMem(PointPtr,len*SizeOf(TPoint));π END;πEND;ππPROCEDURE DonePoly;πBEGINπ WITH p DOπ BEGINπ IF PointPtr<>NIL THEN FreeMem(PointPtr,length*SizeOf(TPoint));π PointPtr:=NIL;π END;πEND;ππEND.ππ{*****************************************************************}π{* ProgramName : FASTPOL.PAS *}π{* Purpose : Demonstration of unit FastPoly *}π{* Version : 1.0 *}π{* Author : Daan de Haas *}π{* Date : 9 jun 1994 *}π{* Last update : 9 jun 1994 *}π{* Language : Borland Pascal 7.0 *}π{* Fidonet : Daan de Haas (2:500/104.6141) *}π{* Internet : Daan.de.Haas@p6141.f104.n500.z2.fidonet.org *}π{*****************************************************************}ππ{$R-,I-,Q-,S-}ππUSESπ Crt, FastPoly;ππPROCEDURE SetVideo(m:word); ASSEMBLER;πASMπ mov ax,mπ int $10πEND;ππPROCEDURE Polydemo;πVARπ p1,p2:TPolygon;πBEGINπ InitPoly(p1,6,YELLOW);π p1.PointPtr^[0].X:=10;π p1.PointPtr^[0].Y:=0;π p1.PointPtr^[1].X:=20;π p1.PointPtr^[1].Y:=0;π p1.PointPtr^[2].X:=30;π p1.PointPtr^[2].Y:=10;π p1.PointPtr^[3].X:=20;π p1.PointPtr^[3].Y:=20;π p1.PointPtr^[4].X:=10;π p1.PointPtr^[4].Y:=20;π p1.PointPtr^[5].X:=0;π p1.PointPtr^[5].Y:=10;π InitPoly(p2,6,BLUE);π p2.PointPtr^[0].X:=10;π p2.PointPtr^[0].Y:=0;π p2.PointPtr^[1].X:=20;π p2.PointPtr^[1].Y:=0;π p2.PointPtr^[2].X:=30;π p2.PointPtr^[2].Y:=10;π p2.PointPtr^[3].X:=20;π p2.PointPtr^[3].Y:=20;π p2.PointPtr^[4].X:=10;π p2.PointPtr^[4].Y:=20;π p2.PointPtr^[5].X:=0;π p2.PointPtr^[5].Y:=10;π REPEATπ FillMonotoneVerticalPolygon(Random(MaxX-35),Random(MaxY-25),p1);π FillMonotoneVerticalPolygon(Random(MaxX-35),Random(MaxY-25),p2);π UNTIL KeyPressed;π ReadKey;π DonePoly(p1);π DonePoly(p2);πEND;ππBEGINπ ClrScr;π Randomize;π SetVideo($13);π PolyDemo;π SetVideo(3);πEND.π 109 08-24-9413:38ALL ALEX CHALFIN Fire Graphic SWAG9408 4[╒¿ 32 ╓ {πHere is a little something for all you pyromaniacs, and demo coders out there.ππI got my hands on Jare's fire code and thought it was pretty cool, so I madeπmy own fire program. Although it didn't turn out like I thought it would (likeπJare's) what I have is (at least I think so) something that looks moreπrealistic.ππThis program was completely written by myself and was inspired by Jare's fireπcode (available on Internet FTP at ftp.eng.ufl.edu pub/msdos/demos/programmingπ/source). A 386 computer is required (Double Word copies are used), but a 486πis highly recommended, as 28800 pixels are calculated each frame (I useπstandard mode 13h). The entire source is Pascal/Inline asm and was writtenπusing Turbo Pascal v6.0. I hope you like it.πππ{ **** Program starts here ******** }ππProgram Phire;π{$G+} { Enable 286 instructions }π{ coded by Phred 7/23/94 aka Alex Chalfin }π{ Internet: achalfin@uceng.uc.edu }π{ A fast computer is HIGHLY recommended. }π{ Inspired by Jare's fire code }ππVarπ Screen : Array[0..63999] of Byte ABSOLUTE $A000:$0000; { the VGA screen }π VScreen : Array[0..63999] of Byte; { an offscreen buffer }π Lookup : Array[0..199] of Word; { an Offset lookup table }ππProcedure SetPalette; Near;π{ Sets the Palette }ππVarπ p : Array[0..767] of Byte;π x : integer;ππBeginπ for x := 0 to 255 do { Generate fade from orange to black }π Beginπ p[x*3] := (x * 63) Shr 8;π P[x*3+1] := (x * 22) Shr 8;π P[x*3+2] := 0;π End;π Port[$3C8] := 0;π For x := 0 to 255 do { Set the palette }π Beginπ Port[$3C9] := P[x*3];π Port[$3C9] := P[x*3+1];π Port[$3C9] := P[x*3+2];π End;πEnd;ππProcedure Burnin_Down_The_House;ππVarπ c : Integer;ππBeginπ Randomize;π Repeatπ For c := 0 to 319 do { Setup bottom line "hot spots" }π If Random(4) = 1π Then VScreen[LookUp[199] + c] := Random(3) * 255;π Asmπ MOV CX,28800 { Number of pixels to calculate }π PUSH CX { Store count on stack }π MOV AX,Offset VScreenπ PUSH AX { Store value on stack }π MOV SI,AXπ MOV BX,199π SHL BX,1π MOV AX,Word Ptr [LookUp + BX]π ADD SI,AXπ DEC SI { DS:SI := VScreen[LookUp[198]+319] }π @Looper:π XOR AX,AXπ XOR BX,BXπ MOV AL,DS:[SI+319]π ADD BX,AXπ MOV AL,DS:[SI+320]π ADD BX,AXπ MOV AL,DS:[SI+321]π ADD BX,AXπ MOV AL,DS:[SI]π ADD BX,AX { Average the three pixels below and the one that its on}π SHR BX,2 { Divide by 4 }π JZ @Skipπ DEC BX { Subtract 1 if value > 0 }π @Skip:π MOV DS:[SI],BL { Store pixel to screen }π DEC SI { Move to next pixel }π DEC CXπ JNZ @Looperπ { Copy the screen Buffer using Double Word copies }π MOV BX,110π SHL BX,1π MOV AX,Word Ptr [LookUp + BX]π MOV DX,AXπ POP SI { Restore starting offset of VScreen }π MOV AX,$A000π MOV ES,AX { DS:SI = starting location in buffer }π XOR DI,DI { ES:DI = Starting location in screen }π ADD SI,DXπ ADD DI,DXπ POP CX { Retrive Count off the stack }π SHR CX,2 { divide by 4 to get # of double words. }π db 66h { Since TP won't allow 386 instructions, fake it. }π REP MOVSW { This translates into REP MOVSD (move double words) }π End;π Until Port[$60] = 1; { Until ESC is pressed }πEnd;ππBeginπ Asm { Initialize mode 13h VGA mode }π MOV AX,13hπ INT 10hπ End;π For LookUp[0] := 1 to 199 do { Calculate lookup table }π LookUp[LookUp[0]] := LookUp[0] * 320;π LookUp[0] := 0;π SetPalette;π FillChar(VScreen, 64000, 0);π Burnin_Down_The_House;π Asmπ MOV AX,3π INT 10hπ End;πEnd.ππ 110 08-24-9413:40ALL FRED JOHNSON FONTS WITH TURBOPASCAL V7SWAG9408 ù┤ƒì 19 ╓ π{compile the *.bgi and *.chr files into a .exe file? If so how?ππ1. Collect all the fonts you canπ If you don't have them all, fake it (use old one in place of real one)π2. Compile them separately into OBJ filesπ example: binobj bold.chr bold.obj boldππ3. DO the BGI driver for your video card.π example: binobj egavga.bgi egavga.obj egavgaππ4. use the TPUs in your main progπ5. Load the video driver like an external procedure;πππ{-------------------------------example 1 (converts chr->obj->tpu)}ππunit boldfont; {use the name + font for all of the fonts}ππinterfaceπprocedure bold;πimplementationπprocedure bold; external;π{$L bold.obj}πend.π{------------------------------------------------------------------------}ππ{--------------------------------example 2}πuses graph,π boldfont, eurofont, gothfont, lcomfont, littfont,π sansfont, simpfont, scrifont, tripfont, tscrfont;ππprocedure egavga; external;π{$L egavga.obj}ππconstπ xFonts : array[0..10] of recordπ sFontName : string;π xpFontAddr : pointer;π end =π ( {Fonts must remain in this order because of settextstyle()}π (sFontName :'Default'; xpFontAddr : nil), {style 00}π (sFontName :'Triplex'; xpFontAddr : @TRIP),{style 01}π (sFontName :'Small'; xpFontAddr : @LITT),{style 02}π (sFontName :'Sans'; xpFontAddr : @SANS),{style 03}π (sFontName :'Gothic'; xpFontAddr : @GOTH),{style 04}π (sFontName :'Script'; xpFontAddr : @SCRI),{style 05}π (sFontName :'Simplex'; xpFontAddr : @SIMP),{style 06}π (sFontName :'Tscr'; xpFontAddr : @TSCR),{style 07}π (sFontName :'Lcom'; xpFontAddr : @LCOM),{style 08}π (sFontName :'Euro'; xpFontAddr : @EURO),{style 09}π (sFontName :'Bold'; xpFontAddr : @BOLD) {style 10}π );ππvarπ gd, gm, i : integer;ππbeginπ if RegisterBGIDriver(@EGAVGA) < 0 then halt;π for i := 1 to 10 doπ if RegisterBGIFont(xFonts[i].xpFontAddr) < 0 thenπ write('Can''t register', xFonts[i].sFontName,' font');ππ gd := VGA;π gm := VGAHi;π initgraph(gd, gm, '');ππ for i := 0 to 10 doπ beginπ settextstyle(i,0,10);π outtextxy(10,20,xFonts[i].sFontName);π readln;π cleardevice;π end;π closegraph;πend.π 111 08-24-9413:40ALL DAVID DANIEL ANDERSON Gif info display SWAG9408 ▓ÆA╨ 36 ╓ {πBS> Can anone out there tell me where you get the resoloution out of a Gif fileπBS> from? What I am saying is, I would like to make a program to look at a GifπBS> and grab the resoloution out of it for my dir list files. Any help would beπBS> appreciated.ππI've written a freeware program to do just this. Program name is GRR,πand Pascal source accompanies it. Here is the source from the latestπ(and only) version. I apologize for the lack of comments, but it isπrather straightforward, I think. }ππprogram getGIFheader;πusesπ dos;πconstπ progdata = 'GRR- Free DOS utility: GIF file info displayer.';π progdat2 =π 'V1.00: August 19, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';π usage =π 'Usage: GRR directory and/or file_spec[.GIF] Example: GRR cindyc*';πvarπ header : string[6];π gpixn : byte;π gpixels, gback, rwidthLSB, rheightLSB, rwidth, rheight : char;π gifname : string[12];π giffile : text;π dirinfo : searchrec;π gpath : pathstr;π gdir : dirstr;π gname : namestr;π gext : extstr;ππprocedure showhelp;πbegin {-- showhelp --}π writeln(progdata);π writeln(progdat2);π writeln(usage);π halt;πend {-- showhelp --};ππfunction taffy(astring : string; newlen : byte) : string;πbegin {-- taffy --}π while (length(astring) < newlen) doπ astring := astring + ' ';π taffy := astring;πend {-- taffy --};ππfunction LeadingZero(w : Word) : string;πvarπ s : string;πbegin {-- LeadingZero --}π Str(w : 0, s);π if (length(s) = 1) thenπ s := '0' + s;π LeadingZero := s;πend {-- LeadingZero --};ππprocedure writeftime(fdatetime : longint);πvarπ Year2 : string;π DateTimeInf : DateTime;πbegin {-- writeftime --}π UnpackTime(fdatetime, DateTimeInf);π with DateTimeInf doπ beginπ Year2 := LeadingZero(Year);π Delete(Year2, 1, 2);π Write(LeadingZero(Month), '-', LeadingZero(Day), '-', Year2, ' ',π LeadingZero(Hour), ':', LeadingZero(Min), ':', LeadingZero(Sec));π end;πend {-- writeftime --};πππprocedure displaygifscreenstats(screendes : byte);πvarπ GCM : Boolean;πbegin {-- displaygifscreenstats --}π GCM := screendes > 128;π if (screendes > 128) thenπ screendes := screendes - 128;π if (screendes > 64) thenπ screendes := screendes - 64;π if (screendes > 32) thenπ screendes := screendes - 32;π if (screendes > 16) thenπ screendes := screendes - 16;π if (screendes > 8) thenπ screendes := screendes - 8;π case (screendes) ofπ 0: Write(' 2');π 1: Write(' 4');π 2: Write(' 8');π 3: Write(' 16');π 4: Write(' 32');π 5: Write(' 64');π 6: Write('128');π 7: Write('256');π end {-- CASE --};π if (GCM) thenπ Write(' ] GCM/')π elseπ Write(' ] ---/');πend {-- displaygifscreenstats --};ππprocedure checkforgiflite(var thefile : text);πvarπ ic : Word;π dummy, glite : char;π gliteword : string[7];πbegin {-- checkforgiflite --}π for ic := 13 to 784 doπ read(thefile, dummy);π gliteword := ' ';π for ic := 1 to 7 doπ beginπ read(thefile, glite);π gliteword[ic] := glite;π end;π if (pos('GIFLITE', gliteword) = 1) thenπ Write('GL')π elseπ Write('--');πend {-- checkforgiflite --};ππbegin {-- getGIFheader --}π gpath := '';π gpath := paramstr(1);π if (gpath = '') thenπ gpath := '*.gif';π if (pos('.', gpath) <> 0) thenπ beginπ gpath := copy(gpath, 1, pos('.', gpath));π gpath := gpath + 'gif'π endπ elseπ gpath := gpath + '*.gif';π fsplit(fexpand(gpath), gdir, gname, gext);π findfirst(gpath, archive, dirinfo);π if (doserror <> 0) thenπ showhelp;π while (doserror = 0) doπ beginπ gifname := dirinfo.name;π assign(giffile, gdir + gifname);π reset(giffile);π read(giffile, header);π if (pos('GIF', header) <> 1) thenπ header := '?_GIF?';π read(giffile, rwidthLSB, rwidth, rheightLSB, rheight, gpixels, gback);π gifname := taffy(gifname, 12);π Write(gifname, ' ', dirinfo.size:7, ' ');π writeftime(dirinfo.time);π Write(' ', header, ' [');π Write((ord(rwidthLSB) + (256 * ord(rwidth))):4, ' ',π (ord(rheightLSB) + (256 * ord(rheight))):4, ' ');π gpixn := ord(gpixels);π displaygifscreenstats(gpixn);π { write ( ', ', ord ( gback )); }π { This is the background color, commented out since it is not used }π checkforgiflite(giffile);π writeln;π close(giffile);π findnext(dirinfo);π end;πend {-- getGIFheader --}.π 112 08-24-9413:41ALL ERIC MILLER Graphic Compression SWAG9408 ╫'∙U 10 ╓ {π TW> I'll need an algorithm to make a graphic smaller.ππ TW> I will read a 640x480x256 and want to make it a smaller size.π TW> For example 80x60x256 or 160x120x256 or something else.π TW> Maybe someone could send me an algorithm or a sample.ππ If you simply want a smaller version of the original image, thenπ it's easy.ππ ie, for 640x480 to 160x120 ( 1/4 original size)π}ππ FOR Y := 0 TO 119 { 160x120 Y axis }π BEGINπ NewY := (Y * 4); { corresponding point on 640x480 Y axis }π FOR X := 0 TO 159 DO { 160x120 X axis }π BEGINπ NewX := (X * 4); { corresponding point on 640x480 X axis }π Image160x120[Y, X] := Image640x480[NewY, NewX];π END;π END;ππ See, simply multiply each point in 160x120 by 4 to get correspondingπ point in 640x480. This of course skips all pixels in between...π Also, the in the example above, note that you cannot haveπ an array of [0..479, 0..639] of Byte! I just put that in thereπ to show how it is done.ππ Eric Millerπ mysticm@ephsa.sat.tx.usπ 113 08-24-9413:42ALL PAUL BROMAN Pallete Handling SWAG9408 g├v6 53 ╓ { GrafCont initializes the graphics mode and handles pallete fades. }ππunit GrafCont;ππinterfaceππusesπ Crt, Dos, Graph;ππtypeπ Palette256 = array[0..255, 0..2] of Byte;π Palette16 = array[0..15, 0..2] of Byte;ππvarπ Mode : byte;ππprocedure Init256VGA;πprocedure Init16VGA;πprocedure SetVGAPalette256(PalBuf: Palette256);πprocedure GetVGAPalette256(var PalBuf: Palette256);πprocedure SetVGAPalette16(PalBuf: Palette16);πprocedure GetVGAPalette16(var PalBuf: Palette16);πprocedure GetRGBPalette(PalNum: integer; var R, G, B: byte);πprocedure FadeOutScreen256;πprocedure FadeOutScreen16;πprocedure FadeInScreen256(PalToMake: Palette256);πprocedure FadeInScreen16(PalToMake: Palette16);ππimplementationππprocedure Init256VGA;π {This procedure relies on BGI drivers obtained for Pascal.π You may need to create a new procedure based on your ownπ method for turning on the graphics mode.}ππ varπ graphmode : integer;π graphdriver : integer;ππ beginπ graphdriver := VGA256Graph; {Defined as an OBJ}π graphmode := 0;π initgraph(graphdriver, graphmode, '');π end;ππprocedure Init16VGA;π varπ graphdriver : integer;π graphmode : integer;ππ beginπ graphdriver := 9;π graphmode := 2;π initgraph(graphdriver, graphmode, '');π end;ππprocedure SetVGAPalette256;πvarπ ColorOn : byte;ππbeginπ Port[$3C8] := 0;π for ColorOn := 0 to 255 doπ beginπ Port[$3C9] := PalBuf[ColorOn, 0];π Port[$3C9] := PalBuf[ColorOn, 1];π Port[$3C9] := PalBuf[ColorOn, 2];π end;πend;ππprocedure GetVGAPalette256;πvarπ ColorOn : byte;ππbeginπ Port[$3C8] := 1;π for ColorOn := 0 to 255 doπ beginπ PalBuf[ColorOn, 0] := Port[$3C9];π PalBuf[ColorOn, 1] := Port[$3C9];π PalBuf[ColorOn, 2] := Port[$3C9];π end;π PalBuf[0, 0] := 0;π PalBuf[0, 1] := 0;π PalBuf[0, 2] := 0;πend;ππprocedure SetVGAPalette16;πvarπ ColorOn : byte;ππbeginπ Port[$3C8] := 0;π for ColorOn := 0 to 15 doπ beginπ Port[$3C9] := PalBuf[ColorOn, 0];π Port[$3C9] := PalBuf[ColorOn, 1];π Port[$3C9] := PalBuf[ColorOn, 2];π end;πend;ππprocedure GetVGAPalette16;πvarπ ColorOn : byte;ππbeginπ Port[$3C8] := 1;π for ColorOn := 0 to 15 doπ beginπ PalBuf[ColorOn, 0] := Port[$3C9];π PalBuf[ColorOn, 1] := Port[$3C9];π PalBuf[ColorOn, 2] := Port[$3C9];π end;π PalBuf[0, 0] := 0;π PalBuf[0, 1] := 0;π PalBuf[0, 2] := 0;πend;πππprocedure GetRGBPalette;ππbeginπ Port[$3C8] := PalNum;π R := Port[$3C9];π G := Port[$3C9];π B := Port[$3C9];πend;ππprocedure FadeOutScreen256;π varπ Count : word;π ColorOn : byte;π PalToMake : Palette256;π PaletteStuff : Palette256;ππ beginπ GetVGAPalette256(PaletteStuff);π PalToMake := PaletteStuff;π for Count := 63 downto 0 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(1);π for ColorOn := 0 to 255 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππprocedure FadeOutText;π varπ Count : word;π ColorOn : byte;π PalToMake : Palette256;π PaletteStuff : Palette256;ππ beginπ GetVGAPalette256(PaletteStuff);π PalToMake := PaletteStuff;π for Count := 63 downto 0 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(20);π for ColorOn := 0 to 255 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππprocedure FadeInScreen256;π varπ Count : byte;π ColorOn : byte;π PaletteStuff : Palette256;π FastPal : Palette256;ππ beginπ GetVGAPalette256(PaletteStuff);π for Count := 0 to 63 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(1);π for ColorOn := 0 to 255 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππprocedure FadeOutScreen16;π varπ Count : word;π ColorOn : byte;π PalToMake : Palette16;π PaletteStuff : Palette16;ππ beginπ GetVGAPalette16(PaletteStuff);π PalToMake := PaletteStuff;π for Count := 63 downto 0 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(5);π for ColorOn := 0 to 15 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππprocedure FadeInScreen16;π varπ Count : byte;π ColorOn : byte;π PaletteStuff : Palette16;π FastPal : Palette16;ππ beginπ GetVGAPalette16(PaletteStuff);π for Count := 0 to 63 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(5);π for ColorOn := 0 to 15 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππend.ππ 114 08-24-9413:46ALL GARTH KRUMINS MODE-X Routines SWAG9408 ╬å2 17 ╓ {π JW> What is mode-x or ($13) or whatever in graphics. I like to writeπ Mode-x is just your 320x200x256 VGA graphics mode.ππIt's pretty similar to using pascal's graph unit, except you don't! You haveπto get all the procedures and functions set-up yourself.π}ππPROCEDURE InitVGA; ASSEMBLER; {Puts you in 320x200x256 VGA}πasm π mov ax, 13h π int 10h πend; π πPROCEDURE InitTEXT; ASSEMBLER; {Puts you back in 80x25 text mode} πasm π mov ax, 03h π int 10h πend; ππPROCEDURE SetColor (ColorNo, Red, Green, Blue : byte); πbegin {Changes the pallete data for a particular colour} π PORT[$3C8] := ColorNo; π PORT[$3C9] := Red; π PORT[$3C9] := Green; π PORT[$3C9] := Blue; πend; π πPROCEDURE MovCursor (X,Y : byte); {Moves the cursor to (X,Y)} πbegin π asm π MOV ah, 02h π XOR bx, bx π MOV dh, Y π MOV dl, X π INT 10h π end; πend; π πFUNCTION ReadCursorX: byte; assembler; {Get X position of cursor}πasm π MOV ah, 03h π XOR bx, bx π INT 10h π MOV al, dl πend; π πFUNCTION ReadCursorY: byte; assembler; {Get Y position of cursor} πasm π MOV ah, 03h π XOR bx, bx π INT 10h π MOV al, dh πend; π πPROCEDURE PutText (TextData : string; Color : byte); {Write a string} πvar {It's not the fastest way to do it, but it does the job} π z, ASCdata, CursorX, CursorY : byte; πbegin π CursorX := ReadCursorX;π CursorY := ReadCursorY; π for z := 1 to Length(TextData) do π begin π ASCdata := Ord(TextData[z]); π asm π MOV ah, 0Ah π MOV al, ASCdata π XOR bx, bx π MOV bl, Color π MOV cx, 1 π INT 10h π end; π inc(CursorX); π if CursorX=40 then begin CursorX:=0; inc(CursorY); end; π MovCursor(CursorX,CursorY); π end; πend; π πPROCEDURE PlotPixel(X, Y: Word; Color: Byte); ASSEMBLER; {Plots a pixel} πasmπ push es π push di π mov ax, Y π mov bx, ax π shl ax, 8 π shl bx, 6 π add ax, bx π add ax, X π mov di, ax π mov ax, $A000 π mov es, ax π mov al, Color π mov es:[di], al π pop diπ pop esπend;π 115 08-24-9413:50ALL JAMES COOK Pcx Viewer! SWAG9408 φE:] 30 ╓ πUses Crt;π{ Sample program to display a 320x200x256 PCX inπ mode 13h. PCX source copied from MCGA07, a MCGAπ graphics unit written by James Cook in his MCGAπ programming tutorial on Quantum Leap BBS }ππTYPEπ TPalette = array[0..767] of Byte;π PalettePtr = ^TPalette;π{ PCX stuff }π PCXHeaderPtr= ^PCXHeader;π PCXHeader = recordπ Signature : Char;π Version : Char;π Encoding : Char;π BitsPerPixel : Char;π XMin,YMin,π XMax,YMax : Integer;π HRes,VRes : Integer;π Palette : Array [0..47] of byte;π Reserved : Char;π Planes : Char;π BytesPerLine : Integer;π PaletteType : Integer;π Filler : Array [0..57] of byte;π end;ππProcedure ExtractLineASM (BytesWide:Integer;Var Source,Dest:Pointer);πvarπ DestSeg,π DestOfs,π SourceSeg,π SourceOfs : Word;πbeginπ SourceSeg := Seg (Source^);π SourceOfs := Ofs (Source^);π DestSeg := Seg (Dest^);π DestOfs := Ofs (Dest^);ππ asmπ push dsπ push siππ cldππ mov ax,DestSegπ mov es,axπ mov di,DestOfs { es:di -> destination pointer }π mov ax,SourceSegπ mov ds,axπ mov si,SourceOfs { ds:si -> source buffer }ππ mov bx,diπ add bx,BytesWide { bx holds position to stop for this row }π xor cx,cxππ @@GetNextByte:π cmp bx,di { are we done with the line }π jbe @@ExitHereππ lodsb { al contains next byte }ππ mov ah,alπ and ah,0C0hπ cmp ah,0C0hππ jne @@SingleByteπ { must be a run of bytes }π mov cl,alπ and cl,3Fhπ lodsbπ rep stosbπ jmp @@GetNextByteππ @@SingleByte:π stosbπ jmp @@GetNextByteππ @@ExitHere:π mov SourceSeg,dsπ mov SourceOfs,siπ mov DestSeg,esπ mov DestOfs,diππ pop siπ pop dsπ end;ππ Source := Ptr (SourceSeg,SourceOfs);π Dest := Ptr (DestSeg,DestOfs);πend;ππProcedure DisplayPCX (X,Y:Integer;Buf:Pointer);πvarπ I,NumRows,π BytesWide : Integer;π Header : PCXHeaderPtr;π DestPtr : Pointer;π Offset : Word;ππbeginπ Header := Ptr (Seg(Buf^),Ofs(Buf^));π Buf := Ptr (Seg(Buf^),Ofs(Buf^)+128);π Offset := Y * 320 + X;π NumRows := Header^.YMax - Header^.YMin + 1;π BytesWide := Header^.XMax - Header^.XMin + 1;π If Odd (BytesWide) then Inc (BytesWide);ππ For I := 1 to NumRows do beginπ DestPtr := Ptr ($A000,Offset);π ExtractLineASM (BytesWide,Buf,DestPtr);π Inc (Offset,320);π end;πend;π{ end PCX stuff }ππProcedure Graph13h; assembler;πasmπ mov al,$13π mov ah,0π int 10hπend;ππVARπ F: File; { PCX file }π Hdr: PCXHeaderPtr; { PCX header structure & file }π Pal: PalettePtr; { PCX palette }π Shade, Size: Word; { RGB shade, file size }ππBEGINπ Graph13h; { set mode 13h }π Assign(F, 'filename.pcx'); { open PCX file }π Reset(F,1);π Size := FileSize(F);π GetMem(Hdr, Size); { load PCX into memory }π Blockread(F, Hdr^, Size);π Close(F);π Pal := Ptr( Seg(Hdr^), Ofs(Hdr^) + Size - 768); { get palette location }π Port[968] := 0; { set palette }π FOR Shade := 0 TO 767 DOπ Port[969] := Pal^[Shade] SHR 2;π DisplayPCX(0, 0, Hdr); { decode PCX to screen }π WHILE Readkey <> #13 DO; { wait for return key }π TextMode(CO80);πEND.π 116 08-24-9413:50ALL OLAF BARTELT Vga 256 Color PCX SWAG9408 ┘* ô 22 ╓ {π CF> I am working with VGA 320x200x256. Can anyone please helpπ CF> me with a good line routine and the PCX format? I haveπ CF> tryed both and things go bad.. If you have code layingπ CF> around it would help me a lot... Thanksππ}ππPROCEDURE load_pcx(dx, dy : WORD; name : STRING);πVAR q : FILE; { Quellendatei-Handle }π b : ARRAY[0..2047] OF BYTE; { Puffer }π anz, pos, c, w, h, e, pack : WORD; { diverse benötigte Variablen }π x, y : WORD; { für die PCX-Laderoutine }ππLABEL ende_background; { Sprungmarken definieren }ππBEGINπ x := dx; y := dy; { Nullpunkt festsetzen }ππ ASSIGN(q, name); {$I-} RESET(q, 1); {$I+} { Quellendatei öffnen }π IF IORESULT <> 0 THEN { Fehler beim Öffnen? }π GOTO ende_background; { Ja: zum Ende springen }ππ BLOCKREAD(q, b, 128, anz); { Header einlesen }ππ IF (b[0] <> 10) OR (b[3] <> 8) THEN { wirklich ein PCX-File? }π BEGINπ CLOSE(q); { Nein: Datei schließen und }π GOTO ende_background; { zum Ende springen }π END;ππ w := SUCC((b[9] - b[5]) SHL 8 + b[8] - b[4]); { Breite auslesen }π h := SUCC((b[11] - b[7]) SHL 8 + b[10] - b[6]); { Höhe auslesen }ππ 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π MEM[SEGA000:y*320+(x+c)] := b[pos];π pack := 0;π ENDπ ELSEπ IF (b[pos] AND $C0) = $C0 THENπ pack := b[pos] AND $3Fπ ELSEπ BEGINπ MEM[SEGA000:y*320+(x+c)] := b[pos];π INC(c);π END;ππ INC(pos);π IF c = w THEN { letzte Spalte erreicht? }π BEGINπ c := 0; { Ja: Spalte auf 0 setzen und }π INC(y); { in die nächste Zeile }π 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;ππ PORT[$3C8] := 0;ππ FOR x := 0 TO 255 DOπ BEGINπ PORT[$3C9] := b[x*3+1];π PORT[$3C9] := b[x*3+2];π PORT[$3C9] := b[x*3+3];π END;ππ CLOSE(q);ππende_background:πEND;ππBEGINπ Load_Pcx(1,1,'c:\lpexface.pcx');πEND. 117 08-24-9413:50ALL ANDREW EIGUS Pcx Bitmap Rotating SWAG9408 tôp 127 ╓ { ROTATE.PAS }ππ{π Rotating textured surface.π Coded by Mike Shirobokov(MSH) aka Mad Max / Queue members.π You can do anything with this code until this commentsπ remain unchanged.ππ Bugs corrected by Alex Grischenkoπ}ππ{$G+,A-,V-,X+}π{$M 16384,0,16384}ππuses Crt, Objects, Memory, VgaGraph; { unit code at the end of program }ππconstπ{ Try to play with this constants }π RotateSteps = {64*5}65*10;π AngleStep = {3}1;π MoveStep = {10}1;π ScaleStep : Real = 0.02;ππtypeπ TBPoint = record X,Y: { Byte} Integer; end;π TPointArray = array[ 1..500 ] of TBPoint;ππ TRotateApp = object(TGraphApplication)π StartTime,π FramesNumber:LongInt;π {Texture: TImage;}π X,Y : Integer;π WSX,WSY: Integer;π WSXR,π WSYR : Real;π Angle : Integer;π Size : TPoint;π CurPage: Integer;π Texture: TImage;π constructor Init;π procedure Run; virtual;π destructor Done; virtual;π procedure Draw; virtual;π procedure FlipPage; virtual;π procedure Rotate( AngleStep: Integer );π procedure Move( DeltaX, DeltaY: Integer );π procedure Scale( Factor: Real );π procedure Update;π end;πvarπ Pal: TRGBPalette;π Time: LongInt absolute $0:$46C;ππprocedure TRotateApp.FlipPage;πbeginπ CurPage := 1-CurPage;π ShowPage(1-CurPage);πend;ππconstructor TRotateApp.Init;πvarπ I, J: Integer;πbeginπ if not inherited Init(True) or not Texture.Load( ParamStr(1) ) then Fail;π SetPalette( Texture.Palette );π X := 0;π Y := 0;π WSX := 240;π WSY := 360;π WSXR := WSX;π WSYR := WSY;π Angle := 0;π Size.X := HRes div 2;π Size.Y := VRes div 2;π FramesNumber := 0;π StartTime := Time; { asm mov ax,13h; int 10h; end;}π system.move (Texture.Data^,Screen,64000);π SetPalette( Texture.Palette );π{ readkey;}πend;ππprocedure TRotateApp.Rotate( AngleStep: Integer );πbeginπ Inc( Angle, AngleStep );π Angle := Angle mod RotateSteps;πend;ππprocedure TRotateApp.Move( DeltaX, DeltaY: Integer );πbeginπ Inc( X, DeltaX );π Inc( Y, DeltaY );πend;ππprocedure TRotateApp.Scale( Factor: Real );πbeginπ WSXR := WSXR*Factor;π WSX := Round(WSXR);π WSYR := WSYR*Factor;π WSY := Round(WSYR);πend;ππprocedure TRotateApp.Update;πbeginπ Move( MoveStep, MoveStep );π Rotate(AngleStep);π Scale(1+ScaleStep);π if (WSY >= 2000) or (WSY<=100) then ScaleStep := -ScaleStep;πend;ππprocedure TRotateApp.Draw;ππvarπ I : Integer;π Border,π LineBuf: TPointArray;π BorderLen: Integer;π X1RN,X1LN,π Y1RN,Y1LN,π X2RN,X2LN,π Y2RN,Y2LN,π X1R,X1L,π Y1R,Y1L,π X2R,X2L,π Y2R,Y2L,π XL,YL: Integer;ππ{ This function can be heavly optimized but I'm too lazy to do absoletelyπ meaningless things :-) }πfunction BuildLine( var Buffer: TPointArray; X1,Y1, X2,Y2: Integer;π Len: Integer ): Integer;πvarπ I: Word;π XStep,π YStep: LongInt;πbeginπ XStep := (LongInt(X2-X1) shl 16) div Len;π YStep := (LongInt(Y2-Y1) shl 16) div Len;π for I := 1 to Len doπ beginπ Buffer[I].X := Integer( ((XStep*I) shr 16) - ((XStep*(I-1)) shr 16) );π Buffer[I].Y := Integer( ((YStep*I) shr 16) - ((YStep*(I-1)) shr 16) );π end;πend;ππprocedure DrawPicLine( var Buffer; BitPlane: Integer;π StartX, StartY: Integer; Len: Integer; var LineBuf );πvarπ PD : Pointer;πbeginπ PD := Texture.Data; { pointer to unpacked screen image }π Port[$3C4] := 2;π if BitPlane = 0 thenπ Port[$3C5] := 3π elseπ Port[$3C5] := 12;ππ asmπ push dsπ mov bx,[StartX] { bx = StartX }π mov dx,[StartY] { dx = StartY }π les di,Buffer { ES:DI = @Screen }π add di,VPageLen/2-Hres/4 { calc target page }π mov cx,Len { Drawing buffer length }π lds si,PD { DS:SI = pointer to data }π push bp { store BP }π mov bp,word ptr LineBuf { BP = offset LineBuf }π cldπ@loop:π PUSH DXπ MOV AX,320π MUL DX { AX = StartY*320 }π POP DXππ PUSH BXπ ADD BX,AXπ mov al,[bx+SI]π POP BXππ stosbπ sub di,HRes/4+1{ add di,hres-1}π add BX,[bp]π ADD bp,2π add DX,[bp]π ADD bp,2ππ{ CMP BX,320π JB @@1π XOR BX,BXπ@@1: CMP DX,200π JB @@2π XOR DX,DXπ@@2:}π loop @loopππ pop bpπ pop dsπ end;πend;ππbeginππ{ Just imagine what can be if the next 8 lines would be more complex.π I'm working around it. }π{π (X1L,Y1L) (X2R,Y1R)π +---------------+π | |π | |π | |π +---------------+π (X2L,Y2L) (X2R,Y2R)ππ (X1LN,Y1LN) (X2RN,Y1RN)π +---------------+π | |π | |π | |π +---------------+π (X2LN,Y2LN) (X2RN,Y2RN)ππ}π X1L := 0;π Y1L := 0;π X2L := 0;π Y2L := WSY;π X1R := WSX;π Y1R := 0;π X2R := WSX;π Y2R := WSY;π{ I call Cos and Sin instead of using tables!? Yeah, I do. So what?π See comments near BuildLine ;-) }π{ I just rotate the rectangle corners, but why I do no more? }π X1RN := Round(π(X1R*Cos(2*Pi/RotateSteps*Angle)+Y1R*Sin(2*Pi/RotateSteps*Angle)) );π Y1RN := Round(π(Y1R*Cos(2*Pi/RotateSteps*Angle)-X1R*Sin(2*Pi/RotateSteps*Angle)) );π X1LN := Round(π(X1L*Cos(2*Pi/RotateSteps*Angle)+Y1L*Sin(2*Pi/RotateSteps*Angle)) );π Y1LN := Round(π(Y1L*Cos(2*Pi/RotateSteps*Angle)-X1L*Sin(2*Pi/RotateSteps*Angle)) );π X2RN := Round(π(X2R*Cos(2*Pi/RotateSteps*Angle)+Y2R*Sin(2*Pi/RotateSteps*Angle)) );π Y2RN := Round(π(Y2R*Cos(2*Pi/RotateSteps*Angle)-X2R*Sin(2*Pi/RotateSteps*Angle)) );π X2LN := Round(π(X2L*Cos(2*Pi/RotateSteps*Angle)+Y2L*Sin(2*Pi/RotateSteps*Angle)) );π Y2LN := Round(π(Y2L*Cos(2*Pi/RotateSteps*Angle)-X2L*Sin(2*Pi/RotateSteps*Angle)) );ππ XL := X+X1LN;π YL := Y+Y1LN;ππ BuildLine( Border, XL,YL, X+X2LN,Y+Y2LN, Size.X );π BuildLine( LineBuf, 0, 0, X1RN-X1LN, Y1RN-Y1LN, Size.Y );ππ{π The only thing that can be optimized is the loop below. I think it shouldπ be completely in asm.π}π for I := 1 to Size.X doπ beginπ DrawPicLine( PBuffer(@Screen)^[CurPage*VPageLen+(I-1) shr 1],π (I-1) {mod 2} and 1, XL, YL, Size.Y, LineBuf );π{π Inc( XL, Border[I].X );π Inc( YL, Border[I].Y );π}π asmπ mov di,Iπ shl di,2π mov ax,word ptr border[di]-4π add XL,axπ mov ax,word ptr Border[di]-4+2π add YL,axπ end;π end;πend;ππprocedure TRotateApp.Run;πvarπ C: Char;πbeginπ repeatπ if KeyPressed thenπ beginπ C := ReadKey;π if C = #0 then C := ReadKey;π case C ofπ #72: Move(0,-10);π #80: Move(0,-10);π #75: Move(-10,0);π #77: Move(10,0);π #81: Rotate(1);π #79: Rotate(-1);π '+': Scale(1+ScaleStep);π '-': Scale(1-ScaleStep);π #27: Exit;π end;π end;π Draw;π{ You can comment out the line below and do all transformation yourself }π Update;π FlipPage;π Inc( FramesNumber );π until False;πend;ππdestructor TRotateApp.Done;πbeginπ inherited Done;π WriteLn( 'Frames per second = ',π (FramesNumber / ((Time-StartTime)*0.055) ):5:2 );πend;ππvarπ RotateApp: TRotateApp;πbeginπ if not RotateApp.Init then Exit;π RotateApp.Run;π RotateApp.Done;πend.ππ{--------------------- UNIT CODE NEEDED HERE -------------------- }ππ{π VGA graphics unit.π Coded by Mike Shirobokov(MSH) aka Mad Max / Queue members.ππ This this the very small part of my gfx unit. I leave only functions usedπ by RotateApp.ππ Bugs corrected by Alex Grischenkoπ}ππunit VGAGraph;ππinterfaceππuses Objects, Memory;ππconstπ HRes = 360;π VRes = 320;π VPageLen = HRes*VRes div 4;ππ{ HRes = 320; VRes=200; Vpagelen=0;}ππtypeπ PBuffer = ^TBuffer;π TBuffer = array[ 0..65534 ] of Byte;π PScreenBuffer = ^TScreenBuffer;π TScreenBuffer = array[ 0..199, 0..319 ] of Byte;π TRGBPalette = array[ 0..255 ] of record R,G,B: Byte; end;ππ PImage = ^TImage;π TImage = object( TObject )π Size: TPoint;π Palette: TRGBPalette;π Data: PBuffer;π constructor Load( Name: String );π{ This procedures are now killed. If you need them just write me or seeπ old mail from me.π procedure Show( Origin: TPoint; var Buffer );π procedure ShowRect( Origin: TPoint; NewSize: TPoint; var Buffer ); }π destructor Done; virtual;π end;ππ PGraphApplication = ^TGraphApplication;π TGraphApplication = object( TObject )π constructor Init( ModeX : Boolean );π procedure Run; virtual;π destructor Done; virtual;π end;ππvarπ Screen: TScreenBuffer absolute $A000:0;ππ procedure SetPalette( var Pal: TRGBPalette );π procedure Set360x240Mode;π procedure ShowPage( Page: Integer );ππimplementationππuses PCX;ππconstructor TImage.Load( Name: String );πvarπ S: TDosStream;π I: Integer;π P: OldPCXPicture;π Len: Word;πbeginπ inherited Init;π P.Init( Name );π if P.Status <> pcxOK thenπ beginπ P.Done;π Fail;π end;π Size.X := P.H.XMax - P.H.XMin + 1;π Size.Y := P.H.YMax - P.H.YMin + 1;π{π I use DOS memory allocation 'cuz GetMem can't allocate 64Kπ Even thru DPMI. :-(π GetMem( Data, Word(Size.X) * Size.Y );π}π Len := Word((LongInt(Size.X)*Size.Y+15) div 16);π LEN:=65536 DIV 16;π asmπ mov ah,48hπ mov bx,Lenπ int 21hπ jnc @mem_okπ xor ax,axπ@mem_ok:π mov word ptr es:[di].Data+2,axπ xor ax,axπ mov word ptr es:[di].Data,axπ end;ππ if Data = nil thenπ beginπ P.Done;π Fail;π end;ππ fillchar(Data^,len*16-1,0);ππ Move( P.Pal, Palette, SizeOf(Palette) );π for I := 0 to 255 doπ beginπ Palette[I].R := Palette[I].R shr 2;π Palette[I].G := Palette[I].G shr 2;π Palette[I].B := Palette[I].B shr 2;π end;ππ for I := 0 to Size.Y-1 doπ P.ReadLine( Data^[ Word(Size.X)*I ] );π P.Done;πend;ππdestructor TImage.Done;πbeginπ{π FreeMem( Data, Word(Size.X)*Size.Y );π}π asmπ mov ah,49hπ mov ax,word ptr es:[di].Data+2π mov es,axπ int 21hπ end;π inherited Done;πend;ππconstructor TGraphApplication.Init( ModeX : Boolean );πbeginπ Set360x240Modeπend;ππprocedure TGraphApplication.Run;πbeginπ Abstract;πend;ππdestructor TGraphApplication.Done;πbeginπ asmπ mov ax,3hπ int 10hπ end;πend;ππprocedure SetPalette( var Pal: TRGBPalette );πvarπ I : Integer;πbeginπ for I := 0 to 255 doπ beginπ Port[$3C8] := I;π Port[$3C9] := Pal[I].R;π Port[$3C9] := Pal[I].G;π Port[$3C9] := Pal[I].B;π end;πend;ππ{ Modified from public-domain mode set code by John Bridges. }ππconstπ SC_INDEX = $03c4; {Sequence Controller Index}π CRTC_INDEX = $03d4; {CRT Controller Index}π MISC_OUTPUT = $03c2; {Miscellaneous Output register}ππ{ Index/data pairs for CRT Controller registers that differ betweenπ mode 13h and mode X. }ππCRT_PARM_LENGTH = 17;πCRTParms : array [1..CRT_PARM_LENGTH] of Word = (ππ $6B00, { Horz total }π $5901, { Horz Displayed }π $5A02, { Start Horz Blanking }π $8E03, { End Horz Blanking }π $5E04, { Start H Sync }π $8A05, { End H Sync }π $0d06, {vertical total}π $3e07, {overflow (bit 8 of vertical counts)}π $ea10, {v sync start}π $8c11, {v sync end and protect cr0-cr7}π $df12, {vertical displayed}π $e715, {v blank start}π $0616, {v blank end}π $4209, {cell height (2 to double-scan)}π $0014, {turn off dword mode}π $e317, {turn on byte mode}π $2D13 {90 bytes per line}π);ππprocedure Set360x240Mode;πbeginπ asmπ mov ax,13h {let the BIOS set standard 256-color}π int 10h {mode (320x200 linear)}ππ mov dx,SC_INDEXπ mov ax,0604hπ out dx,ax {disable chain4 mode}π mov ax,0100hπ out dx,ax {synchronous reset while switching clocks}ππ mov dx,MISC_OUTPUTπ mov al,0E7hπ out dx,al {select 28 MHz dot clock & 60 Hz scanning rate}ππ mov dx,SC_INDEXπ mov ax,0300hπ out dx,ax {undo reset (restart sequencer)}ππ mov dx,CRTC_INDEX {reprogram the CRT Controller}π mov al,11h {VSync End reg contains register write}π out dx,al {protect bit}π inc dx {CRT Controller Data register}π in al,dx {get current VSync End register setting}π and al,7fh {remove write protect on various}π out dx,al {CRTC registers}π dec dx {CRT Controller Index}π cldπ mov si,offset CRTParms {point to CRT parameter table}π mov cx,CRT_PARM_LENGTH {# of table entries}π@SetCRTParmsLoop:π lodsw {get the next CRT Index/Data pair}π out dx,ax {set the next CRT Index/Data pair}π push cxπ mov cx,1000π@loop: loop @loopπ pop cxπ loop @SetCRTParmsLoopππ mov dx,SC_INDEXπ mov ax,0f02hπ out dx,ax {enable writes to all four planes}π mov ax,$A000{now clear all display memory, 8 pixels}π mov es,ax {at a time}π sub di,di {point ES:DI to display memory}π sub ax,ax {clear to zero-value pixels}π mov cx,VRes*HRes/4/2 {# of words in display memory}π rep stosw {clear all of display memory}π end;πend;ππprocedure ShowPage( Page: Integer );πbeginπ asmπ mov ax,VPageLenπ mul word ptr Pageπ mov bx,axππ mov dx,3d4hπ mov al,0chπ mov ah,bhπ out dx,axπ mov dx,3d4hπ mov al,0dhπ mov ah,blπ out dx,axπ{ Uncomment this waiting for retrace if you see flickering }π{π mov dx,3dahπ @@1: in al,dxπ test al,00001000bπ jz @@1π @@2: in al,dxπ test al,00001000bπ jnz @@2π}π end;πend;ππEnd.ππ{ -------------------------- UNIT CODE NEEDED HERE -------------}ππ{π 256 color PCX bitmaps handling unit.π NewPCXPicture object are removed to reduce traffic. If youπ need it just contact me or dig in old mail from me.π Coded by Mike Shirobokov(MSH) aka Mad Max / Queue Members.π Free sourceware.π}ππunit PCX;ππinterfaceππuses Objects;ππtypeπ TRGBPalette = array[ 0..255 ] of record R,G,B: Byte; end;ππ PCXHeader = recordπ Creator,π Version,π Encoding,π Bits: Byte;π XMin,π YMin,π XMax,π YMax,π HRes,π VRes: Integer;π Palette: array [ 1..48 ] of Byte;π VMode,π Planes: Byte;π BytesPerLine,π PaletteInfo,π SHRes,π SVRes: Word;π Dummy: array [0..53] of Byte;π end;ππconstπ pcxOK = 0;π pcxInvalidType = 1;π pcxNoFile = 2;ππtypeπ OldPCXPicture = objectπ H: PCXHeader;π S: TBufStream;π Pal: TRGBPalette;π Status: Integer;π constructor Init( AFileName: String );π procedure ReadLine( var Buffer );π function ErrorText: String;π destructor Done;π end;π{π NewPCXPicture = objectπ H: PCXHeader;π S: TBufStream;π Pal: TRGBPalette;π constructor Init( AFileName: String; HSize: Integer );π procedure WriteLine( var Buffer );π destructor Done;π end;π}πimplementationππtypeπ GetByteFunc = function: Byte;π ByteArr = array [0..65534] of Byte;π PByte = ^ByteArr;ππprocedure UnpackString( GetByte: GetByteFunc; var Dest; Size: Integer );πvarπ DestPtr: PByte;π Count: Integer;π B: Byte;π I: Integer;πbeginπ DestPtr := @Dest;π Count := 0;π while Count < Size doπ beginπ B := GetByte;π if B < $C0 thenπ beginπ DestPtr^[Count] := B;π Inc(Count);π endπ elseπ beginπ DestPtr^[Count] := GetByte;π for I := 0 to B-$C1 doπ DestPtr^[Count+I] := DestPtr^[Count];π Inc( Count, I+1 );π end;π end;πend;ππconstructor OldPCXPicture.Init( AFileName: String );πbeginπ S.Init( AFileName, stOpenRead, 2048 );π if S.Status <> stOk thenπ beginπ Status := pcxNoFile;π Exit;π end;π S.Read( H, SizeOf(H) );π if (H.Planes <> 1) or (H.Encoding <> 1) or (H.Bits <> 8 ) thenπ beginπ Status := pcxInvalidType;π Exit;π end;π S.Seek( S.GetSize - SizeOf(Pal) );π S.Read( Pal, SizeOf(Pal) );π S.Seek( SizeOf(H) );π Status := pcxOK;πend;ππvarπ __GetS__: PStream;ππfunction Get: Byte; far;πvarπ B: Byte;πbeginπ __GetS__^.Read( B, 1 );π Get := B;πend;ππprocedure OldPCXPicture.ReadLine( var Buffer );πbeginπ __GetS__ := @S;π UnpackString( Get, Buffer, H.BytesPerLine );πend;ππfunction OldPCXPicture.ErrorText: String;πbeginπ case Status ofπ pcxOK:π ErrorText := 'No errors';π pcxNoFile:π ErrorText := 'Can''t open file';π pcxInvalidType:π ErrorText := 'Only 8 bit PCXs are supported';π end;πend;ππdestructor OldPCXPicture.Done;πbeginπ S.Done;πend;ππend.ππ 118 08-24-9413:50ALL JENS LARSSON Grabbing Pixel Color SWAG9408 )D█ 6 ╓ {π GK> I have a slight problem. I have written a program that runs inπ GK> graphics mode ($13). I use the following routine to get whatπ GK> colour is at that pixel :-π GK> PixelColor := MEM[$A000:X + (Y*320)];π GK> This works fine, but it is rather slow. I was wondering ifπ GK> anybody knew how to do this faster?π}ππ Function PixColor(x, y : Word) : Byte; Assembler;π Asmπ push dsπ mov ax,0a000hπ mov ds,axπ mov ax,yπ shl ax,6π mov si,axπ shl ax,2π add si,axπ add si,xπ lodsbπ pop dsπ End;π 119 08-24-9413:50ALL MARCIN BORKOWSKI Landscape SWAG9408 ¿ù┬ 30 ╓ πuses crt;ππtype lrgarr = array[0..65534]of byte;ππconstπ pal : array[1..384]of byte =π (0,0,0,48,48,48,1,0,43,1,3,43,2,5,44,2,7,44,3,9,45,4,11,46,5,13,47,6,15,48,π 7,17,49,8,19,50,9,21,51,10,22,52,11,24,52,12,26,54,13,28,54,14,30,56,15,32,π 56,16,34,58,17,34,58,17,36,58,18,38,60,19,40,60,20,42,62,21,44,62,10,31,0,π 11,31,0,11,31,1,11,32,1,12,32,1,12,32,2,12,33,2,13,33,2,14,33,3,15,33,3,15,π 34,3,15,34,4,15,35,4,16,35,4,16,35,5,16,36,5,17,36,5,17,36,6,18,37,6,18,38,π 7,19,38,8,20,39,8,20,40,9,21,40,10,22,41,10,22,42,11,23,42,12,24,43,12,24,π 44,13,25,44,14,25,45,14,26,46,15,27,46,16,27,47,17,28,47,18,28,48,19,29,49,π 19,30,49,20,30,50,21,31,51,21,32,51,22,32,52,23,33,53,23,34,53,24,34,54,25,π 35,55,25,36,55,26,36,56,27,37,57,27,38,57,27,39,57,27,41,57,27,42,57,27,43,π 57,27,44,57,27,45,57,27,46,57,27,47,57,27,49,57,27,50,57,27,51,57,27,52,57,π 27,53,57,27,55,57,27,56,57,27,57,57,27,58,57,27,58,57,26,58,57,25,58,57,24,π 58,56,23,58,55,22,58,54,20,58,53,19,58,51,18,58,50,17,58,50,16,58,49,15,58,π 48,14,58,47,13,58,46,12,58,45,11,58,44,11,58,44,10,58,43,10,58,42,9,57,41,π 8,57,40,8,56,39,7,56,38,6,55,37,5,55,35,4,54,33,4,54,31,2,32,32,32,63,63,63,π 63,63,63,63,63,63,63,63,63,48,48,48,63,63,63,63,63,63);ππvarπ mp,scr : ^lrgarr;π rng : array[0..320]of byte;π dir,i,x,y : integer;ππfunction ncol(mc,n,dvd : integer): integer;πvar loc : integer;πbeginπ loc:=(mc+n-random(2*n)) div dvd; ncol:=loc;π if loc>250 then ncol:=250; if loc<5 then ncol:=5πend;ππprocedure plasma(x1,y1,x2,y2 : word);πvar xn,yn,dxy,p1,p2,p3,p4 : word;πbeginπ if (x2-x1<2) and (y2-y1<2) then EXIT;π p1:=mp^[256*y1+x1]; p2:=mp^[256*y2+x1]; p3:=mp^[256*y1+x2];π p4:=mp^[256*y2+x2]; xn:=(x2+x1) shr 1; yn:=(y2+y1) shr 1;π dxy:=5*(x2-x1+y2-y1) div 3;π if mp^[256*y1+xn]=0 then mp^[256*y1+xn]:=ncol(p1+p3,dxy,2);π if mp^[256*yn+x1]=0 then mp^[256*yn+x1]:=ncol(p1+p2,dxy,2);π if mp^[256*yn+x2]=0 then mp^[256*yn+x2]:=ncol(p3+p4,dxy,2);π if mp^[256*y2+xn]=0 then mp^[256*y2+xn]:=ncol(p2+p4,dxy,2);π mp^[256*yn+xn]:=ncol(p1+p2+p3+p4,dxy,4);π plasma(x1,y1,xn,yn); plasma(xn,y1,x2,yn);π plasma(x1,yn,xn,y2); plasma(xn,yn,x2,y2);πend;ππprocedure draw(xp,yp,dir : integer);πvar z,zobs,ix,iy,iy1,iyp,ixp,x,y,s,csf,snf,mpc,i,j : integer;πbeginπ fillchar(rng,sizeof(rng),200); zobs:=100+mp^[256*yp+xp];π csf:=round(256*cos(dir/180*pi)); snf:=round(256*sin(dir/180*pi));π fillchar(scr^,64000,0);π for iy:=yp to yp+55 doπ beginπ iy1:=1+2*(iy-yp); s:=4+300 div iy1;π for ix:=xp+yp-iy to xp-yp+iy doπ beginπ ixp:=xp+((ix-xp)*csf+(iy-yp)*snf) div 256;π iyp:=yp+((iy-yp)*csf-(ix-xp)*snf) div 256;π x:=160+360*(ix-xp) div iy1;π if (x>=0) and (x+s<=318) thenπ beginπ z:=mp^[256*iyp+ixp]; mpc:=z shr 1;π if z<47 then z:=46; y:=100+(zobs-z)*30 div iy1;π if (y<=199) and (y>=0) thenπ for j:=x to x+s doπ beginπ for i:=y to rng[j] do scr^[320*i+j]:=mpc;π if y<rng[j] then rng[j]:=yπ end;π end;π end;π end;π move(scr^,mem[$A000:0],64000);πend;ππbeginπ writeln('Use arrow keys to pan in/out left/right ... any key to continue ..');π readkey;π randomize; x:=0; y:=0; dir:=0; new(mp); fillchar(mp^,65535,0);π new(scr); mp^[$0000]:=128; plasma(0,0,256,256);π asm xor ax,ax; mov al,$13; int $10; end;π port[$3C8]:=0; for i:=1 to 384 do port[$3C9]:=pal[i];π repeatπ dir:=dir mod 360; draw(x,y,dir);π case readkey ofπ #0 : case readkey ofπ #75 : dec(dir,10);π #77 : inc(dir,10);π #72 : begin y:=y+round(4*cos(dir/180*pi));π x:=x+round(4*sin(dir/180*pi)); end;π #80 : begin y:=y-round(4*cos(dir/180*pi));π x:=x-round(4*sin(dir/180*pi)); end;π end;π #27 : begin asm xor ax,ax; mov al,$3; int $10; end; HALT endπ endπ until false;πend.π 120 08-24-9413:50ALL JONAS MALMSTEN plasma SWAG9408 Um. 22 ╓ {πYesterday I saw Bas' plasma routine. Real nice! But... a little slow I thoughtπso I improved it. Another thing, Bas, the bouble buffer didn't work on myπet4000, the bplptr never changed in your mode.ππWell, enjoy this new routine!π}ππprogram plasma;ππ{ bigscreenplasma, by Bas van Gaalen & Sven van Heel, Holland, PD }π{ Improved by GEM, Sweden (convertion to asm --> many times faster) }ππusesπ crt;ππconstπ vidseg:word=$a000;ππvarπ stab1,stab2:array[0..255+80] of byte;π x:word;ππprocedure setpal(c,r,g,b:byte); assembler;πasmπ mov dx,3c8hπ 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;ππbeginπ asmπ mov ax,0013hπ int 10hπ mov dx,03c4hπ mov ax,0604hπ out dx,axπ mov dx,03d4hπ mov ax,4609hπ out dx,axπ mov ax,0014hπ out dx,axπ mov ax,0e317hπ out dx,axπ mov es,vidsegπ xor di,diπ xor ax,axπ mov cx,16000π rep stoswπ end;π for x:=0 to 63 do beginπ setpal(x,x div 4,x div 2,x);π setpal(127-x,x div 4,x div 2,x);π setpal(127+x,20+x div 4,x div 2,x);π setpal(254-x,20+x div 4,x div 2,x);π end;π for x:=0 to 255+80 do beginπ stab1[x]:=round(sin(2*pi*x/255)*128)+128;π stab2[x]:=round(cos(2*pi*x/255)*128)+128;π end;π asmπ mov cl,50π mov ch,90π mov es,vidsegπ push bpπ @main:ππ{ mov dx,3c8h (* For checking rastertime *)π xor al,alπ out dx,alπ inc dxπ out dx,alπ out dx,alπ out dx,al}ππ mov dx,3dahπ @vert1:π in al,dxπ test al,8π jz @vert1π @vert2:π in al,dxπ test al,8π jnz @vert2ππ mov dx,3dah (* This is kinda rediculous! *)π @vert1b: (* I have to insert another vbl to slow it down.... *)π in al,dxπ test al,8π jz @vert1bπ @vert2b:π in al,dxπ test al,8π jnz @vert2bππ{ mov dx,3c8h (* For checking rastertime *)π xor al,alπ out dx,alπ mov al,30π inc dxπ out dx,alπ out dx,alπ out dx,al}ππ inc clπ inc chπ xor di,diπ mov bp,diπ @loooooop:π mov si,offset stab1π mov bx,bpπ add bl,clπ mov dl,[si+bx]π xor dh,dhπ mov bl,chπ mov al,[si+bx]π add si,dxπ mov bx,bpπ add bl,alπ mov bl,[bx+offset stab2]π mov bh,blπ mov dx,40π @again:π lodswπ add ax,bxπ stoswπ dec dxπ jnz @againπ cmp si,offset stab1[256]π jb @1π sub si,256π @1:π inc bpπ cmp bp,58π jne @loooooopπ in al,60hπ cmp al,1π jne @mainπ pop bpπ end;π textmode(lastmode);πend.ππ 121 08-24-9413:50ALL OLAF BARTELT VGA 640X480x16 SWAG9408 G%¿φ 11 ╓ {π NV> Could somebody tell me how to use mode 640x480x16? Iπ NV> don't mean using it with int 10, 'cause it's too slow,π NV> but writing directly to VGA memory. So how do I draw aπ NV> pixel and how do I read a pixel?πwell, you set the mode with:ππ ASM MOV AX, 12h; INT 10h; END;ππand then draw a pixel with: }ππPROCEDURE plot_640x480x16(x, y : WORD; c : BYTE); ASSEMBLER;πASMπ {$IFDEF DPMI}π MOV ES, SEGA000π {$ELSE}π MOV AX, $A000π MOV ES, AXπ {$ENDIF}π MOV DI, xπ MOV CX, DIπ SHR DI, 3π MOV AX, 80π MUL yπ ADD DI, AXπ AND CL, $07π MOV AH, $80π SHR AH, CLπ MOV AL, $08π MOV DX, $03CEπ OUT DX, AXπ MOV AL, cπ MOV AH, [ES:DI]π MOV [ES:DI], ALπEND;πππ{ and read a pixel with: }πππFUNCTION point_640x480x16(x, y : WORD) : BYTE; ASSEMBLER;πASMπ MOV AX, 80π MUL yπ MOV SI, xπ MOV CX, SIπ SHR SI, 3π ADD SI, AXπ AND CL, $07π XOR CL, $07π MOV CH, 1π SHL CH, CLπ {$IFDEF DPMI}π MOV ES, SEGA000π {$ELSE}π MOV AX, $A000π MOV ES, AXπ {$ENDIF}π MOV DX, $03CEπ MOV AX, 772π XOR BL, BLπ@gp1:π OUT DX, AXπ MOV BH, ES:[SI]π AND BH, CHπ NEG BHπ ROL BX, $0001π DEC AHπ JGE @gp1π MOV AL, BLπEND;ππ 122 08-24-9413:51ALL LUIS MEZQUITA Moving Poligon SWAG9408 åMká 76 ╓ {πPS> I see that a lot of people around here have polygon, texture mapping andπPS> 3D routines so why don't you all post them here, even if you alreadyπPS> have done in the past cause there are people who didn't get themπPS> and want them :)π}ππ{$G+,R-}πProgram Polygoned_and_shaded_objects;ππ{ Mode-x version of polygoned objects }π{ Originally by Bas van Gaalen & Sven van Heel }π{ Optimized by Luis Mezquita Raya }ππuses Crt,x3Dunit2;π { ^^^^^ Contained in GRAPHICS.SWG file }π{$DEFINE Object1} { Try an object between 1..4 }ππconstππ{$IFDEF Object1} { Octagon }π nofpolys=9; { Number of poligons-1 }ππ nofpoints=11; { Number of points-1 }ππ polypoints=4; { Number of points for each poly }ππ sc=5; { Number of visible planes }ππ cr=23; { RGB components }π cg=8;π cb=3;ππ point:array[0..nofpoints,0..2] of integer=(π (-20,-20, 30),( 20,-20, 30),( 40,-40, 0),( 20,-20,-30),π (-20,-20,-30),(-40,-40, 0),(-20, 20, 30),( 20, 20, 30),π ( 40, 40, 0),( 20, 20,-30),(-20, 20,-30),(-40, 40, 0));ππ planes:array[0..nofpolys,0..3] of byte=(π (0,1,7,6),(1,2,8,7),(9,8,2,3),(10,9,3,4),(10,4,5,11),π (6,11,5,0),(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));π{$ENDIF}ππ{$IFDEF Object2} { Cube }π nofpolys=5; { Number of poligons-1 }ππ nofpoints=7; { Number of points-1 }ππ polypoints=4; { Number of points for each poly }ππ sc=3; { Number of visible planes }ππ cr=0; { RGB components }π cg=13;π cb=23;ππ point:array[0..nofpoints,0..2] of integer=(π (-40,-40, 40),( 40,-40, 40),( 40,-40,-40),(-40,-40,-40),π (-40, 40, 40),( 40, 40, 40),( 40, 40,-40),(-40, 40,-40));ππ planes:array[0..nofpolys,0..3] of byte=(π (0,1,5,4),(1,5,6,2),(6,7,3,2),π (7,3,0,4),(0,1,2,3),(6,5,4,7));π{$ENDIF}ππ{$IFDEF Object3} { Octahedron }π nofpolys=7; { Number of poligons-1 }ππ nofpoints=5; { Number of points-1 }ππ polypoints=3; { Number of points for each poly }ππ sc=4; { Number of visible planes }ππ cr=0; { RGB components }π cg=3;π cb=23;ππ point:array[0..nofpoints,0..2] of integer=(π ( 0, 0, 45),(-40,-40, 0),(-40, 40, 0),( 40, 40, 0),π ( 40,-40, 0),( 0, 0,-45));ππ planes:array[0..nofpolys,0..3] of byte=(π (0,1,2,0),(0,2,3,0),(0,3,4,0),(0,4,1,0),π (5,1,2,5),(5,2,3,5),(5,3,4,5),(5,4,1,5));ππ{$ENDIF}ππ{$IFDEF Object4} { Spiky }π nofpolys=15; { Number of poligons-1 }ππ nofpoints=19; { Number of points-1 }ππ polypoints=4; { Number of points for each poly }ππ sc=5; { Number of visible planes }ππ cr=23; { RGB components }π cg=5;π cb=5;ππ point:array[0..nofpoints,0..2] of integer=(π (-10,-10, 30),( 10,-10, 30),( 30,-30, 0),( 10,-10,-30),π (-10,-10,-30),(-30,-30, 0),(-10, 10, 30),( 10, 10, 30),π ( 30, 30, 0),( 10, 10,-30),(-10, 10,-30),(-30, 30, 0),π ( -2, -2, 60),( -2, 2, 60),( 2, -2, 60),( 2, 2, 60),π ( -2, -2,-60),( -2, 2,-60),( 2, -2,-60),( 2, 2,-60));ππ planes:array[0..nofpolys,0..3] of byte=(π (0,1,14,12),(7,15,13,6),(1,14,15,7),(6,13,12,0),π (1,2,8,7),(9,8,2,3),π (10,9,19,17),(10,4,16,17),(3,4,16,18),(3,9,19,18),π (10,4,5,11),π (6,11,5,0),(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));π{$ENDIF}ππtype polytype=array[0..nofpolys] of integer;π pointype=array[0..nofpoints] of integer;ππ ptnode=word;π stack=ptnode;ππconst soplt=SizeOf(polytype);π sopit=SizeOf(pointype);π xst:integer=1;π yst:integer=1;π zst:integer=-2;ππvar polyz,pind:array[byte] of polytype;π xp,yp:array[byte] of pointype;π phix:byte;ππProcedure QuickSort(lo,hi:integer); assembler; { Iterative QuickSort }πvar i,j,x,y:integer; { NON RECURSIVE }πasmπ mov ah,48h { Init stack }π mov bx,1π int 21hπ jc @exitπ mov es,axπ xor ax,axπ mov es:[4],axππ mov cx,lo { Push(lo,hi) }π mov dx,hiπ call @Pushππ@QS: mov ax,es:[4] { ¿Stack empty? }π and ax,axπ jz @Emptyππ mov cx,es:[0] { Top(lo,hi) }π mov dx,es:[2]π mov lo,cxπ mov hi,dxππ mov bx,es:[4] { Pop }π mov ah,49hπ int 21hπ jc @exitπ mov es,bxππ mov ax,cx { ax:=(i+j) div 2 }π mov bx,dxπ add ax,bxπ shr ax,1ππ lea bx,polyz { ax:=polyz[ax] }π call @indexπ mov x,axππ@Rep: mov ax,cx { repeat ... }π lea bx,polyz { while polyz[i]<x do ... }π call @indexπ cmp ax,xπ jge @Rep2π inc cx { inc(i); }π jmp @Repππ@Rep2: mov ax,dx { while x<polyz[j] do ... }π call @indexπ cmp x,axπ jge @EndRπ dec dx { dec(j); }π jmp @Rep2ππ@EndR: cmp cx,dx { if i>j ==> @NSwap}π jg @NBlππ je @NSwapπ push cxππ mov ax,cxπ call @indexπ mov cx,ax { cx:=polyz[i] }π mov si,diππ mov ax,dx { polyz[i]:=polyz[j] }π call @indexπ mov [si],axππ mov [di],cx { polyz[j]:=cx }π pop axππ push axπ lea bx,pindπ call @indexπ mov cx,ax { cx:=pind[i] }π mov si,diππ mov ax,dx { pind[i]:=pind[j] }π call @indexπ mov [si],axππ mov [di],cx { pind[j]:=cx }ππ pop cxπ@NSwap: inc cxπ dec dxππ@NBl: cmp cx,dx { ... until i>j; }π jle @Repππ mov i,cxπ mov j,dxππ mov dx,hi { if i>=hi ==> @ChkLo }π cmp cx,dxπ jge @ChkLoππ call @Push { Push(i,hi) }ππ@ChkLo: mov cx,lo { if lo>=j ==> @QSend }π mov dx,jπ cmp cx,dxπ jge @QSendππ call @Push { Push(lo,j) }ππ@QSend: jmp @QS { loop while stack isn't empty }ππ@Empty: mov ah,49hπ int 21hπ jmp @exitππ@index: shl ax,1 { ax:=2*ax }π add ax,bxπ mov di,axπ push bxπ mov bl,sopltπ mov al,phixπ xor ah,ahπ mul blπ add di,ax { di=2*index+SizeOf(polytype)+polyz }π pop bxπ mov ax,[di]π retππ@Push: mov ah,48h { Push into stack }π mov bx,1π int 21hπ jc @exitπ mov bx,esπ mov es,axπ mov es:[0],cxπ mov es:[2],dxπ mov es:[4],bxπ mov di,axπ retππ@exit:πend;ππProcedure Calc;πvar z:pointype;π spx,spy,spz,π cpx,cpy,cpz,π zd,x,y,i,j,k:integer;π n,key,phiy,phiz:byte;πbeginπ phix:=0;π phiy:=0;π phiz:=0;π FillChar(xp,sizeof(xp),0);π FillChar(yp,sizeof(yp),0);ππ repeatππ spx:=sinus(phix); { 'Precookied' constanst }π spy:=sinus(phiy);π spz:=sinus(phiz);ππ cpx:=cosinus(phix);π cpy:=cosinus(phiy);π cpz:=cosinus(phiz);ππ for n:=0 to nofpoints doπ beginπ i:=(cpy*point[n,0]-spy*point[n,2]) div divd;π j:=(cpz*point[n,1]-spz*i) div divd;π k:=(cpy*point[n,2]+spy*point[n,0]) div divd;π x:=(cpz*i+spz*point[n,1]) div divd;π y:=(cpx*j+spx*k) div divd;π z[n]:=(cpx*k-spx*j) div divd;π zd:=z[n]-dist;π xp[phix,n]:=(160+cpx)-(x*dist) div zd;π yp[phix,n]:=(200+spz) div 2-(y*dist) div zd;π end;ππ for n:=0 to nofpolys doπ beginπ polyz[phix,n]:=(z[planes[n,0]]+z[planes[n,1]]+π z[planes[n,2]]+z[planes[n,3]]) div 4;π pind[phix,n]:=n;π end;ππ QuickSort(0,nofpolys);π inc(phix,xst);π inc(phiy,yst);π inc(phiz,zst);π until phix=0;πend;ππProcedure ShowObject;πvar n:byte; pim:integer;πbeginπ retrace;π if address=0π then address:=16000π else address:=0;π setaddress(address);π cls;π for n:=sc to nofpolys doπ beginπ pim:=pind[phix,n];π polygon(xp[phix,planes[pim,0]],yp[phix,planes[pim,0]],π xp[phix,planes[pim,1]],yp[phix,planes[pim,1]],π xp[phix,planes[pim,2]],yp[phix,planes[pim,2]],π xp[phix,planes[pim,3]],yp[phix,planes[pim,3]],π polyz[phix,n]+30);π end;πend;ππProcedure Rotate;πvar i:byte;πbeginπ setmodex;π address:=0;π Triangles:=polypoints=3;π for i:=1 to 80 do setpal(i,cr+i shr 1,cg+i shr 1,cb+i shr 1);π setborder(63);π repeatπ ShowObject;π inc(phix,xst);π until KeyPressed;π setborder(0);πend;ππvar i:byte;π s:stack;π x,y:integer;ππbeginπ {border:=True;}π if ParamCount=1π then beginπ Val(ParamStr(1),xst,yst);π if yst<>0 then Halt;π zst:=-2*xst;π yst:=xst;π end;π WriteLn('Wait a moment ...');π Calc;π Rotate;π TextMode(LastMode);πend.ππ But ... wait a moment ... you also need x3dUnit2.pasπ which is also included in the SWAG filesπ 123 08-24-9413:56ALL SIMEON SPRY SCI File Viewer SWAG9408 ;{åµ 19 ╓ πProgram ViewASCi;ππ{ Simple SCi Viewer - By Simeon SpryππThis code will display a SCi (320*200*256) file. I would reccomend that youπadd code to find out if the SCi File name is valid. I had some, but I gotπit out of a book so it *might* be copyrighted :-(. You also might want toπsave the old pallete and restore it afterwards I didn't do it because Iπlost my reference.ππThis may be freely distributed, if you incorporate any portions of thisπcode into a part of anything you MUST give me some credit.π}πππProcedure ViewSci( SciF : STRING);π CONST Header : Array[1..4] OF CHAR = ('R','I','X','3');ππ VAR SciFile : File;π HeaderBuf : Array[1..10] OF CHAR;π NewPal : Array[1..768] OF BYTE; { 3 Bytes Per colour, 3*256 = 768}π OldPal : Array[1..768] OF BYTE; { " " "}π Screen : Array[1..64000] OF BYTE ABSOLUTE $A000:0000; { Direct toπthe screen }π i : integer;π Procedure SetPal(Pallete : Array OF BYTE);π VARπ PalPtr : POINTER;π BEGINπ PalPtr := @Pallete;π asmπ mov ax,1012hπ xor bx,bxπ mov cx,0100hπ les dx,PalPtrπ int 10hπ end;π END;ππ Procedure WaitForKey;assembler;π ASMπ xor ax,axπ int 16hπ END;πProcedure SetMode(Mode : BYTE); assembler;π ASMπ mov ah, 00π mov al, modeπ int 10hπ END;ππ BEGINπ { Open The File }π assign(SciFile, SciF);π Reset(SciFile,1);ππ { Check The Header }π BlockRead(SciFile,HeaderBuf,SizeOF(HeaderBuf));π For i := 1 to 4 DOπ Beginπ If HeaderBuf[i] <> Header[i] Thenπ BEGINπ WriteLn;π WriteLn(' Invalid SCI File. ');π WriteLn;π Halt(1);π END;π End;ππ { Set Mode $13 }π SetMode($13);ππ { Read Pallete into a 768 Byte Buffer & DisPlay. }π BlockRead(SciFile,NewPal,768);π SetPal(NewPal);ππ { Read 64000 bytes then write DIRECTLY to Video Memory }π BlockRead(SCIFile,Screen,64000);π cLOSE(SCIFILE);π { Wait Until Key Pressed }π WaitForKey;ππ { Set Text Mode }π SetMode($3);πEND;ππVar SciFile : String[12];ππBEGINπ { Ask For File To View }π WriteLn('SCi Viewer - By Simeon Spry');π Write('View File: ');π ReadLn(SciFile);ππ { View SCi File }π ViewSCI( SciFile );ππ { Display Made-By Message }π WriteLn('Simple SCi Viewer by Simeon Spry');π WriteLn;πEND.π 124 08-24-9413:56ALL BAS VAN GAALEN Scroll Bars SWAG9408 Ω╠E▒ 36 ╓ USES dos, crt;ππCONSTπ v_vidseg : WORD = $B800; { $B000 for mono }π v_columns : BYTE = 80; { Number of CRT columns }ππVARπ x : BYTE;π{πthe dspat routine, as you can see. Displays a string QUICKLYπIf 'Col' (=columns, NOT color) is negative (-1) the centence will be centered.πWorks also in exotic screenmodes, like 132x44, 100x44 or whatever you like.π}πprocedure dspat(Str : string; Col : integer; Row,Attr : byte); assembler;πasmπ push ds { Save Turbo's DS }π mov es,v_vidseg { Place VideoBuffer in es }π xor dh,dh { Clear DH }π mov dl,v_columns { Bytes per row }ππ lds si,Str { DS:SI pts to Str }π xor cx,cx { clear CX }π mov cl,[si] { String len counted in CX }π jcxz @l5 { If null, quit }π inc si { Point DS:SI to first char }ππ mov ax,Col { Get Column value }π cmp ax,0π jge @l6 { Absolute, or centered? }ππ mov ax,dxπ sub ax,cx { Substract stringlen from total }π shr ax,1 { Centre}ππ @l6:π mov di,axπ shl di,1 { Double for attributes }ππ mov al,Row { Get Row value }π mul dl { Times rows }π shl ax,1ππ add di,ax { ES:DI pts to lst pos }π cld { Direction flag forward }π mov ah,Attr { Get Attribute }π @l1:π lodsb { Get a character}π stosw { Write it with attribute }π loop @l1 { Go do next }π @l5:π pop ds { Restore DS and quit }πend;ππprocedure filltext(Dir : char; X1,Y1,X2,Y2,Col : byte); assembler;πasmπ push ds { Save Turbo's DS }ππ xor dh,dh { Clear DH }π mov dl,v_columns { Bytes per row (number of columns) }ππ xor ah,ahπ mov es,v_vidseg { Place VideoBuffer in ES and DS }π mov al,[X1]π mov di,axπ shl di,1 { Double for attributes }π mov al,[Y1] { Get Row value }π mul dl { Times rows }π shl ax,1π add di,ax { ES:DI pts to upperleft corner }ππ xor ch,chπ mov cl,[X2]π inc clπ sub cl,[X1] { Number of bytes to move in CL (columns) }π xor bh,bhπ mov bl,[Y2]π inc blπ sub bl,[Y1] { Number of rows to move in BL }ππ sub dl,[X2] { Substract right site }π dec dlπ shl dx,1 { Times two for attribs }π xor ah,ah { Clear AH }π mov al,[X1] { Left site }π shl ax,1 { Times two for attribs }π add dx,ax { Calculated difference between last col - first col }ππ mov al,[Dir]π mov ah,[Col]ππ cld { Direction flag forward }π @L1:π push cxπ rep stoswπ pop cxπ add di,dxπ dec blπ jnz @L1ππ pop ds { Restore DS and quit }πend;ππ{ Displays Veritical scrollbar }πprocedure ScrollBar(BarXPos,π BarYPos : byte;π CurPos,π ScrLen, { max screen row }π NofItems : word;π ColAttr : byte);πvar barpos,maxpos : word;πbeginπ dspat(#30,barxpos,barypos,colattr);π dspat(#31,barxpos,barypos+scrlen-1,colattr);π filltext('▒',barxpos,barypos+1,barxpos,barypos+scrlen-2,colattr);π if nofitems >= 1 then beginπ maxpos := scrlen-3;π if nofitems <> 1 then barpos := round(((curpos-1)/(nofitems-1))*maxpos)π else barpos := 0;π dspat('■',barxpos,barypos+barpos+1,colattr);π end;πend; { ScrollBar }ππBEGIN { demo coded by Gayle Davis for SWAG 8/18/94 }ππ ClrScr;π { put at col 40 of Row x, 3rd item selected }ππ FOR X := 1 to 24 DOπ BEGINπ ScrollBar(40,1,x,22,40,31);π DELAY(300);π END;ππEND.ππThe assembler stuff is nicely documented, so shouldn't be a problem. What'sπmissing here, you can define as constants at the top of your source, or try toπfind out using interrupt-calls or whatever...ππBtw: these routines are taken from my very private video-unit, and seem to workπon many different configurations (so far...) But that's also due to the factπthat the v_columns is found through some interrupt-calls and stuff...πThe routines work also in 132x44 or whatever strange video-mode.ππAnother point of discussion: no snow-checking is performed. I got in someπanoying discussions about this, because (imho) CGA's are hardly used theseπdays. So it seems a little ... nuts ... to make support for that hand full ofπCGA-users. Ah well, enclose the sc yourself. it's not hard, but it REALY slow'sπstuff down. And these routines were designed with SPEED as first concern andπcompatibily with MODERN hardware as a second...ππ _ _π|_] | _π|__].|__].π 125 08-24-9413:56ALL JENS LARSSON Scrolling Images SWAG9408 »ƒm 18 ╓ {πMichael, you wondered how you could scroll an image (320*200) over theπscreen. And yes, as you probably have figured out, the most reliableπsolution to that is mode-x (or tweaked mode or whatever...).πHere's an example program:ππ--------------------------------------------------------->8-------------------π{ππ Mode-x scrolling, by Jens Larsson 2:201/2120.3, Sweden, PD.π ( btw, hope you know some assembly... <g> )ππ}π{$G+}πUses Crt;ππ Var i, ScrBase : Word;ππ Procedure PutPix(x, y : Word; Color : Byte); Assembler;π Asmπ mov ax,0a000hπ mov es,axπ mov bx,xπ mov dx,3c4hπ mov ax,0102hπ mov cl,blπ and cl,3π shl ah,clπ out dx,axπ mov ax,yπ shl ax,4π mov di,axπ shl ax,2π add di,axπ shr bx,2π add di,bxπ add di,ScrBaseπ mov al,Colorπ mov es:[di],alπ End;ππ Procedure ScrPan(ScrOfs : Word); Assembler;π Asmπ mov bx,ScrOfsπ mov dx,3d4hπ mov ah,bhπ mov al,0chπ out dx,axπ mov ah,blπ inc alπ out dx,axπ End;ππ Procedure SetModeX; Assembler;π Asmπ mov ax,0012hπ int 10hπ mov ax,0013hπ int 10hπ mov dx,3c4hπ mov ax,0604hπ out dx,axπ mov dx,3d4hπ mov ax,0014hπ out dx,axπ mov ax,0e317hπ out dx,axπ End;ππ Procedure Synk; Assembler;π Asmπ mov dx,3dahπ@L1:π in al,dxπ test al,08hπ jne @L1π@L2:π in al,dxπ test al,08hπ je @L2π End;ππ Beginπ Randomize;π SetModeX;π ScrBase := 200*80;π For i := 0 to 9999 do PutPix(Random(320),Random(200),Random(256));π For i := 0 to 200 do Beginπ ScrPan(i*80);π Synk;π End;π ReadKey;π Asm; mov ax,0003h; int 10h; End;π End.ππ 126 08-24-9413:58ALL JOHN HOWARD Sprite Game SWAG9408 ▀î/{ 94 ╓ πprogram SpriteGame; {Verifies a VGA is present}π{$G+,R-}π(* jh Syntax: spritegame.exe [number]π optional number is the total population of sprites. Default is maxsprites.π*)π{ Original Sprites program by Bas van Gaalen, Holland, PD }π{ Modified by Luis Mezquita Raya }π{ Modified by John Howard (jh) into a game }π{ 30-MAY-1994 jh Version 1.0π Now a game to see which sprite survives the longest.π Renamed tScrArray to Screen, and tSprArray to SpriteData.π Removed CRT unit & saved around 1616 bytes. Added command line parameter.π Added timer and energy definitions to provide statistics.π 21-JUN-1994 jh Version 1.1 = ~7.5kπ Added OnlyVGA and SetMode procedures. Added CharSet & CharType definitions.π Implemented characters as sprites.π 29-JUN-1994 jh Version 1.2 = ~8.5k due to command line helpπ Places identification on each sprite by using HexDigits. CharColor defaultsπ to sprite number (0..maxsprites) as a color index in the palette. Fixed bugπ in moire background screen limits.π}πconstπ maxsprites=128; { Number of sprites is [1..128] }π pxsize=320; { screen x-size }π pysize=200; { screen y-size }π xsize=32; { sprite x-size }π ysize=32; { sprite y-size }π CharRows=8; { Characters are 8 rows high }π HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';ππtypeπ Screen=array[0..pysize-1, 0..pxsize-1] of byte;π pScreen=^Screen;π SpriteData=array[0..ysize-1, 0..xsize-1] of byte;π pSpriteData=^SpriteData;π SprRec=recordπ x,y : word; {Absolute location of sprite}π xspd,yspd : shortint; {Velocity horizontal and vertical}π energy : shortint; {Hide is neg., dead is 0, show is pos.}π buf : pSpriteData; {Rectangle of sprite definition}π end;π CharType = array[1..CharRows] of Byte;ππvarπ CharSet : array[0..255] of CharType absolute $F000:$FA6E;π sprite : array[1..maxsprites] of SprRec;π vidscr,virscr,bgscr : pScreen; {video, virtual, background screens}π dead : byte; {Counts the dead sprites}π survivor : byte; {Identify the last dead sprite}π Population : word; {Population from 1..128}π {CharColor : byte;} {Character digit color 0..255}ππ Timer : longint; {Stopwatch}π H, M, S, S100 : Word;π Startclock, Stopclock : Real;π mins, secs : integer;π Code: integer; {temporary result of VAL conversion}ππprocedure GetTime(var Hr, Mn, Sec, S100 : word); assembler; {Avoids DOS unit}πasmπ mov ah,2chπ int 21hπ xor ah,ah {fast register clearing instead of MOV AH,0}π mov al,dlπ les di,S100π stoswπ mov al,dhπ les di,Secπ stoswπ mov al,clπ les di,Mnπ stoswπ mov al,chπ les di,Hrπ stoswπend;ππprocedure StartTimer;πbeginπ GetTime(H, M, S, S100);π StartClock := (H * 3600) + (M * 60) + S + (S100 / 100);πend;ππprocedure StopTimer;πbeginπ GetTime(H, M, S, S100);π StopClock := (H * 3600) + (M * 60) + S + (S100 / 100);π Timer := trunc(StopClock - StartClock);π secs := Timer mod 60; {Seconds remaining}π mins := Timer div 60; {Reduce into minutes}πend;πfunction KeyPressed : boolean; assembler; {Avoids unit CRT.KeyPressed}πasmπ mov ah,01h; int 16h; jnz @0; xor ax,ax; jmp @1;π@0: mov al,1π@1:πend;ππprocedure SetMode(M:byte); assembler;πasmπ mov ah,0; mov al,M; int 10h;πend;πprocedure SetPal(col,r,g,b:byte); assembler; {256 color palette}πasmπ mov dx,03c8hπ mov al,col {color}π out dx,alπ inc dxπ mov al,r {red component}π out dx,alπ mov al,g {green component}π out dx,alπ mov al,b {blue component}π out dx,alπend;πprocedure flip(srcscr, destscr : pScreen); assembler; {copy screen}πasmπ push dsπ lds si,srcscrπ les di,destscrπ mov cx,pxsize*pysize/2π rep movswπ pop dsπend;πprocedure cls(scr : pScreen); assembler; {clear screen}πasmπ les di,scr; xor ax,ax; mov cx,pxsize*pysize/2; rep stoswπend;πprocedure retrace; assembler;πasmπ mov dx,03dahπ@vert1: in al,dxπ test al,8π jnz @vert1π@vert2: in al,dxπ test al,8π jz @vert2πend;πprocedure PutSprite(var sprite: SprRec; virseg: pScreen); assembler;πasmπ push dsπ lds si,sprite { get sprite segment }π les di,virseg { get virtual screen segment }π mov ax,SprRec[ds:si].yπ shl ax,6π mov di,axπ shl ax,2π add di,ax { y*pxsize }π add di,SprRec[ds:si].x { y*pxsize+x }π mov dx,pxsize-xsize { number of pixels left on line }π lds si,SprRec[ds:si].bufπ mov bx,ysizeπ@l1: mov cx,xsizeπ@l0: lodsbπ or al,alπ jz @skip { check if transparent "Black" }π mov es:[di],al { draw it }π@skip: inc diπ dec cxπ jnz @l0π add di,dxπ dec bxπ jnz @l1π pop dsπend;πprocedure OnlyVGA; assembler;πasmπ @CheckForVga: {push es}π mov AH,1ah {Get Display Combination Code}π mov AL,00h {AX := $1A00;}π int 10h {Intr($10, Regs);}π cmp AL,1ah {IsVGA:= (AL=$1A) AND((BL=7) OR(BL=8))}π jne @NoVGAπ cmp BL,07h {VGA w/ monochrome analog display}π je @VgaPresentπ cmp BL,08h {VGA w/ color analog display}π je @VgaPresentπ @NoVGA:π mov ax,3 {text mode}π int 10hπ push csπ pop dsπ lea dx,@messageπ mov ah,9π int 21h {print $ terminated string}π mov ax,4c00hπ int 21h {terminate}π @message: db 'Sorry, but you need a VGA to see this!',10,13,24hπ @VgaPresent: {pop es}π {... After here is where your VGA code can execute}πend; {OnlyVGA}ππVAR n : byte; {sprite number}π hx,hy,i,j,k,np : integer;πBEGIN {PROGRAM}π {Get text from command line and convert into a number}π Val(ParamStr(1), Population, Code);π if (Code <> 0) {writeln('Bad number at position: ', Code);}π OR (Population <1) OR (Population > maxsprites) thenπ Population := maxsprites; {default}π if ParamStr(1) = '?' thenπ beginπ writeln('Howard International, P.O. Box 34633, NKC, MO 64116 USA');π writeln('1994 Freeware Sprite Game v1.2');π writeln('Syntax: spritegame.exe [number]');π writeln(' optional number is the total population of sprites (1 to 128)');π halt;π end;ππ {CharColor := Population;}π OnlyVGA;π SetMode($13); {320x200x256x1 plane}π Randomize;π vidscr := Ptr($A000,0);π New(virscr); cls(virscr); New(bgscr); cls(bgscr);π np := 128 div Population;π for i := 0 to Population-1 doπ begin {Define moire background pattern}π case i mod 6 ofπ 0:beginπ hx := 23; hy := i*np; n := 0;π end;π 1:beginπ hx := i*np; hy := 23; n := 0;π end;π 2:beginπ hx := i*np; hy := 0; n := 23;π end;π 3:beginπ hx := 23; hy := 0; n := i*np;π end;π 4:beginπ hx := 0; hy := 23; n := i*np;π end;π 5:beginπ hx:= 0; hy:= i*np; n := 23;π end;π end;π for j := 0 to np-1 doπ beginπ k := j shr 1;π SetPal(np*i+j+1, k+hx, k+hy, k+n);π end;π end;ππ for i := 1 to 127 do SetPal(127+i, i div 3, 20+i div 5, 20+i div 7);π for i := 0 to pxsize-1 do {jh bug! Reduce to legal screen limits}π for j := 0 to pysize-1 doπ bgscr^[j,i] := 128+ ABS(i*i - j*j) and 127;π(*π flip(bgscr, vidscr); {copy background to video}π {SetPal(?,r,g,b)} {force a visible text palette entry}π writeln('Sprite Game v1.2 '); {modify video}π flip(vidscr, bgscr); {copy video to background}π*)π hx := xsize shr 1;π hy := ysize shr 1;π for n := 1 to Population doπ beginπ with sprite[n] doπ beginπ x := 20+ random(280 - xsize);π y := 20+ random(160 - ysize);π xspd := random(6) - 3;π yspd := random(6) - 3;π energy := random(10); {punishes liberals}π if xspd=0 thenπ beginπ xspd := 1;π energy := random(20); {average life expectancy}π end;π if yspd=0 thenπ beginπ yspd := 1;π energy := random(40); {rewards conservatives}π end;π New(buf);π for i := 0 to xsize-1 doπ for j := 0 to ysize-1 doπ beginπ k := (i-hx) * (i-hx) + (j-hy) * (j-hy);π if (k< hx*hx) and (k> hx*hx div 16)π then buf^[j,i] := k mod np + np * (n-1)π else buf^[j,i] := 0; {CRT color "Black" is transparent}π end;π end; {with}π end; {for}ππ {jh Can store your own bitmap image in any sprite[n].buf^[j,i] such as: }π for i := 0 to xsize-1 doπ for j := 0 to ysize-1 doπ beginπ sprite[1].buf^[j,i] := j; {first sprite. Horizontal bars}π sprite[Population].buf^[j,i] := i; {last sprite. Vertical bars}π end;ππ {jh Get characters from default font and attach to sprites}π for i := 1 to CharRows doπ for j := 1 to CharRows doπ beginπ for n := 1 to Population doπ beginπ {first hex digit for current sprite}π if (CharSet[ord(HexDigits[n SHR 4]),i] shr (8-j) and 1 = 1) thenπ sprite[n].buf^[i,j] := n {CharColor}π elseπ sprite[n].buf^[i,j] := 0; {transparent}π {second hex digit for current sprite}π if (CharSet[ord(HexDigits[n AND $F]),i] shr (8-j) and 1 =1) thenπ sprite[n].buf^[i,j+CharRows] := n {CharColor}π elseπ sprite[n].buf^[i,j+CharRows] := 0; {transparent}π end;π(* {mark last sprite 'Z'}π sprite[Population].buf^[i,j] := CharSet[ord('Z'),i] shr (8-j) and 1; *)π end;ππ {jh Keep track of the last dead sprite and how old it was. }π StartTimer;π while not (KeyPressed or (dead=Population)) doπ beginπ flip(bgscr, virscr);π retrace;π dead := 0; {reset the sentinel}π for n := 1 to Population doπ with sprite[n] doπ beginπ if energy > 0 then PutSprite(sprite[n], virscr) {show(n)}π { else if energy < 0 then hide(n) }π else inc(dead);π inc(x,xspd);π if (x<10) or (x > (310 - xsize)) thenπ beginπ xspd := -xspd;π energy := energy - 1;π end;π inc(y,yspd);π if (y<10) or (y > (190 - ysize)) thenπ beginπ yspd := -yspd;π energy := energy - 1;π end;π end; {with}π flip(virscr, vidscr);π end; {while}ππ StopTimer;π survivor := 0;π for n := 1 to Population doπ begin {find last dead sprite with zero energy}π if sprite[n].energy = 0 then survivor := n;π Dispose(sprite[n].buf);π end;π Dispose(virscr); Dispose(bgscr);π SetMode($3); {resume text video mode 3h= 80x25x16 color}π writeln('Last dead sprite was # ', survivor, ' of ', Population);π writeln('Time of death was ', trunc(StopClock));π writeln('Life span was ', mins:2, ' Minute and ', secs:2, ' Seconds');πEND. {PROGRAM}π 127 08-24-9413:58ALL BAS VAN GAALEN More STAR-ROUTINE SWAG9408
Q╘≡ 19 ╓ {πHowdy all!ππBy request here's the stars-routine, the final update. ;-)πLimits: cpu-speed and conv.-memory. No others...ππ}πprogram _stars;π{ Done by Sven van Heel and Bas van Gaalen, Holland, PD }πuses crt;πconstπ f=6; nofstars=100; vidseg:word=$a000;π bitmask:array[0..1,0..4,0..4] of byte=(π ((0,0,1,0,0),(0,0,3,0,0),(1,3,6,3,1),(0,0,3,0,0),(0,0,1,0,0)),π ((0,0,6,0,0),(0,0,3,0,0),(6,3,1,3,6),(0,0,3,0,0),(0,0,6,0,0)));πtype starstruc=recordπ xp,yp:word; phase,col:byte; dur:shortint; active:boolean; end;πvar stars:array[1..nofstars] of starstruc;ππ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 retrace; assembler; asmπ mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1π @vert2: in al,dx; test al,8; jnz @vert2; end;ππvar i,x,y:word;πbeginπ asm mov ax,13h; int 10h; end;π for i:=1 to 10 do beginπ setpal(i,f*i,0,0); setpal(21-i,f*i,0,0); setpal(20+i,0,0,0);π setpal(30+i,0,f*i,0); setpal(51-i,0,f*i,0); setpal(50+i,0,0,0);π setpal(60+i,0,0,f*i); setpal(81-i,0,0,f*i); setpal(80+i,0,0,0);π setpal(90+i,f*i,f*i,0); setpal(111-i,f*i,f*i,0); setpal(110+i,0,0,0);π setpal(120+i,0,f*i,f*i); setpal(141-i,0,f*i,f*i); setpal(140+i,0,0,0);π setpal(150+i,f*i,f*i,f*i); setpal(171-i,f*i,f*i,f*i); setpal(170+i,0,0,0);π end;π randomize;π for i:=1 to nofstars do with stars[i] do beginπ xp:=0; yp:=0; col:=0; phase:=0;π dur:=random(20);π active:=false;π end;π repeatπ retrace; retrace;π {setpal(0,0,0,30);}π for i:=1 to nofstars do with stars[i] do beginπ dec(dur);π if (not active) and (dur<0) then beginπ active:=true; phase:=0; col:=30*random(6);π xp:=random(315); yp:=random(195);π end;π end;π for i:=1 to nofstars do with stars[i] doπ if active then beginπ for x:=0 to 4 do for y:=0 to 4 doπ if bitmask[byte(phase>10),x,y]>0 thenπ mem[vidseg:(yp+y)*320+xp+x]:=bitmask[byte(phase>10),x,y]+col+phase;π inc(phase);π if phase=20 then begin active:=false; dur:=random(20); end;π end;π setpal(0,0,0,0);π until keypressed;π textmode(lastmode);πend.π 128 08-24-9417:50ALL ERIC COOLMAN Another Fire Graphic SWAG9408 ╔V· 67 ╓ {πAC>I got my hands on Jare's fire code and thought it was pretty cool,πAC>so I made my own fire program. Although it didn't turn out like IπAC>thought it would (like Jare's) what I have is (at least I think so)πAC>something that looks more realistic.ππThis is kinda funny... just the other day I was looking at Jare's fireπcode, and did an 80x50 textmode version of it in C. I did a quick andπdirty conversion of it to Pascal so I could post it here for youπ(don't you feel special? <G>). The pascal version came out a bitπslower then my C version, although they are very similar. I haven'tπfigured out why though... most times I try this, both come out closeπto the same speed.ππ(********************************************************************π Fire by Eric Coolman (aka. Digitar/SKP), Simple Minded Softwareπ Much like Jare's (VangelisTeam) fire, but uses 80x50x16 text modeπ rather than 320x200x256 (which was "tweaked" to look like 80x50π text mode). Reference : FIRE.TXT by Phil Carlisle (aka Zoombapup,π CodeX) from PC Game Programmer's Encyclopedia (PCGPE10.ZIP) by Markπ Feldman and contributers (thanks for the great reads guys!).π Compiler : Turbo Pascal 6.0π Released to public domain, July 30, 1994.ππ NOTE: FirePalette will not get loaded if running under DESQviewπ with "VIRTUALIZE TEXTMODE" on (which will stop any paletteπ manipulation). To fix, go into setup for the DOSBOX, andπ under "VIRTUALIZE TEXT/GRAPHICS" mode, and set it to "N".π Also for DV, set "WRITES DIRECT TO SCREEN" to "Y"es.π********************************************************************)π}ππProgram tFire;ππconstπ MAXX = 80;π MAXY = 50;π { Our gradient firepalette (white/yellow/red/orange/slate/black) }π FirePal : array[0..3*16-1] of byte =π { [ HUES ] }π { RED GREEN BLUE }π { === ===== ==== }π ( { Normal Color }π 0, 0, 0, { BLACK }π 0, 5, 3, { BLUE }π 0, 6, 7, { GREEN }π 0, 7, 9, { CYAN }π 0, 8, 11, { RED }π 0, 9, 12, { MAGENTA }π 63, 13, 0, { BROWN }π 60, 4, 4, { LIGHTGRAY }π 63, 58, 21, { DARKGRAY }π 63, 59, 0, { LIGHTBLUE }π 63, 60, 0, { LIGHTGREEN }π 63, 60, 0, { LIGHTCYAN }π 63, 61, 30, { LIGHTRED }π 63, 55, 42, { LIGHTMAGENTA }π 63, 60, 55, { YELLOW }π 63, 63, 63 { WHITE }π );ππtypeπ ColorArray = array [0..MAXX+1, 0..MAXY] of Byte;πvarπ FireImage : ColorArray;π CUR : Word; { working color }π x, y : Byte; { general counters }ππ(*π Sets video mode. If mode is 64d (40h), 8x8 ROM font will be loadedπ and 80x50 textmode will be activated. Any other value will setπ mode normally.π*)πprocedure VidMode(mode : byte); assembler;πasmπ cmp mode, 40h { (64d) want 80x50/43 mode? }π jnz @normalsetπ mov ax,1112h { set 8 point font as current font }π mov bl,00hπ jmp @MakeItSo { ;-) }π @normalset:π mov ah, 00hπ mov al, modeπ @MakeItSo:π int 10hπend;ππ{ grabs and dumps keypress...returns 1 if a key was hit, else 0 }πfunction KbGrab : boolean;πvarπ WasHit : boolean;πbeginπ WasHit := False;ππ asmπ mov ax, 0100hπ int 16hπ lahfπ test ah, 40hπ jnz @doneπ inc WasHitπ mov ax, 0000h { grab the key they hit .... }π int 16hπ @done:π end;π KbGrab := WasHit;πend;ππ(*********************************************************************π sets only color indexes normally used in textmode (16 of 'em).π Note the heavy use of ternary operator there... what that meansπ is - indexes 7 to 15 (dark gray to white) are actually indexesπ 55 to 63, and index 6 (dark brown) is actually 20d (14h) becauseπ it uses the secondary hues so that it doesn't look too much likeπ red. The rest (0,1,2,4,5,7) are as expected.π*********************************************************************)πprocedure SetFirePal;πvarπ i, j : Byte;πbeginπ for i:= 0 to 16 do { for each index }π beginπ if i <= 7 then begin if i = 6 then j := 20 else j := i; endπ else j := i+48;π port[$3c8] := j; { Send the index }π port[$3c9] := FirePal[i*3]; { Send the red }π port[$3c9] := FirePal[i*3+1]; { Send the green }π port[$3c9] := FirePal[i*3+2]; { Send the blue }π end;πend;πππ(*********************************************************************π +----+-----+----+ Table to left are screen ofs's surrounding CUR(0).π |-81 | -80 |-79 | That we will take average of. 80 is for width ofπ +----+-----+----+ screen in chars in textmode (also width of ourπ | -1 | CUR | +1 | screen buffer). The calculated average will beπ +----+-----+----+ assigned to spot '-80' to move the fire upwards,π |+79 | +80 |+81 | and decremented to fade it out (like a plasmaπ +----+-----+----+ effect somewhat).π*********************************************************************)πprocedure DoFire;πbegin;π { start at [1,1] or above because 0,0 doesn't have 8 surrounding }π { stop x at 78 or less for the same reason (ending y doesn't }π { matter cause we are setting max y randomly anyways). }π { (starting y can be set to 8 to give room for a scroller). }π for y := 1 to MAXY doπ for x := 1 to MAXX-1 doπ beginπ { get average of 8 surrounding colors (-ofs-) }π CUR := ( FireImage[x-1][y] { direct to left (-1) }π + FireImage[x+1][y] { direct to right (+1) }π + FireImage[x][y-1] { direct above (-80) }π + FireImage[x][y+1] { direct below (+80) }π + FireImage[x-1][y-1] { above to left (-81) }π + FireImage[x+1][y+1] { below to right (+81) }π + FireImage[x+1][y-1] { above to right (-79) }π + FireImage[x-1][y+1] { below to left (+79) }π ) shr 3; { divide by 8 }π Dec(CUR); { make fire fade out }π { notice below is assigning the average CUR to (CUR-1 line) }π { ... this keeps fire moving in upward direction. }π FireImage[x][y-1] := CUR; { set color }π mem[$b800:y*160+(x shl 1)+1] := FireImage[x][y];π end;ππ { Randomly set last line of fire... This keeps the fire going }π for x := 0 to 80 doπ FireImage[x][49] := (random(255)+1);π { second last line also to give fire some more height. }π for x := 0 to 80 doπ FireImage[x][48] := (random(255)+1);πend;ππbeginπ VidMode($03); { 80x25 mode (to clear screen) }π VidMode($40); { 80x50 mode }ππ SetFirePal;ππ { change to hi-intense background so we have 16 bg colors to }π { work with. }π asmπ mov ax, 1003h { blinking attr }π mov bx, 0000h { 0=HiIntBackground, 1=Blinking Attr }π int 10hπ end;ππ { clear fire image }π fillchar(FireImage, sizeof(FireImage), 63); { fill with white }ππ for x := 0 to 80 do { set up last line to start the fire }π FireImage[x][49] := (random(255)+1);ππ repeat DoFire; until KbGrab;ππ VidMode($03); { 80x25 mode }πend.π 129 08-24-9417:53ALL DAVID DAHL Transparent 3D Vectors SWAG9408 ┬d 173 ╓ πProgram TrnsVect; { Transparent Vectors }π{$G+} { 286 Instructions Enabled }ππ{ Transparent 3D Vectors Example }π{ Programmed by David Dahl }π{ This program is PUBLIC DOMAIN }ππUses CRT;πConst ViewerDist = 200;πType VGAArray = Array [0..199, 0..319] of Byte;π VGAPtr = ^VGAArray;π PaletteRec = Recordπ Red : Byte;π Green : Byte;π Blue : Byte;π End;π PaletteType = Array [0..255] of PaletteRec;π PalettePtr = ^PaletteType;π PolyRaster = Recordπ X1 : Word;π X2 : Word;π End;π PolyFill = Array [0..199] of PolyRaster;π PolyFillPtr = ^PolyFill;π FacetPtr = ^PolyFacet;π PolyFacet = Recordπ Color : Byte;π X1, Y1, Z1,π X2, Y2, Z2,π X3, Y3, Z3,π X4, Y4, Z4 : Integer;π NextFacet : FacetPtr;π End;π PolyHPtr = ^PolygonHead;π PolygonHead = Recordπ X, Y, Z : Integer;π AX, AY, AZ : Integer;π FirstFacet : FacetPtr;π End;πVar VGAMEM : VGAPtr;π WorkPage : VGAPtr;π BkgPage : VGAPtr;π Palette : PalettePtr;π PolyList : PolyFillPtr;π{-[ Initialize 320 X 200 X 256 VGA ]---------------------------------------}πProcedure GoMode13h; Assembler;πASMπ MOV AX, $0013π INT $10πEnd;π{=[ Convex Polygon Drawing Routines ]======================================}π{-[ Clear Polygon Raster List ]--------------------------------------------}πProcedure ClearPolyList (Var ListIn : PolyFill);πBeginπ FillChar (ListIn, SizeOf(ListIn), $FF);πEnd;π{-[ OR VariableIn with Value -- Modeled after FillChar ]-------------------}πProcedure ORChar (Var VariableIn;π Size : Word;π Value : Byte); Assembler;πASMπ PUSH DSπ MOV CX, Sizeπ OR CX, CXπ JZ @Doneπ LDS SI, VariableInπ MOV AL, Valueπ @ORLoop:π OR DS:[SI], ALπ INC SIπ LOOP @ORLoopπ @Done:π POP DSπEnd;π{-[ Draw Polygon From Raster List To Work Buffer ]-------------------------}πProcedure DrawPolyFromList (Var ListIn : PolyFill;π Var FrameBuffer : VGAArray;π Color : Byte);πVar YCount : Word;π TempX1 : Word;π TempX2 : Word;πBeginπ For YCount := 0 to 199 doπ Beginπ TempX1 := ListIn[YCount].X1;π TempX2 := ListIn[YCount].X2;π If (TempX1 <= 319) AND (TempX2 <= 319)π Thenπ ORChar (FrameBuffer[YCount, TempX1],π TempX2 - TempX1 + 1, Color);π End;πEnd;π{-[ Add An Element To The Raster List ]------------------------------------}πProcedure AddRasterToPoly (Var ListIn : PolyFill;π X, Y : Integer);πBeginπ { Clip X }π If X < 0π Thenπ X := 0π Elseπ If X > 319π Thenπ X := 319;π { If Y in bounds, add to list }π If ((Y >= 0) AND (Y <= 199))π Thenπ Beginπ If (ListIn[Y].X1 > 319)π Thenπ Beginπ ListIn[Y].X1 := X;π ListIn[Y].X2 := X;π Endπ Elseπ If (X < ListIn[Y].X1)π Thenπ ListIn[Y].X1 := Xπ Elseπ If (X > ListIn[Y].X2)π Thenπ ListIn[Y].X2 := X;π End;πEnd;π{=[ Polygon ]==============================================================}π{-[ Add A Facet To Current Polygon ]---------------------------------------}πProcedure AddFacet (Polygon : PolyHPtr;π Color : Byte;π X1In, Y1In, Z1In : Integer;π X2In, Y2In, Z2In : Integer;π X3In, Y3In, Z3In : Integer;π X4In, Y4In, Z4In : Integer);πVar CurrentFacet : FacetPtr;πBeginπ If Polygon^.FirstFacet = Nilπ Thenπ Beginπ New(Polygon^.FirstFacet);π CurrentFacet := Polygon^.FirstFacet;π Endπ Elseπ Beginπ CurrentFacet := Polygon^.FirstFacet;π While CurrentFacet^.NextFacet <> Nil doπ CurrentFacet := CurrentFacet^.NextFacet;π New(CurrentFacet^.NextFacet);π CurrentFacet := CurrentFacet^.NextFacet;π End;π CurrentFacet^.Color := Color;π CurrentFacet^.X1 := X1In;π CurrentFacet^.X2 := X2In;π CurrentFacet^.X3 := X3In;π CurrentFacet^.X4 := X4In;π CurrentFacet^.Y1 := Y1In;π CurrentFacet^.Y2 := Y2In;π CurrentFacet^.Y3 := Y3In;π CurrentFacet^.Y4 := Y4In;π CurrentFacet^.Z1 := Z1In;π CurrentFacet^.Z2 := Z2In;π CurrentFacet^.Z3 := Z3In;π CurrentFacet^.Z4 := Z4In;π CurrentFacet^.NextFacet := Nil;πEnd;π{-[ Initialize a New Polygon ]---------------------------------------------}πProcedure InitializePolygon (Var PolyHead : PolyHPtr;π XIn, YIn, ZIn : Integer;π RollIn, PitchIn, YawIn : Integer);πBeginπ If PolyHead = Nilπ Thenπ Beginπ New(PolyHead);π PolyHead^.X := XIn;π PolyHead^.Y := YIn;π PolyHead^.Z := ZIn;π PolyHead^.AX := RollIn;π PolyHead^.AY := PitchIn;π PolyHead^.AZ := YawIn;π PolyHead^.FirstFacet := Nil;π End;πEnd;π{-[ Dispose Polygon ]------------------------------------------------------}πProcedure DisposePolygon (Var PolyHead : PolyHPtr);πVar TempPtr : FacetPtr;π TP2 : FacetPtr;πBeginπ TempPtr := PolyHead^.FirstFacet;π While TempPtr <> Nil doπ Beginπ TP2 := TempPtr^.NextFacet;π Dispose (TempPtr);π TempPtr := TP2;π End;π Dispose (PolyHead);π PolyHead := Nil;πEnd;π{-[ Rotate Polygon About Axies ]-------------------------------------------}πProcedure RotatePolygon (Var PolyHead : PolyHPtr;π DX, DY, DZ : Integer);πBeginπ INC (PolyHead^.AX, DX);π INC (PolyHead^.AY, DY);π INC (PolyHead^.AZ, DZ);π While (PolyHead^.AX > 360) doπ DEC(PolyHead^.AX, 360);π While (PolyHead^.AY > 360) doπ DEC(PolyHead^.AY, 360);π While (PolyHead^.AZ > 360) doπ DEC(PolyHead^.AZ, 360);π While (PolyHead^.AX < -360) doπ INC(PolyHead^.AX, 360);π While (PolyHead^.AY < -360) doπ INC(PolyHead^.AY, 360);π While (PolyHead^.AZ < -360) doπ INC(PolyHead^.AZ, 360);πEnd;π{=[ Graphics Related Routines ]============================================}π{-[ Build Facet Edge ]-----------------------------------------------------}πProcedure DrawLine (X1In, Y1In,π X2In, Y2In : Integer;π Color : Byte);πVar dx, dy : Integer;π ix, iy : Integer;π X, Y : Integer;π PX, PY : Integer;π i : Integer;π incc : Integer;π plot : Boolean;πBeginπ dx := X1In - X2In;π dy := Y1In - Y2In;π ix := abs(dx);π iy := abs(dy);π X := 0;π Y := 0;π PX := X1In;π PY := Y1In;π AddRasterToPoly (PolyList^, PX, PY);π If ix > iyπ Thenπ incc := ixπ Elseπ incc := iy;π i := 0;π While (i <= incc) doπ Beginπ Inc (X, ix);π Inc (Y, iy);π Plot := False;π If X > inccπ Thenπ Beginπ Plot := True;π Dec (X, incc);π If dx < 0π Thenπ Inc(PX)π Elseπ Dec(PX);π End;π If Y > inccπ Thenπ Beginπ Plot := True;π Dec (Y, incc);π If dy < 0π Thenπ Inc(PY)π Elseπ Dec(PY);π End;π If Plotπ Thenπ AddRasterToPoly (PolyList^, PX, PY);π Inc(i);π End;πEnd;π{-[ Draw Polygon ]---------------------------------------------------------}πProcedure DrawPolygon3D (PolyHead : PolyHPtr;π Buffer : VGAPtr);πVar CurrentFacet : FacetPtr;π CalcX1, CalcY1, CalcZ1,π CalcX2, CalcY2, CalcZ2,π CalcX3, CalcY3, CalcZ3,π CalcX4, CalcY4, CalcZ4 : Integer;π XPrime1, YPrime1, ZPrime1,π XPrime2, YPrime2, ZPrime2,π XPrime3, YPrime3, ZPrime3,π XPrime4, YPrime4, ZPrime4 : Integer;π Temp : Integer;π CTX, STX,π CTY, STY,π CTZ, STZ : Real;πBeginπ CurrentFacet := PolyHead^.FirstFacet;π While CurrentFacet <> Nil doπ With CurrentFacet^ doπ Beginπ ClearPolyList (PolyList^);π XPrime1 := X1; YPrime1 := Y1; ZPrime1 := Z1;π XPrime2 := X2; YPrime2 := Y2; ZPrime2 := Z2;π XPrime3 := X3; YPrime3 := Y3; ZPrime3 := Z3;π XPrime4 := X4; YPrime4 := Y4; ZPrime4 := Z4;π { Rotate Coords }π CTX := COS(PolyHead^.AX * PI / 180);π STX := SIN(PolyHead^.AX * PI / 180);π CTY := COS(PolyHead^.AY * PI / 180);π STY := SIN(PolyHead^.AY * PI / 180);π CTZ := COS(PolyHead^.AZ * PI / 180);π STZ := SIN(PolyHead^.AZ * PI / 180);π Temp := Round((YPrime1 * CTX) - (ZPrime1 * STX));π ZPrime1 := Round((YPrime1 * STX) + (ZPrime1 * CTX));π YPrime1 := Temp;π Temp := Round((XPrime1 * CTY) - (ZPrime1 * STY));π ZPrime1 := Round((XPrime1 * STY) + (ZPrime1 * CTY));π XPrime1 := Temp;π Temp := Round((XPrime1 * CTZ) - (YPrime1 * STZ));π YPrime1 := Round((XPrime1 * STZ) + (YPrime1 * CTZ));π XPrime1 := Temp;π Temp := Round((YPrime2 * CTX) - (ZPrime2 * STX));π ZPrime2 := Round((YPrime2 * STX) + (ZPrime2 * CTX));π YPrime2 := Temp;π Temp := Round((XPrime2 * CTY) - (ZPrime2 * STY));π ZPrime2 := Round((XPrime2 * STY) + (ZPrime2 * CTY));π XPrime2 := Temp;π Temp := Round((XPrime2 * CTZ) - (YPrime2 * STZ));π YPrime2 := Round((XPrime2 * STZ) + (YPrime2 * CTZ));π XPrime2 := Temp;π Temp := Round((YPrime3 * CTX) - (ZPrime3 * STX));π ZPrime3 := Round((YPrime3 * STX) + (ZPrime3 * CTX));π YPrime3 := Temp;π Temp := Round((XPrime3 * CTY) - (ZPrime3 * STY));π ZPrime3 := Round((XPrime3 * STY) + (ZPrime3 * CTY));π XPrime3 := Temp;π Temp := Round((XPrime3 * CTZ) - (YPrime3 * STZ));π YPrime3 := Round((XPrime3 * STZ) + (YPrime3 * CTZ));π XPrime3 := Temp;π Temp := Round((YPrime4 * CTX) - (ZPrime4 * STX));π ZPrime4 := Round((YPrime4 * STX) + (ZPrime4 * CTX));π YPrime4 := Temp;π Temp := Round((XPrime4 * CTY) - (ZPrime4 * STY));π ZPrime4 := Round((XPrime4 * STY) + (ZPrime4 * CTY));π XPrime4 := Temp;π Temp := Round((XPrime4 * CTZ) - (YPrime4 * STZ));π YPrime4 := Round((XPrime4 * STZ) + (YPrime4 * CTZ));π XPrime4 := Temp;π { Translate Coords }π XPrime1 := PolyHead^.X + XPrime1;π YPrime1 := PolyHead^.Y + YPrime1;π ZPrime1 := PolyHead^.Z + ZPrime1;π XPrime2 := PolyHead^.X + XPrime2;π YPrime2 := PolyHead^.Y + YPrime2;π ZPrime2 := PolyHead^.Z + ZPrime2;π XPrime3 := PolyHead^.X + XPrime3;π YPrime3 := PolyHead^.Y + YPrime3;π ZPrime3 := PolyHead^.Z + ZPrime3;π XPrime4 := PolyHead^.X + XPrime4;π YPrime4 := PolyHead^.Y + YPrime4;π ZPrime4 := PolyHead^.Z + ZPrime4;π { Translate 3D Vectorspace to 2D Framespace }π CalcX1 := 160 + ((LongInt(XPrime1)*ViewerDist) DIVπ (ZPrime1+ViewerDist));π CalcY1 := 100 + ((LongInt(YPrime1)*ViewerDist) DIVπ (ZPrime1+ViewerDist));π CalcX2 := 160 + ((LongInt(XPrime2)*ViewerDist) DIVπ (ZPrime2+ViewerDist));π CalcY2 := 100 + ((LongInt(YPrime2)*ViewerDist) DIVπ (ZPrime2+ViewerDist));π CalcX3 := 160 + ((LongInt(XPrime3)*ViewerDist) DIVπ (ZPrime3+ViewerDist));π CalcY3 := 100 + ((LongInt(YPrime3)*ViewerDist) DIVπ (ZPrime3+ViewerDist));π CalcX4 := 160 + ((LongInt(XPrime4)*ViewerDist) DIVπ (ZPrime4+ViewerDist));π CalcY4 := 100 + ((LongInt(YPrime4)*ViewerDist) DIVπ (ZPrime4+ViewerDist));π { Draw Shape }π DrawLine (CalcX1, CalcY1, CalcX2, CalcY2, Color);π DrawLine (CalcX2, CalcY2, CalcX3, CalcY3, Color);π DrawLine (CalcX3, CalcY3, CalcX4, CalcY4, Color);π DrawLine (CalcX4, CalcY4, CalcX1, CalcY1, Color);π DrawPolyFromList (PolyList^, WorkPage^, Color);π CurrentFacet := CurrentFacet^.NextFacet;π End;πEnd;π{-[ Build Background ]-----------------------------------------------------}πProcedure BuildBackground (Var BufferIn : VGAArray);πVar CounterX,π CounterY : Integer;πBeginπ For CounterY := 0 to 199 doπ For CounterX := 0 to 319 doπ BufferIn[CounterY, CounterX] := 1 + ((CounterY MOD 5) * 5) +π (CounterX MOD 5);πEnd;π{-[ Build Palette ]--------------------------------------------------------}πProcedure BuildPalette (Var PaletteOut : PaletteType);πConst BC = 16;πVar Counter1,π Counter2 : Integer;πBeginπ FillChar (PaletteOut, SizeOf(PaletteOut), 0);π For Counter1 := 0 to 4 doπ For Counter2 := 1 to 2 doπ Beginπ PaletteOut[1+(Counter1 * 5)+Counter2].Red := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+Counter2].Green := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+Counter2].Blue := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+4-Counter2].Red := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+4-Counter2].Green := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+4-Counter2].Blue := BC+(Counter2 * 5);π End;π For Counter1 := 0 to 4 doπ Beginπ If PaletteOut[1+(5 * 1)+Counter1].Red < BC + 5π Thenπ Beginπ PaletteOut[1+(5 * 1)+Counter1].Red := BC + 5;π PaletteOut[1+(5 * 1)+Counter1].Green := BC + 5;π PaletteOut[1+(5 * 1)+Counter1].Blue := BC + 5;π PaletteOut[1+(5 * 3)+Counter1].Red := BC + 5;π PaletteOut[1+(5 * 3)+Counter1].Green := BC + 5;π PaletteOut[1+(5 * 3)+Counter1].Blue := BC + 5;π End;π PaletteOut[1+(5 * 2)+Counter1].Red := BC + 10;π PaletteOut[1+(5 * 2)+Counter1].Green := BC + 10;π PaletteOut[1+(5 * 2)+Counter1].Blue := BC + 10;π End;π For Counter1 := 0 to 24 doπ Beginπ PaletteOut[32+Counter1].Red := ((PaletteOut[Counter1].Red* 8)+π (26 * 24)) DIV 32;π PaletteOut[32+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+π (0 * 24)) DIV 32;π PaletteOut[32+Counter1].Blue := ((PaletteOut[Counter1].Blue* 8)+π (0 * 24)) DIV 32;π PaletteOut[64+Counter1].Red := ((PaletteOut[Counter1].Red* 8)+π (0 * 24)) DIV 32;π PaletteOut[64+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+π (26 * 24)) DIV 32;π PaletteOut[64+Counter1].Blue := ((PaletteOut[Counter1].Blue* 8)+π (0 * 24)) DIV 32;π PaletteOut[128+Counter1].Red := ((PaletteOut[Counter1].Red* 8)+π (0 * 24)) DIV 32;π PaletteOut[128+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+π (0 * 24)) DIV 32;π PaletteOut[128+Counter1].Blue := ((PaletteOut[Counter1].Blue* 8)+π (26 * 24)) DIV 32;π PaletteOut[32+64+Counter1].Red := ((PaletteOut[Counter1].Red* 6)+π (23 * 26)) DIV 32;π PaletteOut[32+64+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+π (23 * 26)) DIV 32;π PaletteOut[32+64+Counter1].Blue := ((PaletteOut[Counter1].Blue* 6)+π (0 * 26)) DIV 32;π PaletteOut[32+128+Counter1].Red := ((PaletteOut[Counter1].Red* 6)+π (23 * 26)) DIV 32;π PaletteOut[32+128+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+π (0 * 26)) DIV 32;π PaletteOut[32+128+Counter1].Blue := ((PaletteOut[Counter1].Blue* 6)+π (23 * 26)) DIV 32;π PaletteOut[64+128+Counter1].Red := ((PaletteOut[Counter1].Red* 6)+π (0 * 26)) DIV 32;π PaletteOut[64+128+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+π (23 * 26)) DIV 32;π PaletteOut[64+128+Counter1].Blue := ((PaletteOut[Counter1].Blue* 6)+π (23 * 26)) DIV 32;π End;πEnd;π{-[ Move Background by Moving Palette ]------------------------------------}πProcedure MoveBackground (Var PaletteIn : PaletteType);πVar TempPal : Array[0..5] of PaletteRec;πBeginπ {-- Move Background Colors --}π Move (PaletteIn[1], TempPal[0], 5 * 3);π Move (PaletteIn[1+5], PaletteIn[1], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[1 + (5 * 4)], 5 * 3);π {-- Move See-Through Colors --}π { Red }π Move (PaletteIn[32], TempPal[0], 6 * 3);π Move (PaletteIn[32+5], PaletteIn[32], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[32 + (5 * 4)], 6 * 3);π { Green }π Move (PaletteIn[64], TempPal[0], 6 * 3);π Move (PaletteIn[64+5], PaletteIn[64], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[64 + (5 * 4)], 6 * 3);π { Blue }π Move (PaletteIn[128], TempPal[0], 6 * 3);π Move (PaletteIn[128+5], PaletteIn[128], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[128 + (5 * 4)], 6 * 3);π { Red + Green }π Move (PaletteIn[(32 OR 64)], TempPal[0], 6 * 3);π Move (PaletteIn[(32 OR 64)+5], PaletteIn[(32 OR 64)], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[(32 OR 64) + (5 * 4)], 6 * 3);π { Red + Blue }π Move (PaletteIn[(32 OR 128)], TempPal[0], 6 * 3);π Move (PaletteIn[(32 OR 128)+5], PaletteIn[(32 OR 128)], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[(32 OR 128) + (5 * 4)], 6 * 3);π { Green + Blue }π Move (PaletteIn[(64 OR 128)], TempPal[0], 6 * 3);π Move (PaletteIn[(64 OR 128)+5], PaletteIn[(64 OR 128)], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[(64 OR 128) + (5 * 4)], 6 * 3);πEnd;π{-[ Set Palette ]----------------------------------------------------------}πProcedure SetPalette (Var PaletteIn : PaletteType); Assembler;πASMπ PUSH DSπ LDS SI, PaletteIn { Sets whole palette at once... }π MOV CX, 256 * 3 { *NOT* good practice since many VGA }π MOV DX, 03DAh { cards will show snow at the top of }π @WaitNotVSync: { of the screen. It's done here }π IN AL, DX { 'cause the background animation }π AND AL, 8 { requires large ammounts of the }π JNZ @WaitNotVSync { palette to be updated every new }π @WaitVSync: { frame. }π IN AL, DXπ AND AL, 8π JZ @WaitVSyncπ XOR AX, AXπ MOV DX, 03C8hπ OUT DX, ALπ INC DXπ @PaletteLoop:π LODSBπ OUT DX, ALπ LOOP @PaletteLoopπ POP DSπEnd;π{=[ Main Program ]=========================================================}πVar Polygon1 : PolyHPtr;πBeginπ VGAMEM := Ptr($A000, $0000);π New (WorkPage);π New (BkgPage);π New (Palette);π New (PolyList);π ClearPolyList (PolyList^);π GoMode13h;π BuildBackground (BkgPage^);π BuildPalette (Palette^);π SetPalette (Palette^);π Polygon1 := Nil;π InitializePolygon (Polygon1, { Polygon List Head }π 0, 0, 60, { X, Y, Z of polygon }π 0, 0, 0); { Iniitial Roll, Pitch, Yaw }π AddFacet (Polygon1, { Polygon List Head }π 32, { Color }π -40, -40, 50, { One Corner of Polygon }π 40, -40, 50, { Second Corner of Polygon }π 40, 40, 50, { Third Corner of Polygon }π -40, 40, 50); { Last Corner of Polygon }π AddFacet (Polygon1,π 64,π -50, -40, -40,π -50, -40, 40,π -50, 40, 40,π -50, 40, -40);π AddFacet (Polygon1,π 128,π 40, -50, -40,π 40, -50, 40,π -40, -50, 40,π -40, -50, -40);π Repeatπ { Clear Workpage }π WorkPage^ := BkgPage^;π ClearPolyList (PolyList^);π DrawPolygon3D (Polygon1, { Polygon Definition }π WorkPage); { Work buffer }π MoveBackground (Palette^);π SetPalette (Palette^);π { Display Work Buffer }π VGAMEM^ := WorkPage^;π RotatePolygon (Polygon1,π 5, 10, 1);π Until Keypressed;π DisposePolygon (Polygon1);π Dispose (PolyList);π Dispose (Palette);π Dispose (BkgPage);π Dispose (WorkPage);π TextMode (C80);πEnd.π 130 08-24-9417:53ALL GARTH KRUMINS GRAPHICS ROUTINES SWAG9408 5 12 ╓ {here are some assembler routines for the 320x200x256 mode.}ππusesπ crt;ππPROCEDURE InitVGA; ASSEMBLER;πasmπ mov ax, 13hπ int 10hπend;ππPROCEDURE InitTEXT; ASSEMBLER;πasmπ mov ax, 03hπ int 10hπend;ππPROCEDURE PlotPixel1(X, Y: Word; Color: Byte); ASSEMBLER;πasmπ push esπ push diπ mov ax, Yπ mov bx, axπ shl ax, 8π shl bx, 6π add ax, bxπ add ax, Xπ mov di, axπ mov ax, $A000π mov es, axπ mov al, Colorπ mov es:[di], alπ pop diπ pop esπend;ππPROCEDURE PlotPixel2(X, Y : word; Color : byte);πbeginπ if (X<320) then if (Y<200) then mem[$A000: Y*320+X] := color;πend;πππPROCEDURE SetColor (ColorNo, Red, Green, Blue : byte);πbeginπ PORT[$3C8] := ColorNo;π PORT[$3C9] := Red;π PORT[$3C9] := Green;π PORT[$3C9] := Blue;πend;πππvarπ LoopX : word;π LoopY, R, G, B, i : byte;π Ky : char;ππBeginπ Randomize;π InitVGA;π for LoopY := 0 to 199 doπ beginπ for LoopX := 0 to 319 doπ PlotPixel1(LoopX, LoopY, random(255)+1);π end;π B := 0;π repeatπ G := random(63);π for R := 0 to 63 doπ beginπ Setcolor(random(255)+1, R, G, B);π inc(G, 1);π if G=64 then G := 0;π end;π for G := 63 downto 0 doπ R := random(63);π beginπ Setcolor(random(255)+1, R, G, B);π dec(R, 1);π if R=0 then R := 63;π end;π inc(B, random(10)-5);π if B>63 then B := random(63);π until keypressed;π Ky := readkey;π InitTEXT;πend.πππ 131 08-24-9417:54ALL RICH VERAA Save/Restore Graphics SWAG9408 =Σ3 11 ╓ ππProcedure GetImage (X1,Y1,X2,Y2:Integer;P:Pointer); assembler;πasmπ mov bx,320π push dsπ les di,Pππ mov ax,0A000hπ mov ds,axπ mov ax,Y1π mov dx,320π mul dxπ add ax,X1π mov si,axππ mov ax,X2π sub ax,X1π inc axπ mov dx,axπ stoswππ mov ax,Y2π sub ax,Y1π inc axπ stoswπ mov cx,axππ @@1:π mov cx,dxππ shr cx,1π cldπ rep movswππ test dx,1π jz @@2π movsbπ @@2:π add si,bxπ sub si,dxππ dec axπ jnz @@1ππ pop dsπend;ππProcedure PutImage (X1,Y1:Integer;P:Pointer); assembler;πasmπ mov bx,320π push dsπ lds si,Pππ mov ax,0A000hπ mov es,axπ mov ax,Y1π mov dx,320π mul dxπ add ax,X1π mov di,axππ lodswπ mov dx,axππ lodswππ @@1:π mov cx,dxππ shr cx,1π cldπ rep movswππ test dx,1π jz @@2π movsbπ @@2:π add di,bxπ sub di,dxππ dec axπ jnz @@1ππ pop dsπend;ππProcedure Init;πbeginπ GetMem (Buf1,64000);π GetMem(Buf2,64000);πend;ππbeginπ init;π dographicstuff;ππ GetImage( 0,0,319,199,Buf1); {store page 1}ππ domoregraphicstuff;ππ GetImage( 0,0,319,199,Buf2); {store page 2}ππ PutImage (0,0, Buf1); {restore page 1}ππend.π 132 08-24-9417:55ALL LUIS MEZQUITA X3dunit SWAG9408 w¼è 78 ╓ unit x3dunit2;ππ{ mode-x 3D unit - xhlin-procedure by Sean Palmer }π{ Optimized by Luis Mezquita Raya }ππ{$g+}ππinterfaceππconst vidseg:word=$a000;π divd:word=128;π dist:word=200;π minx:word=0;π maxx:word=319;π border:boolean=false;ππvar ctab:array[byte] of integer;π stab:array[byte] of integer;π address:word;π triangles:boolean;ππProcedure setborder(col:byte);πProcedure setpal(c,r,g,b:byte);πProcedure retrace;πProcedure setmodex;πProcedure setaddress(ad:word);πProcedure cls;πProcedure polygon(x1,y1,x2,y2,x3,y3,x4,y4:integer; c:byte);πFunction cosinus(i:byte):integer;πFunction sinus(i:byte):integer;ππimplementationππvar xpos:array[0..199,0..1] of integer;ππProcedure setborder(col:byte); assembler;πasmπ xor ch,chπ mov cl,borderπ jcxz @outπ mov dx,3dahπ in al,dxπ mov dx,3c0hπ mov al,11h+32π out dx,alπ mov al,colπ out dx,alπ@out:πend;ππProcedure setpal(c,r,g,b:byte); assembler;πasmπ mov dx,3c8hπ 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,3dah;π@vert1: in al,dxπ test al,8π jz @vert1π@vert2: in al,dxπ test al,8π jnz @vert2πend;ππProcedure setmodex; assembler;πasmπ mov ax,13hπ int 10hπ mov dx,3c4hπ mov ax,0604hπ out dx,axπ mov ax,0f02hπ out dx,axπ mov cx,320*200π mov es,vidsegπ xor ax,axπ mov di,axπ rep stoswπ mov dx,3d4hπ mov ax,0014hπ out dx,axπ mov ax,0e317hπ out dx,axπend;ππProcedure setaddress(ad:word); assembler;πasmπ mov dx,3d4hπ mov al,0chπ mov ah,[byte(ad)+1]π out dx,axπ mov al,0dhπ mov ah,[byte(ad)]π out dx,axπend;ππProcedure cls; assembler;πasmπ mov es,vidsegπ mov di,addressπ mov cx,8000π mov dx,3c4hπ mov ax,0f02hπ out dx,axπ xor ax,axπ rep stoswπend;ππ{$f-}ππProcedure polygon(x1,y1,x2,y2,x3,y3,x4,y4:integer; c:byte); assembler;πvar mny,mxy,y,m,mult,divi,top,s,π stb,px1,py1,px2,py2:integer;π dir:byte;πasm { Procedure Polygon }π mov ax,y1 { Determine lowest & highest points }π mov cx,axπ mov bx,y2ππ cmp ax,bx { if mny>y2 ==> mny:=y2 }π jl @p2π mov ax,bxππ@p2: cmp cx,bx { if mxy<y2 ==> mxy:=y2 }π jg @p3π mov cx,bxππ@p3: mov bx,y3π cmp ax,bx { if mny>y3 ==> mny:=y3 }π jl @p3Mπ mov ax,bxππ@p3M: cmp cx,bx { if mxy<y3 ==> mxy:=y3 }π jg @p4π mov cx,bxππ@p4: mov bx,y4π cmp ax,bx { if mny>y4 ==> mny:=y4 }π jl @p4Mπ mov ax,bxππ@p4M: cmp cx,bx { if mxy<y4 ==> mxy:=y4 }π jg @vertπ mov cx,bxππ@vert: cmp ax,0 { Vertical range checking }π jge @minin { if mny<0 ==> mny:=0 }π xor ax,axπ@minin: cmp cx,200 { if mxy>199 ==> mxy:=199 }π jl @maxinπ mov cx,199π@maxin: cmp cx,0 { if mxy<0 ==> Exit }π jl @pexitπ cmp ax,199 { if mny>199 ==> Exit }π jg @pexitππ mov mny,ax { ax=mny=lowest point }π mov mxy,cx { cx=mxy=highest point }ππ push x1 { RangeChk(x1,y1,x2,y2) }π push y1π push x2π push y2π call @Rangeππ push x2 { RangeChk(x2,y2,x3,y3) }π push y2π push x3π push y3π call @Rangeππ push x3 { RangeChk(x3,y3,x4,y4) }π push y3π cmp Triangles,0π jz @Poly4π push x1π push y1π jmp @Lastππ@Poly4: push x4π push y4π call @Rangeππ push x4 { RangeChk(x4,y4,x1,y1) }π push y4π push x1π push y1π@Last: call @Rangeππ mov ax,mny { Show a poly }π mov di,ax { y:=mny }π shl di,2π lea bx,xposπ add di,bx { di points to xpos[y,0] }π@Show: mov y,ax { repeat ... }π mov cx,[di]π mov dx,[di+2]π mov px1,cxπ mov px2,dxπ push axπ push diπ call @xhlin { xhlin(px1,px2,y,c) }π pop diπ pop axπ add di,4 { Next xpos }π inc ax { inc(y) }π cmp ax,mxy { ... until y>mxy; }π jle @Showπ jmp @pexitππ{ RangeChk }ππ@Range: pop di { Get return IP }π pop py2 { Get params }π pop px2π pop py1π pop px1π push di { Save return IP }ππ mov ax,py1 { dir:=byte(y1<y2) }π cmp ax,py2π mov ax,1π jl @Rdwnπ dec alπ@Rdwn: mov dir,alππ shl al,1π push axπ shl al,2π sub ax,4π mov stb,ax { stb:=8*dir-4 }π pop axπ dec ax { s:=2*dir-1 }π mov s,ax { Check directions (-1= down, 1=up) }ππ test AH,10000000b { Calculate constants }π mov dx,0π jz @Rposiπ dec dxπ@Rposi: mov bx,px2π sub bx,px1π imul bxπ mov mult,ax { mult:=s*(x2-x1) }π mov ax,py2π mov bx,py1π mov cx,axπ sub ax,bxπ mov divi,ax { divi:=y2-y1 }ππ cmp bx,cx { ¿y1=y2? }ππ pushf { Calculate pointer to xpos[y,dir] }π mov y,bx { y:=y1 }π mov di,bxπ shl di,2π lea bx,xposπ add di,bxπ mov cl,dirπ mov ch,0π shl cl,1π add di,cx { di points to xpos[y,dir] }π popfππ je @Requ { if y1=y2 ==> @Requ }ππ mov m,0 { m:=0 }π mov ax,py2π add ax,sπ mov top,ax { top:=y2+s }ππ@RLoop: mov ax,y { repeat ... }π cmp ax,mny { if y<mny ==> @RNext }π jl @RNextπ cmp ax,mxy { if y>mxy ==> @RNext }π jg @RNextππ mov ax,m { Calculate int(m/divi)+x1 }π test AH,10000000bπ mov dx,0π jz @RLposπ dec dxπ@RLpos: mov bx,diviπ idiv bxπ add ax,px1π call @HR { HorRangeChk(m div divi+x1) }ππ@RNext: mov ax,multπ add m,ax { inc(m,mult) }π add di,stb { Next xpos }π mov ax,y { inc(y,s) }π add ax,sπ mov y,axπ cmp ax,topπ jne @RLoop { ... until y=top }π jmp @Rexitππ@Requ: mov ax,yπ cmp ax,mny { if y<mny ==> Exit }π jl @Rexitπ cmp ax,mxy { if y>mxy ==> Exit }π jg @Rexitπ mov ax,px1π call @HR { HorRangeChk(px1) }π@Rexit: jmp @exitππ{ HorRangeChk }ππ@HR: mov bx,minx { bx:=minx }π cmp ax,bxπ jl @HRsavπ mov bx,maxx { bx:=maxx }π cmp ax,bxπ jg @HRsavπ mov bx,axπ@HRsav: mov [di],bx { xpos[y,dir]:=bx }π jmp @exitπ{ xhlin }ππ@xhlin: mov es,vidsegπ cldπ mov ax,80π mul yπ mov di,ax { base of scan line }π add di,addressππ mov bx,px1 { px1 = x begin coord }π mov dx,px2 { px2 = x end coord }π cmp bx,dxπ jb @skipπ xchg bx,dx { switch coords if px1>px2 }ππ@skip: mov cl,blπ shr bx,2π 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,1111b { left edge mask }π mov cl,chπ mov bh,$f1π rol bh,clπ and bh,1111b { right edge mask }π mov cx,dxπ or cx,cxπ jnz @leftπ and ah,bh { combine left & right bitmasks }ππ@left: mov dx,$03c4π out dx,axπ inc dxπ mov al,cπ stosbπ jcxz @exitπ dec cxπ jcxz @rightπ mov al,1111bπ out dx,al { skipped if cx=0,1 }π mov al,cπ repz stosb { fill middle Bytes }ππ@right: mov al,bhπ out dx,al { skipped if cx=0 }π mov al,cπ stosbππ@exit: pop axπ push csπ push axπ retπ@pexit:πend;ππ{$f+}ππFunction cosinus(i:byte):integer;πbeginπ cosinus:=ctab[i];πend;ππFunction sinus(i:byte):integer;πbeginπ sinus:=stab[i];πend;ππProcedure Initialize;πvar i:byte;πbeginπ triangles:=False;π for i:=0 to 255 do ctab[i]:=round(-cos(i*pi/128)*divd);π for i:=0 to 255 do stab[i]:=round(sin(i*pi/128)*divd);πend;ππbeginπ Initialize;πend.π 133 08-24-9417:56ALL ANDREW GOLOVIN X-mode Write Mode ExampleSWAG9408 äΦ¼ù 31 ╓ π{ Illustration on how VGA Write Mode 1 works }π{ by Andrew Golovin (2:5080/10@Fidonet) }π{ Can be used at your own risk freely w/o }π{ any charge }π{============================================}π{ PREFACE: }π{ This example illustrate posibility to save }π{ Bitmaps in unused VRam. And use VWM1 to }π{ restore it by 4 pixels at one byte }π{ Use arrows to move "bitmap" on screen. }π{ This example _only_ illustrate this mode }π{ Extremly needs optimization! Don't use it }π{ as is. Just an idea. }ππUses CRT;πvarπ OldMode: Byte;ππprocedure SetWriteMode(Wmode: Byte); assembler;πasmπ Mov DX,3cehπ Mov AL,5π Out DX,ALπ Inc DXπ In AL,DXπ And AL,11111100bπ Or AL,WModeπ Out DX,ALπend;ππprocedure Init320x200_X; assembler;πasmπ Mov AH,0fh; Int 10h; Mov [OldMode],al; Mov AX,13h; Int 10h;π Mov DX,3c4h; Mov AL,04h; Out DX,AL; Inc DX; In AL,DX; And AL,011110111b;π Or AL,000000100b; Out DX,AL; Dec DX; Mov AX,0f02h; Out DX,AX;π Mov AX,0a000h; Mov ES,AX; XOr DI,DI; Mov AX,0202h; Mov CX,8000h;π ClD; RepNZ StoSW; Mov DX,3d4h; Mov AL,14h; Out DX,AL; Inc DX;π In AL,DX; And AL,010111111b; Out DX,AL; Dec DX; Mov AL,017h;π Out DX,AL; Inc DX; In AL,DX; Or AL,01000000b; Out DX,AL; Mov DX,3d4h;π Mov AX,80; ShR AX,1; Mov AH,AL; Mov AL,13h; Out DX,AX; Retπend;ππProcedure PutPixel(x,y: Word; c: Byte);π beginπ asmπ Mov DX,3c4hπ Mov AL,02π Out DX,ALπ Mov AX,Yπ ShL AX,4π Mov DI,AXπ ShL AX,2π Add DI,AXπ Mov AX,Xπ ShR AX,2π Add DI,AXπ Mov AX,Xπ And AX,3π Mov CL,ALπ Mov AL,1π ShL AL,CLπ Inc DXπ Out DX,ALπ Mov AX,0a000hπ Mov ES,AXπ Mov AL,Cπ StoSBπ end;π end;ππprocedure MaskBits(BitsToMask: Byte); assembler;π asmπ Mov DX,3cehπ Mov AL,8π Mov AH,BitsToMaskπ Out DX,AXπ end;ππProcedure MaskPlanes(PlaneToMask: Byte); assembler;πasmπ Mov DX,3c4hπ Mov AL,2π Out DX,ALπ Inc DXπ Mov AL,PlaneToMaskπ Out DX,ALπEnd;ππProcedure StoreBack(x,y,w,h: word; toAddr: word);π varπ curx,cury: Word;π beginπ SetWriteMode(1);π MaskPlanes($f);π MaskBits($ff);π For CurY:=Y to Y+H doπ Move(Mem[$a000:CurY*80+x],Mem[$a000:toAddr+(CurY-Y)*W],w);π SetWriteMode(0);π end;ππProcedure RestoreBack(x,y,w,h: word; fromAddr: Word);π varπ cury,curx: Word;π beginπ SetWriteMode(1);π MaskPlanes($f);π MaskBits($ff);π For CurY:=Y to Y+H doπ Move(Mem[$a000:fromAddr+(CurY-Y)*W],Mem[$a000:CurY*80+x],w);π SetWriteMode(0);π end;ππvarπ x,y: Word;π curx,cury: Word;π c: Char;πBeginπ Init320x200_x;π For x:=0 to 319 doπ For y:=0 to 199 doπ PutPixel(x,y,(x +y) mod 16+16);π StoreBack(0,0,3,12,16000);π For x:=0 to 11 doπ For y:=0 to 11 doπ PutPixel(x,y,Random(255));π StoreBack(0,0,3,12,16200);π CurX:=0;CurY:=0;π Repeatπ Repeat Until KeyPressed;π c:=ReadKey;π If c=#0π thenπ beginπ RestoreBack(CurX,CurY,3,12,16000);π c:=ReadKey;π Case c ofπ #80: If CurY<187π thenπ Inc(CurY);π #72: If CurY>0π Thenπ Dec(CurY);π #75: If CurX>0π Thenπ Dec(CurX);π #77: If CurX<77π Thenπ Inc(CurX);π end;π StoreBack(CurX,CurY,3,12,16000);π RestoreBack(CurX,CurY,3,12,16200);π end;π Until c=#27;π asm Mov al,OldMode; XOr AH,AH; Int 10h end;πEnd.ππ 134 08-25-9409:07ALL KIMMO K K FREDRIKSSON Fastest Putpixel? SWAG9408 Ö║3 22 ╓ (*πFrom: kfredrik@cc.Helsinki.FI (Kimmo K K Fredriksson)ππ: > This routine, from off the net somewhere, is a little fasterπ: > than simply writing to MEM (it replaces the multiply by aπ: > shift).π: Wilbert van Leijen and I once wrote a similar thing like this as an InLineπ: macro, which turned out to be the true fastest code (ok, never say...)ππ: Procedure PutPixel18(c: Byte; x,y: Integer);π: Inline(π: $B8/$00/$A0/ { mov AX,$A000 }π: $8E/$C0/ { mov ES,AX }π: $5B/ { pop BX }π: $88/$DC/ { mov AH,BL }π: $5F/ { pop DI }π: $01/$C7/ { add DI,AX }π: {$IFOPT G+}π: $C1/$E8/$02/ { shr AX,2 }π: {$ELSE}π: $D1/$E8/ { shr AX,1 }π: $D1/$E8/ { shr AX,1 }π: {$ENDIF}π: $01/$C7/ { add DI,AX }π: $58/ { pop AX }π: $AA); { stosb }ππ: I'd be real interested in seeing a PutPixel (remember: one pixel only, not aπ: line, that's another story) that is faster than this one...ππThis is fast indeed, but the last instruction should be replaced atπleast in 486 and Pentium CPUs with instruction mov es:[di],al, whichπis faster than stosb (and you may also want to re-arrange them).ππAlso, the shift and add sequence could be replaced by table look-up,πbut that wouldn't be so elegant, only faster. So if you wanna stickπwith arithmetic address calculation, you could use 32-bit instructions,πsomething like this:ππ mov es,[SegA000]π pop diπ pop bxπ pop axπ shl di,6π lea edi,[edi*4+edi]π mov es:[edi+ebx],alπ πIf I use 32-bit instructions, I usually zero data registers in theπinitialization part of my program, so I can use those registersπin the situations like above without the need to every time zeroπthe high bits.ππYou may also use fs or gs register instead of es, because you mayπalways keep it pointing to video RAM, instead of loading it everyπtime you do PutPixel.ππThis may go beyond the topic, but what the heck: usually I try toπuse the offset of the screen mem as the parameter of these kind ofπprocedures, because it removes the need of address calculation:π*)πPROCEDURE PutPixel( offset : Word; c : Byte );π INLINE(π pop axπ pop diπ mov fs,[di],alπ);π(*πIt is still very easy to use the offset instead of the (x,y)πposition, if you want the next x-pix, add one to offset, ifπyou want the next y-pix, add 320 to offset.ππSorry, but I was too lazy to calc the hex values :-(ππAnd never say that you have the absolutely fastest code ;-)π*)π 135 08-25-9409:08ALL YUAN LIU Virtual world plotting SWAG9408 -G 38 ╓ {πFrom: yliu@morgan.ucs.mun.ca (Yuan Liu)ππ: I have a question for drawing a graphic. I have a set of data.π: I want to read these data and plot them in the XY axes. Does anyoneπ: know how to caculate the data to fit the X axis. I am using TP 7.0.ππWhen converting from HP Pascal, which provides a nice subset of theπdevice-independent graphics kernal and allows plotting in the virtual worldπ(so the window and viewport can be set in the virtual world), I wroteπseveral procedures to simulate virtual world plotting. The following isπpart of a unit Plotbase I created.ππThe function you needed is set_window; the boolean pagefit controlsπwhether you just want your plot to fit in the whole window or there's a concernπabout the isotropy of the plot. I didn't bother to write a virtualπworld set_viewport as I can live without it.ππ}πUNIT PLOTBASE; {******************* Stored in 'PLOTBASE' ******************}π{* Basic procedures for graphical manipulations. *}π{* Created in 1983. Updated 17/05/94 10:00 a.m. By LIU Yuan *}π{**************************************************************************}πinterface USES Graph;πprocedure set_window(left, right, up, down: extended; pagefit: boolean);π {Sets a mapping of virtual window on the current viewport;π use isotropic scaling if not pagefit.}πfunction vToX(x: extended): integer;πfunction vToY(y: extended): integer;π {Map x, y in the virtual world onto real world}πfunction XtoV(X: integer): extended;πfunction YtoV(Y: integer): extended;π {Maps X, Y in the real world onto virtual world}π use isotropic scaling if not pagefit.πprocedure vMove(x, y: extended);π {Moves the current position to (x,y) in the virtual world}πprocedure vMoveRel(Dx, Dy: extended);π{Moves the current position a relative distance in the virtual world}πprocedure vLine(x1, y1, x2, y2: extended);π {Draws a line from (x1,y1) to (x2,y2) in the virtual world}πprocedure vLineTo(x, y: extended);π {Draws a line from current position to (x,y) in the virtual world}πfunction str_width(str: string): extended; {string width in the virtual world}πfunction str_height(str: string): extended; {string height in the virtualπworld}πimplementation {************************** PLOTBASE *************************}π var Text: string[20];π xasp, yasp, xbase, ybase: extended;π {convert from virtual world to display}ππprocedure set_window(left, right, up, down: extended; pagefit: boolean);π {Sets a mapping of virtual window on the current viewport;π use isotropic scaling if not pagefit.π Side effects: xasp, yasp, xbase, ybase.}πvar view: ViewPortType;πbegin xbase:=left; ybase:=down; right:=right-left; up:=up-down;π GetViewSettings(view);π right:=(view.x2-view.x1)/right;π up:=(view.y2-view.y1)/up;π if pagefit then begin xasp:=right; yasp:=up endπ else if right<up then begin yasp:=right; xasp:=right; endπ else begin xasp:=up; yasp:=up endπend; {set_window}ππfunction vToX(x: extended): integer;begin vToX:=round((x-xbase)*xasp) end;π {Maps x in the virtual world onto real world}πfunction vToY(y: extended): integer;begin vToY:=round((y-ybase)*yasp) end;π {Maps x in the virtual world onto real world}ππfunction XtoV(X: integer): extended; begin XtoV:=X/xasp+xbase end; {XtoV}π {Maps X in the real world onto virtual world}πfunction YtoV(Y: integer): extended; begin YtoV:=Y/yasp+ybase end; {YtoV}π {Maps Y in the real world onto virtual world}ππprocedure vMove(x, y: extended);π {Moves the current position to (x,y) in the virtual world}πbegin MoveTo(round((x-xbase)*xasp),round((y-ybase)*yasp)) end; {vMove}πprocedure vMoveRel(Dx, Dy: extended);π{Moves the current position a relative distance in the virtual world}πbegin MoveRel(round(Dx*xasp),round(Dy*yasp)) end; {vMoveRel}ππprocedure vLine(x1, y1, x2, y2: extended);π {Draws a line from (x1,y1) to (x2,y2) in the virtual world}πbegin line(round((x1-xbase)*xasp),round((y1-ybase)*yasp),π round((x2-xbase)*xasp),round((y2-ybase)*yasp)) end; {vLine}ππprocedure vLineTo(x, y: extended);π {Draws a line from current position to (x,y) in the virtual world}πbegin LineTo(round((x-xbase)*xasp),round((y-ybase)*yasp)) end; {vLineTo}ππfunction str_width(str: string): extended; {string width in the virtual world}πbegin str_width:=TextWidth(str)/xasp end; {str_width}ππfunction str_height(str: string): extended; {string height in the virtualπworld}πbegin str_height:=TextHeight(str)/yasp end; {str_height}π 136 08-25-9409:11ALL MIKE CHURCH Stars AGAIN!!!! SWAG9408 ëcè╛ 31 ╓ {πOk... Here goes. You will have to figure out how to TSR this if youπwant... But you can navigate in this one too! TP v6.0π}ππprogram stars;π{$R-}π{$S-} {dangerous, but it's pretty well debugged}π{$G+}πuses crt;πconst MaxStars=1000; { OK for 486-33. Decrease for slower computers}π xltsin:integer=0;π xltcos:integer=round((1-(640/32767)*(640/32767))*32767);π yltsin:integer=0;π yltcos:integer=round((1-(640/32767)*(640/32767))*32767);π zltsin:integer=0;π zltcos:integer=round((1-(640/32767)*(640/32767))*32767);π {rotation parameters, 16-bit.}π speed:word=264; {speed of movement thru starfield}πconst XWIDTH = 320; { basic screen size stuff used for star animation.}πconst YWIDTH = 200;πconst XCENTER = ( XWIDTH div 2 );πconst YCENTER = ( YWIDTH div 2 );πtype STARtype=recordπ x,y,z:integer; {The x, y and z coordinates}π xz,yz:integer; { screen coords}π end;πvar star:array[1..maxstars] of startype;π i:integer;π ch:char;π rotx,roty,rotz:boolean;π rotxv,rotyv,rotzv:integer;πprocedure setmode13; {sets 320*200 256-colour mode}πassembler;πasmπ mov ax,13hπ int 10hπend;πprocedure settextmode; {returns to text mode}πassembler;πasmπ mov ax,03hπ int 10hπend;πprocedure setpix(x,y:integer;c:byte); {NO BOUNDARY CHECKING!}πbegin {Sets a pixel in mode 13h}πasmπ mov ax,0a000hπ mov es,axπ mov ax,yπ mov bx,320π mul bxπ mov di,xπ add di,axπ mov al,cπ mov es:[di],alπend;πend;πprocedure initstar(i:integer); {initialise stars at random positions}πbeginπ with star[i] doπ beginπ x := longint(-32767)+random(65535);π y := longint(-32767)+random(65535); {at rear}π z := random(16000)+256;π xz:=xcenter;π yz:=ycenter;π end;πend;πprocedure newstar(i:integer); {create new star at either front or}πbegin {rear of starfield}π with star[i] doπ beginπ x := longint(-32767)+random(65535);π y := longint(-32767)+random(65535);π if z<256 then z := random(1256)+14500 {kludgy, huh?}π else z:=random(256)+256;π xz:=xcenter;π yz:=ycenter;π end;πend;ππ{$L update.obj}πprocedure update(var star:startype;i:integer);external;πππππbeginπ {gets ~100 frames/sec on a 486-33 with 500 stars,π rotating on 1 axis, speed 256}π clrscr;π checkbreak:=false; { for speed?}π randomize;π for i:=1 to maxstars do initstar(i); {initialise stars}π setmode13;π rotx:=true;roty:=true;rotz:=true;π ch:=' ';π repeatπ for i:=1 to maxstars do update(star[i],i); {update star positions}π if keypressed thenπ beginπ ch:=readkey; { change parameters according to }π if ch='+' then speed:=speed+32; { key pressed}π if ch='-' then speed:=speed-32;π if ch=#13 thenπ beginπ xltsin:=0;π yltsin:=0;π zltsin:=0;π speed:=256;π end;π if ch=#80 then dec(xltsin,96);π if ch=#72 then inc(xltsin,96);π if ch=#77 then dec(yltsin,96);π if ch=#75 then inc(yltsin,96);π if ch=#81 thenπ beginπ dec(yltsin,96);π if xltsin<0 then inc(zltsin,96);π if xltsin>0 then dec(zltsin,96);π end;π if ch=#79 thenπ beginπ inc(yltsin,96);π if xltsin<0 then dec(zltsin,96);π if xltsin>0 then inc(zltsin,96);π end;π if ch=#71 then dec(zltsin,96);π if ch=#73 then inc(zltsin,96);π end;π xltcos:=round((1-sqr(xltsin/32767))*32767);π yltcos:=round((1-sqr(yltsin/32767))*32767); { evaluate cos values}π zltcos:=round((1-sqr(zltsin/32767))*32767);π until ch=#27; {hit ESC to exit}π settextmode;π writeln;πend.π 137 08-25-9409:11ALL BOB SCHOR Storing 3D Graphics SWAG9408 ╖Me∞ 27 ╓ {πFrom: Bschor@vms.cis.pitt.eduππ> Now the problem. "Seek(F, I)" will only take ONE integer at a time!!π> Naturally I need two. I'm trying to run it so that at each virtualπ> "square" a user can define a different message, monster, etc. And theπ> file i'm writing to must be able to define between X & Y, [(1,2) forπ> example], or both of them togeter [E.G. Two steps to the right, two stepsπ> forward = (2,2)]. HOW DO I DO THIS???ππIf I understand the question correctly, you are asking how to map aπtwo-dimensional structure (a 2-D map of your world) into a 1-dimensionalπdata structure (a file). Ah, my ancient Fortran knowledge does come inπuseful ...ππThe following works for arrays of any dimension, though you need toπhave the array size fixed. Suppose you have dimensioned World into R rows,πC columns, and L layers (I'm doing 3-D, just to show how it can be done).πTo make it all very clear, I'll define the world as either a 3-D or linearπstructure, using the Pascal Variant Record type.π}ππCONSTπ rows = 30;π columns = 40;π layers = 5;π rooms = 6000; { rows * columns * layers }πTYPEπ rowtype = 1 .. rows;π columntype = 1 .. columns;π layertype = 1 .. layers;π roomnumbertype = 1 .. rooms;π roomtype = RECORDπ { you define as needed }π END;π worldtype = RECORDπ CASE (d3, d1) ofπ d3 : (spatial: ARRAY [layertype, rowtype, columntype] OF roomtype);π d1 : (linear : ARRAY [roomnumbertype] OF roomtype);π END;π{π Basically, you determine an order you wish to store the data. Supposeπyou say "Start with the first layer, the first row, the first column.πMarch across the columns, then move down a row and repeat across theπcolumns; when you finish a layer, move down to the next layer and repeat".ππ Clearly Layer 1, Row 1, Column C maps to Room C. Since each row hasπ"columns" columns, then the mapping of Layer 1, Row R, Column C is toπRoom (R-1)*columns + C. The full mapping is --π}π FUNCTION roomnumber (layer : layertype; row : rowtype;π column : columntype) : roomnumbertype;ππ BEGIN { roomnumber }π roomnumber := column + pred(row)*columns + pred(layer)*columns*rowsπ END;ππ{ Note you can also map in the other direction:}ππ FUNCTION layer (roomnumber : roomnumbertype) : layertype;ππ BEGIN { layer }π layer := succ (pred(roomnumber) DIV (columns * rows))π END;ππ FUNCTION row (roomnumber : roomnumbertype) : rowtype;ππ BEGIN { row }π row := succ ((pred(roomnumber) MOD (columns * rows)) DIV columns)π END;ππ FUNCTION column (roomnumber : roomnumbertype) : columntype;ππ BEGIN { column }π column := succ (pred(roomnumber) MOD columns)π END;ππ{π Putting it all together, suppose you have a room, "room", with roomπnumber "roomnumber", that you want to put into the world.π}π VAR world : worldtype;π room : roomtype;π roomnumber : roomnumbertype;ππ WITH world DOπ BEGINπ spatial[layer(roomnumber), row(roomnumber), column(roomnumber)] := roomπ END;π{π The above fragment stores a room into the three-dimensional world.πOf course, if you know the room number (which we do), you can also simplyπ}ππ WITH world DO linear[roomnumber] := roomπ{π For the original question, note that the "roomnumber" function givesπyou the record number for the Seek procedure (you may need to offset by 1,πdepending on how Seek is implemented ...).π}π
