DP Tool Club 13/CD_ASCQ_13_0494.iso/news/swag/graphics.swg

Text File | 1994-03-11 | 381KB | 1 lines

SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00082         GRAPHICS ROUTINES                                                 1      05-28-9313:47ALL                      SWAG SUPPORT TEAM        DOTSPIN.PAS              IMPORT              22          program dotspin;ππvar inPort1:word;πprocedure waitRetrace;assembler;asmπ mov dx,inPort1; {find crt status reg (input port #1)}π@L1: in al,dx; test al,8; jnz @L1;  {wait for no v retrace}π@L2: in al,dx; test al,8; jz @L2; {wait for v retrace}π end;ππconstπ tableWriteIndex=$3C8;π tableDataRegister=$3C9;ππprocedure setColor(color,r,g,b:byte);assembler;asm {set DAC color}π mov dx,tableWriteIndex; mov al,color; out dx,al; inc dx;π mov al,r; out dx,al; mov al,g; out dx,al; mov al,b;out dx,al;π end; {write index now points to next color}ππ{plot a pixel in mode $13}πprocedure plot(x,y:word);Inline(π  $5E/                   { pop si  ;y}π  $5F/                   { pop di  ;x}π  $B8/$00/$A0/           { mov ax,$A000}π  $8E/$C0/               { mov es,ax}π  $B8/$40/$01/           { mov ax,320}π  $F7/$E6/               { mul si}π  $01/$C7/               { add di,ax}π  $26/$F6/$15);          {es: not byte[di]}ππprocedure plot4(x,y:word);const f=60;beginπ plot(x+f,y);π plot(199+f-x,199-y);π plot(199+f-y,x);π plot(y+f,199-x);π end;ππprocedure click;assembler;asmπ in al,$61; xor al,2; out $61,al;π end;ππconst nDots=21;ππvarπ dot:array[0..nDots-1]of recordπ  x,y,sx,sy:integer;π  end;ππfunction colorFn(x:integer):byte;beginπ colorFn:=63-(abs(100-x)div 2);π end;ππprocedure moveDots;var i:word;beginπ for i:=0 to nDots-1 do with dot[i] do beginπ  plot4(x,y);π  inc(x,sx);inc(y,sy);π  if(word(x)>200)then beginπ   sx:=-sx;inc(x,sx);click;π   end;π  if(word(y)>199)then beginπ   sy:=-sy;inc(y,sy);click;π   end;π  plot4(x,y);π  end;π waitRetrace;waitRetrace;waitRetrace;{waitRetrace;}π setcolor(255,colorFn(dot[0].x),colorFn(dot[3].x),colorFn(dot[6].x));π end;ππprocedure drawdots;var i:word;beginπ for i:=0 to nDots-1 do with dot[i] do plot4(x,y);π end;ππprocedure initDots;var i,j,k:word;beginπ j:=1;k:=1;π for i:=0 to nDots-1 do with dot[i] do beginπ  x:=100;y:=99;π  sx:=j;sy:=k;π  inc(j);if j>=k then begin j:=1;inc(k); end;π  end;π end;ππfunction readKey:char;Inline(π  $B4/$07/               {mov ah,7}π  $CD/$21);              {int $21}ππfunction keyPressed:boolean;Inline(π  $B4/$0B/               {mov ah,$B}π  $CD/$21/               {int $21}π  $24/$FE);              {and al,$FE}ππbeginπ inPort1:=memw[$40:$63]+6;π port[$61]:=port[$61]and (not 1);π setcolor(255,60,60,63);π initDots;π asm mov ax,$13; int $10; end;π drawDots;π repeat moveDots until keypressed;π readkey;π drawDots;π asm mov ax,3; int $10; end;π end.πππ * OLX 2.2 * Printers do it without wrinkling the sheets.ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π                                                                                                                     2      05-28-9313:47ALL                      SWAG SUPPORT TEAM        MCGATUT.TXT              IMPORT              40                                     MCGA Graphics Tutorialπ                                 Lesson #1π                                by Jim CookππI'm not sure how this online tutorial will be received, but with yourπcomments and feedback I plan on creating a full-blown animation package. Thisπgraphics library will be available to the public domain and will contain theπfollowing abilities:ππ                Setting/Reading Pixelsπ                Drawing linesπ                Saving/Restoring areas of the screenπ                Displaying PCX/LBM files to the screenπ                Spriting (Display picture with transparent areas)π                Palette control (Smooth fades to black)π                Page flippingππBefore we're done, you will have the tools to produce programs with rich,πeven photo-realistic (for the resolution) images on your PC.  The necessaryπhardware is a VGA card and monitor that's it.  I'll be using Turbo Pascalπversion 6.0.  Please holler if that will be a problem.  I'm using it toπcreate inline assembly.  My alternatives are inline code (yuk) or linking inπexternal assembly.  For speed (and actually ease) the latter is better.  If Iπreceive three complaints against 6.0, I'll use external assembly.ππ                                What is MCGA?ππMulti-Color Graphics Array is the video card that IBM built into it's Modelπ25 and 30 PS/2's.  It subsequently became a subset of the standard VGAπadapter card.  It has the distiction of being the first card (excludingπTarga and other expensive cards) to display 256 colors at once on theπcomputer screen.  To us that meant cool games and neat pictures.  The MCGAπaddapter has added two new video modes to the PC world:ππ                Mode $11        640x480x2 colorsπ                Mode $13        320x200x256 colorsππObviously, we will deal with mode $13.  If we wanted to deal with twoπcolors, we'd be programming a CGA.  So much for the history lesson...let'sπdive in.ππI've created a unit, MCGALib, that will contain all of our MCGA routines.πThe first two procedures we will concern ourselves with are setting theπgraphics mode and setting a pixel.  The MCGALib is followed by a testπprogram that uses the two procedures:ππUnit MCGALib;ππinterfaceππProcedure SetGraphMode (Num:Byte);πProcedure SetPixel     (X,Y:Integer;Color:Byte);ππimplementationππvarπ  ScreenWide  :  Integer;π  ScreenAddr  :  Word;ππProcedure SetGraphMode (Num:Byte);πbeginπ  asmπ    mov al,Numπ    mov ah,0π    int 10hπ    end;π  Case Num ofπ    $13 : ScreenWide := 320;π    end;π  ScreenAddr := $A000;πend;π{πFunction PixelAddr (X,Y:Word) : Word;πbeginπ  PixelAddr := Y * ScreenWide + X;πend;ππProcedure SetPixel (X,Y:Integer;Color:Byte);πvarπ  Ofs    :  Word;πbeginπ  Ofs := PixelAddr (X,Y);π  Mem [ScreenAddr:Ofs] := Color;πend;π}ππProcedure SetPixel (X,Y:Integer;Color:Byte);πbeginπ  asmπ    push dsπ    mov  ax,ScreenAddrπ    mov  ds,axππ    mov  ax,Yπ    mov  bx,320π    mul  bxπ    mov  bx,Xπ    add  bx,axππ    mov  al,Colorπ    mov  byte ptr ds:[bx],alπ    pop  dsπ    end;πend;ππBeginπEnd.ππThis is the test program to make sure it's working...ππProgram MCGATest;ππusesπ  Crt,Dos,MCGALib;ππvarπ  Stop,π  Start  :  LongInt;π  Regs   :  Registers;ππFunction Tick : LongInt;πbeginπ  Regs.ah := 0;π  Intr ($1A,regs);π= egs.cx hl 16  Rgs.dx;πend;ππProcedure Control;πvarπ  I,J :  Integr;beginπ  Start := ic;π  Fr I := 0 to 199 doπ  For J  SetPixe (J,I,Random(256));π Stop := Tick;πend;ππPocdure Closing;πvarπ  Ch    :  Chr;πbeginπ  Repet Until Keypressed;π  While Keypressed do Ch:= Reake;π  TextMode (3);πook '(Stop-Start),' ticks or ,(Stop-Start)/182:4:3,'π seconds!');πnd;ππProcedure Init;πbeginπ  SetGaphMode ($13);π Randoiz;πend;ππBeginπ Initπ  Control;π  Cosing;πe where these listings coul get unbearably long in time.  I'lπexplore a few ays I can get this information to ya'll without takingup tooπmuch pace. Iwould like you tomake sue this routine works, ust in caseπyou ou graphis card. You may notce two SetPxelπprocedures in the MCGALib, one is commented out.  Remove he comments,πcomment up the uncommented SetPixel and run the test program aain.  Noticeπthe speed degradation.  Linking in raw assembly will eve improve upon theπspeed of the inline assembly.πPlease take the time to study each procedure and ASK ANY QUESTIONS tht youπmay have, even if it doesn't relate to the graphics routines.  I'm cetain Iπdo not want to get pulled off track by any discussions about STYLE,ur critiqueπ for others to learn rom.ππ                              Coming next timeππI think a discussio of video memory is paramount.  Possibly vertical andπhorizontal lines, if spce permits.ππHappy grafxπjimππ--- QuickBBS 2.75π * Origin: Quantum Leap.. [phone]  HST/DS (1:387/307)π                                                                                                                                                                                                                                                     3      07-16-9306:46ALL                      SWAG SUPPORT TEAM        Simulate Star Field      IMPORT              28     ╓   π{Program to simulate travel through a star field - try a different MaxStar}πusesπ  TpCrt, TpInline, Graph;    {OpInline used for HiWord only}πconstπ  MaxStar = 50;                        {num stars}π  MaxHistory = 3;                      {points per streak, = 2**n -1, note mask on line #59}πtypeπ  T_HistoryPoint = recordπ                     hX, hY : Integer;π                   end;π  T_Star = recordπ             X, Y       : LongInt;           {star position}π             DX, DY     : LongInt;         {delta}π             DXPositive,π             DYPositive : Boolean;π             Speed      : Word;π             History    : array[0..MaxHistory] of T_HistoryPoint; {Position history}π             HistIndex  : Byte;π           end;π  T_StarArray = array[1..MaxStar] of T_Star;πvarπ  Gd,π  Gm,π  i,π  j       : Integer;ππ  Color   : Word;ππ  A       : T_StarArray;π  BoundX,π  BoundY,π  CenterX,ππ  CenterY : LongInt;ππ  Angle   : Real;ππ  Shift   : Byte;ππBEGINπ  Gd := Detect;π  InitGraph(Gd, Gm, '\turbo\tp');π  if GraphResult <> grOk thenπ    Halt(1);π  Color := GetMaxColor;π  BoundX := GetMaxX * 65536;π  BoundY := GetMaxY * 65536;π  CenterX := GetMaxX * 32768;π  CenterY := GetMaxY * 32768;π  FillChar(A, SizeOf(A), $FF);π  Randomize;π  {Background}π  for i := 1 to 1500 doπ    PutPixel(Random(GetMaxX), Random(GetMaxY), Color);π  {Stars}π  repeatπ    for i := 1 to MaxStar doπ      with A[i] doπ        beginπ          if (X < 0) or (X > BoundX) or (Y < 0) or (Y > BoundY) thenπ            beginπ            {Position is off-screen, go back to center, new angle}π              Angle := 6.283185 * Random;π              Speed := Random(2000) + 1000;π              DX := Round(Speed * Sin(Angle));π              DY := Round(Speed * Cos(Angle));π              X := 300 * DX + CenterX;π              Y := 300 * DY + CenterY;π              DXPositive := DX > 0;π              DYPositive := DY > 0;π              DX := Abs(DX);π              DY := Abs(DY);π            {Erase all of old line segment}π              for j := 0 to MaxHistory doπ                with History[j] doπ                  PutPixel(hX, hY, 0);π            endπ          elseπ            begin               {Plot point}π              Inc(HistIndex);                {Next slot in history}π              HistIndex := HistIndex and $03; { <-- change for new MaxHistory!}π              with History[HistIndex] doπ                beginπ                  PutPixel(hX, hY, 0);         {Erase inner dot of line segment}π                  hX := HiWord(X);π                  hY := HiWord(Y);π                  PutPixel(hX, hY, Color);     {New outer dot of line segment}π                end;π        {Next point}π              if DXPositive thenπ                Inc(X, DX)π              elseπ                Dec(X, DX); {Add delta}π              if DYPositive thenπ                Inc(Y, DY)π              elseπ                Dec(Y, DY);π              case Speed ofπ                1000..1300 : Shift := 9;π                1300..1600 : Shift := 8;π                1600..2100 : Shift := 7;π                2100..2700 : Shift := 6;π                2700..2900 : Shift := 5;π                2900..3000 : Shift := 4;π              end;π              Inc(DX, DX shr Shift);         {Increase delta to accelerate}π              Inc(DY, DY shr Shift);π            end;π        end;π  until KeyPressed;π  ReadLn;π  CloseGraph;πEND.ππ                                                         4      07-16-9306:47ALL                      SWAG SUPPORT TEAM        A simple Star Field      IMPORT              11     ╓   πprogram stars;ππconstπ  maxstars = 200;ππvar star  : array[0..maxstars] of word;π    speed : array[0..maxstars] of byte;π    i     : word;ππprocedure create;πbeginπ  for i := 0 to maxstars doπ    beginπ    star[i] := random(320) + random(200) * 320;π    speed[i] := random(3) + 1;π    if mem[$a000:star[i]] = 0 thenπ      mem[$a000:star[i]] := 100;π  end;πend;ππProcedure moveit; assembler;πasmπ     xor   bp,bpπ     mov   ax,0a000hπ     mov   es,axπ     lea   bx,starπ     lea   si,speedπ     mov   cx,320ππ@l1: mov   di,[bx]π     mov   al,es:[di]π     cmp   al,100π     jne   @j1π     xor   al,alπ     stosbπ@j1: mov   al,[si]π     xor   ah,ahπ     add   [bx],axπ     mov   ax,bxπ     xor   dx,dxπ     div   cxπ     mul   cxπ     mov   dx,bxπ     sub   dx,axπ     cmp   dx,319π     jle   @j3π     sub   [bx],cxπ@j3: mov   di,[bx]π     mov   al,es:[di]π     or    al,alπ     jnz   @j2π     mov   al,100π     stosbπ@j2: add   bx,2π     inc   siπ     inc   bpπ     cmp   bp,maxstarsπ     jle   @l1πend;ππbeginπ  asmπ    mov   ax,13hπ    int   10hπ    call  createπ@l1:π    mov   dx,3dahπ@r1:π    in    al,dxπ    test  al,8π    je    @r1π    call moveitπ    in   al,60hπ    cmp  al,1π    jne  @l1;π  end;πend.ππ                                                                      5      07-16-9306:47ALL                      SWAG SUPPORT TEAM        A Color Star Field       IMPORT              29     ╓   {-------------------------- SCHNIPP -----------------------------}ππ{STARSCROLL.PAS geaenderte Fassung  }ππ{$A+,B-,D-,E-,F+,I+,L-,N-,O-,R-,S-,V-}π{$M 64000,0,655360}ππUSES crt,graph,BGIDriv;                 {ich binde die Treiber ein}ππCONST MaxStars=500;                     {auf meinem 386-25er muss ich inπ                                        der geaenderten Fassung schon 500π                                        Sterne eintragen, damit es nur nochπ                                        ein wenig schneller ist als die alteπ                                        Fassung mit 100 Sternen ;-)}ππTYPE Punkt=ARRAY[1..3] OF INTEGER;     {Siehe ganz unten Move()}ππVARπ   gd,gm,mpx,mpy,scal,a,b,e:integer;π   Stars1,Stars:ARRAY[1..MaxStars] OF Punkt;ππ   mx,my,m2x,m2y,sop,                   {siehe Init}π   act:INTEGER;ππPROCEDURE dpunkt( x,y,z, Col:integer);πVAR n:INTEGER;π  BEGINπ   n:=z+e;ππ   {n=Nenner, nur einmal berechnen, geht schneller}ππ   PutPixel(mpx+ (scal*x div n),mpy+ (scal*y div n),col);ππ                 {hier nur integer-operationen}π  END;ππPROCEDURE dline( x1,y1,z1,x2,y2,z2:integer);πVAR n1,n2:INTEGER;π  BEGINπ   n1:=z1+e;n2:=z2+e;  {n1=Nenner fuer 1.Punkt, n2=Nenner fuer 2.Punkt}ππ   Line(mpx+(scal*(x1 div n1)),mpy+(scal*(y1 div n1)),π        mpx+(scal*(x2 div n2)),mpy+(scal*(y2 div n2)));ππ      {Nix mit Round(xxx / nX), dauert zu lange: Integer ->Real ->Integer}π  END;ππPROCEDURE Init;πbeginπ act:=1;π e:=1;π scal := 2;ππ mx:=getmaxx;     {damit man es auch in EgaLo oder anderen GModes}π m2x:=mx shr 1;   {betreiben kann, alle Werte abhaengig von MaximalX und}π my:=getmaxy;     {MaximalY}π m2y:=my shr 1;π mpx:=m2x;π mpy:=m2y-(mpy shr 1);ππ sop:=sizeof(punkt);  {Schreibt sich leichter :-) }πend;ππBEGINπ  Randomize;π  gd:=ega;π  gm:=egahi;ππ  if RegisterBGIdriver(@EgaVgaDriverProc) < 0 then halt(255);ππ  InitGraph(gd,gm,'');  {oder InitGraph(gd,gm,'PathToDriver');}π  Init;π  FOR a:=0 TO 15 DO  SetRGBPalette(a,a*3,a*3,a*3);π  FOR a:=1 TO MaxStars DOπ    BEGINπ      Stars[a,1]:=Random(mx)-m2x;π      Stars[a,2]:=Random(my)-m2y;π      Stars[a,3]:=Random(30)+1;π    END;ππ  Move(Stars,Stars1,SoP*MaxStars);      {man sollte Stars1 initialisieren}π                                        {wenn man es benutzt}π  SetColor(15);π  SetVisualPage(act);ππ  {AB hier kommt es auf Geschwindigkeit an}ππ  REPEATπ            {IF act=0 THEN act:=1 ELSE act:=0; dauert zu lange, deshalb:}π            {wenn (act)=1 -> act:=1-(1) = 0  wenn (act)=0 -> act:=1-(0)=1}π    act:=1-act;ππ    SetActivePage(act);π    FOR a:= 1 TO MaxStars DOπ    BEGINπ      Stars[a,3]:=Stars[a,3]-1;π      IF stars[a,3]= 0 THENπ      BEGINπ        Stars[a,1]:=Random(mx)-m2x;π        Stars[a,2]:=Random(my)-m2y;π        Stars[a,3]:=30;π      END;π      dpunkt(Stars[a,1],Stars[a,2],Stars[a,3],15-(stars[a,3] shr 1));ππ                        {round(xxx/2) dauert zu lange {shr 1 = div 2 }π    END;π    SetVisualPage(act);ππ    act:=1-act;   {s.o.}ππ    SetActivePage(act);π    FOR a:=1 TO MaxStars DOπ    BEGINπ      dpunkt(Stars1[a,1],Stars1[a,2],Stars1[a,3],0);ππ      {Wenn man Stars1 nicht initialisierst kommt es schon mal vor, dassπ       man einen Division by Zero Error beim ersten beim 1. Aufruf erhaelt}ππ      move(stars[a],stars1[a],sop);ππ      {nicht einzeln uebertragen, Move ist schneller, deshalb auch Type Punkt}ππ    END;ππ    act:=1-act; {s.o.}ππ  UNTIL KeyPressed;ππ  closegraph;          {Nicht vergessen !!!! ;-) }πEND.ππ{------------------------- SCHNAPP --------------------------------------}ππ                                                        6      08-23-9309:18ALL                      SEAN PALMER              FAST Mode 13h Line Draw  IMPORT              29     ╓   {π===========================================================================π BBS: Beta ConnectionπDate: 08-20-93 (09:59)             Number: 2208πFrom: SEAN PALMER                  Refer#: NONEπ  To: ALL                           Recvd: NO  πSubj: FAST mode 13h Li (Part 1)      Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------πHey! Here's THE fastest mode 13h bresenham's line drawing function ever.π(I think...prove me wrong, please!!)ππIt's written for TP 6 or better, uses BASM. If you don't know assembly, justπput it in a unit and don't worry about how it works. If you do, fine.πSome good optimizations in there...ππHave fun! If anyone wants the mostly-pascal equivalent, let me know.πIt's still fast.ππ{by Sean Palmer}π{public domain}ππvar color:byte;ππprocedure line(x,y,x2,y2:word);assembler;asm {mode 13}π mov ax,$A000π mov es,axπ mov bx,xπ mov ax,yπ mov cx,x2π mov si,y2π cmp ax,siπ jbe @NO_SWAP   {always draw downwards}π xchg bx,cxπ xchg ax,siπ@NO_SWAP:π sub si,ax         {yd (pos)}π sub cx,bx         {xd (+/-)}π cld               {set up direction flag}π jns @H_ABSπ neg cx      {make x positive}π stdπ@H_ABS:π mov di,320π mul diπ mov di,axπ add di,bx   {di:adr}π or si,siπ jnz @NOT_Hπ{horizontal line}π cldπ mov al,colorπ inc cxπ rep stosbπ jmp @EXITπ@NOT_H:π or cx,cxπ jnz @NOT_Vπ{vertical line}π cldπ mov al,colorπ mov cx,siπ inc cxπ mov bx,320-1π@VLINE_LOOP:π stosbπ add di,bxπ loop @VLINE_LOOPπ jmp @EXITπ@NOT_V:π cmp cx,si    {which is greater distance?}π lahf         {then store flags}π ja @H_INDπ xchg cx,si   {swap for redundant calcs}π@H_IND:π mov dx,si    {inc2 (adjustment when decision var rolls over)}π sub dx,cxπ shl dx,1π shl si,1     {inc1 (step for decision var)}π mov bx,si    {decision var, tells when we need to go secondary direction}π sub bx,cxπ inc cxπ push bp      {need another register to hold often-used constant}π mov bp,320π mov al,colorπ sahf         {restore flags}π jb @DIAG_Vπ{mostly-horizontal diagonal line}π or bx,bx     {set flags initially, set at end of loop for other iterations}π@LH:π stosb        {plot and move x, doesn't affect flags}π jns @SH      {decision var rollover in bx?}π add bx,siπ loop @LH   {doesn't affect flags}π jmp @Xπ@SH:π add di,bpπ add bx,dxπ loop @LH   {doesn't affect flags}π jmp @Xπ@DIAG_V:π{mostly-vertical diagonal line}π or bx,bx    {set flags initially, set at end of loop for other iterations}π@LV:π mov es:[di],al   {plot, doesn't affect flags}π jns @SV          {decision var rollover in bx?}π add di,bp        {update y coord}π add bx,siπ loop @LV         {doesn't affect flags}π jmp @Xπ@SV:π scasb   {sure this is superfluous but it's a quick way to inc/dec x coord!}π add di,bp        {update y coord}π add bx,dxπ loop @LV         {doesn't affect flags}π@X:π pop bpπ@EXIT:π end;ππvar k,i,j:word;πbeginπ asm mov ax,$13; int $10; end;π for k:=0 to 31 do beginπ  i:=k*10;π  j:=k*6;π  color:=14;π  line(159,99,i,0);π  color:=13;π  line(160,99,319,j);π  color:=12;π  line(160,100,319-i,199);π  color:=11;π  line(159,100,0,199-j);π  i:=k*9;π  j:=k*5;π  color:=6;π  line(i,0,159,99);π  color:=5;π  line(319,j,160,99);π  color:=4;π  line(319-i,199,160,100);π  color:=3;π  line(0,199-j,159,100);π  end;π Readln;π asm mov ax,3; int $10; end;π end.ππ... I'm not unemployed, I'm indefinitely leisured.π___ Blue Wave/QWK v2.12π---π * deltaComm Online 919-481-9399 - 10 linesπ * PostLink(tm) v1.06  DELTA (#22) : RelayNet(tm) HUBπ                                                                                                                         7      08-27-9319:57ALL                      STEVE CONNET             3D Rotations             IMPORT              22     ╓   {πSTEVE CONNETππOkay, here's the equations For 3D rotations...ππx,y,z are the coordinates of the point you want to rotate.πrx,ry,rz are the amount of rotation you want (in degrees) For x,y,zπ}ππ  x1 := round(cos(rad(ry)) * x  - sin(rad(ry)) * z);π  z1 := round(sin(rad(ry)) * x  + cos(rad(ry)) * z);π  x  := round(cos(rad(rz)) * x1 + sin(rad(rz)) * y);π  y1 := round(cos(rad(rz)) * y  - sin(rad(rz)) * x1);π  z  := round(cos(rad(rx)) * z1 - sin(rad(rx)) * y1);π  y  := round(sin(rad(rx)) * z1 + cos(rad(rx)) * y1);ππ{πBecause in Turbo Pascal, COS and SIN require radians For the argument,πI wrote a short Function called RAD() that converts degrees into radiansπ(I find degrees much easier to visualize)π}ππ  Function Rad(i : Integer) : Real;π  beginπ    Rad := i * (Pi / 360);π  end;ππ{πOf course, since most computers don't have 3D projection screens <G>,πuse these equations to provide a sense of perspective to the Object,πbut With 2D coordinates you can plot on a screen.ππx,y,z are from the equations above, and xc,yc,zc are the center pointsπfor the Object that you are rotating... I recommend setting xc,yc at 0,0πbut zc should be very high (+100).π}π  x2 := trunc((xc * z - x * zc) / (z - zc));π  y2 := trunc((yc * z - y * zc) / (z - zc));ππ{πAlternatively, if you don't want to bother With perspective, just dropπthe z values, and just plot the (x,y) instead.πππTo use these equations, pick a 3D Object and figure out what the 3Dπcoordinates are For each point on the Object.  You will have to have someπway to let the computer know which two points are connected.  For theπcube that I did, I had one Array For the points and one For each faceπof the cube.  That way the computer can draw connecting lines For eachπface With a simple for-loop.π}ππTypeπ  FaceLoc  = Array [1..4] of Integer;π  PointLoc = Recordπ    x, y, z : Integer;π  end;ππConstπ  face_c : Array [1..6] of faceloc =(π    (1,2,3,4),π    (5,6,2,1),π    (6,5,8,7),π    (4,3,7,8),π    (2,6,7,3),π    (5,1,4,8));ππ  point_c : Array [1..8] of pointloc =(π    (-25, 25, 25),π    ( 25, 25, 25),π    ( 25,-25, 25),π    (-25,-25, 25),π    (-25, 25,-25),π    ( 25, 25,-25),π    ( 25,-25,-25),π    (-25,-25,-25));π{πThere you go.  I'm not going to get much more complicated For now.  if youπcan actually get these equations/numbers to work (and I haven't forgottenπanything!) leave me another message, and I'll give you some advice forπfilling in the sides of the Object (so that you can only see 3 sides atπonce) and some advice to speed things up abit.  if you have any problemsπwith whats here, show some other people, and maybe as a collective you canπfigure it out.  Thats how I got this one started!π}π              8      08-27-9320:02ALL                      THOMAS GROFF             Endpoints of  PIE SegmentIMPORT              10     ╓   {πTHOMAS GROFFππ> would like a unit to return the endpoints of a PIE segment. You couldπ> always draw the arc invisibly and then use the GetArcCoords() procedureπ> provided in the graph unit and save yourself some time.π}ππprogram getlegs;πusesπ  graph;πvarπ  pts3    : arccoordstype; { <---- Necessary to declare this type var. }π  rad,π  startang,π  endang,π  x, y,π  gd, gm  : integer;πbeginπ  gd := detect;π  InitGraph(gd,gm,'e:\bp\bgi');π  cleardevice;π  x := 100;π  y := 100;π  startang := 25;π  endang   := 130;π  rad      := 90;ππ  setcolor(getbkcolor);  {  <------ Draw arc in background color. }π  arc(x, y, startang, endang, rad);π  GetArcCoords(pts3);  {  <----- This is what you want, look it up! }π  setcolor(white);     {  <----- Show your lines now.}π  line(pts3.x, pts3.y, pts3.xstart, pts3.ystart);π  line(pts3.x, pts3.y, pts3.xend, pts3.yend);π  outtextxy(50, 150, 'Press enter to see your original arc when ready...');ππ  readln;π  setcolor(yellow);π  arc(x, y, startang, endang, rad);π  outtextxy(50, 200, 'Press enter stop demo.');π  readln;π  closegraph;πend.π                                                                     9      08-27-9320:03ALL                      STEPHEN CHEOK            ASM Fading               IMPORT              11     ╓   {πSTEPHEN CHEOKππ> Could you post the fade out source?π}ππPROCEDURE DimDisplay(delayfactor : INTEGER); ASSEMBLER;ππ{ Total time to fade out in seconds = ((DelayFactor+1)*MaxIntensity) / 1000 }ππCONSTπ  MaxIntensity = 45;π {MaxIntensity = 63;}ππVARπ  DACTable : Array [0..255] OF RECORDπ               R, G, B : BYTE;π             END;πASMπ  PUSH   DSπ  MOV    AX, SSπ  MOV    ES, AXπ  MOV    DS, AXππ { Store colour information into DACTable }ππ  LEA    DX, DACTableπ  MOV    CX, 256π  XOR    BX, BXπ  MOV    AX, 1017hπ  INT    10hππ  MOV    BX, MaxIntensityππ { VGA port 3C8h: PEL address register, (colour index,π increments automatically after every third write)π VGA port 3C9h: PEL write register (R, G, B) }ππ  CLDπ @1:π  LEA    SI, DACTableπ  MOV    DI, SIπ  MOV    CX, 3*256π  XOR    AX, AXπ  MOV    DX, 3C8hπ  OUT    DX, ALπ  INC    DXππ { Get colour value, decrement it and update the table }ππ @2:π  LODSBπ  OR     AX, AXπ  JZ     @3π  DEC    AXπ @3:π  STOSBπ  OUT    DX, ALπ  LOOP   @2ππ { Delay before next decrement of R, G, B values }ππ  PUSH   ESπ  PUSH   BXπ  MOV    AX, DelayFactorπ  PUSH   AXπ  CALL   Delayπ  POP    BXπ  POP    ESππ  DEC    BXπ  OR     BX, BXπ  JNZ    @1π  POP    DSπEND;  { DimDisplay }πππ                                                      10     08-27-9320:14ALL                      RANDY PARKER             Including BGI in EXE     IMPORT              23     ╓   {πRANDY PARKERππ> Does anyone out there knwo how you can compile a Program using one ofπ> Borland's BGI units for grpahics and not have to distribute the BGIπ> file(s) with the EXE?ππ   First, convert the BGI and CHR files to .OBJ files (object) by usingπBINOBJ.EXE.  You may just want to clip out the following and name it as a batchπfile.ππ   BINOBJ.EXE goth.chr goth gothicfontprocπ   BINOBJ.EXE litt.chr litt smallfontprocπ   BINOBJ.EXE sans.chr sans sansseriffontprocπ   BINOBJ.EXE trip.chr trip triplexfontprocπ   BINOBJ.EXE cga.bgi cga cgadriverprocπ   BINOBJ.EXE egavga.bgi egavga egavgadriverprocπ   BINOBJ.EXE herc.bgi herc hercdriverprocπ   BINOBJ.EXE pc3270.bgi pc3270 pc3270driverprocπ   BINOBJ.EXE at.bgi att attdriverprocππ   You should now have the following files:ππ     ATT.OBJ, CGA.OBJ, EGAVGA.OBJ GOTH.OBJ HERC.OBJ LITT.OBJ PC3270.OBJ,π     SANS.OBJ, TRIP.OBJ.π}ππunit GrDriver;ππinterfaceππuses Graph;ππimplementationππprocedure ATTDriverProc;    External; {$L ATT.OBJ}πprocedure CGADriverProc;    External; {$L CGA.OBJ}πprocedure EGAVGADriverProc; External; {$L EGAVGA.OBJ}πprocedure HercDriverProc;   External; {$L HERC.OBJ}πprocedure PC3270DriverProc; External; {$L PC3270.OBJ}ππprocedure ReportError(s : string);πbeginπ  writeln;π  writeln(s, ': ', GraphErrorMsg(GraphResult));π  Halt(1);πend;ππbeginπ  if RegisterBGIdriver(@ATTDriverProc) < 0 thenπ    ReportError('AT&T');π  if RegisterBGIdriver(@CGADriverProc) < 0 thenπ    ReportError('CGA');π  if RegisterBGIdriver(@EGAVGADriverProc) < 0 thenπ    ReportError('EGA-VGA');π  if RegisterBGIdriver(@HercDriverProc) < 0 thenπ    ReportError('Hercules');π  if RegisterBGIdriver(@PC3270DriverProc) < 0 thenπ    ReportError('PC-3270');πend.πππunit GrFont;ππinterfaceππusesπ  Graph;ππimplementationππprocedure GothicFontProc;    External; {$L GOTH.OBJ}πprocedure SansSerifFontProc; External; {$L SANS.OBJ}πprocedure SmallFontProc;     External; {$L LITT.OBJ}πprocedure TriplexFontProc;   External; {$L TRIP.OBJ}ππprocedure ReportError(s : string);πbeginπ  writeln;π  writeln(s, ' font: ', GraphErrorMsg(GraphResult));π  halt(1)πend;ππbeginπ  if RegisterBGIfont(@GothicFontProc) < 0 thenπ    ReportError('Gothic');π  if RegisterBGIfont(@SansSerifFontProc) < 0 thenπ    ReportError('SansSerif');π  if RegisterBGIfont(@SmallFontProc) < 0 thenπ    ReportError('Small');π  if RegisterBGIfont(@TriplexFontProc) < 0 thenπ    ReportError('Triplex');πend.ππ{πBy using the 2 units above, you should be able to include any video driverπof font (that were listed) by simply insertingππUsesπ  GrFont, GrDriver, Graph;ππinto your graphic files.ππI got this out of a book name Mastering Turbo Pascal 6, by Tom Swan. It's anπexcellent book that covers from Turbo 4.0 to 6.0, basics to advanced subjects.πHope it works for you.π}π                                 11     08-27-9320:16ALL                      WILBER VAN LEIJEN        Very Large Graphic Image IMPORT              15     ╓   {πWILBERT VAN LEIJENππ> I am looking for a way to get an Image into a pointer (besides arrays)π> and write it to my disk. I am using arrays right now, and works fine, butπ> When  I get big images I run out of mem fast...  :: IBUF : array [1..30000]π> of byte; getimage(x1,y1,x2,y2,IBUF); repeat Write(f,IBUF[NUM]); num:=num+1;π> until num=sizeof(ibuf);π> This works as long as I dont try to grab a large image.ππThese "large images" are in fact stored in "planes", chunks of up to 64 kByteπin size. You must understand the VGA architecture to store these in a file.πThe only VGA video mode that keeps all data (from the programmer's point ofπview) into a single data space is mode 13h (320x200 with 256 colours): a simpleπarray [1..200, 1..320] of Byte.  The other video modes require you to accessπthe VGA hardware: take for example 640x480 by 16 colours: 4 planes of 38,400πbytes (Red, Green, Blue and Intensity).  Together with the colour informationπas returned by BIOS call INT 10h/AX=1012h they make up the picture.ππHere's how you select a plane:π}ππProcedure SwitchBitplane(plane : Byte); Assembler;ππASMπ  MOV   DX, 3C4hπ  MOV   AL, 2π  OUT   DX, ALπ  INC   DXπ  MOV   AL, planeπ  OUT   DX, ALπend;ππ{πAssume the video mode to be 12h (640x480/16 colours), BitplaneSize = 38400, andπBitplane is an Array[0..3] of pointer to an array [1..38400] of Byte:π}π      For i := 0 to 3 Doπ        Beginπ          SwitchBitplane(1 shl i);π          Move(Bitplane[i]^, Ptr($A000, $0000)^, BitplaneSize);π        end;π{πThis is a snippet of code lifted from my VGAGRAB package; a TSR that dumpsπgraphic information (any standard VGA mode) to a disk file by pressingπ<PrtScr>, plus a few demo programs written in TP - with source code.  Availableπon FTP sites.π}π                                  12     08-27-9320:18ALL                      RAPHAEL VANNEY           Display Text in Graphics IMPORT              11     ╓   {πRAPHAEL VANNEYππ*You mean displaying Text While in Graphics mode :-) ?ππ> Yup. Already got a suggestion on using 640x480 With 8x8 font, so ifπ> you have any other one please do tell.. ttyl...ππSure. Just call the BIOS routines to display Characters With a "standard"πlook. By standard look, I mean they look like they were Characters inπText mode.ππOkay, here is the basic Procedure to display a String (Works in any Text/πGraphics mode) :π}ππProcedure BIOSWrite(Str : String; Color : Byte); Assembler;πAsmπ  les  di, Strπ  mov  cl, es:[di]     { cl = longueur chane }π  inc  di              { es:di pointe sur 1er caractre }π  xor  ch, ch          { cx = longueur chane }π  mov  bl, Color       { bl:=coul }π  jcxz @ExitBW         { sortie si Length(s)=0 }π @BoucleBW:π  mov  ah, 0eh         { sortie TTY }π  mov  al, es:[di]     { al=caractre  afficher }π  int  10h             { et hop }π  inc  di              { caractre suivant }π  loop @BoucleBWπ @ExitBW:πend ;ππ{πI'm not sure how to manage the background color in Graphics mode ; maybeπyou should experiment With values in "coul", there could be a magic bitπto keep actual background color.π}ππ                                                                                                                              13     08-27-9320:18ALL                      SEAN PALMER              Bit Map scaler           IMPORT              18     ╓   {πSEAN PALMERππWell, I got a wild hair up my butt and decided to convert thatπbitmap scaler I posted into an inline assembler procedure (mostly)πIt's now quite a bit faster...ππby Sean Palmerπpublic domainπ}ππ{bitmaps are limited to 256x256 (duh)}ππtypeπ  fixed = recordπ    case boolean ofπ      true  : (w : longint);π      false : (f, i : word);π    end;ππconstπ  bmp : array [0..3, 0..3] of byte =π    ((0, 1, 2, 3),π     (1, 2, 3, 4),π     (2, 3, 4, 5),π     (3, 4, 5, 6));πvarπ  bmp2 : array [0..63, 0..63] of byte;π  i, j : integer;ππprocedure scaleBitmap(var bitmap; x, y : byte; x1, y1, x2, y2 : word);πvarπ  s, w, h    : word;  {xSkip,width,height}π  sx, sy, cy : fixed; {xinc, yinc, ySrcPos}πbeginπ  w    := x2 - x1 + 1;π  h    := y2 - y1 + 1;π  sx.w := x * $10000 div w;π  sy.w := y * $10000 div h;π  s    := 320-w;π  cy.w := 0;π  asmπ    push dsπ    mov  ds, word ptr bitmap+2;π    mov  ax, $A000π    mov  es, ax  {setup screen seg}π    cldπ    mov  ax, 320π    mul  y1π    add  ax, x1π    mov  di, ax {calc screen adr}π   @L2:π    mov  ax, cy.iπ    mul  xπ    mov  bx, axπ    add  bx, word ptr bitmap {offset}π    mov  cx, wπ    mov  si, 0     {fraction of src adr (bx.si)}π    mov  dx, sx.fπ   @L:π    mov  al, [bx]π    stosbπ    add  si, dxπ    adc  bx, sx.i    {if carry or sx.i<>0, new source pixel}π    loop @Lπ    add  di, s     {skip to next screen row}π    mov  ax, sy.fπ    mov  bx, sy.iπ    add  cy.f, axπ    adc  cy.i, bxπ    dec  word ptr hπ    jnz  @L2π    pop  dsπ  end;πend;ππbeginπ  for i := 0 to 63 do   {init bmp2}π    for j := 0 to 63 doπ      bmp2[j, i] := j + (i xor $19) + 32;π  asmπ    mov ax, $13π    int $10π  end;   {init vga mode 13h}π  for i := 2 to 99 do                 {test bmp}π    scaleBitMap(bmp, 4, 4, 0, 0, i * 2 - 1, i * 2 - 1);π  for i := 99 downto 2 doπ    scaleBitMap(bmp, 4, 4, 0, 0, i * 2 - 1, 197);π  for i := 1 to 66 do                 {test bmp2}π    scaleBitMap(bmp2, 64, 64, 0, 0, i * 2 - 1, i * 3 - 1);π  for i := 66 downto 1 doπ    scaleBitMap(bmp2, 64, 64, 0, 0, i * 2 - 1, i * 2 - 1 + 66);π  asmπ    mov ax, $3π    int $10π  end;      {restore text mode}πend.π                                                  14     08-27-9320:25ALL                      MICHAEL NICOLAI          Drawing Graphic Circles  IMPORT              23     ╓   {πMICHAEL NICOLAIπππThe basic formula (and quickest) For drawing a circle is: x^2 + y^2 = r^2.πThe r stands For radius (half the diameter). You know this formula, i amπsure. A guy called Phytagoras set i up very long ago to calculate theπhypotenuse of a given triangle. (there has to be a 90° angel between a and b)πππ                   |\π                   | \π                 a |  \ c      c^2 = a^2 + b^2π                   |   \π                   |____\ππ                     bππRemember?ππNow look at this:        ...|     a quater of the circleπ                       ..   |π                      . ____|yπ                     . |\   |π                    .  | \  |π                    .  | r\ |π                    .  |   \|π               --------------------------π                    r  x    |0π                            |π                            |πππr is given and take 0 - r as a starting point For x. Then all you have to doπis to calculate y and plot the point.ππ    y = sqrt((r * r) - (x * x))      sqrt : square rootππAfter each calculation x is increased Until it has reached 0. Then oneπquarter of the circle is drawn. The other three quarters are symmetrical.ππI have written a short Program For you to draw a circle in 320x200x256πGraphics mode. When you key in some values please remember that NO errorπchecking will be done. x has to be between 0 and 319, and y between 0 andπ199. The radius must not be greater than x and y.ππExample: x : 160; y : 100; r : 90ππWhen you start this Program you will not get correct circles because inπGraphics mode ONE pixel is not square!!! You have to calculate an aspectπratio to get nice looking circles.π}ππProgram circle;ππUsesπ  Crt, Dos;ππVarπ  regs    : Registers;π  x0, y0  : Word;π  x, y, R : Real;π  temp    : Real;π  c       : Char;ππProcedure putpixel(x, y : Word; color : Byte);πbeginπ  mem[$A000: (y * 320 + x)] := color;πend;ππbeginπ  ClrScr;π  Writeln('Enter coordinates of middle-point :');π  Writeln;π  Write('x : '); readln(x0);π  Write('y : '); readln(y0);π  Writeln;π  Write('Enter radius :'); readln(R);ππ  { Switch to 320x200x256 }ππ  regs.ax := $0013;π  intr($10, regs);ππ  x := (-1) * R;  { go from 0 - R to 0 }π  temp := R * R;π  Repeatπ    y := sqrt(temp - (x * x));π    putpixel((x0 + trunc(x)), (y0 - trunc(y)), 15); { 4.th quadrant }π    putpixel((x0 - trunc(x)), (y0 - trunc(y)), 15); { 1.st quadrant }π    putpixel((x0 + trunc(x)), (y0 + trunc(y)), 15); { 3.rd quadrant }π    putpixel((x0 - trunc(x)), (y0 + trunc(y)), 15); { 2.nd quadrant }π    x := x + 0.1; { change this if you want coarse or fine circle. }π  Until (x >= 0.0);π  c := ReadKey;  { wait For keypress. }ππ  { Switch back to Textmode. }ππ  regs.ax := $0003;π  intr($10, regs);πend.π                                                                      15     08-27-9320:25ALL                      MICHAEL NICOLAI          More Graphic Circles     IMPORT              25     ╓   {πMICHAEL NICOLAIππ>does someone have a circle routine For the 320x200x256 mode.π>I need one using the Assembler...  (FAST) ( or isn't that possible)π>I doesn't need to be very perfect, if it has the shape of a circle,π>I'm satisfied.ππI don't have any Asm-Program yet but i got the same question some time ago.ππOk then, let's do some math:ππThe basic formula (and quickest?) For drawing a circle is: x^2 + y^2 = r^2.πThe r stands For radius (half the diameter). You know this formula, i amπsure. A guy called Phytagoras set i up very long ago to calculate theπhypotenuse of a given triangle.ππ                   |\π                   | \π                 a |  \ c      c^2 = a^2 + b^2π                   |   \π                   |____\ππ                     bπRemember?ππNow look at this:        ...|     a quater of the circleπ                       ..   |π                      . ____|yπ                     . |\   |π                    .  | \  |π                    .  | r\ |π                    .  |   \|π               --------------------------π                    r  x    |0π                            |π                            |ππr is given and take 0 - r as a starting point For x. Then all you have to doπis to calculate y and plot the point.ππ    y = sqrt((r * r) - (x * x))      sqrt : square rootππAfter each calculation x is increased Until it has reached 0. Then oneπquarter of the circle is drawn. The other three quarters are symmetrical.ππI have written a short Program For you to draw a circle in 320x200x256πGraphics mode. When you key in some values please remember that NO errorπchecking will be done. x has to be between 0 and 319, and y between 0 andπ199. The radius must not be greater than x and y.ππExample: x : 160; y : 100; r : 90ππWhen you start this Program you will not get correct circles because inπGraphics mode ONE pixel is not square!!! You have to calculate an aspectπratio to get nice looking circles.π}ππProgram circle;ππUsesπ  Crt, Dos;ππVarπ  regs    : Registers;π  x0, y0  : Word;π  x, y, R : Real;π  temp    : Real;π  c       : Char;ππProcedure putpixel(x, y : Word; color : Byte);πbeginπ  mem[$A000 : (y * 320 + x)] := color;πend;ππbeginπ ClrScr;π Writeln('Enter coordinates of middle-point :');π Writeln;π Write('x : ');π readln(x0);π Write('y : ');π readln(y0);π Writeln;π Write('Enter radius :');π readln(R);ππ { Switch to 320x200x256 }ππ regs.ax := $0013;π intr($10, regs);ππ x := (-1) * R;  { go from 0 - R to 0 }π temp := R * R;π Repeatπ   y := sqrt(temp - (x * x));π   putpixel((x0 + trunc(x)), (y0 - trunc(y)), 15); { 4.th quadrant }π   putpixel((x0 - trunc(x)), (y0 - trunc(y)), 15); { 1.st quadrant }π   putpixel((x0 + trunc(x)), (y0 + trunc(y)), 15); { 3.rd quadrant }π   putpixel((x0 - trunc(x)), (y0 + trunc(y)), 15); { 2.nd quadrant }π   x := x + 0.1; { change this if you want coarse or fine circle. }π Until (x >= 0.0);π c := ReadKey;  { wait For keypress. }ππ { Switch back to Textmode. }ππ regs.ax := $0003;π intr($10, regs);πend.π                                                                       16     08-27-9320:25ALL                      MIKE BURNS               Another Circle Routine   IMPORT              11     ╓   {πMIKE BURNSππ> does someone have a circle routine for the 320x200x256 mode. I need oneπ> using the assembler...  (FAST) ( or isn't that possible) I doesn't need toπ> be very perfect, if it has the shape of a circle, I'm satisfied.π}ππPROCEDURE SWAP(VAR A, B : Integer);πVarπ  X : Integer;πBeginπ  X := A;π  A := B;π  B := X;πEnd;ππVarπ  SCR : Array [0..199, 0..319] of Byte Absolute $A000 : $0000;ππPROCEDURE Circle(X, Y, Radius : Word; Color: Byte);πVARπ  a, af, b, bf,π  target, r2   : Integer;πBeginπ  Target := 0;π  A  := Radius;π  B  := 0;π  R2 := Sqr(Radius);ππ  While a >= B DOπ  Beginπ    b:= Round(Sqrt(R2 - Sqr(A)));π    Swap(Target, B);π    While B < Target Doπ    Beginπ      Af := (120 * a) Div 100;π      Bf := (120 * b) Div 100;π      SCR[x + af, y + b] := color;π      SCR[x + bf, y + a] := color;π      SCR[x - af, y + b] := color;π      SCR[x - bf, y + a] := color;π      SCR[x - af, y - b] := color;π      SCR[x - bf, y - a] := color;π      SCR[x + af, y - b] := color;π      SCR[x + bf, y - a] := color;π      B := B + 1;π    End;π    A := A - 1;π  End;πEnd;ππbeginπ  Asmπ    Mov ax, $13π    Int $10;π  end;ππ  Circle(50, 50, 40, $32);π  Readln;ππ  Asmπ    Mov ax, $03π    Int $10;π  end;πend.ππππππ                                                            17     08-27-9320:28ALL                      SEAN PALMER               Simple coppering routineIMPORT              29     ╓   {πSEAN PALMERππ>Okay, I've got this small problem porting one of my assembler routinesπ>into pascal.  It's a simple coppering routine (multiple setting of theπ>same palette register for trippy effects :), and i can't seem to use itπ>in my code..  I'll post the code here now (it's fairly short), and ifπ>someone could help me out here, i'd be most grateful - since myπ>assembler/pascal stuff isn't too great..ππI imported it, but couldn't get it to work (several problems in theπsource) and in the process of getting it to work (for one thing I didn'tπknow what it was supposed to accomplish in the first place) I added aπfew things to it and this probably isn't what you wanted it to look likeπbut it wouldn't be hard to do now that it's in TP-acceptable form.ππI also added one other small palette flipper that's kind of neat.π}ππ{$G+}πusesπ  crt;ππprocedure copperBars(var colors; lines : word; regNum, count : byte); assembler;πvarπ  c2 : byte;πasmπ{π  okay, Colors is a pointer to the variable array ofπ  colours to use (6bit rgb values to pump to the dac)π  Lines is the number of scanlines on the screen (for syncing)π  RegNum is the colour register (DAC) to use.π  valid values are 0-255. that should explain that one.π  Count is the number of cycles updates to do before it exits.π}π  push dsππ  mov  ah, [RegNum]π  mov  dx, $3DA   {vga status port}π  mov  bl, $C8    {reg for DAC}π  cliπ  cldππ @V1:π  in   al, dxπ  test al, 8π  jz   @V1 {vertical retrace}π @V2:π  in   al, dxπ  test al, 8π  jnz  @V2ππ  mov  c2, 1π  mov  di, [lines]ππ @UPDATER:π  mov  bh, c2π  inc  c2π  lds  si, [colors]π                {now,just do it.}π @NIKE:π  mov  cx, 3π  mov  dl, $DAππ @H1:π  in   al, dxπ  and  al, 1π  jz   @H1  {horizontal retrace}ππ  mov  al, ah  {color}π  mov  dl, blπ  out  dx, alπ  inc  dxπ  rep  outsb              {186 instruction...}ππ  mov  dl, $DAπ @H2:π  in   al, dxπ  and  al, 1π  jnz  @H2;ππ  dec  diπ  jz   @Xπ  dec  bhπ  jnz  @NIKEπ  jmp  @UPDATERπ @X:π  dec  countπ  jnz  @V1π  sti                    {enable interrupts}πEnd;ππprocedure freakout0(lines : word; count : byte); assembler;πasmπ  mov dx, $3DA   {vga status port}π  cliπ  cldππ @V1:π  (* in   al, dxπ     test al, 8π     jz   @V1 {vertical retrace}π  @V2:π     in   al, dxπ     test al, 8π     jnz  @V2π  *)ππ  mov di,[lines]ππ @L:π  mov  dl, $C8π  mov  al, 0  {color}π  out  dx, alπ  inc  dxπ  mov  al, bhπ  out  dx, alπ  add  al, 20π  out  dx, alπ  out  dx, alπ  add  bh, 17π  mov  dl, $DAπ  in   al, dxπ  test al, 1π  jz   @L;  {until horizontal retrace}ππ  dec  diπ  jnz  @Lππ  mov  dl, $DAπ  dec  countπ  jnz  @V1π  sti                    {enable interrupts}πEnd;ππconstπ pal : array [0..3 * 28 - 1] of byte =π   (2,4,4,π    4,8,8,π    6,12,12,π    8,16,16,π    10,20,20,π    12,24,24,π    14,28,28,π    16,32,32,π    18,36,36,π    20,40,40,π    22,44,44,π    24,48,48,π    26,52,52,π    26,52,52,π    28,56,56,π    28,56,56,π    30,60,60,π    30,60,60,π    30,60,60,π    33,63,63,π    33,63,63,π    33,63,63,π    33,63,63,π    33,63,63,π    30,60,60,π    28,56,56,π    26,52,52,π    24,48,48);ππvarπ  i : integer;ππbeginπ  asmπ    mov ax, $13π    int $10π  end;π  for i := 50 to 149 doπ    fillchar(mem[$A000 : i * 320 + 50], 220, 1);ππ  repeatπ    copperBars(pal, 398, 0, 8);  {398 because of scan doubling}π  until keypressed;π  readkey;ππ  repeatπ    freakout0(398, 8);  {398 because of scan doubling}π  until keypressed;π  readkey;ππ  asmπ    mov ax, 3π    int $10π  end;πend.π                                                                                                                   18     08-27-9321:03ALL                      CHRIS BEISEL             Screen Fades             IMPORT              18     ╓   {πCHRIS BEISELππI've gotten many compliments on these two fade routines (a few goodπprogrammers thought they were asm!)... plus, I made them so you can fadeπpart on the palette also... It's very smooth on my 486, as well as 386'sπand 286's at friends houses...ππ        set up in your type declarationsπ                rgbtype=recordπ                    red,green,blue:byte;π                end;π                rgbarray[0..255] of rgbtype;ππ        and in your var declarations have something likeπ                rgbpal:rgbarray;ππ        and set your colors in that...π}πprocedure fadein(fadepal : rgbarray; col1, col2 : byte);πvarπ  lcv,π  lcv2 : integer;π  tpal : rgbarray;πbeginπ  for lcv := col1 to col2 doπ  beginπ    TPal[lcv].red   := 0;π    TPal[lcv].green := 0;π    TPal[lcv].blue  := 0;π  end;π  for lcv := 0 to 63 doπ  beginπ    for lcv2:=col1 to col2 doπ    beginπ      if fadepal[lcv2].red > TPal[lcv2].red thenπ        TPal[lcv2].red := TPal[lcv2].red + 1;π      if fadepal[lcv2].green > TPal[lcv2].green thenπ        TPal[lcv2].green := TPal[lcv2].green + 1;π      if fadepal[lcv2].blue > TPal[lcv2].blue thenπ        TPal[lcv2].blue := TPal[lcv2].blue+1;ππ      setcolor(lcv2, TPal[lcv2].red, TPal[lcv2].green, TPal[lcv2].blue);π    end;π    refresh;π  end;πend;ππ{*******************************************************************}ππprocedure fadeout(fadepal : rgbarray; col1, col2 : byte);πvarπ  lcv,π  lcv2 : integer;π  TPal : rgbarray;πbeginπ  for lcv := col1 to col2 doπ  beginπ    TPal[lcv].red   := 0;π    TPal[lcv].green := 0;π    TPal[lcv].blue  := 0;π  end;π  for lcv := 0 to 63 doπ  beginπ    for lcv2 := col1 to col2 doπ    beginπ      if fadepal[lcv2].red > TPal[lcv2].red thenπ        fadepal[lcv2].red := fadepal[lcv2].red - 1;π      if fadepal[lcv2].green > TPal[lcv2].green thenπ        fadepal[lcv2].green := fadepal[lcv2].green - 1;π      if fadepal[lcv2].blue > TPal[lcv2].blue thenπ        fadepal[lcv2].blue := fadepal[lcv2].blue - 1;ππ      setcolor(lcv2, fadepal[lcv2].red, fadepal[lcv2].green, fadepal[lcv2].blue);π    end;π    refresh;π  end;πend;ππ{*******************************************************************}ππ          19     08-27-9321:25ALL                      ANDRE JAKOBS             Graphic FX Unit          IMPORT              318    ╓   {πI hope you can do something With these listingsπI downloaded from a BBS near me....πThis File contains:  Program VGA3dπ                     Unit DDFigsπ                     Unit DDVarsπ                     Unit DDVideoπ                     Unit DDProcsπJust break it in pieces on the cut here signs......ππif you need some Units or Programs (or TxtFiles) on Programming the Adlib/πSound-Blaster or Roland MPU-401, just let me know, and i see if i can digπup some good listings.....πBut , will your game also have Soundblaster/adlib fm support and SoundπBlaster Digitized Sound support, maybe even MPU/MT32? support....πAnd try to make it as bloody as you can (Heads exploding etc..)(JOKE)ππI hope i you can complete your game (i haven't completed any of my games yet)πAnd i like a copy of it when it's ready......ππPlease leave a message if you received this File.ππ  Andre Jakobsπ    MicroBrain Technologies Inc.π        GelderlandLaan 9π          5691 KL   Son en Breugelπ            The Netherlands............π}πππProgram animatie_van_3d_vector_grafics;ππUsesπ  Crt,π  ddvideo,π  ddfigs,π  ddprocs,π  ddVars;ππVarπ  Opal : paletteType;ππProcedure wireframe(pro : vertex2Array);π{ Teken een lijnen diagram van gesloten voorwerpen met vlakken }πVarπ  i, j, k,π  v1, v2  : Integer;πbeginπ  For i :=  1 to ntf DOπ  beginπ    j := nfac[i];π    if j <> 0 thenπ    beginπ      v1 := faclist[ facfront[j] + size[j] ];π      For k :=  1 to size[j] DOπ      beginπ        v2 := faclist[facfront[j] + k];π        if (v1<v2) or (super[i] <> 0 ) thenπ          linepto(colour[j], pro[v1], pro[v2])π        v1 := v2;π      end;π    end;π  end;πend;ππProcedure hidden(pro : vertex2Array);π{ Display van Objecten als geheel van de projectiepunten van pro }π{ b is een masker voor de kleuren }πVarπ  i,  col : Integer;ππ  Function signe( n : Real) : Integer;π  beginπ    if n >0 thenπ      signe := -1π    elseπ    if n <0 thenπ      signe := 1π    elseπ      signe := 0;π  end;ππ  Function orient(f : Integer; v : vertex2Array) : Integer;π  Varπ    i, ind1,π    ind2, ind3 : Integer;π    dv1, dv2   : vector2;π  beginπ    i := nfac[f];π    if i = 0 thenπ      orient := 0π    elseπ    beginπ      ind1   := faclist[facfront[i] + 1];π      ind2   := faclist[facfront[i] + 2];π      ind3   := faclist[facfront[i] + 3];π      dv1.x  := v[ind2].x - v[ind1].x;π      dv1.y  := v[ind2].y - v[ind1].y;π      dv2.x  := v[ind3].x - v[ind2].x;π      dv2.y  := v[ind3].y - v[ind2].y;π      orient := signe(dv1.x * dv2.y - dv2.x * dv1.y);π    end;π  end;ππ  Procedure facetfill(k : Integer);π  Varπ    v           : vector2Array;π    i, index, j : Integer;π  beginπ    j := nfac[k];π    For i :=  1 to size[j] DOπ    beginπ      index := faclist[facfront[j] + i];π      v[i]  := pro[index];π    end;π    fillpoly(colour[k], size[j], v);π    polydraw(colour[k] - 1, size[j], v);π  end;ππ  Procedure seefacet(k : Integer);π  Varπ    ipt, supk : Integer;π  beginπ    facetfill(k);π    ipt := firstsup[k];π    While ipt <> 0 DOπ    beginπ      supk := facetinfacet[ipt].info;π       facetfill(supk);π      ipt := facetinfacet[ipt].Pointer;π    end;π  end;ππ{ hidden Programmacode }πbeginπ  For i := 1 to nof DOπ  if super[i] = 0 thenπ    if orient(i, pro) = 1 thenπ      seefacet(i);πend;ππProcedure display;πVarπ  i : Integer;πbeginπ  {observe}π  For i := 1 to nov DOπ    transform(act[i], Q, obs[i]);ππ  {project}π  ntv := nov;π  ntf := nof;π  For i := 1 to ntv DOπ  beginπ    pro[i].x := obs[i].x;π    pro[i].y := obs[i].y;π  end;ππ  {drawit}π  switch := switch xor 1;π  hidden(pro);π  Scherm_actief(switch);π  Virscherm_actief(switch xor 1);π  wisscherm(prevpoints, $a000, $8a00);π  wis_hline(prevhline, $8a00);π  prevpoints := points;prevhline := hline;π  points[0]  := 0;π  hline[0]   := 0;πend;ππProcedure anim3d;πVarπ  A, B, C, D, E, F,π  G, H, I, J, QE, P    : matrix4x4;π  zoom, inz, inzplus   : Real;π  angle, angleinc,π  beta, betainc, frame : Integer;π  huidigpalette        : paletteType;ππ  { Kubus Animatie : Roterende kubus }π  Procedure kubus;π  beginπ    angle    := 0;π    angleinc := 9;π    beta     := 0;π    betainc  := 2;π    direct.x := 9;π    direct.y := 2;π    direct.z := -3;π    findQ;π    cubesetup(104);π    frame := 0;ππ    While (NOT (KeyPressed)) and (frame < 91) doπ    beginπ      frame   := frame + 1;π      xyscale := zoom * 2 * sinus(beta);π      rot3(1, trunc(angle/2), Qe);π      rot3(2, angle, P);π      mult3(P, Qe, P);π      cube(P);π      display;π      angle := angle + angleinc;π      beta  := beta + betainc;π      nov   := 0;π    end;π  end;ππ  {Piramides Animatie : Scene opgebouwd uit twee Piramides en 1 Kubus }π  Procedure Piramides;π  beginπ    frame   := 0;π    angle   := 0;π    beta    := 0;π    betainc := 2;π    scale3(4.0, 0.2, 4.0, C);π    cubesetup(90);π    cube(P);ππ    scale3(2.5, 4.0, 2.5, D);π    tran3(2.0, -0.2, 2.0, E);π    mult3(E, D, F);π    pirasetup(34);π    piramid(P);ππ    scale3(2.0, 4.0, 2.0, G);π    tran3(-3.0, -0.2, 0.0, H);π    mult3(H, G, I);π    pirasetup(42);π    piramid(P);ππ    E := Q;π    nov := 0;ππ    While (NOT (KeyPressed)) and (frame < 18) doπ    beginπ      frame   := frame + 1;π      xyscale := zoom * 2 * sinus(beta);ππ      rot3(2, angle, B);ππ      mult3(B, C, P);π      cube(P);ππ      mult3(B, F, P);π      piramid(P);ππ      mult3(B, I, P);π      piramid(P);ππ      display;ππ      angle := angle + angleinc;π      beta  := beta + betainc;π      nov   := 0;π     end;ππ     frame := 0;π     angleinc := 7;ππ     While (NOT (KeyPressed)) and (frame < 75) doπ     beginπ       frame := frame + 1;ππ       rot3(2, angle, B);ππ       mult3(B, C, P);π       cube(P);ππ       mult3(B, F, P);π       piramid(P);ππ       mult3(B, I, P);π       piramid(P);ππ       display;ππ       angle := angle + angleinc;π       nov   := 0;π     end;ππ     frame := 0;π     beta := 180-beta;ππ     While (NOT (KeyPressed)) and (frame < 19) doπ     beginππ       frame := frame + 1;ππ       xyscale := zoom * 2 * sinus(beta);π       rot3(2, angle, B);ππ       mult3(C, B, P);π       cube(P);ππ       mult3(B, F, P);π       piramid(P);ππ       mult3(B, I, P);π       piramid(P);ππ       display;ππ       angle := angle + angleinc;π       beta  := beta  + betainc;π       nov   := 0;π    end;π  end;ππ  { Huis_animatie4 : Figuur huis roteert en "komt uit de lucht vallen" }π  Procedure huisval;π  beginπ    xyscale  := zoom;π    nof      := 0;π    nov      := 0;π    last     := 0;π    angle    := 1355;π    angleinc := -7;π    frame    := 0;ππ    huissetup;ππ    zoom     := 0.02;π    Direct.x := 30;π    direct.y := -2;π    direct.z := 30;π    findQ;ππ    While (NOT (KeyPressed)) and (frame < 40) doπ    beginπ      frame := frame + 1;π      zoom  := zoom + 0.01;π      Scale3(zoom, zoom, zoom, Qe);π      tran3(0, (-7 / zoom) + frame / 1.8, 0, A);π      mult3(Qe, A, C);π      rot3(2, angle, B);π      mult3(C, B, P);π      huis(P);π      display;π      angle := angle + angleinc;π      nov   := 0;π    end;ππ    frame   := 0;π    beta    := angle;π    betainc := angleinc;ππ    While (NOT (KeyPressed)) and (frame < 15) doπ    beginπ      frame := frame + 1;ππ      rot3(2, beta, B);π      mult3(B, Qe, P);π      mult3(P, A, P);π      huis(P);ππ      display;ππ      beta    := beta + betainc;π      betainc := trunc(betainc + (7 / 15));π      nov     := 0;π    end;ππ    frame := 0;ππ    While (NOT (KeyPressed)) and (frame < 30) doπ    beginπ      frame    := frame + 1;π      direct.z := direct.z - (frame * (20 / 70));π      findQ;π      huis(P);π      display;π      nov := 0;π    end;ππ    frame := 0;π    zoom  := 1;ππ    While (NOT (KeyPressed)) and (frame < 31) doπ    beginπ      frame := frame + 1;π      mult3(B, Qe, P);π      scale3(zoom, zoom, zoom, C);π      mult3(P, A, P);π      mult3(P, C, P);π      huis(P);π      display;π      zoom := zoom - 1 / 30;π      nov  := 0;π    end;ππ    zoom := xyscale;π  end;ππ  { Ster Animatie : Roterende ster als kubus met 4 piramides }π  Procedure Sterrot;π  beginπ    xyscale  := zoom;π    frame    := 0;π    angle    := 0;π    angleinc := 9;π    beta     := 0;π    betainc  := 2;π    nof      := 0;π    last     := 0;π    nov      := 0;ππ    stersetup(140);π    scale3(0, 0, 0, P);π    ster(P, 4);ππ    Direct.x := 30;π    direct.y := -2;π    direct.z := 30;π    findQ;π    E := Q;ππ    While (NOT (KeyPressed)) and (frame < 90) doπ    beginπ      frame   := frame + 1;π      xyscale := zoom * 1.7 * sinus(beta);π      rot3(1, Round(angle/5), A);π      mult3(A, E, Q);π      rot3(2, angle, P);π      ster(P, 4);π      display;π      angle := angle + angleinc;π      beta  := beta  + betainc;π      nov   := 0;π    end;π  end;ππbeginπ  eye.x := 0;π  eye.y := 0;π  eye.z :=  0;π  zoom  := xyscale;π  Repeatπ    nov  := 0;π    nof  := 0;π    last := 0;π    Kubus;π    Piramides;π    Huisval;π    Sterrot;π  Until KeyPressed;πend;ππ{ _______________Hoofd Programma --------------------- }ππbeginπ  nov  := 0;π  nof  := 0;π  last := 0;π  start('pira', 15,  Opal);ππ  points[0]     := 0;π  prevpoints[0] := 0;π  hline[0]      := 0;π  prevhline[0]  := 0;ππ  anim3D;ππ  finish(Opal);π  Writeln('Coded by ...... " De Vectorman "');π  Writeln;πend.πππ{ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ }ππUnit ddfigs;ππInterfaceππUsesπ  DDprocs, DDVars;ππConstπ  cubevert : Array [1..8] of vector3 =π    ((x :  1; y :  1; z :  1),π     (x :  1; y : -1; z :  1),π     (x :  1; y : -1; z : -1),π     (x :  1; y :  1; z : -1),π     (x : -1; y :  1; z :  1),π     (x : -1; y : -1; z :  1),π     (x : -1; y : -1; z : -1),π     (x : -1; y :  1; z : -1));ππ  cubefacet : Array [1..6, 1..4] of Integer =π    ((1, 2, 3, 4),π     (1, 4, 8, 5),π     (1, 5, 6, 2),π     (3, 7, 8, 4),π     (2, 6, 7, 3),π     (5, 8, 7, 6));ππ  piravert  : Array [1..5] of vector3 =π    ((x :  0; y :  1; z :  0),π     (x :  1; y :  0; z : -1),π     (x : -1; y :  0; z : -1),π     (x : -1; y :  0; z :  1),π     (x :  1; y :  0; z :  1));ππ  pirafacet : Array [1..5, 1..3] of Integer =π    ((1, 2, 3),π     (1, 3, 4),π     (1, 4, 5),π     (1, 5, 2),π     (5, 4, 3));ππ  huisvert  : Array[1..59] of vector3 =π    ((x : -6; y :  0; z :  4), (x :  6; y : 0; z :  4),π     (x :  6; y :  0; z : -4),π     (x : -6; y :  0; z : -4), (x : -6; y : 8; z :  4), (x :  6; y : 8; z :  4),π     (x :  6; y : 11; z :  0), (x :  6; y : 8; z : -4), (x : -6; y : 8; z : -4),π     (x : -6; y : 11; z :  0), (x : -4; y : 1; z :  4), (x : -1; y : 1; z :  4),π     (x : -1; y :  3; z :  4), (x : -4; y : 3; z :  4), (x : -4; y : 5; z :  4),π     (x : -1; y :  5; z :  4), (x : -1; y : 7; z :  4), (x : -4; y : 7; z :  4),π     (x :  0; y :  0; z :  4), (x :  5; y : 0; z :  4), (x :  5; y : 4; z :  4),π     (x :  0; y :  4; z :  4), (x :  1; y : 5; z :  4), (x :  4; y : 5; z :  4),π     (x :  4; y :  7; z :  4), (x :  1; y : 7; z :  4), (x :  6; y : 5; z : -1),π     (x :  6; y :  5; z : -3), (x :  6; y : 7; z : -3), (x :  6; y : 7; z : -1),π     (x :  5; y :  1; z : -4), (x :  2; y : 1; z : -4), (x :  2; y : 3; z : -4),π     (x :  5; y :  3; z : -4), (x :  5; y : 5; z : -4), (x :  2; y : 5; z : -4),π     (x :  2; y :  7; z : -4), (x :  5; y : 7; z : -4), (x :  1; y : 0; z : -4),π     (x : -1; y :  0; z : -4), (x : -1; y : 3; z : -4), (x :  0; y : 4; z : -4),π     (x :  1; y :  3; z : -4), (x : -2; y : 1; z : -4), (x : -5; y : 1; z : -4),π     (x : -5; y :  3; z : -4), (x : -2; y : 3; z : -4), (x : -2; y : 5; z : -4),π     (x : -5; y :  5; z : -4), (x : -5; y : 7; z : -4), (x : -2; y : 7; z : -4),π     (x : -6; y :  0; z :  1), (x : -6; y : 0; z :  3), (x : -6; y : 3; z :  3),π     (x : -6; y :  3; z :  1), (x : -6; y : 5; z :  1), (x : -6; y : 5; z :  3),π     (x : -6; y :  7; z :  3), (x : -6; y : 7; z :  1));ππ  huissize  : Array [1..19] of Integer =π    (4, 4, 5, 4, 4, 5, 4, 4, 4, 4, 4, 4, 4, 4, 5, 4, 4, 4, 4);ππ  huissuper : Array [1..19] of Integer =π    (0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 3, 4, 4, 4, 4, 4, 6, 6);ππ  huisfacet : Array [1..79] of Integer =π    ( 1,  2,  6,  5,π      5,  6,  7, 10,π      2,  3,  8,  7,π      6,  3,  4,  9,π      8,  8,  9, 10,π      7,  4,  1,  5,π     10,  9,  4,  3,π      2,  1, 11, 12,π     13, 14, 15, 16,π     17, 18, 19, 20,π     21, 22, 23, 24,π     25, 26, 27, 28,π     29, 30, 31, 32,π     33, 34, 35, 36,π     37, 38, 39, 40,π     41, 42, 43, 44,π     45, 46, 47, 48,π     49, 50, 51, 52,π     53, 54, 55, 56,π     57, 58, 59);ππ  stervert : Array [1..6] of vector3 =π    ((x :  1; y :  0; z :  0),π     (x :  0; y :  1; z :  0),π     (x :  0; y :  0; z :  1),π     (x :  0; y :  0; z : -1),π     (x :  0; y : -1; z :  0),π     (x : -1; y :  0; z :  0));ππProcedure cubesetup(c : Integer);πProcedure cube(P : matrix4x4);πProcedure pirasetup(c : Integer);πProcedure piramid(P : matrix4x4);πProcedure huissetup;πProcedure huis(P : matrix4x4);πProcedure hollow(P1 : matrix4x4);πProcedure stersetup(col : Integer);πProcedure ster(P : matrix4x4; d : Real);πProcedure ellips(P : matrix4x4; col : Integer);πProcedure goblet(P : matrix4x4; col : Integer);ππImplementationππProcedure cubesetup(c : Integer);π{ zet kubusdata in facetlist van de scene}πVarπ  i, j : Integer;πbeginπ  For i :=  1 to 6 DOπ  beginπ    For j := 1 to 4 DOπ      faclist[last + j] := cubefacet[i, j] + nov;π    nof := nof + 1;π    facfront[nof] := last;π    colour[nof]   := c;π    nfac[nof]     := nof;π    super[nof]    := 0;π    firstsup[nof] := 0;π    size[nof]     := 4;π    last := last + size[nof];π  end;πend;ππProcedure cube(P : matrix4x4);πVarπ  i, j : Integer;πbeginπ  For i :=  1 to 8 DOπ  beginπ    nov := nov + 1;π    transform(cubevert[i], P, act[nov]);π  end;πend;ππProcedure pirasetup(c : Integer);πVarπ  i, j : Integer;πbeginπ  For i :=  1 to 5 DOπ  beginπ    For j := 1 to 3 DOπ      faclist[last + j] := pirafacet[i, j] + nov;π    nof := nof + 1;π    facfront[nof] := last;π    size[nof]     := 3;π    last          := last + size[nof];π    colour[nof]   := c;π    nfac[nof]     := nof;π    super[nof]    := 0;π    firstsup[nof] := 0;π  end;ππ  size[nof] := 4;π  faclist[facfront[nof] + 4] := 2 + nov;π  last := last + 1;πend;ππProcedure piramid(P : matrix4x4);πVarπ  i, j : Integer;πbeginπ  For i :=  1 to 5 DOπ  beginπ    nov := nov + 1;π    transform(piravert[i], P, act[nov]);π  end;πend;πππProcedure huissetup;πVarπ  i, j,π  host,π  nofstore : Integer;πbeginπ  For i := 1 to 79 DOπ    faclist[last + i] := huisfacet[i] + nov;ππ  nofstore := nof;ππ  For i := 1 to 19 DOπ  beginπ    nof           := nof + 1;π    facfront[nof] := last;π    size[nof]     := huissize[i];π    last          := last + size[nof];π    nfac[nof]     := nof;ππ    if (i = 2) or (i = 5) thenπ      colour[nof] := 111π    elseπ    if i = 7 thenπ      colour[nof] := 20π    elseπ    if i < 8 thenπ      colour[nof] := 42π    elseπ      colour[nof] := 25;ππ    super[nof] := huissuper[i];π    firstsup[nof] := 0;ππ    if super[nof] <> 0 thenπ    beginπ      host := super[nof] + nofstore;π      super[nof] := host;π      pushfacet(firstsup[host], nof);π    end;π  end;π  For i  :=  1 to 59 DOπ    setup[i] := huisvert[i];πend;ππProcedure huis(P : matrix4x4);πVarπ  i : Integer;πbeginπ  For i := 1 to 59 DOπ  beginπ    nov := nov + 1;π    transform(setup[i], P, act[nov]);π  end;πend;πππProcedure hollow(P1 : matrix4x4);πVarπ  A, B,π  P, P2 : matrix4x4;π  i     : Integer;πbeginπ  For i := 1 to 8 DOπ  beginπ    tran3(4.0 * cubevert[i].x, 4.0 * cubevert[i].y, 4.0 * cubevert[i].z, P2);π    mult3(P1, P2, P);π    cube(P);π  end;ππ  For i := 1 to 4 DOπ  beginπ    scale3(3.0, 1.0, 1.0, A);π    tran3(0.0, 4.0 * cubevert[i].y, 4.0 * cubevert[i].z, B);π    mult3(A, B, P2);mult3(P1, P2, P);π    cube(P);π    scale3(1.0, 3.0, 1.0, A);π    tran3(4.0 * cubevert[i].y, 0.0, 4.0 * cubevert[i].z, B);π    mult3(A, B, P2);mult3(P1, P2, P);π    cube(P);π    scale3(1.0, 1.0, 3.0, A);π    tran3(4.0 * cubevert[i].z, 4.0 * cubevert[i].y, 0.0, B);π    mult3(A, B, P2);mult3(P1, P2, P);π    cube(P);π  end;πend;ππProcedure stersetup(col : Integer);πVarπ  i, j,π  v1, v2 : Integer;πbeginπ  For i := 1 to 6 DOπ  beginπ    v1 := cubefacet[i, 4] + nov;π    For j := 1 to 4 DOπ    beginπ      v2  := cubefacet[i, j] + nov;π      nof := nof + 1;π      faclist[last + 1] := v1;π      faclist[last + 2] := v2;π      faclist[last + 3] := nov + 8 + i;π      facfront[nof]     := last;π      size[nof] := 3;ππ      last := last + size[nof];π      colour[nof] := col;π      nfac[nof]   := nof;π      super[nof]  := 0;π      firstsup[nof] := 0;π      v1 := v2;π    end;π  end;πend;ππProcedure ster(P : matrix4x4; d : Real);πVarπ  i, j,π  v1, v2 : Integer;π  A, S   : matrix4x4;πbeginπ  For i :=  1 to 8 DOπ  beginπ    nov := nov + 1;π    transform(cubevert[i], P, act[nov]);π  end;ππ  scale3(D, D, D, A);π  mult3(A, P, S);ππ  For i := 1 to 6 DOπ  beginπ    nov := nov + 1;π    transform(stervert[i], S, act[nov]);π  end;πend;ππProcedure ellips(P : matrix4x4; col : Integer);πVarπ  v : vector2Array;π  theta,π  thetadiff,π  i : Integer;πbeginπ  theta := -90;π  thetadiff := -9;π  For i :=  1 to 21 DOπ  beginπ    v[i].x := cosin(theta);π    v[i].y := sinus(theta);π    theta  := theta + thetadiff;π  end;π  bodyofrev(P, col, 21, 20, v);πend;ππProcedure goblet(P : matrix4x4; col : Integer);πConstπ  gobletdat : Array [1..12] of vector2 =π    ((x :  0; y : -16),π     (x :  8; y : -16),π     (x :  8; y : -15),π     (x :  1; y : -15),π     (x :  1; y :  -2),π     (x :  6; y :  -1),π     (x :  8; y :   2),π     (x : 14; y :  14),π     (x : 13; y :  14),π     (x :  7; y :   2),π     (x :  5; y :   0),π     (x :  0; y :   0));ππVarπ  gobl : vector2Array;π  i    : Integer;πbeginπ  For i := 1 to 12 DOπ    gobl[i] := gobletdat[i];π  bodyofrev(P, col, 12, 20, gobl)πend;ππbegin;πend.πππ{ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ }ππUnit ddprocs;ππInterfaceππUsesπ  DDVars;ππConstπ  maxv = 200;π  maxf = 400;π  maxlist = 1000;π  vectorArraysize  = 32;π  sizeofpixelArray = 3200;π  sizeofhlineArray = 320 * 4;ππTypeπ  vector2      = Record x, y : Real; end;π  vector3      = Record x, y, z : Real; end;π  pixelvector  = Record x, y : Integer; end;π  pixelArray   = Array [0..sizeofpixelArray] of Integer;π  hlineArray   = Array [0..sizeofhlineArray] of Integer;π  vector3Array = Array [1..vectorArraysize] of vector3;π  matrix3x3    = Array [1..3, 1..3] of Real;π  matrix4x4    = Array [1..4, 1..4] of Real;π  vertex3Array = Array [1..maxv] of vector3;π  vertex2Array = Array [1..maxv] of vector2;π  vector2Array = Array [1..vectorArraysize ] of vector2;π  facetArray   = Array [1..maxf] of Integer;π  facetlist    = Array [1..maxlist] of Integer;ππConstπ  EenheidsM : matrix4x4 =π    ((1, 0, 0, 0),π     (0, 1, 0, 0),π     (0, 0, 1, 0),π     (0, 0, 0, 1));πVarπ  Q           : matrix4x4;π  eye, direct : vector3;π  nov, ntv,π  ntf, nof,π  last        : Integer;π  setup,π  act, obs    : vertex3Array;π  pro         : vertex2Array;π  faclist     : facetlist;π  colour,π  size,π  facfront,π  nfac,π  super,π  firstsup    : facetArray;π  points,π  prevpoints  : pixelArray;π  hline,π  prevhline   : hlineArray;ππProcedure tran3(tx, ty, tz : Real; Var A : matrix4x4);πProcedure scale3(sx, sy, sz : Real; Var A : matrix4x4);πProcedure rot3(m : Integer; theta : Integer; Var A : matrix4x4);πProcedure mult3(A, B : matrix4x4; Var C : matrix4x4);πProcedure findQ;πProcedure genrot(phi : Integer; b, d : vector3; Var A : matrix4x4);πProcedure transform(v : vector3; A : matrix4x4; Var w : vector3);πProcedure extrude(P : matrix4x4; d : Real; col, n : Integer;π                  v : vector2Array);πProcedure bodyofrev(P : matrix4x4; col, nvert, nhoriz : Integer;π                    v : vector2Array);πProcedure polydraw(c, n : Integer; poly : vector2Array);πProcedure linepto(c : Integer; pt1, pt2 : vector2);πProcedure WisScherm(punten : pixelArray; SchermSeg, VirSeg : Word);πProcedure fillpoly(c, n : Integer; poly : vector2Array);πProcedure Wis_Hline(hline_ar : hlineArray; virseg : Word);ππImplementationππProcedure tran3(tx, ty, tz : Real; Var A : matrix4x4);π{ zet matrix A op punt tx, ty, tz }πbeginπ  A := EenheidsM;π  A[1, 4] := -tx;π  A[2, 4] := -ty;π  A[3, 4] := -tz;πend;ππProcedure scale3(sx, sy, sz : Real; Var A : matrix4x4);π{ zet matrix A om in schaal van sx, sy, sz }πbeginπ  A := EenheidsM;π  A[1, 1] := sx;π  A[2, 2] := sy;π  A[3, 3] := sz;πend;ππProcedure rot3(m : Integer; theta : Integer; Var A : matrix4x4);π{ roteer matrix A om m: 1=x-as; 2=y-as; 3=z-as met hoek theta (in graden)}πVarπ  m1, m2 : Integer;π  c, s   : Real;πbeginπ  A  := EenheidsM;π  m1 := (m MOD 3) + 1;π  m2 := (m1 MOD 3) + 1;π  c  := cosin(theta);π  s  := sinus(theta);π  A[m1, m1] := c;π  A[m2, m2] := c;π  A[m1, m2] := s;π  A[m2, m1] := -s;πend;ππProcedure mult3(A, B : matrix4x4; Var C : matrix4x4);π{ vermenigvuldigd matrix A en B naar matrix C }πVarπ  i, j, k : Integer;π  ab      : Real;πbeginπ  For i := 1 to 4 doπ    For j :=  1 to 4 doπ    beginπ      ab := 0;π      For k := 1 to 4 doπ        ab := ab + A[i, k] * B[k, j];π      C[i, j] := ab;π    end;πend;ππProcedure findQ;π{ Bereken de Observatie-matrix 'Q' voor een punt in de ruimte }πVarπ  E, F, G,π  H, U    : matrix4x4;π  alpha,π  beta,π  gamma   : Integer;π  v, w    : Real;πbeginπ  tran3(eye.x, eye.y, eye.z, F);ππ  alpha := angle(-direct.x, -direct.y);π  rot3(3, alpha, G);ππ  v :=  sqrt( (direct.x * direct.x) + (direct.y * direct.y));π  beta := angle(-direct.z, v);π  rot3(2, beta, H);ππ  w :=  sqrt( (v * v) + (direct.z * direct.z));π  gamma := angle( -direct.x * w,  direct.y * direct.z);π  rot3(3, gamma, U);ππ  mult3(G, F, Q);π  mult3(H, Q, E);π  mult3(U, E, Q);πend;ππProcedure genrot (phi : Integer; b, d : vector3; Var A : matrix4x4);πVarπ  F, G, H,π  W, FI, GI,π  HI, S, T  : matrix4x4;π  v         : Real;π  beta,π  theta     : Integer;πbeginπ  tran3(b.x, b.y, b.z, F);π  tran3(-b.x, -b.y, -b.z, FI);π  theta := angle(d.x, d.y);π  rot3(3, theta, G);π  rot3(3, -theta, GI);π  v := sqrt(d.x * d.x + d.y * d.y);π  beta := angle(d.z, v);π  rot3(2, beta, H);π  rot3(2, -beta, HI);π  rot3(2, beta, H);π  rot3(2, -beta, HI);π  rot3(3, phi, W);π  mult3(G, F, S);π  mult3(H, S, T);π  mult3(W, S, T);π  mult3(HI, S, T);π  mult3(GI, T, S);π  mult3(FI, S, A);πend;ππProcedure transform(v : vector3; A : matrix4x4; Var w : vector3);π{ transformeer colomvector 'v' uit A in colomvector 'w'}πbeginπ  w.x := A[1, 1] * v.x + A[1, 2] * v.y + A[1, 3] * v.z + A[1, 4];π  w.y := A[2, 1] * v.x + A[2, 2] * v.y + A[2, 3] * v.z + A[2, 4];π  w.z := A[3, 1] * v.x + A[3, 2] * v.y + A[3, 3] * v.z + A[3, 4];πend;ππProcedure extrude(P : matrix4x4; d : Real; col, n : Integer;π                  v : vector2Array);π{ Maakt van een 2d-figuur een 3d-figuur }π{ vb: converteert 2d-letters naar 3d-letters }πVarπ  i, j,π  lasti : Integer;π  v3    : vector3;πbeginπ  For i := 1 to n DOπ  beginπ    faclist[last + i] := nov + i;π    faclist[last + n + i] := nov + 2 * n + 1 - i;π  end;π  facfront[nof + 1] := last;π  facfront[nof + 2] := last + n;π  size[nof + 1] := n;π  size[nof + 2] := n;π  nfac[nof + 1] := nof + 1;π  nfac[nof + 2] := nof + 2;π  super[nof + 1] := 0;π  super[nof + 2] := 0;π  firstsup[nof + 1] := 0;π  firstsup[nof + 2] := 0;π  colour[nof + 1] := col;π  colour[nof + 2] := col;π  last  := last + 2 * n;π  nof   := nof + 2;π  lasti := n;ππ  For i := 1 to n DOπ  beginπ    faclist[last + 1] := nov + i;π    faclist[last + 2] := nov + lasti;π    faclist[last + 3] := nov + n + lasti;π    faclist[last + 4] := nov + n + i;π    nof := nof + 1 ;π    facfront[nof] := last;π    size[nof]     := 4;π    nfac[nof]     := nof;π    super[nof]    := 0;π    firstsup[nof] := 0;π    colour[nof]   := col;π    last  := last + 4;π    lasti := i;π  end;π  For i :=  1 To n DOπ  beginπ    v3.x := v[i].x;π    v3.y := v[i].y;π    v3.z := 0.0;π    nov  := nov + 1;π    transform(v3, P, act[nov]);π    v3.z := -d;π    transform(v3, P, act[nov + n]);π  end;π  nov := nov + n;πend;ππProcedure bodyofrev(P : matrix4x4; col, nvert, nhoriz : Integer;π                    v : vector2Array);π{ maakt een "rond" figuur van een 2-dimensionale omlijning van het figuur }πVarπ  theta,π  thetadiff,π  i, j, newnov : Integer;π  c, s         : Array [1 .. 100] of Real;π  index1,π  index2       : Array [1 .. 101] of Integer;πbeginπ  theta := 0;π  thetadiff := trunc(360 / nhoriz);ππ  For i := 1 to nhoriz DOπ  beginπ    c[i]  := cosin(theta);π    s[i]  := sinus(theta);π    theta := theta + thetadiff;π  end;π  newnov := nov;ππ  if abs(v[1].x) < epsilon  thenπ  beginπ    newnov := newnov + 1;π    setup[newnov].x := 0.0;π    setup[newnov].y := v[1].y;π    setup[newnov].z := 0.0;π    For i := 1 to nhoriz + 1 DOπ      index1[i] := newnov;π  endπ  elseπ  beginπ    For i := 1 to nhoriz DOπ    beginπ      newnov := newnov + 1;π      setup[newnov].x := v[1].x * c[i];π      setup[newnov].y := v[1].y;π      setup[newnov].z := -v[1].x * s[i];π      index1[i] := newnov;π    end;π    index1[nhoriz + 1] := index1[i];π  end;ππ  For j :=  2 to nvert DOπ  beginπ    if abs(v[j].x) < epsilon thenπ    beginπ      newnov := newnov + 1;π      setup[newnov].x := 0.0;π      setup[newnov].y := v[j].y;π      setup[newnov].z := 0.0;π      For i := 1 to nhoriz + 1 DOπ        index2[i] := newnov;π    endπ    elseπ    beginπ      For i := 1 To nhoriz DOπ      beginπ        newnov := newnov + 1;π        setup[newnov].x :=  v[j].x * c[i];π        setup[newnov].y :=  v[j].y;π        setup[newnov].z := -v[j].x * s[i];π        index2[i] := newnov;π      end;π      index2[nhoriz + 1] := index2[1];π    end;ππ    if index1[1] <> index1[2] thenπ      if index2[1] = index2[2] thenπ      beginπ        For i := 1 to nhoriz DOπ        beginπ          nof := nof + 1; size[nof] := 3;π          facfront[nof] := last;π          faclist[last + 1] := index1[i + 1];π          faclist[last + 2] := index2[i];π          faclist[last + 3] := index1[i];π          last := last + size[nof];π          nfac[nof]     := nof;π          colour[nof]   := col;π          super[nof]    := 0;π          firstsup[nof] := 0;π        end;π      endπ      elseπ      beginπ        For i := 1 to nhoriz DOπ        beginπ          nof := nof + 1;π          size[nof] := 4;π          facfront[nof] := last;π          faclist[last + 1] := index1[i + 1];π          faclist[last + 2] := index2[i + 2];π          faclist[last + 3] := index2[i];π          faclist[last + 4] := index1[i];π          last := last + size[nof];π          nfac[nof]     := nof;π          colour[nof]   := col;π          super[nof]    := 0;π          firstsup[nof] := 0;π        end;π      endπ      elseπ      if index2[1] <> index2[2] thenπ        For i := 1 to nhoriz DOπ        beginπ          nof := nof + 1;π          size[nof] := 3;π          facfront[nof] := last;π          faclist[last + 1] := index2[i + 1];π          faclist[last + 2] := index2[i];π          faclist[last + 3] := index1[i];π          last := last + size[nof];π          nfac[nof]     := nof;π          colour[nof]   := col;π          super[nof]    := 0;π          firstsup[nof] := 0;π        end;ππ        For i :=  1 to nhoriz + 1 DOπ          index1[i] := index2[i];π  end;ππ  For i :=  nov + 1 to newnov DOπ    transform(setup[i], P, act[i]);ππ  nov := newnov;ππend;ππProcedure BressenHam( Virseg : Word;          { Adres-> VIRSEG:0 }π                      pnts   : pixelArray;π                      c      : Byte;          { c->     kleur    }π                      p1, p2 : pixelvector);  { vector           } Assembler;πVarπ  x, y, error,π  s1,  s2,π  deltax,π  deltay, i   : Integer;π  interchange : Boolean;π  dcolor      : Word;πAsmπ{  initialize Variables  }π  PUSH   dsπ  LDS    si, pntsπ  MOV    ax, virsegπ  MOV    es, axπ  MOV    cx, 320π  MOV    ax, p1.xπ  MOV    x,  axπ  MOV    ax, p1.yπ  MOV    y, axπ  MOV    dcolor, axππ  MOV    ax, p2.x                { deltax := abs(x2 - x1) }π  SUB    ax, p1.x                { s1 := sign(x2 - x1) }π  PUSH   axπ  PUSH   axπ  CALL   ddVars.signπ  MOV    s1, ax;π  POP    axπ  TEST   ax, $8000π  JZ     @@GeenSIGN1π  NEG    axπ @@GeenSign1:π  MOV    deltax, axπ  MOV    ax, p2.yπ  SUB    ax, p1.yπ  PUSH   axπ  PUSH   axπ  CALL   ddVars.signπ  MOV    s2, axπ  POP    axπ  TEST   ax, $8000π  JZ     @@GeenSign2π  NEG    axπ @@GeenSign2:π  MOV    deltay, axππ { Interchange DeltaX and DeltaY depending on the slope of the line }ππ  MOV    interchange, Falseπ  CMP    ax, deltaxπ  JNG    @@NO_INTERCHANGEπ  XCHG   ax, deltaxπ  XCHG   ax, deltayπ  MOV    interchange, Trueππ @@NO_INTERCHANGE:ππ  { Initialize the error term to compensate For a nonzero intercept }ππ  MOV    ax, deltaYπ  SHL    ax, 1π  SUB    ax, deltaXπ  MOV    error, axππ  { Main loop }π  MOV    ax, 1π  MOV    i, axπ @@FOR_begin:π  CMP    ax, deltaXπ  JG     @@EINDE_FOR_LOOPππ  { Plot punt! }π  MOV   bx, xπ  MOV   ax, yπ  MUL   cxπ  ADD   bx, axπ  MOV   al, cπ  MOV   Byte PTR [es:bx], alπ  INC   [Word ptr ds:si]     { aantal verhogen }π  MOV   ax, [si]π  SHL   ax, 1                { offset berekenen }π  PUSH  siπ  ADD   si, axπ  MOV   [si], bxπ  POP   siππ  { While Loop }π @@W1_begin:π  CMP    error, 0π  JL     @@EINDE_WHILEππ  { if interchange then }ππ  CMP    interchange, Trueπ  JE     @@i_is_tπ  MOV    ax, s2π  ADD    y, axπ  JMP    @@w1_eruitππ @@i_is_t:π  MOV    ax, s1π  ADD    x, axππ @@w1_eruit:π  MOV    ax, deltaxπ  SHL    ax, 1π  SUB    error, axπ  JMP    @@w1_beginππ @@EINDE_WHILE:π  CMP    interchange, Trueπ  JE     @@i_is_t_1π  MOV    ax, s1π  ADD    x, axπ  JMP    @@if_2_eruitππ @@i_is_t_1:π  MOV    ax, s2π  ADD    y, axππ @@if_2_eruit:π  MOV    ax, deltayπ  SHL    ax, 1π  ADD    error, axπ  INC    iπ  MOV    ax, iπ  JMP    @@FOR_beginπ @@Einde_for_loop:π  POP    dsπend;ππProcedure linepto(c : Integer; pt1, pt2 : vector2);πVarπ  p1, p2 : pixelvector;πbeginπ  p1.x := fx(pt1.x);π  p1.y := fy(pt1.y);π  p2.x := fx(pt2.x);π  p2.y := fy(pt2.y);π  BressenHam($a000, points, c,  p1,  p2);πend;ππProcedure WisScherm(punten : pixelArray; SchermSeg , Virseg : Word); Assembler;πAsmπ  PUSH      dsπ  MOV       ax, SchermSegπ  MOV       es, axπ  LDS       bx, puntenπ  MOV       cx, [bx]π  JCXZ      @@NietTekenenπ @@Wis:π  INC       bxπ  INC       bxπ  MOV       si, [bx]π  MOV       di, siπ  PUSH      dsπ  MOV       ax, virsegπ  MOV       ds, axπ  MOVSBπ  POP       dsπ  LOOP      @@Wisπ @@NietTekenen:π  POP       dsπend;ππProcedure polydraw(c, n : Integer; poly : vector2Array);πVarπ  i : Integer;πbeginπ  For i :=  1 to n - 1 doπ    linepto(c, poly[i], poly[i + 1]);π  linepto(c, poly[n], poly[1]);πend;ππProcedure fillpoly(c, n : Integer; poly : vector2Array);πVarπ  scan_table : tabel;π  scanline,π  line,π  offsetx    : Integer;ππ  Procedure Draw_horiz_line(hline_ar  : hlineArray;π                            color     : Byte;π                            lijn      : Word;π                            begin_p   : Word;π                            linelen   : Word); Assembler;π  Asmπ    PUSH  dsπ    MOV   cx, 320π    MOV   ax, 0a000hπ    MOV   es, axπ    MOV   di, begin_pπ    MOV   ax, lijnπ    MUL   cxπ    ADD   di, axπ    PUSH  diπ    MOV   al, colorπ    MOV   cx, linelenπ    PUSH  cxπ    REP   STOSBπ    LDS   si, hline_arπ    INC   [Word ptr ds:si]π    MOV   ax, [si]π    SHL   ax, 1π    SHL   ax, 1π    ADD   si, axπ    POP   bxπ    POP   dxπ    MOV   [si], dxπ    MOV   [si + 2], bxπ    POP   dsπ  end;ππ  Procedure swap(Var x, y : Integer);π  beginπ    x := x + y;π    y := x - y;π    x := x - y;π  end;ππ{πProcedure Calc_x(x1, y1, x2, y2 : Word; Var scan_table : tabel);πVarπ  m_inv,π  xReal : Real;πbeginπ  Asmπ    LDS     dx, scan_tableπ    MOV     ax, y1π    MOV     bx, y2π    CMP     ax, bxπ    JNE     @@NotHorizLineπ    MOV     bx, x1π    SHL     ax, 1π    ADD     ax, dxπ    CMP     bx, [dx]π    JGE     @@Notstorexminπ    MOV     [dx], bxππ   @@Notstorexmin:π    INC     dxπ    MOV     bx, x2π    CMP     bx, [dx]π    JLE     @@Klaarπ    MOV     [dx], bxπ    JMP     @@Klaarππ   @@NotHorizLine:π}ππ  Procedure Calc_x(x1, y1, x2, y2 : Integer; Var scan_table : tabel);π  Varπ    m_inv, xReal : Real;π    i, y, temp   : Integer;π  beginπ    if y1 = y2 thenπ    beginπ      if x2 < x1 thenπ        swap(x1, x2)π      elseπ      beginπ        if x1 < scan_table[y1].xmin thenπ          scan_table[y1].xmin := x1;π        if x2 > scan_table[y2].xmax thenπ          scan_table[y2].xmax := x2;π      end;π    endπ    elseπ    beginπ      m_inv := (x2 - x1) / (y2 - y1);ππ      if y1 > y2 then {swap}π      beginπ        swap(y1, y2);π        swap(x1, x2);π      end;ππ      if x1 < scan_table[y1].xmin thenπ        scan_table[y1].xmin := x1;π      if x2 > scan_table[y2].xmax thenπ        scan_table[y2].xmax := x2;π      xReal := x1; y := y1;ππ      While y < y2 doπ      beginπ        y := y + 1;π        xReal := xReal + m_inv;π        offsetx := round(xReal);π        if xReal < scan_table[y].xmin thenπ          scan_table[y].xmin := offsetx;π        if xReal > scan_table[y].xmax thenπ          scan_table[y].xmax := offsetx;π      end;π    end;π  end;ππbeginπ  scan_table := emptytabel;π  For line := 1 to n - 1 doπ    calc_x(fx(poly[line].x), fy(poly[line].y),π           fx(poly[line + 1].x), fy(poly[line + 1].y), scan_table);ππ  calc_x(fx(poly[n].x), fy(poly[n].y),π         fx(poly[1].x), fy(poly[1].y), scan_table);ππ  scanline := 0;ππ  While scanline < nypix - 1 doπ  beginπ    With Scan_table[scanline] DOπ      if xmax > xmin thenπ        draw_horiz_line(hline, c,  scanline,  xmin,  xmax - xmin + 1);π      scanline := scanline + 1;π  end;πend;ππProcedure  Wis_Hline(hline_ar : hlineArray; virseg : Word); Assembler;πAsmπ  PUSH      dsπ  MOV       ax, 0a000hπ  MOV       es, axπ  LDS       bx, hline_arπ  MOV       cx, [bx]π  JCXZ      @@Niet_tekenenπ  ADD       bx, 4π @@Wis:π  XCHG      cx, dxπ  MOV       si, [bx]π  MOV       cx, [bx + 2]π  MOV       di, siπ  PUSH      dsπ  MOV       ax, virsegπ  MOV       ds, axπ  CLDπ  REP       MOVSBπ  POP       dsπ  XCHG      cx, dxπ  ADD       bx, 4π  LOOP      @@Wisπ @@Niet_tekenen:π  POP       dsπend;ππbeginπend.πππ{ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ }ππUnitπ  ddVars;ππInterfaceππConstπ  pi      = 3.1415926535;π  epsilon = 0.000001;π  rad     = pi / 180;π  nxpix   = 320; { scherm resolutie }π  nypix   = 200;π  maxfinf = 200;ππTypeπ  xmaxymax  = Record xmin, xmax : Integer; end;π  facetinfo = Record info, Pointer : Integer; end;π  tabel     = Array [1..nypix - 1] of xmaxymax;π  sincos    = Array [0..359] of Real;ππVarπ  sinusArray   : sincos;π  cosinusArray : sincos;π  facetinfacet : Array [1..maxfinf] of facetinfo;π  facetfree    : Integer;π  xyscale      : Real;π  emptytabel   : tabel;ππFunction  fx(x : Real) : Integer;πFunction  fy(y : Real) : Integer;πFunction  Sign(I : Integer) : Integer;πFunction  macht(a, n : Real) : Real;πFunction  angle(x, y : Real) : Integer;πFunction  sinus(hoek : Integer) : Real;πFunction  cosin(hoek : Integer) : Real;πProcedure pushfacet(Var stackname : Integer; value : Integer);ππImplementationππFunction fx(x : Real) : Integer;πbeginπ  fx := nxpix - trunc(x * xyscale + nxpix * 0.5 - 0.5);πend;ππFunction fy(y : Real) : Integer;πbeginπ  fy := nypix - trunc(y * xyscale + nypix * 0.5 - 0.5);πend;ππFunction Sign(I : Integer) : Integer; Assembler;πAsmπ  MOV  ax, iπ  CMP  ax, 0π  JGE  @@Zero_or_oneπ  MOV  ax, -1π  JMP  @@Exitππ @@Zero_or_One:π  JE   @@Nulπ  MOV  ax, 1π  JMP  @@Exitππ @@Nul:π  xor  ax, axππ @@Exit:πend;ππFunction macht(a, n : Real) : Real;πbeginπ  if a > 0 thenπ    macht :=  exp(n * (ln(a)))π  elseπ  if a < 0 thenπ    macht := -exp(n * (ln(-a)))π  elseπ    macht := a;πend;ππFunction angle(x, y : Real) : Integer;πbeginπ  if abs(x) < epsilon thenπ    if abs(y) < epsilon thenπ      angle := 0π    elseπ    if y > 0.0 thenπ      angle := 90π    elseπ      angle := 270π  elseπ  if x < 0.0 thenπ    angle := round(arctan(y / x) / rad) + 180π  elseπ    angle := round(arctan(y / x) / rad);πend;ππFunction sinus(hoek : Integer) : Real;πbeginπ  hoek  := hoek mod 360;π  sinus := sinusArray[hoek];πend;ππFunction cosin(hoek : Integer) : Real;πbeginπ  hoek  := hoek mod 360 ;π  cosin := cosinusArray[hoek];πend;ππProcedure pushfacet(Var stackname : Integer; value : Integer);πVarπ  location : Integer;πbeginπ  if facetfree = 0 thenπ  beginπ    Write('Cannot hold more facets');π    HALT;π  endπ  elseπ  beginπ    location  := facetfree;π    facetfree := facetinfacet[facetfree].Pointer;π    facetinfacet[location].info := value;π    facetinfacet[location].Pointer := stackname;π    stackname := location;π  end;πend;ππVarπ  i : Integer;πbeginπ  { vul sinus- en cosinusArray met waarden }π  For i := 0 to 359 DOπ  beginπ    sinusArray[i]   := sin(i * rad);π    cosinusArray[i] := cos(i * rad);π  end;π  { Init facetinfacet }π  facetfree := 1;π  For i :=  1 to maxfinf - 1 DOπ    facetinfacet[i].Pointer := i + 1;ππ  facetinfacet[maxfinf].Pointer := 0;ππ  { Init EmptyTabel }π  For i := 0 to nypix - 1 DOπ  beginπ    Emptytabel[i].xmin := 319;π    Emptytabel[i].xmax := 0;π  end;πend.πππ{ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ }ππUnit ddvideo;ππInterfaceππUsesπ  Dos, DDVars;ππTypeπ  schermPointer = ^schermType;π  schermType    = Array [0..nypix - 1, 0..nxpix - 1] of Byte;π  color         = Record  R, G, B : Byte; end;π  paletteType   = Array [0..255] of color;π  WordArray     = Array [0..3] of Word;π  palFile       = File of paletteType;π  picFile       = File of schermType;ππVarπ  scherm    : schermType Absolute $8A00 : $0000;π  schermptr : schermPointer;π  switch    : Integer;ππProcedure start(Filenaam : String; horiz : Real; Var Oldpal : paletteType);πProcedure finish(Oldpal : paletteType);πProcedure VirScherm_actief(switch : Word);πProcedure Scherm_actief(switch : Word);ππImplementationππProcedure Virscherm_actief(switch : Word); Assembler;πAsmπ  MOV     dx, 3cchπ  MOV     cx, switchπ  JCXZ    @@volgendeπ  in      al, dx             { switch=1 }π  and     al, 0dfhπ  MOV     dx, 3c2hπ  OUT     dx, al             { set even mode }π  JMP     @@Klaarππ @@Volgende:π  in      al, dx             { switch=0 }π  or      al, 20hπ  MOV     dx, 3c2hπ  OUT     dx, al             { set odd mode }ππ @@Klaar:π  MOV     dx, 3dah           { Wacht op Vert-retrace }π  in      al, dx             { Zodat virscherm = invisible }π  TEST    al, 08hπ  JZ      @@Klaarπend;ππProcedure Scherm_actief(switch : Word);πbeginπ  Asmπ   @@Wacht:π    MOV  dx, 3dahπ    in   al, dxπ    TEST al, 01hπ    JNZ  @@Wachtπ  end;π  port[$3d4] := $c;π  port[$3d5] := switch * $80;πend;ππProcedure SetVgaPalette(Var p : paletteType);πVarπ  regs : Registers;πbeginπ  With regs doπ  beginπ    ax := $1012;π    bx := 0;π    cx := 256;π    es := seg(p);π    dx := ofs(p);π  end;π  intr ($10, regs);πend;πππProcedure start(Filenaam : String; horiz : Real; Var Oldpal : paletteType);ππ  Procedure readimage(Filenaam : String; Var pal : paletteType);ππ    Function FileExists(FileName : String) : Boolean;π    Varπ      f : File;π    beginπ      {$I-}π      Assign(f,  FileName);π      Reset(f);π      Close(f);π      {$I + }π      FileExists := (IOResult = 0) and (FileName <> '');π    end;ππ  Varπ    pFile : picFile;π    lFile : palFile;π    a     : Integer;π  beginπ    if (FileExists(Filenaam + '.pal')) andπ       (FileExists(Filenaam + '.dwg')) thenπ    beginπ      assign(lFile, Filenaam + '.pal');π      reset(lFile);π      read(lFile, pal);π      close(lFile);π      assign(pFile, Filenaam + '.dwg');π      reset(pFile);π      read(pFile, schermptr^);π      close(pFile);π    endπ    elseπ    beginπ      Writeln('Palette en Picture bestanden niet gevonden....');π      Halt;π    end;π  end;ππ  Procedure SetVgaMode; Assembler;π  Asmπ    mov  ah, 0π    mov  al, 13hπ    int  $10π  end;ππ  Procedure GetVgaPalette(Var p : paletteType);π  Varπ    regs : Registers;π  beginπ    With regs doπ    beginπ      ax := $1017;π      bx := 0;π      cx := 256;π      es := seg(p);π      dx := ofs(p);π    end;π    intr ($10, regs);π  end;ππVarπ  pal : paletteType;ππbeginπ  getmem(schermptr, sizeof(schermType));π  readimage(Filenaam, pal);π  GetVgaPalette(OldPal);π  SetVgaPalette(pal);π  SetVgaMode;π  move(schermptr^, scherm, nypix * nxpix);π  Virscherm_actief(0);π  move(schermptr^, mem[$A000 : 0], nypix * nxpix);     { blanko scherm }π  VirScherm_actief(1);π  move(schermptr^, mem[$A000 : 0], nypix * nxpix);     { blanko scherm }π  Scherm_actief(1);π  switch  := 0;π  xyscale := (nypix - 1) / horiz;πend;ππProcedure finish(Oldpal : paletteType);ππ  Procedure SetNormalMode; Assembler;π  Asmπ    mov  ah,  0π    mov  al,  3π    int  $10π  end;ππbeginπ  SetVgaPalette(Oldpal);π  SetNormalMode;π  Virscherm_actief(0);π  Freemem(schermptr, sizeof(schermType));πend;ππbeginπend.π                    20     08-27-9321:27ALL                      SWAG SUPPORT TEAM        A Simple Graph Unit      IMPORT              12     ╓   Unit MyGraph;ππInterfaceππTypeπ  ColorValue = Recordπ    Rvalue,π    Gvalue,π    Bvalue : Byte;π  end;ππ  PaleteType = Array [0..255] of ColorValue;ππProcedure palette(tp : paleteType);πProcedure pset(x, y : Integer; c : Byte);πFunction  Point(x, y : Integer) : Byte;πProcedure RotatePalette(Var p : PaleteType; n1, n2, d : Integer);πProcedure SetVga;ππImplementationππUsesπ  Crt, Dos;ππππVarπ  n, x,π  y, c, i : Integer;π  ch      : Char;π  p       : PaleteType;π  image   : File;π  ok      : Boolean;ππProcedure palette(tp : PaleteType);πVarπ  regs : Registers;πbegin { Procedure VGApalette }π  Regs.AX := $1012;π  Regs.BX := 0; { first register to set }π  Regs.CX := 256; { number of Registers to set }π  Regs.ES := Seg(tp);π  Regs.DX := Ofs(tp);π  Intr($10, regs);πend; { Procedure SetVGApalette }ππProcedure Pset(x, y : Integer; c : Byte);πbegin { Procedure PutPixel }π  mem[$A000 : Word(320 * y + x)] := c;πend; { Procedure PutPixel }ππFunction point(x, y : Integer) : Byte;πbegin { Function GetPixel }π  Point := mem[$A000 : Word(320 * y + x)];πend; { Function GetPixel }ππProcedure rotatePalette(Var p : PaleteType; n1, n2, d : Integer);πVarπ  q : PaleteType;πbegin { Procedure rotatePalette }π  q := p;π  For i := n1 to n2 doπ    p[i] := q[n1 + (i + d) mod (n2 - n1 + 1)];π  palette(p);πend; { Procedure rotatePalette }ππProcedure SetVga;πbeginπ  Inline($B8/$13/$00/$CD/$10);πend;ππend.ππ           21     08-27-9321:37ALL                      MARK DIXON               ModeX Code               IMPORT              41     ╓   {πMARK DIXONππUm, have a look at this, and see what you can come up with. It's some code Iπwrote a while back to use mode-x and do double buffering (or page-flipping).π}ππProgram Test_ModeX;ππUsesπ  crt;πππ{ This program will put the VGA card into a MODEX mode (still only 320x200)π  and demonstrate double buffering (page flipping)ππ  This program was written by Mark Dixon, and has been donated to theπ  Public Domain with the exception that if you make use of these routines,π  the author of these routines would appreciate his name mentioned somewhereπ  in the documentation.ππ  Use these routines at your own risk! Because they use the VGA's registers,π  cards that are not 100% register compatible may not function correctly, andπ  may even be damaged. The author will bear no responsability for any actionsπ  occuring as a direct (or even indirect) result of the use of this program.ππ  Any donations (eg Money, Postcards, death threats.. ) can be sent to  :ππ  Mark Dixonπ  12 Finchley Stπ  Lynwood,π  Western Australiaπ  6147ππ  If you have Netmail access, then I can also be contacted on 3:690/660.14ππ  }ππConstπ  Page : Byte = 0;ππVarπ  I, J : Word;πππProcedure InitModeX;π{ Sets up video mode to Mode X (320x200x256 with NO CHAIN4) making availableπ  4 pages of 4x16k bitmaps }πBeginπ  asmπ    mov    ax, 0013h    { Use bios to enter standard Mode 13h }π    int    10hπ    mov    dx, 03c4h    { Set up DX to one of the VGA registers }π    mov    al, 04h      { Register = Sequencer : Memory Modes }π    out    dx, alπ    inc    dx           { Now get the status of the register }π    in     al, dx       { from the next port }π    and    al, 0c7h     { AND it with 11000111b ie, bits 3,4,5 wiped }π    or     al, 04h      { Turn on bit 2 (00000100b) }π    out    dx, al       { and send it out to the register }π    mov    dx, 03c4h    { Again, get ready to activate a register }π    mov    al, 02h      { Register = Map Mask }π    out    dx, alπ    inc    dxπ    mov    al, 0fh      { Send 00001111b to Map Mask register }π    out    dx, al       { Setting all planes active }π    mov    ax, 0a000h   { VGA memory segment is 0a000h }π    mov    es, ax       { load it into ES }π    sub    di, di       { clear DI }π    mov    ax, di       { clear AX }π    mov    cx, 8000h    { set entire 64k memory area (all 4 pages) }π    repnz  stosw        { to colour BLACK (ie, Clear screens) }π    mov    dx, 03d4h    { User another VGA register }π    mov    al, 14h      { Register = Underline Location }π    out    dx, alπ    inc    dx           { Read status of register }π    in     al, dx       { into AL }π    and    al, 0bFh     { AND AL with 10111111b }π    out    dx, al       { and send it to the register }π                        { to deactivate Double Word mode addressing }π    dec    dx           { Okay, this time we want another register,}π    mov    al, 17h      { Register = CRTC : Mode Control }π    out    dx, alπ    inc    dxπ    in     al, dx       { Get status of this register }π    or     al, 40h      { and Turn the 6th bit ON }π    out    dx, al       { to turn WORD mode off }π                        { And thats all there is too it!}π  End;πEnd;πππProcedure Flip;π{ This routine will flip to the next page, and change the value inπ  PAGE such that we will allways be drawing to the invisible page. }πVarπ  OfsAdr : Word;πBeginπ  OfsAdr := Page * 16000;π  asmπ    mov    dx, 03D4hπ    mov    al, 0Dh      { Set the Start address LOW register }π    out    dx, alπ    inc    dxππ    mov    ax, OfsAdrπ    out    dx, al       { by sending low byte of offset address }π    dec    dxπ    mov    al, 0Ch      { now set the Start Address HIGH register }π    out    dx, alπ    inc    dxπ    mov    al, ahπ    out    dx, al       { by sending high byte of offset address }π  End;ππ  Page := 1 - Page;     { Flip the page value.π                          Effectively does a :π                          If Page = 0 then Page = 1 elseπ                          If Page = 1 then Page = 0.       }πEnd;ππππProcedure PutPixel (X, Y : Integer; Colour : Byte );π{ Puts a pixel on the screen at the current page. }πVarπ  OfsAdr : Word;πBEGINπ  OfsAdr := Page * 16000;π  ASMπ    mov    bx, xπ    mov    ax, Yπ    mov    cx, 80     { Since there are now 4 pixels per byte, weπ                        only multiply by 80 (320/4) }π    mul    cxπ    mov    di, axπ    mov    ax, bxπ    shr    ax, 1π    shr    ax, 1π    add    di, axπ    and    bx, 3π    mov    ah, 1π    mov    cl, blπ    shl    ah, clππ    mov    al, 2π    mov    dx, 03C4hππ    mov    bx, $A000π    mov    es, bxπ    add    di, OfsAdrππ    out    dx, ax        { Set plane to address (where AH=Plane) }π    mov    al, Colourπ    mov    es:[di], alπ  end;πend;ππBeginπ  Randomize;π  InitModeX;π  Flip;ππ  For I := 0 to 319 doπ    For J := 0 to 199 doπ      PutPixel(I, J, Random(32) );π  Flip;ππ  For I := 0 to 319 doπ    For J := 0 to 199 doπ      PutPixel(I, J, Random(32) + 32);ππ  Repeatπ    Flip;π    Delay(200);π  Until Keypressed;ππEnd.π                                                                                               22     08-27-9321:52ALL                      MIKE BRENNAN             Rotate Grahic Image      IMPORT              17     ╓   {πMIKE BRENNANππ> I've been trying For some time to get a Pascal Procedure that canπ> SCALE and/or ROTATE Graphic images. if anyone has any idea how to doππ    Here are a couple of Procedures I made For rotating images, 2D and 3D.  Iπbasically had to rotate each dot individually, and then form the image byπconnecting the specified dots.  Here they are...π}ππProcedure Rotate(cent1, cent2 : Integer;     { Two centroids For rotation }π                 angle : Real;               { Angle to rotate in degrees }π                 Var coord1, coord2 : Real); { both coordinates to rotate }πVarπ  coord1t, coord2t : Real;πbeginπ  {Set coordinates For temp system}π  coord1t := coord1 - cent1;π  coord2t := coord2 - cent2;ππ  {set new rotated coordinates}π  coord1 := coord1t * cos(angle * pi / 180) - coord2t * sin(angle * pi / 180);π  coord2 := coord1t * sin(angle * pi / 180) + coord2t * cos(angle * pi / 180);ππ  {Change coordinates from temp system}π  coord1 := coord1 + cent1;π  coord2 := coord2 + cent2;πend;ππProcedure Draw3d(x, y, z : Real; {coordinates} a, b : Real; {View angles}π                 Var newx, newy : Integer); {return coordinates}πVarπ  Xd, Yd, Zd : Real;πbeginπ  Xd := cos(a * pi / 180) * cos(b * pi / 180);π  Yd := cos(b * pi / 180) * sin(a * pi / 180);π  Zd := -sin(b * pi / 180);π  {Set coordinates For X/Y system}π  newx:= round(-z * Xd / Zd + x);π  newy:= round(-z * Yd / Zd + y);πend;ππ{πFor the first Procedure, you can rotate an image along any two axes, (ieπX,Y...X,Z...Y,Z).  Simply calculate the centroid For each axe, (the average Xπcoordinate, or Y or Z), then pass the angle to rotate (use a negative For otherπdirection) and it will pass back the new rotated coordinates.ππ    The second Procedure is For 3D drawing only. It transforms any 3D dot intoπits corresponding position on a 2D plan (ie your screen).  The new coordinatesπare returned in the NewX, and NewY. Those are what you would use to plot yourπdot on the screen.π}                                                                                  23     08-27-9321:52ALL                      SEAN PALMER              Another Graphic Rotate   IMPORT              58     ╓   {πSEAN PALMERππ> I've been trying For some time to get a Pascal Procedure that canπ> SCALE and/or ROTATE Graphic images. if anyone has any idea how to do this,π> or has a source code, PLEEEAASSEE drop me a line.. THANK YOU!ππThis is an out-and-out blatant hack of the routines from Abrash'sπXSHARP21. They are too slow to be usable as implemented here.π}ππ{$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+}π{$M $2000,0,0}πProgram VectTest;πUsesπ  Crt, b320x200; {<-this Unit just implements Plot(x, y) and Color : Byte; }ππConstπ  ClipMinY = 0;π  ClipMaxY = 199;π  ClipMinX = 0;π  ClipMaxX = 319;π  VertMax  = 3;ππTypeπ  fixed = Recordπ    Case Byte ofπ      0 : (f : Byte; si : shortint);π      1 : (f2, b : Byte);π      2 : (w : Word);π      3 : (i : Integer);π    end;ππ  ByteArray = Array [0..63999] of Byte;ππ  VertRec   = Recordπ    X, Y : Byte;π  end;ππ  VertArr   = Array [0..VertMax] Of VertRec;π  EdgeScan  = Recordπ    scansLeft   : Integer;π    Currentend  : Integer;π    srcX, srcY  : fixed;π    srcStepX,π    srcStepY    : fixed;π    dstX        : Integer;π    dstXIntStep : Integer;π    dstXdir     : Integer;π    dstXErrTerm : Integer;π    dstXAdjUp   : Integer;π    dstXAdjDown : Integer;π    dir         : shortInt;π  end;ππConstπ  numVerts = 4;π  mapX     = 7;π  mapY     = 7;ππ  Vertex : Array [0..vertMax] of vertRec =π    ((x : 040; y : 020),π     (x : 160; y : 050),π     (x : 160; y : 149),π     (x : 040; y : 179));ππ  Points : Array [0..vertMax] of vertRec =π    ((x : 0; y : 0),π     (x : mapX; y : 0),π     (x : mapX; y : mapY),π     (x : 0; y : mapY));ππ  texMap : Array [0..mapY, 0..mapX] of Byte =π    (($F, $F, $F, $F, $F, $F, $F, $0),π     ($F, $7, $7, $7, $7, $7, $F, $0),π     ($F, $7, $2, $2, $2, $7, $F, $0),π     ($F, $7, $2, $2, $2, $7, $F, $0),π     ($F, $7, $2, $2, $9, $7, $F, $0),π     ($F, $7, $2, $2, $2, $7, $F, $0),π     ($F, $7, $2, $2, $2, $7, $F, $0),π     ($0, $0, $0, $0, $0, $0, $0, $0));ππVarπ  lfEdge,π  rtEdge : EdgeScan;π  z, z2  : Integer;ππFunction fixedDiv(d1, d2 : LongInt) : LongInt; Assembler;πAsmπ  db  $66; xor dx, dxπ  mov cx, Word ptr D1+2π  or  cx, cxπ  jns @Sπ  db  $66; dec dxπ @S:π  mov dx, cxπ  mov ax, Word ptr D1π  db  $66; shl ax, 16π  db  $66; idiv Word ptr d2π  db  $66; mov dx, axπ  db  $66; shr dx, 16πend;ππFunction div2Fixed(d1, d2 : LongInt) : LongInt; Assembler;πAsmπ  db $66; xor dx, dxπ  db $66; mov ax, Word ptr d1π  db $66; shl ax, 16π  jns @Sπ  db $66; dec dxπ @S:π  db $66; idiv Word ptr d2π  db $66; mov dx, axπ  db $66; shr dx, 16πend;ππFunction divfix(d1, d2 : Integer) : Integer; Assembler;πAsmπ  mov  al, Byte ptr d1+1π  cbwπ  mov  dx, axπ  xor  al, alπ  mov  ah, Byte ptr d1π  idiv d2πend;ππProcedure Draw;πVarπ  MinY,π  MaxY,π  MinVert,π  MaxVert,π  I, dstY  : Integer;ππ  Function SetUpEdge(Var Edge : EdgeScan; StartVert : Integer) : Boolean;π  Varπ    NextVert   : shortint;π    dstXWidth  : Integer;π    T,π    dstYHeight : fixed;π  beginπ    SetUpEdge := True;π    While (StartVert <> MaxVert) Doπ    beginπ      NextVert := StartVert + Edge.dir;π      if (NextVert >= NumVerts) Thenπ        NextVert := 0π      elseπ      if (NextVert < 0) Thenπ        NextVert := pred(NumVerts);ππ      With Edge Doπ      beginπ       scansLeft := vertex[NextVert].Y - vertex[StartVert].Y;π       if (scansLeft <> 0) Thenπ       beginπ         dstYHeight.f  := 0;π         dstYHeight.si := scansLeft;π         Currentend    := NextVert;π         srcX.f  := 0;π         srcX.si := Points[StartVert].X;π         srcY.f  := 0;π         srcY.si := Points[StartVert].Y;π         srcStepX.i := divFix(points[nextVert].x - srcX.si, scansLeft);π         srcStepY.i := divFix(points[nextVert].y - srcY.si, scansLeft);π         dstX       := vertex[StartVert].X;π         dstXWidth  := vertex[NextVert].X-vertex[StartVert].X;ππ         if (dstXWidth < 0) Thenπ         beginπ           dstXdir     := -1;π           dstXWidth   := -dstXWidth;π           dstXErrTerm := 1 - scansLeft;π           dstXIntStep := -(dstXWidth Div scansLeft);π         endπ         elseπ         beginπ           dstXdir     := 1;π           dstXErrTerm := 0;π           dstXIntStep := dstXWidth Div scansLeft;π         end;π         dstXAdjUp   := dstXWidth Mod scansLeft;π         dstXAdjDown := scansLeft;π         Exit;π       end;π       StartVert := NextVert;π      end;π    end;π    SetUpEdge := False;π  end;ππ  Function StepEdge(Var Edge : EdgeScan) : Boolean;π  beginπ    Dec(Edge.scansLeft);π    if (Edge.scansLeft = 0) Thenπ    beginπ      StepEdge := SetUpEdge(Edge, Edge.Currentend);π      Exit;π    end;π    With Edge Doπ    beginπ      Inc(srcX.i, srcStepX.i);π      Inc(srcY.i, srcStepY.i);π      Inc(dstX, dstXIntStep);π      Inc(dstXErrTerm, dstXAdjUp);π      if (dstXErrTerm > 0) Thenπ      beginπ        Inc(dstX, dstXdir);π        Dec(dstXErrTerm, dstXAdjDown);π      end;π    end;π    StepEdge := True;π  end;ππ  Procedure ScanOutLine;π  Varπ    srcX,π    srcY     : fixed;π    dstX,π    dstXMax  : Integer;π    dstWidth,π    srcXStep,π    srcYStep : fixed;π  beginπ    srcX.w  := lfEdge.srcX.w;π    srcY.w  := lfEdge.srcY.w;π    dstX    := lfEdge.dstX;π    dstXMax := rtEdge.dstX;ππ    if (dstXMax <= ClipMinX) Or (dstX >= ClipMaxX) Thenπ      Exit;π    dstWidth.f  := 0;π    dstWidth.si := dstXMax - dstX;π    if (dstWidth.i <= 0) Thenπ      Exit;π    srcXStep.i := divFix(rtEdge.srcX.i - srcX.i, dstWidth.i);π    srcYStep.i := divFix(rtEdge.srcY.i - srcY.i, dstWidth.i);π    if (dstXMax > ClipMaxX) Thenπ      dstXMax := ClipMaxX;π    if (dstX < ClipMinX) Thenπ    beginπ      Inc(srcX.i, srcXStep.i * (ClipMinX - dstX));π      Inc(srcY.i, srcYStep.i * (ClipMinX - dstX));π      dstX := ClipMinX;π    end;ππ    Asmπ     mov  ax, $A000π     mov  es, axπ     mov  ax, xResπ     mul  dstYπ     add  ax, dstXπ     mov  di, axπ     mov  cx, dstXMaxπ     sub  cx, dstXπ     mov  bx, srcXStep.iπ     mov  dx, srcYStep.iπ    @L:π     mov  al, srcY.&siπ     xor  ah, ahπ     shl  ax, 3π     add  al, srcX.&siπ     add  ax, offset texmapπ     mov  si, axπ     movsbπ     add  srcX.i,bxπ     add  srcY.i,dxπ     loop @Lπ     end;π   end;ππbeginπ  if (NumVerts < 3) Thenπ    Exit;π  MinY := vertex[numVerts - 1].y;π  maxY := vertex[numVerts - 1].y;π  maxVert := numVerts - 1;π  minVert := numVerts - 1;π  For I := numVerts - 2 downto 0 Doπ  beginπ    if (vertex[I].Y < MinY) Thenπ    beginπ      MinY    := vertex[I].Y;π      MinVert := I;π    end;π    if (vertex[I].Y > MaxY) Thenπ    beginπ      MaxY    := vertex[I].Y;π      MaxVert := I;π    end;π  end;π  if (MinY >= MaxY) Thenπ    Exit;π  dstY := MinY;π  lfEdge.dir := -1;π  SetUpEdge(lfEdge, MinVert);π  rtEdge.dir := 1;π  SetUpEdge(rtEdge, MinVert);π  While (dstY < ClipMaxY) Doπ  beginπ    if (dstY >= ClipMinY) Thenπ      ScanOutLine;π    if Not StepEdge(lfEdge) Thenπ      Exit;π    if Not StepEdge(rtEdge) Thenπ      Exit;π    Inc(dstY);π  end;πend;ππbeginπ  directVideo := False;π  TextAttr    := 63;π  { For z:=0 to mapY do For z2:=0 to mapx do texMap[z,z2]:=random(6+53);}π  For z := 4 to 38 doπ  beginπ    clearGraph;π    vertex[0].x := z * 4;π    vertex[3].x := z * 4;π    draw;π    if KeyPressed thenπ    beginπ      ReadKey;π      ReadKey;π    end;π  end;π  readln;πend.ππ                                                                                            24     08-27-9321:52ALL                      WILLIAM SITCH            Rotate PIC               IMPORT              22     ╓   {πWILLIAM SITCHππ> I've been trying For some time to get a Pascalπ> Procedure that can SCALE and/or ROTATE Graphic images. ifπ> anyone has any idea how to do this, or has a source code,π> PLEEEAASSEE drop me a line.. THANK YOU!ππHere is some code to rotate an image (in MCGA screen mode $13) ... but it has aπfew drawbacks... its kinda slow and the image falls apart during rotation... itπhasn't been tested fully either...π}ππProcedure rotate(x1, y1, x2, y2 : Word; ang, ainc : Real);πVarπ  ca, sa :  Real;π  cx, cy :  Real;π  dx, dy :  Real;π  h, i,π  j, k   :  Word;ππ  pinf   :  Array [1..12500] of Recordπ    x, y :  Word;π    col  :  Byte;π  end;ππbeginπ  ca := cos((ainc / 180) * pi);π  sa := sin((ainc / 180) * pi);ππ  For h := 1 to round(ang / ainc) doπ  beginπ    k  := 0;π    cx := x1 + ((x2 - x1) / 2);π    cy := y1 + ((y2 - y1) / 2);π    For i := x1 to x2 doπ      For j := y1 to y2 doπ      beginπ        inc(k);ππ        dx := cx + (((i - cx) * ca) - ((j - cy) * sa));π        dy := cy + (((i - cx) * sa) + ((j - cy) * ca));ππ        if (round(dx) > 0) and (round(dy) > 0) andπ           (round(dx) < 65000) and (round(dy) < 65000) thenπ        beginπ          pinf[k].x   := round(dx);π          pinf[k].y   := round(dy);π          pinf[k].col := mem[$A000 : j * 320 + i];π        endπ        elseπ        beginπ          pinf[k].x   := 0;π          pinf[k].y   := 0;π          pinf[k].col := 0;π        end;π      end;ππ      For i := x1 to x2 doπ        For j := y1 to y2 doπ          mem[$A000 : j * 320 + i] := 0;ππ      x1 := 320;π      x2 := 1;π      y1 := 200;π      y2 := 1;π      For i := 1 to k doπ      beginπ        if (pinf[i].x < x1) thenπ          x1 := pinf[i].x;π        if (pinf[i].x > x2) thenπ          x2 := pinf[i].x;ππ        if (pinf[i].y < y1) thenπ          y1 := pinf[i].y;π        if (pinf[i].y > y2) thenπ          y2 := pinf[i].y;ππ        if (pinf[i].x > 0) and (pinf[i].y > 0) thenπ          mem[$A000 : pinf[i].y * 320 + pinf[i].x] := pinf[i].col;π      end;π  end;πend;ππ{πIt works, but DON'T try to use it For a main module or base a Program AROUNDπit... instead try to change it to suit your needs, as right now it's kindaπoptimized For my needs...ππSorry For not editing it to work With any screen mode, but I just don't haveπthe time.  MCGA memory is a linear block of Bytes, and you can access it using:πmem[$A000:offset].  So to find the color at screen position 10,10, you wouldπgo:ππmem[$A000 : y * 320 + x]π          ^     ^     ^-- x val, 10π          |     |----- screenwidthπ          |-------- y val, 10π}                                                                                                                        25     08-27-9321:58ALL                      WILLIAM SITCH            Graphic Spinning Disk    IMPORT              24     ╓   {πWILLIAM SITCHππ> Okay, I've just finally got my hands on the formulas forπ> doing good Graphics manipulations...well, I decided to startπ> With something simple.  A rotating square.  But it DOESN'Tπ> WORK RIGHT.  I noticed the size seemed to shift in and outπ> and a little testing showed me that instead of following aπ> circular path (as they SHOULD), the corners (while spinning)π> actually trace out an OCTAGON. Why????  I've checked andπ> rechecked the formula logic...It's just as I was given.  Soπ> there's some quirk about the code that I don't know about.π> Here's the rotating routine:ππAhhh... "rounding errors" is what my comp sci teacher explained to me, butπthere isn't much you can do about it... I've included my (rather long)πspinning disc code to take a look at ... feel free to try to port it to yourπapplication...ππ}ππUsesπ  Graph, Crt;ππProcedure spin_disk;πTypeπ  pointdataType = Array [1..4] of Record x,y : Integer; end;πConstπ  delVar = 10;ππVarπ  ch       :  Char;π  p, op    :  pointdataType;π  cx, cy,π  x, y, r  :  Integer;π  i        :  Integer;π  rot      :  Integer;π  tempx,π  tempy    :  Integer;π  theta    :  Real;π  down     :  Boolean;π  del      :  Real;πbeginπ  cx := getmaxx div 2;π  cy := getmaxy div 2;π  r := 150;π  circle(cx,cy,r);ππ  rot := 0;π  p[1].x := 100;  p[1].y := 0;π  p[2].x := 0;    p[2].y := -100;π  p[3].x := -100; p[3].y := 0;π  p[4].x := 0;    p[4].y := 100;π  del := 50;π  down := True;ππ  Repeatπ    rot := rot + 2;π    theta := rot * 3.14 / 180;π    For i := 1 to 4 doπ      beginπ        tempx := p[i].x;π        tempy := p[i].y;π        op[i].x := p[i].x;π        op[i].y := p[i].y;π        p[i].x := round(cos(theta) * tempx - sin(theta) * tempy);π        p[i].y := round(sin(theta) * tempx + cos(theta) * tempy);π      end;π    setcolor(0);π    line(op[1].x + cx,cy - op[1].y,op[2].x + cx,cy - op[2].y);π    line(op[2].x + cx,cy - op[2].y,op[3].x + cx,cy - op[3].y);π    line(op[3].x + cx,cy - op[3].y,op[4].x + cx,cy - op[4].y);π    line(op[4].x + cx,cy - op[4].y,op[1].x + cx,cy - op[1].y);π    For i := 1 to 4 doπ      line(op[i].x + cx,cy - op[i].y,cx,cy);π    setcolor(11);π    line(p[1].x + cx,cy - p[1].y,p[2].x + cx,cy - p[2].y);π    line(p[2].x + cx,cy - p[2].y,p[3].x + cx,cy - p[3].y);π    line(p[3].x + cx,cy - p[3].y,p[4].x + cx,cy - p[4].y);π    line(p[4].x + cx,cy - p[4].y,p[1].x + cx,cy - p[1].y);π    setcolor(10);π    For i := 1 to 4 doπ      line(p[i].x + cx,cy - p[i].y,cx,cy);π    if (del < 1) thenπ      down := Falseπ    else if (del > 50) thenπ      down := True;π    if (down) thenπ      del := del - delVarπ    elseπ      del := del + delVar;π    Delay(round(del));π  Until (KeyPressed = True);π  ch := ReadKey;π  NoSound;πend;ππVarπ  Gd, Gm : Integer;ππbeginπ  Gd := Detect;π  InitGraph(Gd, Gm, 'd:\bp\bgi');ππ  Spin_disk;ππend.                                                                                                                      26     08-27-9321:59ALL                      SEAN PALMER              Drawing a B-Spline curve IMPORT              22     ╓   {πSEAN PALMERππI was just toying around With a B-Spline curve routine I got out of anπold issue of Byte, and thought it was pretty neat. I changed it to useπfixed point fractions instead of Reals, and optimized it some...ππby Sean Palmerπpublic domainπ}ππVarπ  color : Byte;πProcedure plot(x, y : Word);πbeginπ  mem[$A000 : y * 320 + x] := color;πend;ππTypeπ  coord = Recordπ    x, y : Word;π  end;ππ  CurveDataRec = Array [0..65521 div sizeof(coord)] of coord;ππFunction fracMul(f, f2 : Word) : Word;πInline(π  $58/                   {pop ax}π  $5B/                   {pop bx}π  $F7/$E3/               {mul bx}π  $89/$D0);              {mov ax,dx}ππFunction mul(f, f2 : Word) : LongInt;πInline(π  $58/                   {pop ax}π  $5B/                   {pop bx}π  $F7/$E3);              {mul bx}πππConstπ  nSteps = 1 shl 8;  {about 8 For smoothness (dots), 4 For speed (lines)}ππProcedure drawBSpline(Var d0 : coord; nPoints : Word);πConstπ  nsa  = $10000 div 6;π  nsb  = $20000 div 3;π  step = $10000 div nSteps;πVarπ  i, xx, yy,π  t1, t2, t3,π  c1, c2, c3, c4 : Word;ππ  d : curveDataRec Absolute d0;ππbeginπ  t1 := 0;π  color := 32 + 2;ππ  For i := 0 to nPoints - 4 doπ  beginππ   {algorithm converted from Steve Enns' original Basic subroutine}ππ    Repeatπ      t2 := fracMul(t1, t1);π      t3 := fracMul(t2, t1);π      c1 := (Integer(t2 - t1) div 2) + nsa - fracmul(nsa, t3);π      c2 := (t3 shr 1) + nsb - t2;π      c3 := ((t2 + t1 - t3) shr 1) + nsa;π      c4 := fracmul(nsa, t3);π      xx := (mul(c1, d[i].x) + mul(c2, d[i + 1].x) +π             mul(c3, d[i + 2].x) + mul(c4, d[i + 3].x)) shr 16;π      yy := (mul(c1, d[i].y) + mul(c2, d[i + 1].y) +π             mul(c3, d[i + 2].y) + mul(c4, d[i + 3].y)) shr 16;π      plot(xx, yy);π      inc(t1, step);π    Until t1 = 0;  {this is why nSteps must be even power of 2}π   inc(color);π   end;πend;ππConstπ  pts = 24; {number of points} {chose this because of colors}ππVarπ  c : Array [-1..2 + pts] of coord;π  i : Integer;πbeginπ  Asmπ    mov ax, $13π    int $10π  end;  {init vga/mcga Graphics}π  randomize;π  For i := 1 to pts doπ  With c[i] doπ  beginπ    {x:=i*(319 div pts);}    {for precision demo}π    x := random(320);               {for fun demo}π    y := random(200);π  end;π  {for i:=1 to pts div 2 do c[i*2+1].y:=c[i*2].y;}    {fit closer}π  For i := 1 to pts doπ  With c[i] doπ  beginπ    color := i + 32;π    plot(x, y);π  end;π  {replicate end points so curves fit to input}π  c[-1] := c[1];π  c[0]  := c[1];π  c[pts + 1] := c[pts];π  c[pts + 2] := c[pts];π  drawBSpline(c[-1], pts + 4);π  readln;π  Asmπ    mov ax, 3π    int $10π  end;  {Text mode again}πend.π                                                    27     08-27-9321:59ALL                      SEAN PALMER              Another B-Spline Curve   IMPORT              35     ╓   {πSEAN PALMERππI've been playing around with it as a way to make 'heat-seekingπmissiles' in games. Very interesting...ππWhat I do is have the points set up as follows:ππ1   : current positionπ2&3 : current speed + the current positionπ4   : destinationππand update current position by indexing somewhere into the curve (likeπat $100 out of $FFFFππThis works very well. Problem is that I don't know of a good way toπchange the speed.ππHere is a simple demo that makes a dot chase the mouse cursor (needsπVGA as written) that shows what I mean.ππIf ANYBODY can make this work smoother or improve on it in any way Iπwould appreciate being told how... 8)π}ππusesπ  mouse, crt;  { you will need to change accesses to the mouse unit }π               { to use a mouse package that you provide }πtypeπ  coord = recordπ    x, y : word;π  end;π  CurveDataRec = array [0..65521 div sizeof(coord)] of coord;ππconstπ  nSteps = 1 shl 8;  {about 8 for smoothness (dots), 4 for speed (lines)}ππvarπ  color : byte;π  src, spd,π  dst, mov1,π  mov2 : coord;π  i : integer;ππprocedure plot(x, y : word);πbeginπ  mem[$A000 : y * 320 + x] := color;πend;ππfunction fracMul(f, f2 : word) : word;πInline(π  $58/                   {pop ax}π  $5B/                   {pop bx}π  $F7/$E3/               {mul bx}π  $89/$D0);              {mov ax,dx}ππfunction mul(f, f2 : word) : longint;πinline(π  $58/                   {pop ax}π  $5B/                   {pop bx}π  $F7/$E3);              {mul bx}πππ{this is the original full BSpline routine}ππprocedure drawBSpline(var d0 : coord; nPoints : word);πconstπ  nsa  = $10000 div 6;π  nsb  = $20000 div 3;π  step = $10000 div nSteps;πvarπ  i, xx, yy : word;π  t1, t2, t3 : word;π  c1, c2, c3, c4 : word;π  d : curveDataRec absolute d0;πbeginπ  t1 := 0;π  color := 32 + 2;π  for i := 0 to nPoints - 4 doπ  beginπ    {algorithm converted from Steve Enns' original Basic subroutine}π    repeatπ      t2 := fracMul(t1, t1);π      t3 := fracMul(t2, t1);π      c1 := (integer(t2 - t1) div 2) + nsa - fracmul(nsa, t3);π      c2 := (t3 shr 1) + nsb - t2;π      c3 := ((t2 + t1 - t3) shr 1) + nsa;π      c4 := fracmul(nsa, t3);π      xx := (mul(c1, d[i].x) + mul(c2, d[i + 1].x) +π             mul(c3, d[i + 2].x) + mul(c4, d[i + 3].x)) shr 16;π      yy := (mul(c1, d[i].y) + mul(c2, d[i + 1].y) +π             mul(c3, d[i + 2].y) + mul(c4, d[i + 3].y)) shr 16;π      plot(xx, yy);π      inc(t1, step);π    until t1 = 0;  {this is why nSteps must be even power of 2}π    inc(color);π  end;πend;πππ{find 1/nth point in BSpline}  {this is what does the B-Spline work}ππprocedure moveTowards(d1, d2, d3, d4 : coord; t1 : word; var mov : coord);πconstπ  nsa = $10000 div 6;π  nsb = $20000 div 3;πvarπ  t2, t3 : word;π  c1, c2,π  c3, c4 : word;πbeginπ  t2 := fracMul(t1, t1);π  t3 := fracMul(t2, t1);π  c1 := (integer(t2 - t1) div 2) + nsa - fracmul(nsa, t3);π  c2 := (t3 shr 1) + nsb - t2;π  c3 := ((t2 + t1 - t3) shr 1) + nsa;π  c4 := fracmul(nsa, t3);π  mov.x := (mul(c1, d1.x) + mul(c2, d2.x) + mul(c3, d3.x) + mul(c4, d4.x)) shr 16;π  mov.y := (mul(c1, d1.y) + mul(c2, d2.y) + mul(c3, d3.y) + mul(c4, d4.y)) shr 16;πend;ππbeginπ  asmπ    mov ax, $13π    int $10π  end;  {init vga/mcga graphics}ππ  {mouse.init;}π  mshow;ππ  src.x := 5;π  src.y := 5;π  spd.x := 5;π  spd.y := 5;π  dst.x := 315;π  dst.y := 190;ππ  repeatπ   {for i:=0 to 23 do begin}π   { color:=i+32;}π   { inc(dst.x,i);}π    delay(10);π    {mouse.check;}  {this loads Mouse.X, Mouse.Y, Mouse.Button from driver}π    mhide;π    color := 15;π    plot(src.x, src.y);π    color := 14;π    plot(spd.x, spd.y);π    dst.x := mousex shr 1;π    dst.y := mousey;π    color := 1;π    plot(dst.x, dst.y);π    mshow;ππ    {the parameters in these next two lines can be changed}π    {I have played with almost all possible combinations and}π    {most work, but not well, so don't be afraid to play around}π    {But I think an entirely different approach is needed for the}π    {second moveTowards..}ππ    moveTowards(src, src, spd, dst, $0010, mov1);π    moveTowards(src, spd, dst, dst, $5000, mov2);π    src := mov1;π    longint(spd) := (longint(spd) * 7 + longint(mov2)) shr 3 and $1FFF1FFF;π  until 1=0;ππ  mhide;ππ  asmπ    mov ax, 3π    int $10π  end; {text mode again}πend.ππ                                                                                                               28     08-27-9322:00ALL                      BRENDEN BEAMAN           Another Star field       IMPORT              14     ╓   { BRendEN BEAMAN }ππProgram starfield;πUsesπ  Crt, Graph;ππVarπ  l, l2,π  gd, gm,π  x, y   : Integer;π  rad    : Array [1..20] of Integer;π  p      : Array [1..20, 1..5] of Integer;ππProcedure put(p, rad : Integer; col : Word);πbeginπ  setcolor(col);  {1 pixel arc instead of putpixel}π  arc(x, y, p, p + 1, rad);πend;ππProcedure putstar;πbeginπ  For l := 1 to 20 do      {putting stars. #15 below is color of stars}π    For l2 := 1 to 5 do put(p[l, l2], rad[l], 15);πend;ππProcedure delstar;πbeginπ  For l := 1 to 20 do  {erasing stars}π    For l2 := 1 to 5 do put(p[l, l2], rad[l], 0);πend;ππbeginπ  randomize;π  gd := detect;π  initGraph(gd, gm, 'd:\bp\bgi');π  x := 320;π  y := 240;ππ  For l := 1 to 20 doπ    rad[l] := l * 10;π  For l := 1 to 20 doπ    For l2 := 1 to 5 doπ      p[l, l2] := random(360);ππ  While not KeyPressed doπ  beginπ    delstar;π    For l := 1 to 20 doπ    begin                {moving stars towards 'camera'}π      rad[l] := rad[l] + round(rad[l] / 20 + 1); { (20)=starspeed.  }π      if rad[l] > 400 thenπ        rad[l] := l * 10;                 { starspeed must be equal }π    end;                                   { to or less than 20     }π    putstar;π  end;π  readln;πend.ππ   The concept is fairly simple, but most people underestimate arcs...π you can set where on the circle, (0-360 degres) the arc starts, andπ stops... if you set a one pixel arc at 100, and increase the radius ofπ the circle in a loop, it will apear to come towards you in threeπ dimentions... any other questions, or problems running it, contactπ me... ttylπ                                                                                               29     08-27-9322:08ALL                      SEAN PALMER              TWEAKED! Graph unit      IMPORT              132    ╓   {$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+} {TP 6.0 & 286 required!}πUnit x320x240;ππ{π Sean Palmer, 1993π released to the Public Domainπ in tweaked modes, each latch/bit plane contains the entire 8-bit pixel.π the sequencer map mask determines which plane (pixel) to update, and, whenπ reading, the read map select reg determines which plane (pixel) to read.π almost exactly opposite from regular vga 16-color modes which is why I neverπ could get my routines to work For BOTH modes. 8)ππ  # = source screen pixelπ  Normal 16-color         Tweaked 256-colorππ      Bit Mask                Bit Maskπ      76543210                33333333π Map  76543210           Map  22222222π Mask 76543210           Mask 11111111π      76543210                00000000ππ  Functional equivalentsπ      Bit Mask        =       Seq Map Maskπ      Seq Map Mask    =       Bit Maskπ}πππInterfaceππVarπ  color : Byte;ππConstπ xRes    = 320;π yRes    = 240;   {displayed screen size}π xMax    = xRes - 1;π yMax    = yRes - 1;π xMid    = xMax div 2;π yMid    = yMax div 2;π vxRes   = 512;π vyRes   = $40000 div vxRes; {virtual screen size}π nColors = 256;π tsx : Byte = 8;π tsy : Byte = 8;  {tile size}πππProcedure plot(x, y : Integer);πFunction  scrn(x, y : Integer) : Byte;ππProcedure hLin(x, x2, y : Integer);πProcedure vLin(x, y, y2 : Integer);πProcedure rect(x, y, x2, y2 : Integer);πProcedure pane(x, y, x2, y2 : Integer);ππProcedure line(x, y, x2, y2 : Integer);πProcedure oval(xc, yc, a, b : Integer);πProcedure disk(xc, yc, a, b : Integer);πProcedure fill(x, y : Integer);ππProcedure putTile(x, y : Integer; p : Pointer);πProcedure overTile(x, y : Integer; p : Pointer);πProcedure putChar(x, y : Integer; p : Word);ππProcedure setColor(color, r, g, b : Byte);π{rgb vals are from 0-63}πFunction  getColor(color : Byte) : LongInt;π{returns $00rrggbb format}πProcedure setPalette(color : Byte; num : Word; Var rgb);π{rgb is list of 3-Byte rgb vals}πProcedure getPalette(color : Byte; num : Word; Var rgb);ππProcedure clearGraph;πProcedure setWriteMode(f : Byte);πProcedure waitRetrace;πProcedure setWindow(x, y : Integer);ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππImplementationππConstπ  vSeg     = $A000;        {video segment}π  vxBytes  = vxRes div 4;  {Bytes per virtual scan line}π  seqPort  = $3C4;   {Sequencer}π  gcPort   = $3CE;    {Graphics Controller}π  attrPort = $3C0;   {attribute Controller}ππ  tableReadIndex    = $3C7;π  tableWriteIndex   = $3C8;π  tableDataRegister = $3C9;ππ  CrtcRegLen   = 10;π  CrtcRegTable : Array [1..CrtcRegLen] of Word =π    ($0D06, $3E07, $4109, $EA10, $AC11, $DF12, $0014, $E715, $0616, $E317);ππππVarπ  CrtcPort   : Word;  {Crt controller}π  oldMode    : Byte;π  ExitSave   : Pointer;π  input1Port : Word;  {Crtc Input Status Reg #1=CrtcPort+6}π  fillVal    : Byte;ππTypeπ tRGB = Recordπ   r, g, b : Byte;π end;ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππProcedure clearGraph; Assembler;πAsmπ  mov ax, vSegπ  mov es, axπ  mov dx, seqPortπ  mov ax, $0F02π  out dx, ax {enable whole map mask}π  xor di, diπ  mov cx, $8000 {screen size in Words}π  cldπ  mov al, colorπ  mov ah, alπ  repz stosw {clear screen}πend;ππProcedure setWriteMode(f : Byte); Assembler;πAsm {copy/and/or/xor modes}π  mov ah, fπ  shl ah, 3π  mov al, 3π  mov dx, gcPortπ  out dx, ax {Function select reg}πend;ππProcedure waitRetrace; Assembler;πAsmπ  mov  dx, CrtcPortπ  add  dx, 6 {find Crt status reg (input port #1)}π @L1:π  in   al, dxπ  test al, 8π  jnz  @L1;  {wait For no v retrace}π @L2:π  in   al, dxπ  test al, 8π  jz   @L2 {wait For v retrace}π end;πππ{π Since a virtual screen can be larger than the actual screen, scrolling isπ possible.  This routine sets the upper left corner of the screen to theπ specified pixel. Make sure 0 <= x <= vxRes - xRes, 0 <= y <= vyRes - yResπ}πProcedure setWindow(x, y : Integer); Assembler;πAsmπ  mov  ax, vxBytesπ  mul  yπ  mov  bx, xπ  mov  cl, blπ  shr  bx, 2π  add  bx, ax     {bx=Ofs of upper left corner}π  mov  dx, input1Portπ @L:π  in   al, dxπ  test al, 8π  jnz  @L  {wait For no v retrace}π  sub  dx, 6  {CrtC port}π  mov  al, $Dπ  mov  ah, blπ  cli {these values are sampled at start of retrace}π  out  dx, ax  {lo Byte of display start addr}π  dec  alπ  mov  ah, bhπ  out  dx, ax    {hi Byte}π  stiπ  add  dx, 6π @L2:π  in   al, dxπ  test al, 8π  jz   @L2  {wait For v retrace}π  {this also resets Attrib flip/flop}π  mov  dx, attrPortπ  mov  al, $33π  out  dx, al   {Select Pixel Pan Register}π  and  cl, 3π  mov  al, clπ  shl  al, 1π  out  dx, al   {Shift is For 256 Color Mode}πend;ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππProcedure plot(x, y : Integer); Assembler;πAsmπ  mov   ax, vSegπ  mov   es, axπ  mov   di, xπ  mov   cx, diπ  shr   di, 2π  mov   ax, vxBytesπ  mul   yπ  add   di, axπ  mov   ax, $0102π  and   cl, 3π  shl   ah, clπ  mov   dx, seqPortπ  out   dx, ax {set bit mask}π  mov   al, colorπ  stosbπend;ππFunction scrn(x, y : Integer) : Byte; Assembler;πAsmπ  mov ax, vSegπ  mov es, axπ  mov di, xπ  mov cx, diπ  shr di, 2π  mov ax, vxBytesπ  mul yπ  add di, axπ  and cl, 3π  mov ah, clπ  mov al, 4π  mov dx, gcPortπ  out dx, ax      {Read Map Select register}π  mov al, es:[di]  {get the whole plane}πend;ππProcedure hLin(x, x2, y : Integer); Assembler;πAsmπ  mov   ax, vSegπ  mov   es, axπ  cldπ  mov   ax, vxBytesπ  mul   yπ  mov   di, ax {base of scan line}π  mov   bx, xπ  mov   cl, blπ  shr   bx, 2π  mov   dx, x2π  mov   ch, dlπ  shr   dx, 2π  and   cx, $0303π  sub   dx, bx     {width in Bytes}π  add   di, bx     {offset into video buffer}π  mov   ax, $FF02π  shl   ah, clπ  and   ah, $0F {left edge mask}π  mov   cl, chπ  mov   bh, $F1π  rol   bh, clπ  and   bh, $0F {right edge mask}π  mov   cx, dxπ  or    cx, cxπ  jnz   @LEFTπ  and   ah, bh                  {combine left & right bitmasks}π @LEFT:π  mov   dx, seqPortπ  out   dx, axπ  inc   dxπ  mov   al, colorπ  stosbπ  jcxz  @EXITπ  dec   cxπ  jcxz  @RIGHTπ  mov   al, $0Fπ  out   dx, al     {skipped if cx=0,1}π  mov   al, colorπ  repz  stosb   {fill middle Bytes}π @RIGHT:π  mov   al, bhπ  out   dx, al       {skipped if cx=0}π  mov   al, colorπ  stosbπ @EXIT:πend;ππProcedure vLin(x, y, y2 : Integer); Assembler;πAsmπ  mov ax, vSegπ  mov es, axπ  cldπ  mov di, xπ  mov cx, diπ  shr di, 2π  mov ax, vxBytesπ  mul yπ  add di, axπ  mov ax, $102π  and cl, 3π  shl ah, clπ  mov dx, seqPortπ  out dx, axπ  mov cx, y2π  sub cx, yπ  inc cxπ  mov al, colorπ @DOLINE:π  mov bl, es:[di]π  stosbπ  add di, vxBytes-1π  loop @DOLINEπend;ππProcedure rect(x, y, x2, y2 : Integer);πVarπ  i : Word;πbeginπ  hlin(x, pred(x2), y);π  hlin(succ(x), x2, y2);π  vlin(x, succ(y), y2);π  vlin(x2, y, pred(y2));πend;ππProcedure pane(x, y, x2, y2 : Integer);πVarπ  i : Word;πbeginπ  For i := y2 downto y doπ    hlin(x, x2, i);πend;ππProcedure line(x, y, x2, y2:Integer);πVarπ  d, dx, dy,π  ai, bi, xi, yi : Integer;πbeginπ  if(x < x2) thenπ  beginπ    xi := 1;π    dx := x2 - x;π  endπ  elseπ  beginπ    xi := -1;π    dx := x - x2;π  end;π  if (y < y2) thenπ  beginπ    yi := 1;π    dy := y2 - y;π  endπ  elseπ  beginπ    yi := -1;π    dy := y - y2;π  end;π  plot(x, y);π  if dx > dy thenπ  beginπ    ai := (dy - dx) * 2;π    bi := dy * 2;π    d  := bi - dx;π    Repeatπ      if (d >= 0) thenπ      beginπ        inc(y, yi);π        inc(d, ai);π      endπ      elseπ        inc(d, bi);π      inc(x, xi);π      plot(x, y);π    Until (x = x2);π  endπ  elseπ  beginπ    ai := (dx - dy) * 2;π    bi := dx * 2;π    d  := bi - dy;π    Repeatπ      if (d >= 0) thenπ      beginπ        inc(x, xi);π        inc(d, ai);π      endπ      elseπ        inc(d, bi);π      inc(y, yi);π      plot(x, y);π    Until (y = y2);π  end;πend;ππProcedure oval(xc, yc, a, b : Integer);πVarπ  x, y      : Integer;π  aa, aa2,π  bb, bb2,π  d, dx, dy : LongInt;πbeginπ  x := 0;π  y := b;π  aa := LongInt(a) * a;π  aa2 := 2 * aa;π  bb := LongInt(b) * b;π  bb2 := 2 * bb;π  d := bb - aa * b + aa div 4;π  dx := 0;π  dy := aa2 * b;π  plot(xc, yc - y);π  plot(xc, yc + y);π  plot(xc - a, yc);π  plot(xc + a, yc);π  While (dx < dy) doπ  beginπ    if(d > 0) thenπ    beginπ      dec(y);π      dec(dy, aa2);π      dec(d, dy);π    end;π    inc(x);π    inc(dx, bb2);π    inc(d, bb + dx);π    plot(xc + x, yc + y);π    plot(xc - x, yc + y);π    plot(xc + x, yc - y);π    plot(xc - x, yc - y);π  end;ππ  inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);ππ  While (y > 0) doπ  beginπ    if (d < 0) thenπ    beginπ      inc(x);π      inc(dx, bb2);π      inc(d, bb + dx);π    end;π    dec(y);π    dec(dy, aa2);π    inc(d, aa - dy);π    plot(xc + x, yc + y);π    plot(xc - x, yc + y);π    plot(xc + x, yc - y);π    plot(xc - x, yc - y);π  end;πend;ππProcedure disk(xc, yc, a, b:Integer);πVarπ  x, y      : Integer;π  aa, aa2,π  bb, bb2,π  d, dx, dy : LongInt;πbeginπ  x   := 0;π  y   := b;π  aa  := LongInt(a) * a;π  aa2 := 2 * aa;π  bb  := LongInt(b) * b;π  bb2 := 2 * bb;π  d   := bb - aa * b + aa div 4;π  dx  := 0;π  dy  := aa2 * b;ππ  vLin(xc, yc - y, yc + y);ππ  While (dx < dy) doπ  beginπ    if (d > 0) thenπ    beginπ      dec(y);π      dec(dy, aa2);π      dec(d, dy);π    end;π    inc(x);π    inc(dx, bb2);π    inc(d, bb + dx);π    vLin(xc - x, yc - y, yc + y);π    vLin(xc + x, yc - y, yc + y);π  end;ππ  inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);ππ  While (y >= 0) doπ  beginπ    if (d < 0) thenπ    beginπ      inc(x);π      inc(dx, bb2);π      inc(d, bb + dx);π      vLin(xc - x, yc - y, yc + y);π      vLin(xc + x, yc - y, yc + y);π    end;π    dec(y);π    dec(dy, aa2);π    inc(d, aa - dy);π  end;πend;ππ{This routine only called by fill}πFunction lineFill(x, y, d, prevXL, prevXR : Integer) : Integer;πVarπ  xl, xr, i : Integer;πLabelπ  _1, _2, _3;πbeginπ  xl := x;π  xr := x;ππ  Repeatπ    dec(xl);π  Until (scrn(xl, y) <> fillVal) or (xl < 0);ππ  inc(xl);ππ  Repeatπ    inc(xr);π  Until (scrn(xr, y) <> fillVal) or (xr > xMax);ππ  dec(xr);π  hLin(xl, xr, y);π  inc(y, d);ππ  if Word(y) <= yMax thenπ  For x := xl to xr doπ    if (scrn(x, y) = fillVal) thenπ    beginπ      x := lineFill(x, y, d, xl, xr);π      if Word(x) > xr thenπ        Goto _1;π    end;ππ  _1 :ππ  dec(y, d + d);π  Asmπ    neg d;π  end;π  if Word(y) <= yMax thenπ  beginπ  For x := xl to prevXL doπ    if (scrn(x, y) = fillVal) thenπ    beginπ      i := lineFill(x, y, d, xl, xr);π      if Word(x) > prevXL thenπ        Goto _2;π    end;ππ    _2 :ππ    for x := prevXR to xr doπ      if (scrn(x, y) = fillVal) thenπ      beginπ        i := lineFill(x, y, d, xl, xr);π        if Word(x) > xr thenπ          Goto _3;π      end;ππ      _3 :ππ      end;ππ  lineFill := xr;πend;ππProcedure fill(x, y : Integer);πbeginπ  fillVal := scrn(x, y);π  if fillVal <> color thenπ    lineFill(x, y, 1, x, x);πend;πππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππProcedure putTile(x, y : Integer; p : Pointer); Assembler;πAsmπ  push  dsπ  lds   si, pπ  mov   ax, vSegπ  mov   es, axπ  mov   di, xπ  mov   cx, diπ  shr   di, 2π  mov   ax, vxBytesπ  mul   yπ  add   di, axπ  mov   ax, $102π  and   cl, 3π  shl   ah, cl      {make bit mask}π  mov   dx, seqPortπ  mov   bh, tsyπ @DOLINE:π  mov   cl, tsxπ  xor   ch, chπ  push  axπ  push  di    {save starting bit mask}π @LOOP:π  {mov al, 2}π  out   dx, axπ  shl   ah, 1       {give it some time to respond}π  mov   bl, es:[di]π  movsbπ  dec   diπ  test  ah, $10π  jz    @SAMEByteπ  mov   ah, 1π  inc   diπ @SAMEByte:π  loop  @LOOPπ  pop   diπ  add   di, vxBytesπ  pop   ax {start of next line}π  dec   bhπ  jnz   @DOLINEπ  pop   dsπend;ππProcedure overTile(x, y : Integer; p : Pointer); Assembler;πAsmπ  push  dsπ  lds   si, pπ  mov   ax, vSegπ  mov   es, axπ  mov   di, xπ  mov   cx, diπ  shr   di, 2π  mov   ax, vxBytesπ  mul   yπ  add   di, axπ  mov   ax, $102π  and   cl, 3π  shl   ah, cl      {make bit mask}π  mov   bh, tsyπ  mov   dx, seqPortπ @DOLINE:π  mov   ch, tsxπ  push  axπ  push  di    {save starting bit mask}π @LOOP:π  mov   al, 2π  mov   dx, seqPortπ  out   dx, axπ  shl   ah, 1π  xchg  ah, clπ  mov   al, 4π  mov   dl, gcPort and $FFπ  out   dx, axπ  xchg  ah, clπ  inc   clπ  and   cl, 3π  lodsbπ  or    al, alπ  jz    @SKIPπ  mov   bl, es:[di]π  cmp   bl, $C0π  jae   @SKIPπ  stosbπ  dec   diπ @SKIP:π  test  ah, $10π  jz    @SAMEByteπ  mov   ah, 1π  inc   diπ @SAMEByte:π  dec   chπ  jnz   @LOOPπ  pop   diπ  add   di, vxBytesπ  pop   ax {start of next line}π  dec   bhπ  jnz   @DOLINEπ  pop   dsπend;ππ{won't handle Chars wider than 1 Byte}πProcedure putChar(x, y : Integer; p : Word); Assembler;πAsmπ  mov   si, p  {offset of Char in DS}π  mov   ax, vSegπ  mov   es, axπ  mov   di, xπ  mov   cx, diπ  shr   di, 2π  mov   ax, vxBytesπ  mul   yπ  add   di, axπ  mov   ax, $0102π  and   cl, 3π  shl   ah, cl      {make bit mask}π  mov   dx, seqPortπ  mov   cl, tsyπ  xor   ch, chπ @DOLINE:π  mov   bl, [si]π  inc   siπ  push  axπ  push  di    {save starting bit mask}π @LOOP:π  mov   al, 2π  out   dx, axπ  shl   ah, 1π  shl   bl, 1π  jnc   @SKIPπ  mov   al, colorπ  mov   es:[di], alπ @SKIP:π  test  ah, $10π  jz    @SAMEByteπ  mov   ah, 1π  inc   diπ @SAMEByte:π  or    bl, blπ  jnz   @LOOPπ  pop   diπ  add   di, vxBytesπ  pop   ax {start of next line}π  loop  @DOLINEπend;ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππProcedure setColor(color, r, g, b : Byte); Assembler;πAsm {set DAC color}π  mov  dx, tableWriteIndexπ  mov  al, colorπ  out  dx, alπ  inc  dxπ  mov  al, rπ  out  dx, alπ  mov  al, gπ  out  dx, alπ  mov  al, bπ  out  dx, alπend; {Write index now points to next color}ππFunction getColor(color : Byte) : LongInt; Assembler;πAsm {get DAC color}π  mov  dx, tableReadIndexπ  mov  al, colorπ  out  dx, alπ  add  dx, 2π  cldπ  xor  bh, bhπ  in   al, dxπ  mov  bl, alπ  in   al, dxπ  mov  ah, alπ  in   al, dxπ  mov  dx, bxπend; {read index now points to next color}ππProcedure setPalette(color : Byte; num : Word; Var rgb); Assembler;πAsmπ  mov   cx, numπ  jcxz  @Xπ  mov   ax, cxπ  shl   cx, 1π  add   cx, ax {mul by 3}π  push  dsπ  lds   si, rgbπ  cldπ  mov   dx, tableWriteIndexπ  mov   al, colorπ  out   dx, alπ  inc   dxπ @L:π  lodsbπ  out   dx, alπ  loop  @Lπ  pop   dsπ @X:πend;ππProcedure getPalette(color : Byte; num : Word; Var rgb); Assembler;πAsmπ  mov   cx, numπ  jcxz  @Xπ  mov   ax, cxπ  shl   cx, 1π  add   cx, ax {mul by 3}π  les   di, rgbπ  cldπ  mov   dx, tableReadIndexπ  mov   al, colorπ  out   dx, alπ  add   dx, 2π @L:π  in    al, dxπ  stosbπ  loop  @Lπ @X:πend;ππ{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}ππFunction vgaPresent : Boolean; Assembler;πAsmπ  mov ah, $Fπ  int $10π  mov oldMode, al  { save old Gr mode}π  mov ax, $1A00π  int $10          { check For VGA}π  cmp al, $1Aπ  jne @ERR         { no VGA Bios}π  cmp bl, 7π  jb @ERR          { is VGA or better?}π  cmp bl, $FFπ  jnz @OKπ @ERR:π  xor al, alπ  jmp @EXITπ @OK:π  mov al, 1π @EXIT:πend;ππProcedure Graphbegin;πVarπ  p     : Array [0..255] of tRGB;π  i, j,π  k, l  : Byte;πbeginπ  Asmπ    mov ax, $0013π    int $10π  end;   {set BIOS mode}ππ  l := 0;π  For i := 0 to 5 doπ    For j := 0 to 5 doπ      For k := 0 to 5 doπ      With p[l] doπ      beginπ        r := (i * 63) div 5;π        g := (j * 63) div 5;π        b := (k * 63) div 5;π        inc(l);π      end;ππ  For i := 216 to 255 doπ  With p[i] doπ  beginπ    l := ((i - 216) * 63) div 39;π    r := l;π    g := l;π    b := l;π  end;ππ  setpalette(0, 256, p);π  color := 0;ππ  Asmπ   mov  dx, seqPortπ   mov  ax, $0604π   out  dx, ax            { disable chain 4}π   mov  ax, $0100π   out  dx, ax            { synchronous reset asserted}π   dec  dxπ   dec  dxπ   mov  al, $E3π   out  dx, al            { misc output port at $3C2}π                          { use 25mHz dot clock,  480 lines}π   inc  dxπ   inc  dxπ   mov  ax, $0300π   out  dx, ax            { restart sequencer}π   mov  dx, CrtcPortπ   mov  al, $11π   out  dx, al            { select cr11}π   inc  dxπ   in   al, dxπ   and  al, $7Fπ   out  dx, alπ   dec  dx                { remove Write protect from cr0-cr7}π   mov  si, offset CrtcRegTableπ   mov  cx, CrtcRegLenπ   repz outsw             { set Crtc data}π   mov  ax, vxBytesπ   shr  ax, 1             { Words per scan line}π   mov  ah, alπ   mov  al, $13π   out  dx, ax            { set CrtC offset reg}π  end;ππ  clearGraph;πend;ππProcedure Graphend; Far;πbeginπ  ExitProc := exitSave;π  Asmπ    mov al, oldModeπ    mov ah, 0π    int $10π  end;πend;ππbeginπ  CrtcPort   := memw[$40 : $63];π  input1Port := CrtcPort + 6;π  if vgaPresent thenπ  beginπ    ExitSave := exitProc;π    ExitProc := @Graphend;π    Graphbegin;π  endπ  elseπ  beginπ    Writeln(^G + 'VGA required.');π    halt(1);π  end;πend.π                                                                     30     10-28-9311:39ALL                      BAS VAN GALLEN           Another STARS            SWAG9311            29     ╓   {===========================================================================π BBS: Canada Remote SystemsπDate: 10-17-93 (23:26)πFrom: BAS VAN GAALENπSubj: Stars?ππ{$N+}ππprogram _Rotation;ππusesπ  crt,dos;ππconstπ  NofPoints = 75;π  Speed = 5;π  Xc : real = 0;π  Yc : real = 0;π  Zc : real = 150;π  SinTab : array[0..255] of integer = (π    0,2,5,7,10,12,15,17,20,22,24,27,29,31,34,36,38,41,43,45,47,49,52,54,π    56,58,60,62,64,66,67,69,71,73,74,76,78,79,81,82,83,85,86,87,88,90,91,π    92,93,93,94,95,96,97,97,98,98,99,99,99,100,100,100,100,100,100,100,π    100,99,99,99,98,98,97,97,96,95,95,94,93,92,91,90,89,88,87,85,84,83,π    81,80,78,77,75,73,72,70,68,66,65,63,61,59,57,55,53,51,48,46,44,42,40,π    37,35,33,30,28,26,23,21,18,16,14,11,9,6,4,1,-1,-4,-6,-9,-11,-14,-16,π    -18,-21,-23,-26,-28,-30,-33,-35,-37,-40,-42,-44,-46,-48,-51,-53,-55,π    -57,-59,-61,-63,-65,-66,-68,-70,-72,-73,-75,-77,-78,-80,-81,-83,-84,π    -85,-87,-88,-89,-90,-91,-92,-93,-94,-95,-95,-96,-97,-97,-98,-98,-99,π    -99,-99,-100,-100,-100,-100,-100,-100,-100,-100,-99,-99,-99,-98,-98,π    -97,-97,-96,-95,-94,-93,-93,-92,-91,-90,-88,-87,-86,-85,-83,-82,-81,π    -79,-78,-76,-74,-73,-71,-69,-67,-66,-64,-62,-60,-58,-56,-54,-52,-49,π    -47,-45,-43,-41,-38,-36,-34,-31,-29,-27,-24,-22,-20,-17,-15,-12,-10,π    -7,-5,-2,0);ππtypeπ  PointRec = recordπ               X,Y,Z : integer;π             end;π  PointPos = array[0..NofPoints] of PointRec;ππvarπ  Point : PointPos;ππ{----------------------------------------------------------------------------}ππprocedure SetGraphics(Mode : byte); assembler;πasm mov AH,0; mov AL,Mode; int 10h; end;ππ{----------------------------------------------------------------------------}ππprocedure Init;ππvarπ  I : byte;ππbeginπ  randomize;π  for I := 0 to NofPoints do beginπ    Point[I].X := random(250)-125;π    Point[I].Y := random(250)-125;π    Point[I].Z := random(250)-125;π  end;πend;ππ{----------------------------------------------------------------------------}ππprocedure DoRotation;ππconstπ  Xstep = 1;π  Ystep = 1;π  Zstep = -2;ππvarπ  Xp,Yp : array[0..NofPoints] of word;π  X,Y,Z,X1,Y1,Z1 : real;π  PhiX,PhiY,PhiZ : byte;π  I,Color : byte;ππfunction Sinus(Idx : byte) : real;ππbeginπ  Sinus := SinTab[Idx]/100;πend;ππfunction Cosinus(Idx : byte) : real;ππbeginπ  Cosinus := SinTab[(Idx+192) mod 255]/100;πend;ππbeginπ  PhiX := 0; PhiY := 0; PhiZ := 0;π  repeatπ    while (port[$3da] and 8) <> 8 do;π    while (port[$3da] and 8) = 8 do;π    for I := 0 to NofPoints do beginππ      if (Xp[I]+160 < 320) and (Yp[I]+100 < 200) thenπ        mem[$a000:(Yp[I]+100)*320+Xp[I]+160] := 0;ππ      X1 := Cosinus(PhiY)*Point[I].X-Sinus(PhiY)*Point[I].Z;π      Z1 := Sinus(PhiY)*Point[I].X+Cosinus(PhiY)*Point[I].Z;π      X := Cosinus(PhiZ)*X1+Sinus(PhiZ)*Point[I].Y;π      Y1 := Cosinus(PhiZ)*Point[I].Y-Sinus(PhiZ)*X1;π      Z := Cosinus(PhiX)*Z1-Sinus(PhiX)*Y1;π      Y := Sinus(PhiX)*Z1+Cosinus(PhiX)*Y1;ππ      Xp[I] := round((Xc*Z-X*Zc)/(Z-Zc));π      Yp[I] := round((Yc*Z-Y*Zc)/(Z-Zc));π      if (Xp[I]+160 < 320) and (Yp[I]+100 < 200) then beginπ        Color := 31+round(Z/7);π        if Color > 31 then Color := 31π        else if Color < 16 then Color := 16;π        mem[$a000:(Yp[I]+100)*320+Xp[I]+160] := Color;π      end;ππ      inc(Point[I].Z,Speed); if Point[I].Z > 125 then Point[I].Z := -125;π    end;π    inc(PhiX,Xstep);π    inc(PhiY,Ystep);π    inc(PhiZ,Zstep);π  until keypressed;πend;ππ{----------------------------------------------------------------------------}ππbeginπ  SetGraphics($13);π  Init;π  DoRotation;π  textmode(lastmode);πend.ππ      31     11-02-9305:31ALL                      DAVE FOSTER              Display PIC Files        SWAG9311            27     ╓   {πDave Fosterππ> Could anyone please post any routines or help on howπ> to read an image into TURBO 6. I can save the imageπ> in any format, but i need code to be able to displayπ> it on the screen. Source code would be an advantage!π>πI wrote this Program For a friend to read a image into his Program, andπand I would be happy For any help on how to improve it.π}ππProgram  Read_Image;      { SRC-CODE.PAS   ver 1.00 }π{-----------------------------------------------------------------------------π Program reads in a binary data File, and displays the image on the screen byπ using "PutPixel" Procedure in the Graph Unit.  The image can be displayed inπ color, or in grey-scale by using the subroutine "Set64Gray" below.π This is a quick and dirty method to display the image using "PutPixel",π and I hope someone will be able to show us how to use the "PutImage" toπ display the image quicker.π-----------------------------------------------------------------------------}ππUsesπ  Dos, Crt, Graph;ππTypeπ  ByteArray = Array [0..175] of Byte;ππVarπ  Gd, Gm,π  m, n    : Integer;π  buffer  : ByteArray;π  f       : File;ππ{π> Does anyone know how can I get a Graphic mode in VGA in which Iπ> could use 64 gray level (at least 32)?  Could I keep on using theπ> Graphical Procedures in Unit Graph then?ππ The fragment below will initialize the first 64 VGA color values toπ gray scale.  These colors are valid For any VGA mode (including Text),π but in most Graphics modes/devices the Borland Graph Unit limits youπ to using only 16 colors.π}ππProcedure Set64Gray;π{ Sets up 64 shades of gray where 0 = black, 63 = full white }πTypeπ  CRec = Recordπ    R, G, B: Byte;π  end;πVarπ  Regs : Registers;π  I    : Integer;π  G64  : Array [0..63] of CRec;πbeginπ  { Initialize the block of color values }π  For I := 0 to 63 doπ  With G64[I] doπ  beginπ    R := I;π    G := I;          { Color is gray when RGB values are equal }π    B := I;π  end;ππ  Regs.ax := $1012;      { Dos Function to update block of colors }π  Regs.bx := 0;          { First color to change }π  Regs.cx := 64;         { Number of colors to change }π  Regs.es := seg(G64); { Address of block of color values }π  Regs.dx := ofs(G64);π  intr($10, Regs);πend;ππbeginπ  Gd := detect;π  initGraph(Gd, Gm, 'e:\bp\bgi');ππ  { Open the image File which is 250 lines, and 175 pixels per line.π    Each pixel is 1 Byte, and no header data, or Record delimiters.π    File is 43,750 Bytes (250 x 175) in size.  Have look at the inputπ    File using binary File viewer. }ππ   assign(f, 'DOMINO.DAT');π   reset(f, 175);ππ  { if you enable this, you will be able to see the image in grey-scale,π    but I am not sure if it is quite right.  Currently it seems to displayπ    only few grey-scale levels instead of the full 64 levels.ππ   }Set64Gray;ππ  { Method used to read the File line at a time, and Write the pixelπ    values to the screen. This is bit slow, and it would be lot fasterπ    by using "PutImage" but I do not know the method For that. }ππ   n := 1;π   While not eof(f) doπ   beginπ     BlockRead(f, buffer, 1);π     For m := 1 to 175 doπ       PutPixel(m, n, buffer[m]);π     n := n + 1;π   end;ππ   close(f);π   readln;π   closeGraph;πend.ππ{πThe image File "DOMINO.DAT" used in the Program "SRC-CODE.PAS".πImage File is 250 x 175 pixels (43,750 Bytes).π}ππ 32     11-02-9306:11ALL                      KEVIN OTTO               Fading                   SWAG9311            11     ╓   { KEVIN OTTO }ππUnit Fade;ππ{ Change DelayAmt and Steps to change the speed of fading. }ππInterfaceππUsesπ  Dos, Crt;ππConstπ  Colors   = 64;π  DelayAmt = 15;π  Steps    = 24;ππTypeπ  PalType = Array [0..Colors - 1] of Recordπ    R, G, B : Byte;π  end;ππVarπ  OrigPal : palType;ππProcedure GetPal(Var OrigPal : PalType);πProcedure FadePal(OrigPal : PalType; FadeOut : Boolean);ππImplementationππProcedure GetPal(Var OrigPal : PalType);πVarπ  Reg : Registers;πbeginπ  With Reg doπ  beginπ    AX := $1017;π    BX := 0;π    CX := colors;π    ES := seg(OrigPal);π    DX := ofs(OrigPal);π    intr ($10, Reg);π  end;πend;ππProcedure FadePal(OrigPal : PalType; FadeOut : Boolean);πVarπ  Reg     : Registers;π  WorkPal : PalType;π  Fade    : Word;π  Pct     : Real;π  I       : Word;πbeginπ  With Reg doπ  For Fade := 0 to Steps doπ  beginπ    Pct := Fade / Steps;π    if FadeOut thenπ      Pct := 1 - Pct;π    For I := 0 to Colors - 1 doπ    With WorkPal[I] doπ    beginπ      R := round(OrigPal[I].R * Pct);π      G := round(OrigPal[I].G * Pct);π      B := round(OrigPal[I].B * Pct);π    end;π    AX := $1012;π    BX := 0;π    CX := Colors;π    ES := seg (WorkPal);π    DX := ofs (WorkPal);π    intr ($10, Reg);π    Delay (DelayAmt);π  end;πend;ππend.π                                  33     11-21-9309:28ALL                      MICHAEL HOENIE           Create Chars in Graphics SWAG9311            78     ╓   π  { This program allows you to create characters using the GRAPHICS unitπ    supplied otherwise with the SWAG routines. If you have any questionsπ    on these routines, please let me know.ππ    MICHAEL HOENIE - Intelec Pascal Moderator.  }ππ  program charedit;ππ  uses dos, crt;ππ  const numnewchars=1;ππ  typeπ    string80=string[80];ππ  var { all variables inside of the game }π    char_map:array[1..16] of string[8];π    xpos,ypos,x,y,z:integer;π    out,incom:string[255];π    charout:char;π    outfile:text;π    char:array[1..16] of byte;ππ    procedure loadchar;π    typeπ      bytearray=array[0..15] of byte;π      chararray=recordπ        charnum:byte;π        chardata:bytearray;π      end;π    varπ      regs:registers;π      newchars:chararray;π    beginπ      with regs doπ        beginπ          ah:=$11;   { video sub-Function $11 }π          al:=$0;    { Load Chars to table $0 }π          bh:=$10;   { number of Bytes per Char $10 }π          bl:=$0;    { Character table to edit }π          cx:=$1;    { number of Chars we're definig $1}π          dx:=176;π          for x:=0 to 15 do newchars.chardata[x]:=char[x+1];π          es:=seg(newchars.chardata);π          bp:=ofs(newchars.chardata);π          intr($10,regs);π        end;π    end;ππ  Procedure FastWrite(Col,Row,Attrib:Byte; Str:string80);π  beginπ    inlineπ      ($1E/$1E/$8A/$86/row/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/π      $03/$C3/$03/$C0/$8B/$F8/$be/$00/$00/$8A/$BE/attrib/π      $8a/$8e/str/$22/$c9/$74/$3e/$2b/$c0/$8E/$D8/$A0/$49/$04/π      $1F/$2C/$07/$74/$22/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/$46/π      $8a/$9A/str/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/π      $89/$1D/$47/$47/$E2/$Ea/$2A/$C0/$74/$10/$BA/$00/$B0/π      $8E/$DA/$46/$8a/$9A/str/$89/$1D/$47/$47/$E2/$F5/$1F);π  end;ππ  procedure initalize;ππ  beginπ    for x:=1 to 16 do char[x]:=0;π    xpos:=1;π    ypos:=1;π    for x:=1 to 16 do char_map[x]:='        '; { clear it out }π  end;ππ  procedure display_screen;π  beginπ    loadchar;π     fastwrite(1,1,$1F,'         CHAREDIT - By Michael S. Hoenie         ');π     fastwrite(1,2,$7,'      12345678   ┌─────Data');π     fastwrite(1,3,$7,'     ▄▄▄▄▄▄▄▄▄▄  │');π     fastwrite(1,4,$7,'   1 █        █ 000');π     fastwrite(1,5,$7,'   2 █        █ 000 Single:  ░');π     fastwrite(1,6,$7,'   3 █        █ 000');π     fastwrite(1,7,$7,'   4 █        █ 000 Multiple:');π     fastwrite(1,8,$7,'   5 █        █ 000');π     fastwrite(1,9,$7,'   6 █        █ 000     ░░░░░░');π    fastwrite(1,10,$7,'   7 █        █ 000     ░░░░░░');π    fastwrite(1,11,$7,'   8 █        █ 000     ░░░░░░');π    fastwrite(1,12,$7,'   9 █        █ 000                    U            ');π    fastwrite(1,13,$7,'  10 █        █ 000 f1=paint spot      │    MOVEMENT');π    fastwrite(1,14,$7,'  11 █        █ 000 f2=erase spot   L──┼──R         ');π    fastwrite(1,15,$7,'  12 █        █ 000  S=save char       │            ');π    fastwrite(1,16,$7,'  13 █        █ 000  Q=quit editor     D');π    fastwrite(1,17,$7,'  14 █        █ 000  C=reset char    r=scroll-right');π    fastwrite(1,18,$7,'  15 █        █ 000  l=scroll-left');π    fastwrite(1,19,$7,'  16 █        █ 000  r=scroll-right');π    fastwrite(1,20,$7,'     ▀▀▀▀▀▀▀▀▀▀      u=scroll-up');π  end;ππ  procedure calculate_char;π  beginπ    for x:=1 to 16 do char[x]:=0;π    for x:=1 to 16 doπ      beginπ        fastwrite(7,x+3,$4F,char_map[x]);π        incom:=char_map[x];π        y:=0;π        if copy(incom,1,1)='█' then y:=y+1;π        if copy(incom,2,1)='█' then y:=y+2;π        if copy(incom,3,1)='█' then y:=y+4;π        if copy(incom,4,1)='█' then y:=y+8;π        if copy(incom,5,1)='█' then y:=y+16;π        if copy(incom,6,1)='█' then y:=y+32;π        if copy(incom,7,1)='█' then y:=y+64;π        if copy(incom,8,1)='█' then y:=y+128;π        char[x]:=y;π      end;π    for x:=1 to 16 doπ      beginπ        str(char[x],incom);π        while length(incom)<3 do insert(' ',incom,1);π        fastwrite(17,x+3,$4E,incom);π      end;π    loadchar;π  end;ππ  procedure do_online;π  varπ    done:boolean;π    int1,int2,int3:integer;π  beginπππ    done:=false;π    int1:=0;π    int2:=0;π    int3:=0;π    while not done doπ      beginπ        incom:=copy(char_map[ypos],xpos,1);π        int1:=int1+1;π        if int1>150 then int2:=int2+1;π        if int2>4 thenπ          beginπ            int1:=0;π            int3:=int3+1;π            if int3>2 then int3:=1;π            case int3 ofπ              1:fastwrite(xpos+6,ypos+3,$F,incom);π              2:fastwrite(xpos+6,ypos+3,$F,'');π            end;π          end;ππ{ this section moved over to be transferred across the network. }ππif keypressed thenπ  beginπ    charout:=readkey;π    out:=charout;π    if ord(out[1])=0 thenπ      beginπ        charout:=readkey;π        out:=charout;π        fastwrite(60,2,$2F,out);π        case out[1] ofπ          ';':begin { F1 }π                delete(char_map[ypos],xpos,1);π                insert('█',char_map[ypos],xpos);π                calculate_char;π              end;π          '<':begin { F2 }π                delete(char_map[ypos],xpos,1);π                insert(' ',char_map[ypos],xpos);π                calculate_char;π              end;π          'H':begin { up }π                ypos:=ypos-1;π                if ypos<1 then ypos:=16;π                calculate_char;π              end;π          'P':begin { down }π                ypos:=ypos+1;π                if ypos>16 then ypos:=1;π                calculate_char;π              end;π          'K':begin { left }π                xpos:=xpos-1;π                if xpos<1 then xpos:=8;π                calculate_char;π              end;π          'M':begin { right }π                xpos:=xpos+1;π                if xpos>8 then xpos:=1;π                calculate_char;π              end;π        end;π      end elseπππ        begin { regular keys }π          case out[1] ofπ            'Q','q':begin { done }π                      clrscr;π                      write('Are you SURE you want to quit? (Y/n) ? ');π                      readln(incom);π                      case incom[1] ofπ                        'Y','y':done:=true;π                      end;π                      clrscr;π                      display_screen;π                      calculate_char;π                    end;π            'S','s':begin { save }π                      assign(outfile,'chardata.txt');π                      {$i-} reset(outfile) {$i+};π                      if (ioresult)>=1 then rewrite(outfile);π                      append(outfile);π                      writeln(outfile,'Character Char:');π                      writeln(outfile,'');π                      writeln(outfile,'       12345678');π                      for x:=1 to 16 doπ                        beginπ                          str(x,out);π                          while length(out)<6 do insert(' ',out,1);π                          writeln(outfile,out+char_map[x]);π                        end;π                      writeln(outfile,'');π                      write(outfile,'Chardata:');π                      for x:=1 to 15 doπ                        beginπ                          str(char[x],incom);π                          write(outfile,incom+',');π                        end;π                      str(char[16],incom);π                      writeln(outfile,incom);π                      writeln(outfile,'-----------------------------');π                      close(outfile);π                      clrscr;π                      writeln('File was saved under CHARDATA.TXT.');π                      writeln;π                      write('Press ENTER to continue ? ');π                      readln(incom);π                      clrscr;π                      display_screen;π                      calculate_char;π                    end;π            'U','u':begin { move entire char up }π                     incom:=char_map[1];π                     for x:=2 to 16 do char_map[x-1]:=char_map[x];π                     char_map[16]:=incom;π                     calculate_char;π                    end;π            'R','r':begin { move entire char to the right }π                      for x:=1 to 16 doπ                        beginπ                          out:=copy(char_map[x],8,1);π                          incom:=copy(char_map[x],1,7);π                          char_map[x]:=out+incom;π                        end;π                      calculate_char;π                    end;π            'L','l':begin { move entire char to the left }π                      for x:=1 to 16 doπππ                        beginπ                          out:=copy(char_map[x],1,1);π                          incom:=copy(char_map[x],2,7);π                          char_map[x]:=incom+out;π                        end;π                      calculate_char;π                    end;π            'D','d':begin { move entire char down }π                      incom:=char_map[16];π                      for x:=16 downto 2 do char_map[x]:=char_map[x-1];π                      char_map[1]:=incom;π                      calculate_char;π                    end;π            'C','c':begin { reset }π                      clrscr;π                      write('Are you SURE you want to clear it? (Y/n) ? ');π                      readln(incom);π                      case incom[1] ofπ                        'Y','y':initalize;π                      end;π                      clrscr;π                      display_screen;π                      calculate_char;π                    end;π          end;π        end;π  end;π      end;π  end;ππ  beginπ    textmode(c80);π    initalize;π    display_screen;π    calculate_char;π    do_online;π    clrscr;π    writeln('Thanks for using CHAREDIT!');π  end.ππ                                                                                                                                34     11-02-9305:54ALL                      NICK ONOUFRIOU           Quick PutImage           SWAG9311            22     ╓   {πNICK ONOUFRIOUππI'm writing a small game that requires a transparent putimage Function. Iπnormally use the BGI, but in this Case I need a little bit more speed. Thisπpartial Program shows what I have already. What I want to know is there isπsimple method of masking color 0 so it won't be displayed.π}πProgram PutMan;ππUsesπ  Dos, Crt;ππConstπ(* Turbo Pascal, Width= 11 Height= 23 Colors= 256 *)ππ  Man : Array [1..259] of Byte = (π          $0A,$00,$16,$00,$00,$00,$00,$00,$00,$00,$00,$00,π          $00,$00,$00,$00,$00,$00,$00,$02,$02,$02,$00,$00,π          $00,$00,$00,$00,$00,$02,$02,$02,$02,$02,$00,$00,π          $00,$00,$00,$02,$2C,$2C,$2C,$2C,$2C,$02,$00,$00,π          $00,$00,$2C,$10,$10,$2C,$10,$10,$2C,$00,$00,$00,π          $00,$2C,$2C,$2C,$2C,$2C,$2C,$2C,$00,$00,$00,$00,π          $00,$2C,$0C,$0C,$0C,$2C,$00,$00,$00,$00,$00,$00,π          $00,$2C,$2C,$2C,$00,$00,$00,$00,$00,$00,$00,$00,π          $00,$0F,$00,$00,$00,$00,$00,$00,$0F,$00,$00,$0F,π          $0F,$0F,$00,$00,$00,$00,$00,$0F,$00,$0D,$0D,$0D,π          $0D,$0D,$00,$00,$00,$00,$0F,$0D,$0D,$0D,$0D,$0D,π          $0D,$0D,$00,$00,$00,$0F,$1F,$1F,$1F,$1F,$1F,$1F,π          $1F,$0F,$00,$00,$00,$1F,$1F,$1F,$1F,$1F,$1F,$1F,π          $0F,$00,$00,$00,$00,$1F,$1F,$1F,$1F,$1F,$00,$0F,π          $00,$00,$00,$00,$00,$0D,$0D,$0D,$00,$00,$0F,$00,π          $00,$00,$00,$0D,$0D,$0D,$0D,$0D,$00,$00,$00,$00,π          $00,$00,$0D,$0D,$0D,$0D,$0D,$00,$00,$00,$00,$00,π          $00,$0D,$0D,$00,$0D,$0D,$00,$00,$00,$00,$00,$00,π          $0D,$0D,$00,$0D,$0D,$00,$00,$00,$00,$00,$00,$07,π          $07,$00,$07,$07,$00,$00,$00,$00,$00,$00,$07,$07,π          $00,$07,$07,$00,$00,$00,$00,$00,$00,$00,$00,$00,π          $00,$00,$00,$00,$00,$00,$00);ππTypeπ  _screenRec = Array [0..199, 0..319] of Byte;ππVarπ  _mcgaScreen  : _screenRec Absolute $A000:0000;πππProcedure SetMode(mode : Integer);πVarπ  regs : Registers;πbeginπ  regs.ah := 0;π  regs.al := mode;π  intr($10, regs);πend;ππProcedure ClearPage(color : Integer);πbeginπ  FillChar(_mcgaScreen, 64000, color);πend;ππProcedure PutImg(x, y : Integer; Var Img);πTypeπ  AList = Array[1..$FFFF] of Byte;πVarπ  APtr      : ^AList;π  J, Width,π  Height,π  Counter   : Word;πbeginπ  Aptr    := @Img;π  Width   := (Aptr^[2] SHL 8) + Aptr^[1] + 1;π  Height  := (Aptr^[4] SHL 8) + Aptr^[3] + 1;π  Counter := 5;π  For j := y to (y + height - 1) doπ  beginπ    Move(Aptr^[Counter], _mcgaScreen[j, x], Width);π    Inc(Counter, Width);π  end;πend;ππbeginπ  SetMode(19);π  ClearPage(Blue);π  PutImg(150, 80, Ptr(seg(man), ofs(man))^);π  readln;π  SetMode(3);πend.π                                                                                                                        35     11-02-9305:30ALL                      NORMAN YEN               Display PCX Files        SWAG9311            26     ╓   {π> I heard something in this echo about someone having Pascal source to viewπ> .PCX Files and I would appreciate if they would re-post the source if it'sπ> not too long or tell me where I can get it.  I am also looking For someπ> good COMM routines For Pascal, anyone have any or no where I can get some?ππThe routine I have will only work With 320x200x256c images.ππ        For all those Pascal Programmers who just want something simpleπ        to display a 320x200x256 colour PCX File on the screen here it is.π        This was a direct translation from the C source code of PCXVIEWπ        written by Lee Hamel (Patch), Avalanche coder.  I removed theπ        Inline assembly code so that you beginners can see what was goingπ        on behind those routines.ππNorman Yen - Infinite Dreams BBS - August 11, 1993π}ππTypeπ  pcxheader_rec = Recordπ    manufacturer   : Byte;π    version        : Byte;π    encoding       : Byte;π    bits_per_pixel : Byte;π    xmin, ymin     : Word;π    xmax, ymax     : Word;π    hres, vres     : Word;π    palette        : Array [0..47] of Byte;π    reserved       : Byte;π    colour_planes  : Byte;π    Bytes_per_line : Word;π    palette_Type   : Word;π    filler         : Array [0..57] of Byte;π  end;ππVarπ  header  : pcxheader_rec;π  width,π  depth   : Word;π  Bytes   : Word;π  palette : Array [0..767] of Byte;π  f       : File;π  c       : Byte;ππProcedure Read_PCX_Line(vidoffset : Word);πVarπ  c, run : Byte;π  n      : Integer;π  w      : Word;πbeginπ  n := 0;π  While (n < Bytes) doπ  beginπ    blockread (f, c, 1);π    { if it's a run of Bytes field }π    if ((c and 192) = 192) thenπ    beginπ      { and off the high bits }π      run := c and 63;π      { get the run Byte }π      blockread (f, c, 1);π      n := n + run;π      For w := 0 to run - 1 doπ      beginπ        mem[$a000 : vidoffset] := c;π        inc(vidoffset);π      end;π    endπ    elseπ    beginπ      n := n + 1;π      mem[$a000 : vidoffset] := c;π      inc(vidoffset);π    end;π  end;πend;ππProcedure Unpack_PCX_File;πVarπ  i : Integer;πbeginπ  For i := 0 to 767 doπ    palette[i] := palette[i] shr 2;π  Asmπ    mov ax, 13hπ    int 10hπ    mov ax, 1012hπ    xor bx, bxπ    mov cx, 256π    mov dx, offset paletteπ    int 10hπ  end;π  For i := 0 to depth - 1 doπ    Read_PCX_Line(i * 320);π  Asmπ    xor ax, axπ    int 16hπ    mov ax, 03hπ    int 10hπ  end;πend;ππbeginπ  if (paramcount > 0) thenπ  beginπ    assign(f, paramstr(1));π    reset(f, 1);π    blockread (f, header, sizeof(header));π    if (header.manufacturer = 10) and (header.version = 5) andπ       (header.bits_per_pixel = 8) and (header.colour_planes = 1) thenπ    beginπ      seek(f, Filesize(f) - 769);π      blockread(f, c, 1);π      if (c = 12) thenπ      beginπ        blockread(f, palette, 768);π        seek(f, 128);π        width := header.xmax - header.xmin + 1;π        depth := header.ymax - header.ymin + 1;π        Bytes := header.Bytes_per_line;π        Unpack_PCX_File;π      endπ      elseπ        Writeln('Error reading palette.');π    endπ    elseπ      Writeln('Not a 256 colour PCX File.');π    close(f);π  endπ  elseπ    Writeln('No File name specified.');πend.π                                36     10-28-9311:35ALL                      NORMAN YEN               View PCX File            SWAG9311            28     ╓   {===========================================================================πDate: 08-23-93 (08:26)πFrom: NORMAN YENπSubj: RE: .PCX AND COMM ROUTINEπ---------------------------------------------------------------------------ππ MB> I heard something in this echo about someone having Pascal source toπ MB> view .PCXπ MB> files and I would appreciate if they would re-post the source if it'sπ MB> not tooπ MB> long or tell me where I can get it.  I am also looking for some goodπ MB> COMM routines for Pascal, anyone have any or no where I can get some?ππ        The routine I have will only work with 320x200x256c images.πHope it helps!ππNormanππ{π        For all those Pascal programmers who just want something simpleπ        to display a 320x200x256 colour PCX file on the screen here it is.π        This was a direct translation from the C source code of PCXVIEWπ        written by Lee Hamel (Patch), Avalanche coder.  I removed theπ        inline assembly code so that you beginners can see what was goingπ        on behind those routines.ππ                                                      Norman Yenπ                                                      Infinite Dreams BBSπ                                                      August 11, 1993π}ππtype pcxheader_rec=recordπ     manufacturer: byte;π     version: byte;π     encoding: byte;π     bits_per_pixel: byte;π     xmin, ymin: word;π     xmax, ymax: word;π     hres: word;π     vres: word;π     palette: array [0..47] of byte;π     reserved: byte;π     colour_planes: byte;π     bytes_per_line: word;π     palette_type: word;π     filler: array [0..57] of byte;π     end;ππvar header: pcxheader_rec;π    width, depth: word;π    bytes: word;π    palette: array [0..767] of byte;π    f: file;π    c: byte;ππprocedure Read_PCX_Line(vidoffset: word);πvar c, run: byte;π    n: integer;π    w: word;πbeginπ  n:=0;π  while (n < bytes) doπ  beginπ    blockread (f, c, 1);ππ    { if it's a run of bytes field }π    if ((c and 192)=192) thenπ    beginππ      { and off the high bits }π      run:=c and 63;ππ      { get the run byte }π      blockread (f, c, 1);π      n:=n+run;π      for w:=0 to run-1 doπ      beginπ        mem [$a000:vidoffset]:=c;π        inc (vidoffset);π      end;π    end elseπ    beginπ      n:=n+1;π      mem [$a000:vidoffset]:=c;π      inc (vidoffset);π    end;π  end;πend;ππprocedure Unpack_PCX_File;πvar i: integer;πbeginπ  for i:=0 to 767 doπ    palette [i]:=palette [i] shr 2;π  asmπ    mov ax,13hπ    int 10hπ    mov ax,1012hπ    xor bx,bxπ    mov cx,256π    mov dx,offset paletteπ    int 10hπ  end;π  for i:=0 to depth-1 doπ    Read_PCX_Line (i*320);π  asmπ    xor ax,axπ    int 16hπ    mov ax,03hπ    int 10hπ  end;πend;ππbeginπ  if (paramcount > 0) thenπ  beginπ    assign (f, paramstr (1));π    reset (f,1);π    blockread (f, header, sizeof (header));π    if (header.manufacturer=10) and (header.version=5) andπ       (header.bits_per_pixel=8) and (header.colour_planes=1) thenπ    beginπ      seek (f, filesize (f)-769);π      blockread (f, c, 1);π      if (c=12) thenπ      beginπ        blockread (f, palette, 768);π        seek (f, 128);π        width:=header.xmax-header.xmin+1;π        depth:=header.ymax-header.ymin+1;π        bytes:=header.bytes_per_line;π        Unpack_PCX_File;π      end else writeln ('Error reading palette.');π    end else writeln ('Not a 256 colour PCX file.');π    close (f);π  end else writeln ('No file name specified.');πend.ππ    37     11-02-9305:49ALL                      RANDY PARKER             Writing to Graphic Pages SWAG9311            9      ╓   {πRANDY PARKERππ    I've been playing With using the Absolute address $A000:0000 to do directπvideo Writes in Graphics mode and was wondering if someone could tell me howπto get colors.  I use an Array of [1..NumOfBits].  NumOfBits being the numberπof bits the current Graphic page Uses when it stores it's information.ππThe following is an example of what I mean:π}ππProgram UseFastGraf;πUsesπ  Graph;ππTypeπ  View = Array [1..19200] of Word;ππVarπ  I,π  GraphDriver,π  GraphMode    : Integer;π  View1        : View Absolute $A000:0000;π  View2        : View;ππbeginπ  GraphDriver := Detect;π  InitGraph(GraphDriver, GraphMode, 'e:\bp\bgi');π  For I := 1 to 1000 Doπ  beginπ    SetColor(Random(GetMaxColor));π    Line(Random(GetMaxX), Random(GetMaxY), Random(GetMaxX), GetMaxY);π  end;π  View2 := View1;π  SetColor(15);π  OutTextXY(100, 100, 'Press Enter To Continue : ');π  Readln;π  ClearDevice;π  OutTextXY(100, 100, 'Press Enter To See The Previous Screen');π  Readln;π  View1 := View2;π  Readln;πend.ππ                38     11-02-9305:56ALL                      SEAN PALMER              Another QUICK PutImage   SWAG9311            18     ╓   (*πSEAN PALMERππ> there is simple method of masking color 0 so it won't be displayed.π> An assembly language routine based around this:ππProcedure PutImg(x, y : Integer; Var Img);πTypeπ  AList = Array[1..$FFFF] of Byte; {1-based Arrays are slower than 0-based}πVarπ  APtr    : ^AList; {I found a very fast way to do this: With}π  j, i,π  Width,π  Height,π  Counter : Word;πbeginπ  Aptr    := @Img;π  Width   := (Aptr^[2] SHL 8) + Aptr^[1] + 1; {these +1's that 1-based Arrays }π  Height  := (Aptr^[4] SHL 8) + Aptr^[3] + 1; { require make For slower code}π  Counter := 5;π  For j := y to (y + height - 1) doπ  begin  {try pre-calculating the offset instead}π    For i := x to (x + width - 1) doπ    beginπ      Case Aptr^[Counter] of {CASE is probably not the way to do this}π        0:; { do nothing }π      else _mcgaScreen[j, i] := Aptr^[Counter]; { plot it }π      end;π      Inc(Counter);π    end;π  end;πend;ππok, here's my try:π*)ππTypeπ  pWord = ^Word;ππProcedure putImg(x, y : Integer; Var image);πVarπ  anImg : Recordπ    img : Array [0..$FFF7] of Byte;π  end Absolute image;ππ  aScrn : Recordπ    scrn : Array [0..$FFF7] of Byte;π  end Absolute $A000 : 0000;ππ  width,π  height,π  counter,π  offs, src : Word;ππbeginπ  width  := pWord(@anImg[0])^;π  height := pWord(@anImg[2])^;π  offs   := y * 320 + x;π  src    := 4;   {skip width, height}π  With aScrn, anImg doπ  Repeatπ    counter := width;π    Repeatπ      if img[src] <> 0 thenπ        scrn[offs] := img[src];π      inc(src);π      inc(offs);π      dec(counter);π    Until counter = 0;π    inc(offs, 320 - width);π    dec(height);π  Until height = 0;πend;ππ{πThose Arrays-pretending-to-be-Records above so they'll work With the Withπstatement should end up making BP keep the address in Registers, making itπfaster. In any Case it won't be slower than yours. I'd appreciate youπtiming them and letting me know the results. Actually, let me know if itπeven compiles and works... 8)ππBut Really, man, if you're writing Graphics routines you Really have toπgo For assembly. Pascal don't cut it. (c doesn't either...)π}π                                                                                            39     11-02-9317:44ALL                      SEAN PALMER              Bresenham Line           SWAG9311            12     ╓   {πFrom: SEAN PALMERπSubj: Bresenham's LineππYou need a plot(x,y) procedure and a global color variable to use these asπposted. }πππ{bresenham's line}πprocedure line(x,y,x2,y2:integer);var d,dx,dy,ai,bi,xi,yi:integer;beginπ if(x<x2)then begin xi:=1;dx:=x2-x;end else begin xi:=-1;dx:=x-x2;end;π if(y<y2)then begin yi:=1;dy:=y2-y;end else begin yi:=-1;dy:=y-y2;end;π plot(x,y);π if dx>dy then begin ai:=(dy-dx)*2;bi:=dy*2; d:=bi-dx;π  repeatπ   if(d>=0)then begin inc(y,yi);inc(d,ai);end else inc(d,bi);π   inc(x,xi);plot(x,y);π   until(x=x2);π  endπ else begin ai:=(dx-dy)*2;bi:=dx*2; d:=bi-dy;π  repeatπ   if(d>=0)then begin inc(x,xi);inc(d,ai);end else inc(d,bi);π   inc(y,yi);plot(x,y);π   until(y=y2);π  end;π end;πππ{filled ellipse}πprocedure disk(xc,yc,a,b:integer);π var x,y:integer; aa,aa2,bb,bb2,d,dx,dy:longint; beginπ x:=0;y:=b;π aa:=longint(a)*a; aa2:=2*aa;π bb:=longint(b)*b; bb2:=2*bb;π d:=bb-aa*b+aa div 4;π dx:=0;dy:=aa2*b;π vLin(xc,yc-y,yc+y);π while(dx<dy)do beginπ  if(d>0)then begin dec(y); dec(dy,aa2); dec(d,dy); end;π  inc(x); inc(dx,bb2); inc(d,bb+dx);π  vLin(xc-x,yc-y,yc+y);vLin(xc+x,yc-y,yc+y);π  end;π inc(d,(3*(aa-bb)div 2-(dx+dy))div 2);π while(y>=0)do beginπ  if(d<0)then beginπ   inc(x); inc(dx,bb2); inc(d,bb+dx);π   vLin(xc-x,yc-y,yc+y);vLin(xc+x,yc-y,yc+y);π   end;π  dec(y); dec(dy,aa2); inc(d,aa-dy);π  end;π end;π                                                          40     11-02-9317:24ALL                      SEAN PALMER              Transparent PutImage     SWAG9311            15     ╓   {πFrom: SEAN PALMERπSubj: transparent putimageπ}ππProcedure PutImg(x,y : integer;Var Img);πtypeπ AList = array[1..$FFFF] of Byte; {1-based arrays are slower than 0-based}πvarπ APtr : AList;                   {I found a very fast way to do this: WITH}π j,i,Width,Height,Counter : Word;πbeginπ Aptr:=@Img;π Width:=(Aptr] SHL 8) + Aptr]+1;  {these +1's that 1-based arrays }π Height:=(Aptr] SHL 8) + Aptr]+1;  { require make for slower code}π Counter:=5;π For j:=y to (y+height-1) do begin  {try pre-calculating the offset instead}π  for i:=x to (x+width-1) do beginπ   case AptrCounter] of          {CASE is probably not the way to do this}π    0:; (* do nothing *)π    else _mcgaScreen[j,i]:=AptrCounter]; (* plot it *)π    end;π   Inc(Counter);π   end;π  end;π end;ππok, here's my try:ππtype pWord=word;ππprocedure putImg(x,y:integer;var image);πvarπ anImg:record img:array[0..$FFF7]of byte; end absolute image;π aScrn:record scrn:array[0..$FFF7]of byte; end absolute $A000:0000;π width,height,counter,offs,src:word;πbeginπ width:=pWord(@anImg[0])π height:=pWord(@anImg[2])π offs:=y*320+x;π src:=4;   {skip width, height}π with aScrn,anImg do repeatπ  counter:=width;π  repeatπ   if img[src]<>0 then scrn[offs]:=img[src];π   inc(src);π   inc(offs);π   dec(counter);π   until counter=0;π  inc(offs,320-width);π  dec(height);π  until height=0;π end;πππThose arrays-pretending-to-be-records above so they'll work with the WITHπstatement should end up making BP keep the address in registers, making itπfaster. In any case it won't be slower than yours. I'd appreciate youπtiming them and letting me know the results. Actually, let me know if itπeven compiles and works... 8)π                                                                                                  41     11-02-9305:55ALL                      STEFAN XENOS             Loading Images from Disk SWAG9311            27     ╓   {πSTEFAN XENOSππ> I am able to load an image into a buffer and display it with PutImage ect.,π> but I would like to load the image from disk instead of with getimage.ππName: ImageStuff.PasπPurpose: ImageStuff is a unit for storing bitmaps in dynamic variables andπ         writing them to disk.πProgger: Stefan XenosππThis unit is public domain.}ππUnit ImageStuff;ππinterfaceππUsesπ Graph;ππTypeπ  Image = Recordπ    BitMap : Pointer;π    Size   : Word;π end;ππProcedure Get(X1, Y1, X2, Y2 : Word; Var aImage : Image);πProcedure Put(X, Y : Word; aImage : Image; BitBlt : Word);πProcedure Kill(Var aImage : Image);πProcedure Save(Var F : File; aImage : Image);πProcedure Load(Var F : File; Var aImage : Image);ππimplementationππProcedure Get(X1, Y1, X2, Y2 : Word; Var aImage : Image);π{Clips an image from the screen and store it in a dynamic variable}πBeginπ  aImage.bitmap := nil;π  aImage.size   := ImageSize(X1, Y1, X2, Y2);π  GetMem(aImage.BitMap,aImage.Size);    {Ask for some memory}π  GetImage(X1, Y1, X2, Y2, aImage.BitMap^); {Copy the image}πEnd;ππProcedure Put(X, Y : Word; aImage : Image; BitBlt : Word);πBeginπ  PutImage(X, Y, aImage.BitMap^, BitBlt);   {Display image}πEnd;ππProcedure Kill(Var aImage : Image);π{Frees up the memory used by an unwanted image}πBeginπ  FreeMem (aImage.BitMap, aImage.Size); {Free up memory used by image}π  aImage.Size   := 0;π  aImage.BitMap := Nil;πEnd;ππProcedure Save(Var F : File; aImage : Image);π{Saves an image to disk. File MUST already be opened for write}πBeginπ  BlockWrite(F, aImage.Size, 2);             {Store the image's size so thatπ                                            it may be correctly loaded later}π  BlockWrite(F, aImage.BitMap^, aImage.Size); {Write image itself to disk}πEnd;ππProcedure Load (Var F : File; Var aImage : Image);π{Loads an image off disk and stores it in a dynamic variable}πBeginπ BlockRead(F, aImage.Size, 2);              {Find out how big the image is}π GetMem(aImage.BitMap, aImage.Size);        {Allocate memory for it}π BlockRead(F, aImage.BitMap^, aImage.Size)  {Load the image}πEnd;ππBeginπEnd.ππ{πHere's some source which should help you figure out how to use the unit Iπjust sent.π}ππ{By Stefan Xenos}πProgram ImageTest;ππUsesπ  Graph,π  ImageStuff;ππVarπ  Pic      : Image;π  LineNum  : Byte;π  DataFile : File;π  GrDriver,π  GrMode   : Integer;ππConstπ FileName = 'IMAGE.DAT';π MaxLines = 200;ππBeginπ {Initialise}π DetectGraph(GrDriver, GrMode);π InitGraph(GrDriver, GrMode, '');π Randomize;ππ {Draw some lines}π For LineNum := 1 to MaxLines doπ beginπ   setColor(random (maxcolors));π   line(random(getmaxx), random(getmaxy), random(getmaxx), random(getmaxy));π end;ππ {Copy image from screen}π Get(100, 100, 150, 150, Pic);ππ readLn;ππ {Clear screen}π ClearDevice;ππ {Display image}π Put(100, 100, Pic, NormalPut);ππ readLn;ππ {Clear screen}π ClearDevice;ππ {Save image to disk}π Assign(DataFile, FileName);π Rewrite(DataFile, 1);π Save(DataFile, Pic);π Close(DataFile);ππ {Kill image}π Kill(pic);ππ {Load image from disk}π Assign(DataFile, FileName);π Reset(DataFile, 1);π Load(DataFile, pic);π Close(DataFile);ππ {Display image}π Put(200, 200, Pic, NormalPut);ππ readLn;ππ CloseGraph;π WriteLn(Pic.size);πEnd.π                                                                                                            42     11-02-9304:50ALL                      STEVE BOUTILIER          Simple & QUICK Graphics  SWAG9311            8      ╓   { STEVE BOUTILIER }ππUsesπ  Dos,π  Crt;ππProcedure OpenGraphics; Assembler;πAsmπ  Mov Ah, 00hπ  Mov Al, 13hπ  Int $10πend;ππProcedure CloseGraphics; Assembler;πAsmπ  Mov Ah, 00hπ  Mov Al, 03hπ  Int $10πend;ππProcedure PutXY(X, Y : Byte); Assembler;πAsmπ  Mov Ah, 02hπ  Mov Dh, Y - 1π  Mov Dl, X - 1π  Mov Bh, 0π  Int $10πend;ππProcedure OutChar(S : Char; Col : Byte); Assembler;πAsmπ  Mov Ah, 0Ehπ  Mov Al, Sπ  Mov Bh, 0π  Mov Bl, Colπ  Int $10πend;ππProcedure OutString(S : String; Col : Byte);πVarπ I  : Integer;π Ch : Char;πbeginπ  For I := 1 to Length(s) doπ  beginπ   Ch := S[I];π   OutChar(Ch, Col);π  end;πend;ππbeginπ  OpenGraphics;π  OutString('HELLO WORLD!' + #13#10, 14);π  Repeat Until KeyPressed;π  CloseGraphics;πend.ππ{πBTW: This code is Public Domain! Do what you want With it! most of youπ     probably already have routines that are even better than this.π}ππ                   43     11-02-9305:52ALL                      VINCE LAURENT            Scalable HEX Screen      SWAG9311            25     ╓   {πVINCE LAURENTππI wrote some code to draw a scalable hex field on the screen. Canπanyone give me a hand in optimizing it? There is a lot of redundantπline drawing and positioning... I would also like to be able to haveπa fexible amount of hexigons showing.  For example, if the scale is,πsay 40, show 19 hexs, if it is smaller, show more (like as many thatπcould have fit in the area occupied by 19).ππBTW, this code can be freely used and distributed or completely ignored :-) }ππProgram HexzOnScreen;πUsesπ  Graph, Crt;πTypeπ  PtArray = Array [1..6, 1..2] of Real;πVarπ  s1, s2,π  side,π  i, j,π  Gd, Gm  : Integer;π  Pts     : PtArray;π  ErrCode : Integer;π  Sqrt3,π  sts     : Real;ππbeginπ  Sqrt3 := Sqrt(3);π  Side  := 40;             { initial hex side length ( min = 8 ) }π  sts   := Side * Sqrt3;π  s1    := 200;π  s2    := 60;     { starting point For hex field }π  InitGraph(Gd, Gm, 'e:\bp\bgi\');π  ErrCode := GraphResult;π  if not ErrCode = grOk thenπ  beginπ    Writeln('Error: ', GraphErrorMsg(ErrCode));π    Halt(0);π  end;π  SetColor(LightGray);π  Delay(10);   { give the screen a chance to toggle to Graph mode }π  For j := 1 to 17 DOπ  beginπ    Pts[1, 1] := s1;π    Pts[1, 2] := s2;π    Pts[2, 1] := Pts[1, 1] - side;π    Pts[2, 2] := Pts[1, 2];π    Pts[3, 1] := Pts[1, 1] - side - (side / 2);π    Pts[3, 2] := Pts[1, 2] + (sts / 2);π    Pts[4, 1] := Pts[1, 1] - side;π    Pts[4, 2] := Pts[1, 2] + sts ;π    Pts[5, 1] := Pts[1, 1];π    Pts[5, 2] := Pts[4, 2];π    Pts[6, 1] := Pts[1, 1] + (side / 2);π    Pts[6, 2] := Pts[1, 2] + (sts  / 2);π    For I := 1 to 6 DOπ    beginπ      if i <> 6 thenπ        Line(Round(Pts[i, 1]),  Round(Pts[i, 2]),π             Round(Pts[i + 1, 1]), Round(Pts[i + 1, 2]))π      elseπ        Line(Round(Pts[i, 1]), Round(Pts[i, 2]),π             Round(Pts[1, 1]), Round(Pts[1, 2]));π    end;π    Case j OFπ      1..2 :π      beginπ        s1 := Round(Pts[6, 1] + side);π        s2 := Round(Pts[6, 2]);π      end;π      3..4 :π      beginπ        s1 := Round(Pts[5, 1]);π        s2 := Round(Pts[5, 2]);π      end;π      5..6 :π      beginπ        s1 := Round(Pts[3, 1]);π        s2 := Round(Pts[3, 2]);π      end;π      7..8 :π      beginπ        s1 := Round(Pts[3, 1]);π        s2 := Round(Pts[3, 2] - sts);π      end;π      9..10 :π      beginπ        s1 := Round(Pts[1, 1]);π        s2 := Round(Pts[1, 2] - sts);π      end;π      11 :π      beginπ        s1 := Round(Pts[6, 1] + side);π        s2 := Round(Pts[6, 2] - sts);π      end;π      12..13 :π      beginπ        s1 := Round(Pts[6, 1] + side);π        s2 := Round(Pts[6, 2]);π      end;π      14 :π      beginπ        s1 := Round(Pts[5, 1]);π        s2 := Round(Pts[5, 2]);π      end;π      15 :π      beginπ        s1 := Round(Pts[3, 1]);π        s2 := Round(Pts[3, 2]);π      end;π      16 :π      beginπ        s1 := Round(Pts[3, 1]);π        s2 := Round(Pts[3, 2] - sts);π      end;π    end;π  end;π  Line(s1, s2, Round(s1 + (side / 2)), Round(s2 - sts / 2));π  Readln;π  CloseGraph;πend.π                                                                     44     11-21-9309:44ALL                      WILLIAM PLANKE           Writing PCX files        SWAG9311            94     ╓   {πFrom: WILLIAM PLANKEπSubj: Write PCX example 1/4ππAs I follow this forum, many requests are made for PCX graphicsπfile routines. Those that are looking for Read_PCX info canπfind it on the ZSoft BBS in a wonderful Pascal example: ShowPCX.ππOn the other hand, there is next to zilch out there on how toπWrite_PCX files. I know.... I searched and searched and couldn'tπfind a thing! So with a little brute force  and a few ZSoftπC language snippets <groan>, I got this together:π}πππ{ =================== TPv6.0  P C X _ W ======================== }ππ{$R-}    {Range checking, turn off when debugged}ππunit PCX_W;ππ{ --------------------- Interface ----------------- }ππinterfaceππtypeπ    Str80 = string [80];ππprocedure Write_PCX  (Name:Str80);πππ{ ===================== Implementation ============ }ππimplementationππusesπ    Graph;πππ{-------------- Write_PCX --------------}ππprocedure Write_PCX (Name:Str80);ππconstπ     RED1   = 0;π     GREEN1 = 1;π     BLUE1  = 2;ππtypeπ    ArrayPal   = array [0..15, RED1..BLUE1] of byte;ππconstπ     MAX_WIDTH  = 4000;    { arbitrary - maximum width (in bytes) ofπ                             a PCX image }π     INTENSTART =   $5;π     BLUESTART  =  $55;π     GREENSTART =  $A5;π     REDSTART   =  $F5;ππtypeπ    Pcx_Header = recordπ    {comments from ZSoft ShowPCX pascal example}ππ        Manufacturer: byte;     { Always 10 for PCX file }ππ        Version: byte;          { 2 - old PCX - no palette (not usedπ                                      anymore),π                                  3 - no palette,π                                  4 - Microsoft Windows - no paletteπ                                      (only in old files, new Windowsπ                                      version uses 3),π                                  5 - with palette }ππ        Encoding: byte;         { 1 is PCX, it is possible that we mayπ                                  add additional encoding methods in theπ                                  future }ππ        Bits_per_pixel: byte;   { Number of bits to represent a pixelπ                                  (per plane) - 1, 2, 4, or 8 }ππ        Xmin: integer;          { Image window dimensions (inclusive) }π        Ymin: integer;          { Xmin, Ymin are usually zero (not always)}π        Xmax: integer;π        Ymax: integer;ππ        Hdpi: integer;          { Resolution of image (dots per inch) }π        Vdpi: integer;          { Set to scanner resolution - 300 isπ                                  default }ππ        ColorMap: ArrayPal;π                                { RGB palette data (16 colors or less)π                                  256 color palette is appended to endπ                                  of file }ππ        Reserved: byte;         { (used to contain video mode)π                                  now it is ignored - just set to zero }ππ        Nplanes: byte;          { Number of planes }ππ        Bytes_per_line_per_plane: integer;   { Number of bytes toπ                                               allocate for a scanlineπ                                               plane. MUST be an an EVENπ                                               number! Do NOT calculateπ                                               from Xmax-Xmin! }ππ        PaletteInfo: integer;   { 1 = black & white or color image,π                                  2 = grayscale image - ignored in PB4,π                                      PB4+ palette must also be set toπ                                      shades of gray! }ππ        HscreenSize: integer;   { added for PC Paintbrush IV Plusπ                                  ver 1.0,  }π        VscreenSize: integer;   { PC Paintbrush IV ver 1.02 (and later)}π                                { I know it is tempting to use theseπ                                  fields to determine what video modeπ                                  should be used to display the imageπ                                  - but it is NOT recommended since theπ                                  fields will probably just containπ                                  garbage. It is better to have theπ                                  user install for the graphics mode heπ                                  wants to use... }ππ        Filler: array [74..127] of byte;     { Just set to zeros }π    end;ππ    Array80    = array [1..80]        of byte;π    ArrayLnImg = array [1..326]       of byte; { 6 extra bytes atπ     beginng of line that BGI uses for size info}π    Line_Array = array [0..MAX_WIDTH] of byte;π    ArrayLnPCX = array [1..4]         of Array80;ππvarπ   PCXName   : File;π   Header    : Pcx_Header;                 { PCX file header }π   ImgLn     : ArrayLnImg;π   PCXLn     : ArrayLnPCX;π   RedLn,π   BlueLn,π   GreenLn,π   IntenLn   : Array80;π   Img       : pointer;πππ{-------------- BuildHeader- -----------}ππprocedure BuildHeader;ππconstπ     PALETTEMAP: ArrayPal=π                 {  R    G    B                    }π                (($00, $00, $00),  {  black        }π                 ($00, $00, $AA),  {  blue         }π                 ($00, $AA, $00),  {  green        }π                 ($00, $AA, $AA),  {  cyan         }π                 ($AA, $00, $00),  {  red          }π                 ($AA, $00, $AA),  {  magenta      }π                 ($AA, $55, $00),  {  brown        }π                 ($AA, $AA, $AA),  {  lightgray    }π                 ($55, $55, $55),  {  darkgray     }π                 ($55, $55, $FF),  {  lightblue    }π                 ($55, $FF, $55),  {  lightgreen   }π                 ($55, $FF, $FF),  {  lightcyan    }π                 ($FF, $55, $55),  {  lightred     }π                 ($FF, $55, $FF),  {  lightmagenta }π                 ($FF, $FF, $55),  {  yellow       }π                 ($FF, $FF, $FF) );{  white        }ππvarπ   i : word;ππbeginπ     with Header doπ          beginπ               Manufacturer  := 10;π               Version  := 5;π               Encoding := 1;π               Bits_per_pixel := 1;π               Xmin := 0;π               Ymin := 0;π               Xmax := 639;π               Ymax := 479;π               Hdpi := 640;π               Vdpi := 480;π               ColorMap := PALETTEMAP;π               Reserved := 0;π               Nplanes  := 4; { Red, Green, Blue, Intensity }π               Bytes_per_line_per_plane := 80;π               PaletteInfo := 1;π               HscreenSize := 0;π               VscreenSize := 0;π               for i := 74 to 127 doπ                   Filler [i] := 0;π          end;πend;πππ{-------------- GetBGIPlane ------------}ππprocedure GetBGIPlane (Start:word; var Plane:Array80);ππvarπ   i : word;ππbeginπ     for i:= 1 to Header.Bytes_per_line_per_plane doπ         Plane [i] := ImgLn [Start +i -1]πend;ππ{-------------- BuildPCXPlane ----------}ππprocedure BuildPCXPlane (Start:word; Plane:Array80);ππvarπ   i : word;ππbeginπ     for i := 1 to Header.Bytes_per_line_per_plane doπ         PCXLn [Start] [i] := Plane [i];πend;πππ{-------------- EncPCXLine -------------}ππprocedure EncPCXLine (PlaneLine : word); { Encode a PCX line }ππvarπ   This,π   Last,π   RunCount : byte;π   i,π   j        : word;πππ  {-------------- EncPut -----------------}ππ  procedure EncPut (Byt, Cnt :byte);ππ  constπ       COMPRESS_NUM = $C0;  { this is the upper two bits thatπ                              indicate a count }ππ  varπ     Holder : byte;ππ  beginπ  {$I-}π       if (Cnt = 1) and (COMPRESS_NUM <> (COMPRESS_NUM and Byt)) thenπ          blockwrite (PCXName, Byt,1)          { single occurance }π          {good place for file error handler!}π       elseπ           beginπ                Holder := (COMPRESS_NUM or Cnt);π                blockwrite (PCXName, Holder, 1); { number of times theπ                                                   following colorπ                                                   occurs }π                blockwrite (PCXName, Byt, 1);π           end;π  {$I+}π  end;πππbeginπ     i := 1;         { used in PCXLn }π     RunCount := 1;π     Last := PCXLn [PlaneLine][i];π     for j := 1 to Header.Bytes_per_line_per_plane -1 doπ         beginπ              inc (i);π              This := PCXLn [PlaneLine][i];π              if This = Last thenπ                 beginπ                      inc (RunCount);π                      if RunCount = 63 then   { reached PCX run lengthπ                                                limited max yet? }π                         beginπ                              EncPut (Last, RunCount);π                              RunCount := 0;π                         end;π                 endπ              elseπ                  beginπ                       if RunCount >= 1 thenπ                          Encput (Last, RunCount);π                       Last := This;π                       RunCount := 1;π                  end;π         end;π     if RunCount >= 1 then  { any left over ? }π        Encput (Last, RunCount);πend;ππ            { - - -W-R-I-T-E-_-P-C-X- - - - - - - - }ππconstπ     XMAX = 639;π     YMAX = 479;ππvarπ   i, j, Size : word;ππbeginπ     BuildHeader;π     assign     (PCXName,Name);π{$I-}π     rewrite    (PCXName,1);π     blockwrite (PCXName,Header,sizeof (Header));π     {good place for file error handler!}π{$I+}π     setviewport (0,0,XMAX,YMAX, ClipOn);π     Size := imagesize (0,0,XMAX,0); { size of a single row }π     getmem (Img,Size);ππ     for i := 0 to YMAX doπ         beginπ              getimage (0,i,XMAX,i,Img^);  { Grab 1 line from theπ                                             screen store in Imgπ                                             buffer  }π              move (Img^,ImgLn,Size {326});πππ              GetBGIPlane (INTENSTART, IntenLn);π              GetBGIPlane (BLUESTART,  BlueLn );π              GetBGIPlane (GREENSTART, GreenLn);π              GetBGIPlane (REDSTART,   RedLn  );π              BuildPCXPlane (1, RedLn  );π              BuildPCXPlane (2, GreenLn);π              BuildPCXPlane (3, BlueLn );π              BuildPCXPlane (4, IntenLn); { 320 bytes/lineπ                                            uncompressed }π              for j := 1 to Header.NPlanes doππ                  EncPCXLine (j);π         end;π     freemem (Img,Size);           (* Release the memory        *)π{$I-}π     close (PCXName);              (* Save the Image            *)π{$I+}πend;ππend {PCX.TPU} .πππ{ -----------------------Test Program -------------------------- }ππprogram WritePCX;ππusesπ    Graph, PCX_W;ππ{-------------- DrawHorizBars ----------}ππprocedure DrawHorizBars;ππvarπ   i, Color : word;ππbeginπ     cleardevice;π     Color := 15;π     for i := 0 to 15 doπ         beginπ              setfillstyle (solidfill,Color);π              bar (0,i*30,639,i*30+30);       { 16*30 = 480 }π              dec (Color);π         end;πend;ππ{-------------- Main -------------------}ππvarπ   NameW : Str80;π   Gd,π   Gm    : integer;ππbeginπ     writeln;π     if (ParamCount = 0) then           { no DOS command lineπ                                          parameters }π        beginπ             write ('Enter name of PCX picture file to write: ');π             readln (NameW);π             writeln;π        endπ     elseπ         beginπ              NameW := paramstr (1);  { get filename from DOSπ                                        command line }π         end;ππ     if (Pos ('.', NameW) = 0) then   { make sure the filenameπ                                        has PCX extension }π        NameW := Concat (NameW, '.pcx');ππ     Gd:=VGA;π     Gm:=VGAhi; {640x480, 16 colors}π     initgraph (Gd,Gm,'..\bgi');  { path to your EGAVGA.BGI }ππ     DrawHorizBars;ππ     readln;π     Write_PCX (NameW); { PCX_W.TPU }π     closegraph;                    { Close graphics    }π     textmode (co80);               { back to text mode }πend.  { Write_PCX }π                                                                           45     01-27-9411:51ALL                      PETER M. GRUHN           3D Rotation              SWAG9402            49     ╓   program BoxRot;ππ{PUBLIC DOMAIN  1993 Peter M. GruhnππProgram draws a box on screen. Allows user to rotate the box aroundπthe three primary axes. Viewing transform is simple ignore z.ππI used _Computer_Graphics:_Principles_and_Practice_, Foley et alπISBN 0-201-12110-7 as a referenceππRUNNING:πBorland Pascal 7. Should run on any graphics device supported by BGI.πIf you have smaller than 280 resolution, change '+200' to somethingπsmaller and/or change 75 to something smaller.ππSince this machine isπnot really set up for doing DOS graphics, I hard coded my BGI path, soπyou have to find 'initgraph' and change the bgi path to something thatπworks on your machine. Try ''.ππOkey dokey. This is kinda slow, and does a nice job of demonstrating theπproblems of repeatedly modifying the same data set. That is, the more andπmore you rotate the box, the more and more distorted it gets. This isπbecause computers are not perfect at calculations, and all of those littleπerrors add up quite quickly.ππIt's because of that that I used reals, not reals. I used floating pointπbecause the guy doesn't know what is going on at all with 3d, so better toπlook at only the math that is really happening. Besides, I still have toπthink to use fixed point. Whaddaya want for .5 hour programming.ππ DIRECTIONS:π   ',' - rotates around the x axisπ   '.' - rotates around the y axisπ   '/' - rotates around the z axisπ   'q' - quitsππ   All rotations are done around global axes, not object axes.π}ππusesπ  graph,π  crt;ππconstπ  radtheta = 1 {degrees} * 3.1415926535 {radians} / 180 {per degrees};π  { sin and cos on computers are done in radians. }ππtypeπ  tpointr = record   { Just a record to hold 3d points }π    x, y, z : real;π  end;ππvarπ  box : array [0..7] of tpointr;   { The box we will manipulate }π  c   : char;                      { Our input mechanism }ππprocedure init;πvarπ  gd, gm : integer;π{ turns on graphics and creates a cube. Since the rotation routinesπ  rotate around the origin, I have centered the cube on the origin, soπ  that it stays in place and only spins. }πbeginπ  gd := detect;π  initgraph(gd, gm, 'e:\bp\bgi');π  box[0].x := -75;  box[0].y := -75;  box[0].z := -75;π  box[1].x := 75;   box[1].y := -75;  box[1].z := -75;π  box[2].x := 75;   box[2].y := 75;   box[2].z := -75;π  box[3].x := -75;  box[3].y := 75;   box[3].z := -75;π  box[4].x := -75;  box[4].y := -75;  box[4].z := 75;π  box[5].x := 75;   box[5].y := -75;  box[5].z := 75;π  box[6].x := 75;   box[6].y := 75;   box[6].z := 75;π  box[7].x := -75;  box[7].y := 75;   box[7].z := 75;πend;ππprocedure myline(x1, y1, z1, x2, y2, z2 : real);π{ Keeps the draw routine pretty. Pixels are integers, so I round. Since theπ cube is centered around 0,0 I move it over 200 to put it on screen. }πbeginπ{ if you think those real mults are slow, here's some rounds too... hey, youπ  may wonder, what happened to the stinking z coordinate? Ah, says I, thisπ  is the simplest of 3d viewing transforms. You just take the z coord out ofπ  things and boom. Looking straight down the z axis on the object. If I getπ  inspired, I will add simple perspective transform to these.  There, gotπ  inspired. Made mistakes. Foley et al are not very good at tutoringπ  perspective and I'm kinda ready to be done and post this. }π  line(round(x1) + 200, round(y1) + 200, round(x2) + 200, round(y2) + 200);πend;ππprocedure draw;π{ my model is hard coded. No cool things like vertex and edge and face lists.}πbeginπ  myline(box[0].x, box[0].y, box[0].z, box[1].x, box[1].y, box[1].z);π  myline(box[1].x, box[1].y, box[1].z, box[2].x, box[2].y, box[2].z);π  myline(box[2].x, box[2].y, box[2].z, box[3].x, box[3].y, box[3].z);π  myline(box[3].x, box[3].y, box[3].z, box[0].x, box[0].y, box[0].z);ππ  myline(box[4].x, box[4].y, box[4].z, box[5].x, box[5].y, box[5].z);π  myline(box[5].x, box[5].y, box[5].z, box[6].x, box[6].y, box[6].z);π  myline(box[6].x, box[6].y, box[6].z, box[7].x, box[7].y, box[7].z);π  myline(box[7].x, box[7].y, box[7].z, box[4].x, box[4].y, box[4].z);ππ  myline(box[0].x, box[0].y, box[0].z, box[4].x, box[4].y, box[4].z);π  myline(box[1].x, box[1].y, box[1].z, box[5].x, box[5].y, box[5].z);π  myline(box[2].x, box[2].y, box[2].z, box[6].x, box[6].y, box[6].z);π  myline(box[3].x, box[3].y, box[3].z, box[7].x, box[7].y, box[7].z);ππ  myline(box[0].x, box[0].y, box[0].z, box[5].x, box[5].y, box[5].z);π  myline(box[1].x, box[1].y, box[1].z, box[4].x, box[4].y, box[4].z);πend;ππprocedure rotx;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x   [ 1  0  0  0   [x',y',z',1]π  y     0  c -s  0 =π  z     0  s  c  0π  1]    0  0  0  1]π}πvarπ  i : integer;πbeginπ  setcolor(0);π  draw;π  for i := 0 to 7 doπ  beginπ    box[i].x :=  box[i].x;π    box[i].y :=  box[i].y * cos(radTheta) + box[i].z * sin(radTheta);π    box[i].z := -box[i].y * sin(radTheta) + box[i].z * cos(radTheta);π  end;π  setcolor(15);π  draw;πend;ππprocedure roty;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x   [ c  0  s  0   [x',y',z',1]π  y     0  1  0  0 =π  z    -s  0  c  0π  1]    0  0  0  1]π}πvarπ  i : integer;πbeginπ  setcolor(0);π  draw;π  for i := 0 to 7 doπ  beginπ    box[i].x := box[i].x * cos(radTheta) - box[i].z * sin(radTheta);π    box[i].y := box[i].y;π    box[i].z := box[i].x * sin(radTheta) + box[i].z * cos(radTheta);π  end;π  setcolor(15);π  draw;πend;ππprocedure rotz;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x   [ c -s  0  0   [x',y',z',1]π  y     s  c  0  0 =π  z     0  0  1  0π  1]    0  0  0  1]π}πvarπ  i : integer;πbeginπ  setcolor(0);π  draw;π  for i := 0 to 7 doπ  beginπ    box[i].x :=  box[i].x * cos(radTheta) + box[i].y * sin(radTheta);π    box[i].y := -box[i].x * sin(radTheta) + box[i].y * cos(radTheta);π    box[i].z :=  box[i].z;π  end;π  setcolor(15);π  draw;πend;πππbeginπ  init;π  setcolor(14);π  draw;π  repeatπ    c := readkey;π    case c ofπ      ',' : rotx;π      '.' : roty;π      '/' : rotz;π      else {who gives a};π    end; {case}π  until c = 'q';π  closegraph;πend.πππ                                         46     01-27-9411:58ALL                      SEAN PALMER              Bresenham's Line         SWAG9402            20     ╓   {π>> I was wondering if anyone could show me the equations (and perhaps aπ>> demo in standard pascal) of the following shapes. What I need to know isπ>> where to plot the point.π>> Circle. (I've tried using the equation taught to me at school, but itπ>> Line  (What I would like would be to be able to plot a line by giving itππThere seems yet again to be enough interest/need so I'll post this stuff justπONCE more.... somebody put this in SWAG or something.... PLEASE!!!ππ [Okay Sean, here you go!  -Kerry]ππYou need a plot(x,y) procedure and a global color variable to use these asπposted.π}ππ{bresenham's line}πprocedure line(x, y, x2, y2 : integer);πvarπ  d, dx, dy,π  ai, bi,π  xi, yi : integer;πbeginπ  if (x < x2) thenπ  beginπ    xi := 1;π    dx := x2 - x;π  endπ  elseπ  beginπ    xi := - 1;π    dx := x - x2;π  end;ππ  if (y < y2) thenπ  beginπ    yi := 1;π    dy := y2 - y;π  endπ  elseπ  beginπ    yi := - 1;π    dy := y - y2;π  end;ππ  plot(x, y);ππ  if dx > dy thenπ  beginπ    ai := (dy - dx) * 2;π    bi := dy * 2;π    d  := bi - dx;π    repeatπ      if (d >= 0) thenπ      beginπ        inc(y, yi);π        inc(d, ai);π      endπ      elseπ        inc(d, bi);ππ      inc(x, xi);π      plot(x, y);π    until (x = x2);π  endπ  elseπ  beginπ    ai := (dx - dy) * 2;π    bi := dx * 2;π    d  := bi - dy;π    repeatπ      if (d >= 0) thenπ      beginπ        inc(x, xi);π        inc(d, ai);π      endπ      elseπ        inc(d, bi);ππ      inc(y, yi);π      plot(x, y);π    until (y = y2);π  end;πend;πππ{filled ellipse}πprocedure disk(xc,  yc,  a,  b : integer);πvarπ  x, y      : integer;π  aa, aa2,π  bb, bb2,π  d, dx, dy : longint;πbeginπ  x   := 0;π  y   := b;π  aa  := longint(a) * a;π  aa2 := 2 * aa;π  bb  := longint(b) * b;π  bb2 := 2 * bb;π  d   := bb - aa * b + aa div 4;π  dx  := 0;π  dy  := aa2 * b;π  vLin(xc, yc - y, yc + y);ππ  while (dx < dy) doπ  beginπ    if (d > 0) thenπ    beginπ      dec(y);π      dec(dy, aa2);π      dec(d, dy);π    end;π    inc(x);π    inc(dx, bb2);π    inc(d, bb + dx);π    vLin(xc - x, yc - y, yc + y);π    vLin(xc + x, yc - y, yc + y);π  end;ππ  inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);π  while (y >= 0) doπ  beginπ    if (d < 0) thenπ    beginπ      inc(x);π      inc(dx, bb2);π      inc(d, bb + dx);π      vLin(xc - x, yc - y, yc + y);π      vLin(xc + x, yc - y, yc + y);π    end;π    dec(y);π    dec(dy, aa2);π    inc(d, aa - dy);π  end;πend;ππ                    47     01-27-9412:05ALL                      LIOR BAR-ON              Gif Source 1             SWAG9402            98     ╓   {π> Can you post the gif source and any other graphic source for doing thisππHere is gif format (it doesn't get to full 768·1024·256)πor even less, but it is ok.π}ππ{$R-}{$S-}{$B-}πprogram GIF4TP;ππusesπ  crt, GRAPH;ππconstπ  ProgramName = 'TP4GIF';π  ProgramRevision = '2';ππtypeπ  BufferArray = array[0..63999] of byte;π  BufferPointer = ^BufferArray;ππvarπ  GifFile : file of BufferArray;π  InputFileName : string;π  RawBytes : BufferPointer;   { The heap array to hold it, raw    }π  Buffer : BufferPointer;     { The Buffer data stream, unblocked }π  Buffer2 : BufferPointer;    { More Buffer data stream if needed }π  Byteoffset,                 { Computed byte position in Buffer array }π  BitIndex                    { Bit offset of next code in Buffer array }π   : longint;ππ  Width,      {Read from GIF header, image width}π  Height,     { ditto, image height}π  LeftOfs,    { ditto, image offset from left}π  TopOfs,     { ditto, image offset from top}π  RWidth,     { ditto, Buffer width}π  RHeight,    { ditto, Buffer height}π  ClearCode,  {GIF clear code}π  EOFCode,    {GIF end-of-information code}π  OutCount,   {Decompressor output 'stack count'}π  MaxCode,    {Decompressor limiting value for current code size}π  CurCode,    {Decompressor variable}π  OldCode,    {Decompressor variable}π  InCode,     {Decompressor variable}π  FirstFree,  {First free code, generated per GIF spec}π  FreeCode,   {Decompressor, next free slot in hash table}π  RawIndex,     {Array pointers used during file read}π  BufferPtr,π  XC,YC,      {Screen X and Y coords of current pixel}π  ReadMask,   {Code AND mask for current code size}π  I           {Loop counter, what else?}π  :word;ππ  Interlace,  {true if interlaced image}π  AnotherBuffer, {true if file > 64000 bytes}π  ColorMap    {true if colormap present}π  : boolean;ππ  ch : char;π  a,              {Utility}π  Resolution,     {Resolution, read from GIF header}π  BitsPerPixel,   {Bits per pixel, read from GIF header}π  Background,     {Background color, read from GIF header}π  ColorMapSize,   {Length of color map, from GIF header}π  CodeSize,       {Code size, read from GIF header}π  InitCodeSize,   {Starting code size, used during Clear}π  FinChar,        {Decompressor variable}π  Pass,           {Used by video output if interlaced pic}π  BitMask,        {AND mask for data size}π  R,G,Bπ  :byte;ππ    {The hash table used by the decompressor}π  Prefix: array[0..4095] of word;π  Suffix: array[0..4095] of byte;ππ    {An output array used by the decompressor}π  PixelValue : array[0..1024] of byte;ππ    {The color map, read from the GIF header}π  Red,Green,Blue: array [0..255] of byte;π  MyPalette : PaletteType;ππ  TempString : String;ππConstπ MaxCodes: Array [0..9] of Word = (4,8,16,$20,$40,$80,$100,$200,$400,$800);π CodeMask:Array [1..4] of byte= (1,3,7,15);π PowersOf2: Array [0..8] of word=(1,2,4,8,16,32,64,128,256);π Masks: Array [0..9] of integer = (7,15,$1f,$3f,$7f,$ff,$1ff,$3ff,$7ff,$fff);π BufferSize : Word = 64000;ππfunction NewExtension(FileName,Extension : string) : string;π{πPlaces a new extension on to the file name.π}πvarπ  I : integer;πbeginπ  if (Extension[1] = '.') then delete(Extension,1,1);π  delete(Extension,4,251);π  I := pos('.',FileName);π  if (I = 0) thenπ  beginπ    while (length(FileName) > 0) and (FileName[length(FileName)] = ' ')π      do delete(FileName,length(FileName),1);π    NewExtension := FileName + '.' + Extension;π  end else beginπ    delete(FileName,I + 1,254 - I);π    NewExtension := FileName + Extension;π  end;πend; { NewExtension }ππfunction Min(I,J : longint) : longint;πbeginπ  if (I < J) then Min := I else Min := J;πend; { Min }ππprocedure AllocMem(var P : BufferPointer);πvarπ  ASize : longint;πbeginπ  ASize := MaxAvail;π  if (ASize < BufferSize) then beginπ    Textmode(15);π    writeln('Insufficient memory available!');π    halt;π  end else getmem(P,BufferSize);πend; { AllocMem }ππfunction Getbyte : byte;πbeginπ  if (RawIndex >= BufferSize) then exit;π  Getbyte := RawBytes^[RawIndex];π  inc(RawIndex);πend;ππfunction Getword : word;πvarπ  W : word;πbeginπ  if (succ(RawIndex) >= BufferSize) then exit;π  move(RawBytes^[RawIndex],W,2);π  inc(RawIndex,2);π  Getword := W;πend; { GetWord }ππprocedure ReadBuffer;πvarπ  BlockLength : byte;π  I,IOR : integer;πbeginπ  BufferPtr := 0;π  Repeatπ    BlockLength := Getbyte;π    For I := 0 to Blocklength-1 doπ    beginπ      if RawIndex = BufferSize thenπ      beginπ        {$I-}π        Read (GIFFile,RawBytes^);π        {$I+}π        IOR := IOResult;π        RawIndex := 0;π      end;π      if not AnotherBufferπ        then Buffer^[BufferPtr] := Getbyteπ        else Buffer2^[BufferPtr] := Getbyte;π      BufferPtr := Succ (BufferPtr);π      if BufferPtr=BufferSize then beginπ        AnotherBuffer := true;π        BufferPtr := 0;π        AllocMem (Buffer2);π      end;π    end;π  Until Blocklength=0;πend; { ReadBuffer }ππprocedure InitEGA;πvarπ  Driver,Mode : integer;πbeginπ  DetectGraph(Driver,Mode);π  InitGraph(Driver,Mode,'e:\bp\bgi');π  SetAllPalette(MyPalette);π  if (Background <> 0) then beginπ    SetFillStyle(SolidFill,Background);π    bar(0,0,Width,Height);π  end;πend; { InitEGA }ππprocedure DetColor(var PValue : byte; MapValue : Byte);π{πDetermine the palette value corresponding to the GIF colormap intensityπvalue.π}πvarπ  Local : byte;πbeginπ  PValue := MapValue div 64;π  if (PValue = 1)π    then PValue := 2π    else if (PValue = 2)π      then PValue := 1;πend; { DetColor }ππprocedure Init;πvarπ  I : integer;πbeginπ  XC := 0;          {X and Y screen coords back to home}π  YC := 0;π  Pass := 0;        {Interlace pass counter back to 0}π  BitIndex := 0;   {Point to the start of the Buffer data stream}π  RawIndex := 0;      {Mock file read pointer back to 0}π  AnotherBuffer := false;    {Over 64000 flag off}π  AllocMem(Buffer);π  AllocMem(RawBytes);π  InputFileName := NewExtension(InputFileName,'GIF');π  {$I-}π  Assign(giffile,InputFileName);π  Reset(giffile);π  I := IOResult;π  if (I <> 0) then beginπ    textmode(15);π    writeln('Error opening file ',InputFileName,'. Press any key ');π    readln;π    halt;π  end;π  read(GIFFile,RawBytes^);π  I := IOResult;π{$I+}πend; { Init }ππprocedure ReadGifHeader;πvarπ  I : integer;πbeginπ  TempString := '';π  for I := 1 to 6 do TempString := TempString + chr(Getbyte);π  if (TempString <> 'GIF87a') then beginπ    textmode(15);π    writeln('Not a GIF file, or header read error. Press enter.');π    readln;π    halt;π  end;π{πGet variables from the GIF screen descriptorπ}π  RWidth := Getword;         {The Buffer width and height}π  RHeight := Getword;π{πGet the packed byte immediately following and decode itπ}π  B := Getbyte;π  Colormap := (B and $80 = $80);π  Resolution := B and $70 shr 5 + 1;π  BitsPerPixel := B and 7 + 1;π  ColorMapSize := 1 shl BitsPerPixel;π  BitMask := CodeMask[BitsPerPixel];π  Background := Getbyte;π  B := Getbyte;         {Skip byte of 0's}π{πCompute size of colormap, and read in the global one if there. Computeπvalues to be used when we set up the EGA paletteπ}π  MyPalette.Size := Min(ColorMapSize,16);π  if Colormap then beginπ    for I := 0 to pred(ColorMapSize) do beginπ      Red[I] := Getbyte;π      Green[I] := Getbyte;π      Blue[I] := Getbyte;π      DetColor(R,Red[I]);π      DetColor(G,Green [I]);π      DetColor(B,Blue [I]);π      MyPalette.Colors[I] := B and 1 +π                    ( 2 * (G and 1)) + ( 4 * (R and 1)) + (8 * (B div 2)) +π                    (16 * (G div 2)) + (32 * (R div 2));π    end;π  end;π{πNow read in values from the image descriptorπ}π  B := Getbyte;  {skip image seperator}π  Leftofs := Getword;π  Topofs := Getword;π  Width := Getword;π  Height := Getword;π  A := Getbyte;π  Interlace := (A and $40 = $40);π  if Interlace then beginπ    textmode(15);π    writeln(ProgramName,' is unable to display interlaced GIF pictures.');π    halt;π  end;πend; { ReadGifHeader }ππprocedure PrepDecompressor;πbeginπ  Codesize := Getbyte;π  ClearCode := PowersOf2[Codesize];π  EOFCode := ClearCode + 1;π  FirstFree := ClearCode + 2;π  FreeCode := FirstFree;π  inc(Codesize); { since zero means one... }π  InitCodeSize := Codesize;π  Maxcode := Maxcodes[Codesize - 2];π  ReadMask := Masks[Codesize - 3];πend; { PrepDecompressor }ππprocedure DisplayGIF;π{πDecompress and display the GIF data.π}πvarπ  Code : word;ππ  procedure DoClear;π  beginπ    CodeSize := InitCodeSize;π    MaxCode := MaxCodes[CodeSize-2];π    FreeCode := FirstFree;π    ReadMask := Masks[CodeSize-3];π  end; { DoClear }ππ  procedure ReadCode;π  varπ    Raw : longint;π  beginπ    if (CodeSize >= 8) then beginπ      move(Buffer^[BitIndex shr 3],Raw,3);π      Code := (Raw shr (BitIndex mod 8)) and ReadMask;π    end else beginπ      move(Buffer^[BitIndex shr 3],Code,2);π      Code := (Code shr (BitIndex mod 8)) and ReadMask;π    end;π    if AnotherBuffer then beginπ      ByteOffset := BitIndex shr 3;π      if (ByteOffset >= 63000) then beginπ        move(Buffer^[Byteoffset],Buffer^[0],BufferSize-Byteoffset);π        move(Buffer2^[0],Buffer^[BufferSize-Byteoffset],63000);π        BitIndex := BitIndex mod 8;π        FreeMem(Buffer2,BufferSize);π      end;π    end;π    BitIndex := BitIndex + CodeSize;π  end; { ReadCode }ππ  procedure OutputPixel(Color : byte);π  beginπ    putpixel(XC,YC,Color); { about 3x faster than using the DOS interrupt! }π    inc(XC);π    if (XC = Width) then beginπ      XC := 0;π      inc(YC);π      if (YC mod 10 = 0) and keypressed and (readkey = #27) then beginπ        textmode(15);  { let the user bail out }π        halt;π      end;π    end;π  end; { OutputPixel }ππππbegin { DisplayGIF }π  CurCode := 0; { not initted anywhere else... don't know why }π  OldCode := 0; { not initted anywhere else... don't know why }π  FinChar := 0; { not initted anywhere else... don't know why }π  OutCount := 0;π  DoClear;      { not initted anywhere else... don't know why }π  repeatπ    ReadCode;π    if (Code <> EOFCode) then beginπ      if (Code = ClearCode) then begin { restart decompressor }π        DoClear;π        ReadCode;π        CurCode := Code;π        OldCode := Code;π        FinChar := Code and BitMask;π        OutputPixel(FinChar);π      end else begin        { must be data: save same as CurCode and InCode }π        CurCode := Code;π        InCode := Code;π{ if >= FreeCode, not in hash table yet; repeat the last character decoded }π        if (Code >= FreeCode) then beginπ          CurCode := OldCode;π          PixelValue[OutCount] := FinChar;π          inc(OutCount);π        end;π{πUnless this code is raw data, pursue the chain pointed to by CurCodeπthrough the hash table to its end; each code in the chain puts itsπassociated output code on the output queue.π}π        if (CurCode > BitMask) then repeatπ          PixelValue[OutCount] := Suffix[CurCode];π          inc(OutCount);π          CurCode := Prefix[CurCode];π        until (CurCode <= BitMask);π{πThe last code in the chain is raw data.π}π        FinChar := CurCode and BitMask;π        PixelValue[OutCount] := FinChar;π        inc(OutCount);π{πOutput the pixels. They're stacked Last In First Out.π}π        for I := pred(OutCount) downto 0 do OutputPixel(PixelValue[I]);π        OutCount := 0;π{πBuild the hash table on-the-fly.π}π        Prefix[FreeCode] := OldCode;π        Suffix[FreeCode] := FinChar;π        OldCode := InCode;π{πPoint to the next slot in the table. If we exceed the current MaxCodeπvalue, increment the code size unless it's already 12. if it is, doπnothing: the next code decompressed better be CLEARπ}π        inc(FreeCode);π        if (FreeCode >= MaxCode) then beginπ          if (CodeSize < 12) then beginπ            inc(CodeSize);π            MaxCode := MaxCode * 2;π            ReadMask := Masks[CodeSize - 3];π          end;π        end;π      end; {not Clear}π    end; {not EOFCode}π  until (Code = EOFCode);πend; { DisplayGIF }ππbegin { TP4GIF }π  writeln(ProgramName,' Rev ',ProgramRevision);π  if (paramcount > 0)π    then TempString := paramstr(1)π  else beginπ    write(' > ');π    readln(TempString);π  end;π  InputFileName := TempString;π  Init;π  ReadGifHeader;π  PrepDecompressor;π  ReadBuffer;π  FreeMem(RawBytes,BufferSize);π  InitEGA;π  DisplayGIF;π  SetAllPalette(MyPalette);π  close(GifFile);π  Ch := readkey;π  textmode(15);π  freemem(Buffer,BufferSize);        { totally pointless, but it's good form }πend.π                                                  48     01-27-9412:07ALL                      THORSTEN BARTH           GIF Code                 SWAG9402            42     ╓   {π> Does anyone have ANY source, on how to display a gif in VGA modeππIt's as bad as ... but it works.ππ--- VGA gif loader part 1 of 3 ---π}ππ{$X+}ππUses Graph,Dos;ππVarπ  Gd,Gm: Integer;π  Datei: File;π  palette: array[0..767] of byte;π  buffer: array[0..1279] of byte;π  prefix,tail: array[0..4095] OF WORD;π  keller: array[0..640] of Word;ππFunction LoadGif(N: String; VersX,VersY: Word): Integer;ππFunction GetChar: Char;πVar C: Char;πBeginπ  BlockRead(Datei,C,1);π  GetChar:=C;πEnd;ππFunction GetByte: Byte;πVar B: Byte;πBeginπ  BlockRead(Datei,B,1);π  GetByte:=B;πEnd;ππFunction GetWord: Word;πVar W: Word;πBeginπ  BlockRead(Datei,W,2);π  Getword:=W;πEnd;ππProcedure AGetBytes(Anz: Word);πBeginπ  BlockRead(Datei,Buffer,Anz);πEnd;ππVarπ  lokal_farbtafel: Integer;π  mask,restbytes,pp,lbyte,blocklen,code,oldcode,sonderfall,π  incode,freepos,kanz,pass,clearcode,eofcode,maxcode,infobyte,π  globalfarbtafel,backcolor,interlace,bilddef,abslinks,absoben: word;π  bits,restbits,codesize: Byte;π  rot,gruen,blau,by,bpp: Byte;π  z,i,x1,y1,x2,y2: integer;π  bem: string[6];π  farben: integer;π  x,y,xa,ya,dy: word;πbeginπ  loadgif:=0;π  Assign(Datei,N);π  reset(Datei,1);π  if ioresult>0 then begin loadgif:=1; exit; end;π  bem:='';π  for i:=1 to 6 do bem:=bem+getchar;π  if copy(bem,1,3)<>'GIF' then begin loadgif:=2; exit; end;π  x2:=getword;π  y2:=getword;π  infobyte:=getbyte;π  globalfarbtafel:=infobyte and 128;π  bpp:=(infobyte and 7)+1;π  farben:=1 shl bpp;π  backcolor:=getbyte;π  by:=getbyte;π  if globalfarbtafel<>0 thenπ    for i:=0 to (3*farben)-1 doπ      palette[i]:=getbyte shr 2;π  bilddef:=getbyte;π  while bilddef=$21 do beginπ    by:=getbyte; z:=getbyte;π    for i:=1 to z do by:=getbyte;π    by:=getbyte;π    bilddef:=getbyte;π  end;πππ  if bilddef<>$2c then begin loadgif:=3; exit; end;π  abslinks:=getword+VersX;π  absoben:=getword+VersY;π  x2:=getword;π  y2:=getword;π  by:=getbyte;π  lokal_farbtafel:=by and 128;π  interlace:=by and 64;π  by:=getbyte;π  x1:=0; y1:=0; xa:=x2; Ya:=Y2;π  if farben<16 then begin loadgif:=4; exit; end;π  if lokal_farbtafel<>0 thenπ    for i:=0 to 3*Farben-1 doπ      palette[I]:=getbyte shr 2;π  asmπ    mov ax,$1012π    push dsπ    pop esπ    xor bx,bxπ    mov cx,256π    lea dx,paletteπ    int $10π    mov pass,0π    MOV CL,bppπ    MOV AX,1π    SHL AX,CLπ    MOV clearcode,AXπ    INC AXπ    MOV eofcode,AXπ    INC AXπ    MOV freepos,AXπ    MOV AL,bppπ    MOV AH,0π    INC AXπ    MOV codesize,ALπ    MOV CX,AXπ    MOV AX,1π    SHL AX,CLπ    DEC AXπ    MOV maxcode,AXπ    MOV kanz,0π    MOV dy,8π    MOV restbits,0π    MOV restbytes,0π    MOV x,0π    MOV y,0π@gif0: CALL FAR PTR @getgifbyteπ    CMP AX,eofcodeπ    je @ende1π@gif1: CMP AX,clearcodeπ    je @reset1π@gif3: MOV AX,codeπ    MOV incode,AXπ    CMP ax,freeposπ    jb @gif4π    MOV AX,oldcodeπ    MOV code,AXπ    MOV BX,kanzπ    MOV CX,sonderfallπ    SHL BX,1π    MOV [OFFSET keller+BX],CXπ    INC kanzπ@gif4: CMP AX,clearcodeπ    JB @gif6π@gif5: MOV BX,codeπ    SHL BX,1π    PUSH BXπ    MOV AX,[Offset tail+BX]π    MOV BX,kanzπ    SHL BX,1π    MOV [OFFSET keller+BX],AXπ    INC kanzπ    POP BXπ    MOV AX,[Offset prefix+BX]π    MOV code,AXπ    CMP AX,clearcodeπ    ja @gif5π@gif6: MOV BX,kanzπ    SHL BX,1π    MOV [Offset keller+BX],AXπ    MOV sonderfall,AXπ    INC kanzπ@gif7: MOV AX,[Offset keller+BX]π    CALL FAR PTR @pixelπ    CMP BX,0π    JE @gif8π    DEC BXπ    DEC BXπ    JMP @gif7ππ@gif8: MOV kanz,0π    MOV BX,freeposπ    SHL BX,1π    MOV AX,oldcodeπ    MOV [Offset prefix+BX],AXπ    MOV AX,codeπ    MOV [Offset tail+BX],AXπ    MOV AX,incodeπ    MOV oldcode,AXπ    INC freeposπ    MOV AX,freeposπ    CMP AX,maxcodeπ    JBE @gif2π    CMP codesize,12π    JAE @gif2π    INC codesizeπ    MOV CL,codesizeπ    MOV AX,1π    SHL AX,CLπ    DEC AXπ    MOV maxcode,AXπ@gif2: JMP @gif0π@ende1: JMP @endeπ@reset1: MOV AL,bppπ    MOV AH,0π    INC AXπ    MOV codesize,ALπ    MOV CX,AXπ    MOV AX,1π    SHL AX,CLπ    DEC AXπ    MOV maxcode,AXπ    MOV AX,clearcodeπ    ADD AX,2π    MOV freepos,AXπ    CALL FAR PTR @getgifbyteπ    MOV sonderfall,AXπ    MOV oldcode,AXπ    CALL FAR PTR @pixelπ    JMP @gif2π@getgifbyte: MOV DI,0π    MOV mask,1π    MOV bits,0π@g1: MOV AL,bitsπ    CMP AL,codesizeπ    JAE @g0π    CMP restbits,0π    JA @g2π    CMP restbytes,0π    JNE @l2π    PUSH DIπ    CALL Getbyteπ    POP DIπ    MOV blocklen,AXπ    MOV restbytes,AXπ    PUSH DIπ    PUSH AXπ    CALL AGetbytesπ    POP DIπ    MOV pp,0π@l2: MOV BX,ppπ    MOV AL,[BX+Offset Buffer]π    XOR AH,AHπ    INC ppπ    DEC restbytesπ    MOV lbyte,AXπ    MOV restbits,8π@g2: SHR lbyte,1π    JNC @nocarryπ    OR DI,maskπ@nocarry: INC bitsπ    DEC restbitsπ    SHL mask,1π    JMP @g1π@g0:MOV bits,0π    MOV code,DIπ    MOV AX,DIπ    RETFπ@pixel:π    PUSH BXπ    MOV BX,xπ    ADD BX,abslinksπ    PUSH BXπ    MOV BX,yπ    ADD BX,absobenπ    PUSH BXπ    PUSH AXπ    CALL Putpixelπ    POP BXπ    INC xπ    MOV AX,xπ    CMP AX,x2π    JB @s0π    MOV x,0π    CMP interlace,0π    JNE @s1π    INC yπ    JMP @s0π@s1: MOV AX,dyπ    ADD y,AXπ    MOV AX,yπ    CMP AX,y2π    JB @s0π    INC passπ    CMP pass,1π    JNE @s3π    JMP @s2π@s3: SHR dy,1π@s2: MOV AX,DYπ    SHR AX,1π    MOV Y,AXπ@s0: RETFπ@ende:π  End;π  Close(Datei);πEnd;πππbeginππend.                                         49     01-27-9412:07ALL                      BERNIE PALLEK            VGA256 Unit              SWAG9402            40     ╓   {π> I'm using 320x200x256.  I use mainly assembly to do my procedures andπ> function in this library... but I can't manage to figure out a way to doπ> GET and PUTs ... have ny Idea how to do it?  And yes, if you have any niceπ> graphic procedures/functions, well, I'm interrested...ππOk, if you want, I can post a bitmap scaler I got from Sean Palmer... it's inπassembler, so it's fast, and you could use it just like put, except it doesn'tπdo "transparency."  If I ever figure out how to do it, I'll modify it and postπit.  But for now, here are some other routines for mode 13h:π}ππTYPEπ  RGBPalette = ARRAY[0..767] OF Byte;ππPROCEDURE SetVideoMode(desiredVideoMode : Byte);πBEGIN ASM MOV AH,0; MOV AL,desiredVideoMode; INT $10; END; END;ππFUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;πBEGIN GetPixel := Mem[$A000 : pix2get_y * 320 + pix2get_x]; END;ππPROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);πBEGIN Mem[$A000 : pix2set_y * 320 + pix2set_x] := pix2set_c; END;ππPROCEDURE Ellipse(exc, eyc, ea, eb : Integer);πVAR elx, ely : Integer;π  aa, aa2, bb, bb2, d, dx, dy : LongInt;πBEGINπ  elx:=0; ely:=eb; aa:=LongInt(ea)*ea; aa2:=2*aa;π  bb:=LongInt(eb)*eb; bb2:=2*bb;π  d:=bb-aa*eb+aa DIV 4; dx:=0; dy:=aa2*eb;π  SetPixel(exc, eyc-ely, Colour); SetPixel(exc, eyc+ely, Colour);π  SetPixel(exc-ea, eyc, Colour); SetPixel(exc+ea, eyc, Colour);π  WHILE (dx < dy) DO BEGINπ    IF (d > 0) THEN BEGINπ      Dec(ely); Dec(dy, aa2); Dec(d, dy);π    END;π    Inc(elx); Inc(dx, bb2); Inc(d, bb+dx);π    SetPixel(exc+elx, eyc+ely, Colour);π    SetPixel(exc-elx, eyc+ely, Colour);π    SetPixel(exc+elx, eyc-ely, Colour);π    SetPixel(exc-elx, eyc-ely, Colour);π  END;π  Inc(d, (3*(aa-bb) DIV 2-(dx+dy)) DIV 2);π  WHILE (ely > 0) DO BEGINπ    IF (d < 0) THEN BEGINπ      Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);π    END;π    Dec(ely); Dec(dy, aa2); Inc(d, aa-dy);π    SetPixel(exc+elx, eyc+ely, Colour);π    SetPixel(exc-elx, eyc+ely, Colour);π    SetPixel(exc+elx, eyc-ely, Colour);π    SetPixel(exc-elx, eyc-ely, Colour);π  END;πEND;ππ{ these routines have been "compressed" to take up less line space; Iπ  like spaces between addition, subtraction, etc, but I took them outπ  to save space... you can add them again if you want }πππPROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);πVAR lndd, lndx, lndy, lnai, lnbi, lnxi, lnyi : Integer;πBEGINπ  IF (lnx1 < lnx2) THEN BEGIN lnxi:=1; lndx:=lnx2-lnx1;π  END ELSE BEGIN lnxi := (-1); lndx:= lnx1-lnx2; END;π  IF (lny1 < lny2) THEN BEGIN lnyi:=1; lndy:=lny2-lny1;π  END ELSE BEGIN lnyi := (-1); lndy:=lny1-lny2; END;π  SetPixel(lnx1, lny1, Colour);π  IF (lndx > lndy) THEN BEGINπ    lnai:=(lndy-lndx)*2; lnbi:=lndy*2; lndd:=lnbi-lndx;π    REPEATπ      IF (lndd >= 0) THEN BEGINπ        Inc(lny1, lnyi);π        Inc(lndd, lnai);π      END ELSE Inc(lndd, lnbi);π      Inc(lnx1, lnxi);π      SetPixel(lnx1, lny1, Colour);π    UNTIL (lnx1 = lnx2);π  END ELSE BEGINπ    lnai := (lndx - lndy) * 2;π    lnbi := lndx * 2;π    lndd := lnbi - lndy;π    REPEATπ      IF (lndd >= 0) THEN BEGINπ        Inc(lnx1, lnxi);π        Inc(lndd, lnai);π      END ELSE inc(lndd, lnbi);π      Inc(lny1, lnyi);π      SetPixel(lnx1, lny1, Colour);π    UNTIL (lny1 = lny2);π  END;πEND;ππPROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);π{ returns the r, g, and b values of a palette index }πBEGINπ  Port[$3C7] := index2get;π  r_inte := Port[$3C9];π  g_inte := Port[$3C9];π  b_inte := Port[$3C9];πEND;ππPROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);π{ sets the r, g, and b values of a palette index }πBEGINπ  Port[$3C8] := index2set;π  Port[$3C9] := r_inte;π  Port[$3C9] := g_inte;π  Port[$3C9] := b_inte;πEND;ππ{ oh, I'll give credit where credit is due: Sean Palmer supplied theπ  Bresenham line and ellipse procedures }πππPROCEDURE BurstSetPalette(burstPalette : RGBPalette);πVARπ  burstCount : Word;πBEGINπ  Port[$3C8] := 0;π  FOR burstCount := 0 TO 767 DO Port[$3C9] := burstPalette[burstCount];πEND;ππPROCEDURE WaitForRetrace;π{ waits for a vertical retrace to reduce flicker }πBEGINπ     (* REPEAT UNTIL (Port[$3DA] AND $08) = 0; *)π     { the above loop has been commented because it is only }π     { necessary to wait until a retrace is in progress }π     REPEAT UNTIL (Port[$3DA] AND $08) <> 0;πEND;ππPROCEDURE ClearScr;πBEGINπ     FillChar(Mem[$A000:0000], 64000, 0);πEND;ππFUNCTION GetOverscan : Byte;πVARπ  tmpOverscanByte : Byte;πBEGINπ  ASMπ    MOV AX,$1008π    INT $10π    MOV tmpOverscanByte,BHπ  END;π  GetOverscan := tmpOverscanByte;πEND;ππPROCEDURE SetOverscan(borderColour : Byte);πBEGINπ  ASMπ    MOV AX,$1001π    MOV BH,borderColourπ    INT $10π  END;πEND;ππ{πWell, that's basically it, except for the bitmap scaler.  If you want it, letπme know if you can receive NetMail, and I'll send it that way; otherwise, I'llπpost.  The last two procedures/functions have not been tested.  In fact, Iπcan't guarantee that any of the stuff will work.  But try it out...  :^)πC-YA.π}                 50     01-27-9412:07ALL                      JASEN BETTS              Line Drawing             SWAG9402            14     ╓   {π> I used something like this:π> for x := 1 to 100 doπ> beginπ>      y := slope*x;π>      putpixel(x,y);π> end;ππthe slope method is a close cousin to bubble-sort an algorithm to use ifπyou can't be bothered to use a more efficient one for the job.ππhere's one. that only uses addition and subtraction in it's loop.π(FWIW it's based on the commutativity of multiplication.)ππI think It's got some fancy name which I forget, this code is 100% myπown (freeware) and reasonably well tested.π}ππ  procedure myline(x1,y1,x2,y2,color:integer);ππ    {Freeware: my bugs - your problem , 29 dec 1993 J.Betts,π     PASCAL echo Fidonet.     please keep this notice intact}ππ  function sign(x:integer):integer; {like sgn(x) in basic}π  begin if x<0 then sign:=-1 else if x>0 then sign:=1 else sign:=0 end;π  varπ    x,y,count,xs,ys,xm,ym:integer;π  beginπ    x:=x1;y:=y1;ππ    xs:=x2-x1;    ys:=y2-y1;ππ    xm:=sign(xs); ym:=sign(ys);π    xs:=abs(xs);  ys:=abs(ys);ππ    putpixel(x,y,color);ππ  if xs > ysπ    then begin {flat line <45 deg}π      count:=-(xs div 2);π      while (x <> x2 ) do beginπ        count:=count+ys;π        x:=x+xm;π        if count>0 then beginπ          y:=y+ym;π          count:=count-xs;π          end;π        putpixel(x,y,color);π        end;π      endπ    else begin {steep line >=45 deg}π      count:=-(ys div 2);π      while (y <> y2 ) do beginπ        count:=count+xs;π        y:=y+ym;π        if count>0 then beginπ          x:=x+xm;π          count:=count-ys;π          end;π        putpixel(x,y,color);π        end;π      end;π  end;ππ                                                                                                      51     01-27-9412:09ALL                      JORDAN PHILLIPS          Graphics Images          SWAG9402            21     ╓   {π  Well, here are some image routines, I made it to where the WIDTH is storedπ in the first two bytes and the HEIGHT is stored in the 3rd and 4th bytes...π If you must really know... I guess it goes along with TP's get/put imageπ convention... This is for mode $13 ONLY of coarse...π}ππ  Procedure GetImage ( X1, Y1, X2, Y2 : Integer; VAR DEST ) ;π   Var Width,S,O : Word ;ππ    BEGINπ     S := SEG (DEST);π     O := OFS (DEST);ππ     ASMπ      PUSH DSππ      MOV DX, Video_Segπ      MOV DS, DXπ      MOV BX, 320π      MOV AX, Y1; MUL BXπ      ADD AX, X1; MOV SI, AXππ      MOV DX, Sπ      MOV ES, DXπ      MOV DI, Oππ      MOV DX, Y2; SUB DX, Y1; INC DXπ      MOV BX, X2; SUB BX, X1; INC BXπ      MOV WIDTH, BXππ      MOV AX, WIDTHπ      STOSWπ      MOV AX, DXπ      STOSWππ     @LOOP:π      MOV CX, WIDTHπ      REP MOVSBπ      ADD SI, 320; SUB SI, WIDTHπ      DEC DXπ      JNZ @LOOPππ      POP DSπ     End ;π   End ;ππ  Procedure PutImage ( X1, Y1 : Integer; VAR SOURCE ) ;π   Var Width, S, O : Word ;π    BEGINπ     S := SEG (SOURCE);π     O := OFS (SOURCE);ππ     ASMπ      PUSH DSππ      MOV DX, Video_Segπ      MOV ES, DXπ      MOV BX, 320            { Setup Dest Addr }π      MOV AX, Y1; MUL BXπ      ADD AX, X1; MOV DI, AXππ      MOV DX, S { Setup Source Addr }π      MOV DS, DXπ      MOV SI, Oππ      LODSW   { Get Width and Height }π      MOV WIDTH, AXπ      LODSWπ      MOV DX, AXππ     @LOOP:π      MOV CX, WIDTHπ      REP MOVSBπ      ADD DI, 320; SUB DI, WIDTHπ      DEC DXπ      JNZ @LOOPππ      POP DSπ     End ;π   End ;ππ  Function SaveImage ( X1, Y1, X2, Y2 : Integer ; VAR Size : Word ) : Pointer ;π   Var Img : Pointer ;π    Beginπ     FixInt ( X1, X2 ) ; { Put lesser in X1 }π     FixInt ( Y1, Y2 ) ; { Put lesser in Y1 }π     Size := WORD((X2-X1+1)*(Y2-Y1+1) +4);π     GetMem ( Img, Size ) ;π     GetImage ( X1, Y1, X2, Y2, Img^ ) ;π     SaveImage := Img ;π    End ;ππ Procedure CopyImage ( X1, Y1, X2, Y2, Dx, DY : Integer ) ;π  Var Img : Pointer ;π      Size : Word ;π   Beginπ    Img := SaveImage ( X1, Y1, X2, Y2, Size ) ;π    PutImage ( Dx, Dy, Img^) ;π    FreeMem ( Img, Size ) ;π   End ;ππ Procedure LoadImage ( FileName : String ; VAR Img : Pointer ; Var Size : Wordπ   Var F : File ;π  Beginπ   Img := NIL ;π   Size := 0 ;π   If Not Exist ( FileName ) Then Exit ;π   Assign ( F, Filename ) ;π   Reset ( F, 1 ) ;π   Size := FileSize ( F ) ;π   GetMem ( Img, Size ) ;π   BlockRead ( F, Img^, Size ) ;π   Close ( F ) ;π  End ;π                                                                                                        52     01-27-9412:11ALL                      SEAN PALMER              Flood Filling            SWAG9402            13     ╓   {π> Does anyone have any code to flood fill an area? I need the code to doπ> both, a fill to a certain border colour, or a fill to ANYπ> colour other then the one the fill started on.π}ππvar fillVal:byte;π{This routine only called by fill}πfunction lineFill(x,y,d,prevXL,prevXR:integer):integer;π var xl,xr,i:integer;πbeginπ xl:=x;xr:=x;π repeat dec(xl); until(scrn(xl,y)<>fillVal)or(xl<0); inc(xl);π repeat inc(xr); until(scrn(xr,y)<>fillVal)or(xr>xMax); dec(xr);π hLin(xl,xr,y);π inc(y,d);π if word(y)<=yMax thenπ  for x:=xl to xr doπ   if(scrn(x,y)=fillVal)then beginπ    x:=lineFill(x,y,d,xl,xr);π    if word(x)>xr then break;π    end;π dec(y,d+d); asm neg d;end;π if word(y)<=yMax then beginπ  for x:=xl to prevXL doπ   if(scrn(x,y)=fillVal)then beginπ    i:=lineFill(x,y,d,xl,xr);π    if word(x)>prevXL then break;π    end;π  for x:=prevXR to xr doπ   if(scrn(x,y)=fillVal)then beginπ    i:=lineFill(x,y,d,xl,xr);π    if word(x)>xr then break;π    end;π  end;π lineFill:=xr;π end;ππprocedure fill(x,y:integer);beginπ fillVal:=scrn(x,y);if fillVal<>color then lineFill(x,y,1,x,x);π end;ππ{πThis one's too recursive for anything really complicated (blows the stack). Butπit works. You'll find that making it do a border fill instead isn't hard atπall. You'll need to provide your own hLin and scrn routines.ππhLin draws a horizontal line from X,to X2,at Y scrn reads the pixel at X,Y andπreturns its color color is a global byte variable in this incarnation. The fillπhappens in this color.π}π                                       53     01-27-9412:13ALL                      TIM JENSEN               Masked Images            SWAG9402            12     ╓   {π>Try converting it to use pointers instead of accessing the array withπ>indexes, and use a pointer to video memory for direct plotsπ>instead of using the putPixel routine. Also it's quicker toπ>check against 0 for the background than to check against 255.ππI found a copy of "The Visible Computer: 8088" in my bookshelves andπtried rewriting my assembly routines.  Here's what I finally got:π}ππprocedure MaskPut(x,y: word; p: pointer); assembler;πvarπ XX,YY: byte;πasmπ        LES SI,pπ        MOV [XX],0π        MOV [YY],0π        MOV CX,256π        XOR DX,DXπ        CLDπ@Loopit:SEGES LODSBπ        MOV DL,ALπ        PUSH ESπ        PUSH SIπ        CMP DL,255π        JZ @Doneπ        MOV AX,0A000hπ        MOV ES,AXπ        MOV AX,320π        MOV BX,[Y]π        ADD BL,[YY]π        PUSH DXπ        MUL BXπ        POP DXπ        MOV BX,[X]π        ADD BL,[XX]π        ADD AX,BXπ        MOV SI,AXπ        MOV ES:[SI],DLπ@Done:  INC [XX]π        CMP [XX],16π        JNZ @Okayπ        MOV [XX],0π        INC [YY]π@Okay:  POP SIπ        POP ESπ        LOOP @Loopitπend;ππ{πIt works fine.  I didn't notice much of a difference in speed though.  Iπtested it and I can plot about 1103 sprites/second in ASM and 828πsprites/sec. with my original TP code.  Please keep in mind I'm not muchπof an assembly programmer. Can anyone help me optimize this code (intoπ286 would be good too). Thanx for your help!π}π    54     01-27-9412:14ALL                      JENS LARSSON             ModeX Scrolling          SWAG9402            6      ╓   {π> does anyone know how to scroll up or down in 320*200*256 mode ??ππ     Enter mode-x (look for source on any board, quite common), andπ     then pan the screen like this:π}ππ     Asmπ      mov     bx,StartMemπ      mov     ah,bhπ      mov     al,0chπ      mov     dx,3d4hπ      out     dx,axπ      mov     ah,blπ      inc     alπ      out     dx,axπ     End;π{π     To begin, zero StartMem and then increase it with 80 each time -π     tada - the screen pans down. Oh, btw, If I were you I would callπ     a sync just before running it...π}                                                                                                 55     01-27-9412:15ALL                      RICHARD MOREY            Images                   SWAG9402            13     ╓   {π-> I'm trying to use the GetImage and PutImage commands from Turboπ-> PascalππOkay.. did you declare a varible that would hold the size you needed? Iπhave a little program I wrote to draw a musical staff and put the notesπup randomly so that I can practice reading music..π}ππProgram MusicNotes;ππUsesπ  Crt,π  Dos,π  Graph,π  XtraDos;ππconstπ  NotePos : Array[1..11] Of Integer =π(164,179,194,209,224,239,254,269,284,299,314);π  Note : Array[1..11] Of Char =π('G','F','E','D','C','B','A','G','F','E','D');ππProcedure Beep;ππbeginπ  sound(600);π  delay(100);π  nosound;πend;ππvarπ  CallUnit : CallH;π  Key : Char;π  P : Pointer;π  Size : Word;π  Y, X,π  MaxX, MaxY,π  grMode,π  grDriver : Integer;ππBeginπgrDriver := Detect;πInitGraph(grDriver, grMode,'D:\bp\bgi');πMaxX:=GetMaxX;πMaxY:=GetMaxY;πSetColor(white);πCircle(15,15,15);πFloodFill(15,15,white);πSize:=ImageSize(0,0,30,30);πGetMem(P,Size);πgetImage(0,0,30,30,P^);πcleardevice;πY:=((MaxY Div 2)-60);πFor X:=1 To 5 Doπ Beginπ  Line(0,Y,MaxX,Y);π  Y:=Y+30;π End;πRandomize;πRepeatπX:=Random(11)+1;π  PutImage(320,(NotePos[X]-15),P^,ORPut);π  Repeatπ   Key:=Char(CallUnit.KeyReturn);π  Until Key=Note[X];π  Beep;π  PutImage(320,(NotePos[X]-15),P^,XOrPut);π  If (X/2)=(X Div 2) Thenπ    Line(290,NotePos[x],350,NotePos[x])π    Elseπ     If X>1 Thenπ       Line(290,NotePos[x-1],350,NotePos[x-1]);πUntil 3=2;πEnd.ππThe important part is the SIZE=.. Use that line to create a varbibleπbuig enough to hold the image.π                                                                  56     01-27-9412:17ALL                      DAVID DAHL               Palette Maniputlation    SWAG9402            44     ╓   {$G+}  { Enable 286 Instructions }πUnit Palette;ππ{ Programmed By David Dahl }ππ(* PUBLIC DOMAIN *)ππInterfaceππ  Type PaletteRec  = Recordπ                           Red,π                           Green,π                           Blue  : Byte;π                     End;π       PaletteType = Array[0..255] of PaletteRec;π       PalettePtr  = ^PaletteType;ππ  Procedure SetPalette        (Var PalBuf : PaletteType);π  Procedure GetPalette        (Var PalBuf : PaletteType);ππ  Procedure BlackPalette;π  Procedure FadeInFromBlack   (Var Palin : PaletteType);π  Procedure FadeInFromBlackQ  (Var Palin     : PaletteType;π                                   Intensity : Word);π  Procedure FadeOutToBlack    (Var Palin : PaletteType);π  Procedure FadeFromPalToPal  (Var OldPal, NewPal : PaletteType);π  Procedure FadeFromPalToPalQ (Var OldPal, NewPal : PaletteType;π                                   Color          : Word);πππ  Var BlackP  : PaletteType;π      WhiteP  : PaletteType;ππ      TempPal : PaletteType;ππImplementationππ{-[ Set Value Of All DAC Registers ]--------------------------------------}πProcedure SetPalette (Var PalBuf : PaletteType); Assembler;πAsmπ    PUSH DSππ    XOR AX, AX       { Palette Start = 0 }π    MOV CX, 0300h / 2π    LDS SI, PalBuf   { Load DS:SI With Address Of PalBuf (For OUTSB) }ππ    MOV DX, 03C8h    { Tell VGA Card What DAC Color To Start With }π    OUT DX, ALππ    INC DX           { Set DX To Equal DAC Data Port }π    MOV BX, DXπ    CLDππ    { Wait For V-sync }π    MOV DX, 03DAhπ    @VSYNC0:π      IN   AL, DXπ      TEST AL, 8π    JZ @VSYNC0ππ    MOV DX, BXπ    REPπ       OUTSBππ    MOV BX, DXππ    { Wait For V-sync }π    MOV DX, 03DAhπ    @VSYNC1:π      IN   AL, DXπ      TEST AL, 8π    JZ @VSYNC1ππ    MOV DX, BXπ    MOV CX, 0300h / 2π    REPπ       OUTSBππ    POP DSπEnd;ππ{-[ Get Value Of All DAC Registers ]--------------------------------------}πProcedure GetPalette (Var PalBuf : PaletteType); Assembler;πAsmπ    PUSH DSππ    XOR AX, AX       { Palette Start = 0 }π    MOV CX, 0300hπ    LES DI, PalBuf   { Load ES:DI With Address Of PalBuf (For INSB) }ππ    MOV DX, 03C7h    { Tell VGA Card What DAC Color To Start With }π    OUT DX, ALππ    INC DX           { Set DX To Equal DAC Data Port }π    INC DXπ    CLDππ    REPπ       INSBππ    POP DSπEnd;πππProcedure BlackPalette;πBeginπ     SetPalette (BlackP);πEnd;ππProcedure FadeInFromBlack (Var Palin : PaletteType);πVar DAC,π    Intensity : Word;πBeginπ     For Intensity := 0 to 32 doπ     Beginπ       For DAC := 0 to 255 doπ       Beginπ          TempPal[DAC].Red   := (Palin[DAC].Red   * Intensity) DIV 32;π          TempPal[DAC].Green := (Palin[DAC].Green * Intensity) DIV 32;π          TempPal[DAC].Blue  := (Palin[DAC].Blue  * Intensity) DIV 32;π       End;ππ       SetPalette (TempPal);π     End;πEnd;ππProcedure FadeInFromBlackQ (Var Palin     : PaletteType;π                                Intensity : Word);πConst DAC : Word = 0;πBeginπ     For DAC := 0 to 255 doπ     Beginπ          TempPal[DAC].Red   := (Palin[DAC].Red   * Intensity) DIV 32;π          TempPal[DAC].Green := (Palin[DAC].Green * Intensity) DIV 32;π          TempPal[DAC].Blue  := (Palin[DAC].Blue  * Intensity) DIV 32;π     End;ππ     SetPalette (TempPal);πEnd;ππProcedure FadeOutToBlack (Var Palin : PaletteType);πVar DAC,π    Intensity : Word;πBeginπ     For Intensity := 32 downto 0 doπ     Beginπ       For DAC := 0 to 255 doπ       Beginπ          TempPal[DAC].Red   := (Palin[DAC].Red   * Intensity) DIV 32;π          TempPal[DAC].Green := (Palin[DAC].Green * Intensity) DIV 32;π          TempPal[DAC].Blue  := (Palin[DAC].Blue  * Intensity) DIV 32;π       End;ππ       SetPalette (TempPal);π     End;πEnd;πππProcedure FadeFromPalToPal (Var OldPal, NewPal : PaletteType);πVar DAC,π    Color : Word;πBeginπ     For Color := 32 downto 0 doπ     Beginπ       For DAC := 0 to 255 doπ       Beginπ          TempPal[DAC].Red   := ((OldPal[DAC].Red   * Color) DIV 32) +π                                ((NewPal[DAC].Red   * (32 - Color)) DIV 32);π          TempPal[DAC].Green := ((OldPal[DAC].Green * Color) DIV 32) +π                                ((NewPal[DAC].Green * (32 - Color)) DIV 32);π          TempPal[DAC].Blue  := ((OldPal[DAC].Blue  * Color) DIV 32) +π                                ((NewPal[DAC].Blue  * (32 - Color)) DIV 32);π       End;ππ       SetPalette (TempPal);π     End;πEnd;ππProcedure FadeFromPalToPalQ (Var OldPal, NewPal : PaletteType;π                                 Color          : Word);πConst DAC : Word = 0;πBeginπ     For DAC := 0 to 255 doπ     Beginπ          TempPal[DAC].Red   := ((OldPal[DAC].Red   * (32 - Color)) DIV 32)+π                                ((NewPal[DAC].Red   * Color) DIV 32);π          TempPal[DAC].Green := ((OldPal[DAC].Green * (32 - Color)) DIV 32)+π                                ((NewPal[DAC].Green * Color) DIV 32);π          TempPal[DAC].Blue  := ((OldPal[DAC].Blue  * (32 - Color)) DIV 32)+π                                ((NewPal[DAC].Blue  * Color) DIV 32);π     End;ππ     SetPalette (TempPal);πEnd;ππVar Counter : Word;πBeginπ     For Counter := 0 to 255 doπ     Beginπ          BlackP[Counter].Red   := 0;π          BlackP[Counter].Green := 0;π          BlackP[Counter].Blue  := 0;π     End;ππ     For Counter := 0 to 255 doπ     Beginπ          WhiteP[Counter].Red   := 63;π          WhiteP[Counter].Green := 63;π          WhiteP[Counter].Blue  := 63;π     End;πEnd.ππ                                                                               57     01-27-9412:17ALL                      LIOR BAR-ON              PCX Files                SWAG9402            122    ╓   πunit PCX;ππ{   The following display modes are supported:ππ          Mode      TP GraphMode     Resolution    Colorsπ          ~~~~      ~~~~~~~~~~~~     ~~~~~~~~~~    ~~~~~~π          $04       CGAC0 to C3      320 x 200         4π          $06       CGAHi            640 x 200         2π          $0D        ---             320 x 200        16π          $0E       EGALo/VGALo      640 x 200        16π          $10       EGAHi/VGAMed     640 x 350        16π          $12       VGAHi            640 x 480        16π          $13        ---             320 x 200       256ππ   Mode $13 is supported only for files containing palette information,π   i.e. not those produced by versions of Paintbrush earlier than 3.0.}ππINTERFACEππuses DOS, GRAPH;ππtype    RGBrec = recordπ                   redval, greenval, blueval: byte;π                 end;ππvar     pcxfilename: pathstr;π        file_error: boolean;π        pal: palettetype;π        RGBpal: array[0..15] of RGBrec;π        RGB256: array[0..255] of RGBrec;π        page_addr: word;π        bytes_per_line: word;π        buff0, buff1: pointer;ππ        { CGA display memory banks: }π        screenbuff0: array[0..7999] of byte absolute $b800:$0000;π        screenbuff1: array[0..7999] of byte absolute $b800:$2000;ππconst   page0 = $A000;           { EGA/VGA display segment }ππprocedure SETMODE(mode: byte);πprocedure SETREGISTERS(var palrec);πprocedure READ_PCX_FILE(gdriver: integer; pfilename: pathstr);πprocedure READ_PCX256(pfilename: pathstr);ππ{========================================================================}ππIMPLEMENTATIONππvar     scratch, abuff0, abuff1: pointer;π        is_CGA, is_VGA: boolean;π        repeatcount: byte;π        datalength: word;π        columncount, plane, video_index: word;π        regs: registers;ππconst   buffsize = 65521;   { Largest possible }ππ{ -------------------------- BIOS calls --------------------------------- }ππ{ For modes not supported by the BGI, use SetMode to initialize theπ  graphics. Since SetRGBPalette won't work if Turbo hasn't done theπ  graphics initialization itself, use SetRegisters to change the colorsπ  in mode $13. }ππprocedure SETMODE(mode: byte);ππbeginπregs.ah:= 0;                 { BIOS set mode function }πregs.al:= mode;              { Display mode }πintr($10, regs);             { Call BIOS }πend;ππprocedure SETREGISTERS(var palrec);ππ{ Palrec is any string of 768 bytes containing the RGB data. }ππbeginπregs.ah:= $10;               { BIOS color register function }πregs.al:= $12;               { Subfunction }πregs.es:= seg(palrec);       { Address of palette info. }πregs.dx:= ofs(palrec);πregs.bx:= 0;                 { First register to change }πregs.cx:= $100;              { Number of registers to change }πintr($10, regs);             { Call BIOS }πend;ππ{ ====================== EGA/VGA 16-color files ========================= }ππprocedure DECODE_16; assembler;ππasmπpush    bpππ{ ----------------- Assembler procedure for 16-color files -------------- }ππ{ The first section is initialization done on each run through theπ  input buffer. }ππ@startproc:πmov     bp, plane           { plane in BP }πmov     es, page_addr       { video display segment }πmov     di, video_index     { index into video segment }πmov     ah, byte ptr bytes_per_line  { line length in AH }πmov     dx, columncount     { column counter }πmov     bx, datalength      { no. of bytes to read }πxor     cx, cx              { clean up CX for loop counter }πmov     cl, repeatcount     { count in CX }πpush    ds                  { save DS }πlds     si, scratch         { input buffer pointer in DS:SI }πadd     bx, siπcld                         { clear DF for stosb }πcmp     cl, 0               { was last byte a count? }πjne     @multi_data         { yes, so next is data }πjmp     @getbyte            { no, so find out what next is }ππ{ -------------- Procedure to write EGA/VGA image to video -------------- }ππ@writebyte:πstosb                       { AL into ES:DI, inc DI }πinc     dl                  { increment column }πcmp     dl, ah              { reached end of scanline? }πje      @doneline           { yes }πloop    @writebyte          { no, do another }πjmp     @getbyte            {   or get more data }π@doneline:πshl     bp, 1               { shift to next plane }πcmp     bp, 8               { done 4 planes? }πjle     @setindex           { no }πmov     bp, 1               { yes, reset plane to 1 but don't reset index }πjmp     @setplaneπ@setindex:πsub     di, dx              { reset to start of line }π@setplane:πpush    ax                  { save AX }πcli                         { no interrupts }πmov     ax, bp              { plane is 1, 2, 4, or 8 }πmov     dx, 3C5h            { sequencer data register }πout     dx, al              { mask out 3 planes }πsti                         { enable interrupts }πpop     ax                  { restore AX }πxor     dx, dx              { reset column count }πloop    @writebyte          { do it again, or fetch more data }ππ@getbyte:                   { last byte was not a count }πcmp     si, bx              { end of input buffer? }πje      @exit               { yes, quit }πlodsb                       { get a byte from DS:SI into AL, increment SI }πcmp     al, 192             { test high bits }πjb      @one_data           { not set, it's data to be written once }π { It's a count byte: }πxor     al, 192             { get count from 6 low bits }πmov     cl, al              { store repeat count }πcmp     si, bx              { end of input buffer? }πje      @exit               { yes, quit }π@multi_data:πlodsb                       { get data byte }πjmp     @writebyte          { write it CL times }π@one_data:πmov     cl, 1               { write byte once }πjmp     @writebyteππ{ ---------------------- Finished with buffer --------------------------- }ππ@exit:πpop     ds                  { restore Turbo's data segment }πmov     plane, bp           { save status for next run thru buffer }πmov     repeatcount, clπmov     columncount, dxπmov     video_index, diπpop     bpπend;  { asm }ππ{ ===================== CGA 2- and 4-color files ======================== }ππprocedure DECODE_CGA; assembler;ππasmππpush    bpπjmp     @startprocππ{ ------------- Procedure to store CGA image in buffers ----------------- }ππ@storebyte:πstosb                       { AL into ES:DI, increment DI }πinc     dx                  { increment column count }πcmp     dl, ah              { reached end of line? }πje      @row_ends           { yes }πloop    @storebyte          { not end of row, do another byte }πretπ@row_ends:πxor     bp, 1               { switch banks }πcmp     bp, 1               { is bank 1? }πje      @bank1              { yes }πmov     word ptr abuff1, di { no, save index into bank 1 }πles     di, abuff0          { bank 0 pointer into ES:DI }πxor     dx, dx              { reset column counter }πloop    @storebyteπretπ@bank1:πmov     word ptr abuff0, di { save index into bank 0 }πles     di, abuff1          { bank 1 pointer into ES:DI }πxor     dx, dx              { reset column counter }πloop    @storebyteπretππ{ ---------------- Main assembler procedure for CGA --------------------- }ππ@startproc:πmov     bp, 0                        { bank in BP }πmov     es, word ptr abuff0[2]       { segment of bank 0 buffer }πmov     di, word ptr abuff0          { offset of buffer }πmov     ah, byte ptr bytes_per_line  { line length in AH }πmov     bx, datalength               { no. of bytes to read }πxor     cx, cx                       { clean up CX for loop counter }πxor     dx, dx                       { initialize column counter }πmov     si, dx                       { initialize input index }πcld                                  { clear DF for stosb }ππ{ -------------------- Loop through input buffer ------------------------ }ππ@getbyte:πcmp     si, bx              { end of input buffer? }πje      @exit               { yes, quit }πpush    es                  { save output pointer }πpush    diπles     di, scratch         { get input pointer in ES:DI }πadd     di, si              { add current offset }πmov     al, [es:di]         { get a byte }πinc     si                  { advance input index }πpop     di                  { restore output pointer }πpop     esπcmp     cl, 0               { was previous byte a count? }πjg      @multi_data         { yes, this is data }πcmp     al, 192             { no, test high bits }πjb      @one_data           { not set, not a count }π { It's a count byte: }πxor     al, 192             { get count from 6 low bits }πmov     cl, al              { store repeat count }πjmp     @getbyte            { go get data byte }π@one_data:πmov     cl, 1               { write byte once }πcall    @storebyteπjmp     @getbyteπ@multi_data:πcall    @storebyte          { CL already set }πjmp     @getbyteππ{ ---------------------- Finished with buffer --------------------------- }ππ@exit:πpop     bpπend;  { asm }ππ{ ============= Main procedure for CGA and 16-color files =============== }ππprocedure READ_PCX_FILE(gdriver: integer; pfilename: pathstr);ππtype    ptrrec = recordπ                   segm, offs: word;π                 end;ππvar     entry, gun, pcxcode, mask, colorID: byte;π        palbuf: array[0..66] of byte;π        pcxfile: file;ππbegin   { READ_PCX_FILE }πis_CGA:= (gdriver = CGA);   { 2 or 4 colors }πis_VGA:= (gdriver = VGA);   { 16 of 256K possible colors }π                            { Otherwise EGA - 16 of 64 possible colors }πassign(pcxfile, pfilename);π{$I-} reset(pcxfile, 1);  {$I+}πfile_error:= (IOresult <> 0);πif file_error then exit;ππgetmem(scratch, buffsize);                 { Allocate scratchpad }πblockread(pcxfile, scratch^, 128);         { Get header into scratchpad }ππmove(scratch^, palbuf, 67);πbytes_per_line:= palbuf[66];ππ{------------------------ Setup for CGA ---------------------------------}ππif is_CGA thenπbeginπ  getmem(buff0, 8000);      { Allocate memory for output }π  getmem(buff1, 8000);π  abuff0:= buff0;           { Make copies of pointers }π  abuff1:= buff1;πend elseππ{----------------------- Setup for EGA/VGA ------------------------------}ππbeginπ  video_index:= 0;π  port[$3C4]:= 2;           { Index to map mask register }π  plane:= 1;                { Initialize plane }π  port[$3C5]:= plane;       { Set sequencer to mask out other planes }ππ  for entry:= 0 to 15 doπ  beginπ    colorID:= 0;π    for gun:= 0 to 2 doπ    beginπ      pcxcode:= palbuf[16 + entry * 3 + gun];   { Get primary color value }π      if not is_VGA thenπ      begin                                     { Interpret for EGA }π        case (pcxcode div $40) ofπ          0: mask:= $00;    { 000000 }π          1: mask:= $20;    { 100000 }π          2: mask:= $04;    { 000100 }π          3: mask:= $24;    { 100100 }π        end;π        colorID:= colorID or (mask shr gun);    { Define two bits }π      end  { not is_VGA }π      elseπ      begin  { is_VGA }π        with RGBpal[entry] do                   { Interpret for VGA }π        case gun ofπ          0: redval:= pcxcode div 4;π          1: greenval:= pcxcode div 4;π          2: blueval:= pcxcode div 4;π        end;π      end;  { is_VGA }π    end;  { gun }π    if is_VGA then pal.colors[entry]:= entryπ              else pal.colors[entry]:= colorID;π  end;  { entry }π  pal.size:= 16;πend;   { not is_CGA }ππ{ ---------------- Read and decode the image data ----------------------- }ππrepeatcount:= 0;                        { Initialize assembler vars. }πcolumncount:= 0;πrepeatπ  blockread(pcxfile, scratch^, buffsize, datalength);π  if is_CGA then decode_CGA else decode_16;   { Call assembler routine }πuntil eof(pcxfile);πclose(pcxfile);πif not is_CGA then port[$3C5]:= $F;     { Reset mask map }πfreemem(scratch,buffsize);              { Discard scratchpad }πend;  { READ_PCX_FILE }ππ{ ========================= 256-color files ============================= }ππprocedure DECODE_PCX256; assembler;ππasmπmov     es, page_addr       { video segment }πmov     di, video_index     { index into video }πxor     cx, cx              { clean up loop counter }πmov     cl, repeatcount     { count in CL }πmov     bx, datalength      { end of input buffer }πpush    ds                  { save DS }πlds     si, scratch         { pointer to input in DS:SI }πadd     bx, si              { adjust datalength - SI may not be 0 }πcld                         { clear DF }πcmp     cl, 0               { was last byte a count? }πjne     @multi_data         { yes, so next is data }ππ{ --------------------- Loop through input buffer ----------------------- }ππ@getbyte:                   { last byte was not a count }πcmp     si, bx              { end of input buffer? }πje      @exit               { yes, quit }πlodsb                       { get byte into AL, increment SI }πcmp     al, 192             { test high bits }πjb      @one_data           { not set, not a count }π{ It's a count byte }πxor     al, 192             { get count from 6 low bits }πmov     cl, al              { store repeat count }πcmp     si, bx              { end of input buffer? }πje      @exit               { yes, quit }π@multi_data:πlodsb                       { get byte into AL, increment SI }πrep     stosb               { write byte CX times }πjmp     @getbyteπ@one_data:πstosb                       { byte into video }πjmp     @getbyteππ{ ------------------------- Finished with buffer ------------------------ }ππ@exit:πpop     ds                  { restore Turbo's data segment }πmov     video_index, di     { save status for next run thru buffer }πmov     repeatcount, clπend;  { asm }ππ{ ================= Main procedure for 256-color files ================== }ππprocedure READ_PCX256(pfilename: pathstr);ππvar     x, gun, pcxcode: byte;π        pcxfile: file;π        palette_start, total_read: longint;π        palette_flag: byte;π        version: word;ππprocedure CLEANUP;ππbeginπclose(pcxfile);πfreemem(scratch, buffsize);πend;ππbegin    { READ_PCX256 }πassign(pcxfile, pfilename);π{$I-} reset(pcxfile, 1);  {$I+}πfile_error:= (IOresult <> 0);πif file_error then exit;πgetmem(scratch, buffsize);                  { Allocate scratchpad }πblockread(pcxfile, version, 2);             { Read first two bytes }πfile_error:= (hi(version) < 5);             { No palette info. }πif file_error thenπbeginπ  cleanup; exit;πend;πpalette_start:= filesize(pcxfile) - 769;ππseek(pcxfile, 128);                        { Scrap file header }πtotal_read:= 128;ππrepeatcount:= 0;                           { Initialize assembler vars. }πvideo_index:= 0;ππrepeatπ  blockread(pcxfile, scratch^, buffsize, datalength);π  inc(total_read, datalength);π  if (total_read > palette_start) thenπ      dec(datalength, total_read - palette_start);π  decode_pcx256;πuntil (eof(pcxfile)) or (total_read>= palette_start);ππseek(pcxfile, palette_start);πblockread(pcxfile, palette_flag, 1);πfile_error:= (palette_flag <> 12);πif file_error thenπbeginπ  cleanup; exit;πend;πblockread(pcxfile, RGB256, 768);         { Get palette info. }πfor x:= 0 to 255 doπwith RGB256[x] doπbeginπ  redval:= redval shr 2;π  greenval:= greenval shr 2;π  blueval:= blueval shr 2;πend;πcleanup;πend;  { READ_PCX256 }ππ{ ========================== Initialization ============================= }ππBEGINπpage_addr:= page0;                      { Destination for EGA/VGA data }πEND.π                                                                                                                         58     01-27-9412:18ALL                      DAVID DAHL               Plasma                   SWAG9402            33     ╓   {$G+} { Enable 286 Instructions }π{$N+} { Enable Math Coprocessor - Delete This Line If You Don't Have One }πProgram FractalPlasma;ππ{ Programmed By David Dahl }ππ(* PUBLIC DOMAIN *)ππUsesπ  CRT,π  Palette;ππConstπ  Rug = 0.2;ππTypeπ  VGAPtr  = ^VGAType;π  VGAType = Array [0..199, 0..319] of Byte;ππVarπ  Screen    : VGAPtr;ππ  PlasmaMap : VGAPtr;π  PlasmaPal : PaletteType;ππProcedure GeneratePlasma(P : VGAPtr);π{                                                                 }π{ This procedure uses an algorithm to generate a fractal surface. }π{                                                                 }π{ Algorithm from page 359 of _Computer_Graphics:_the_Principles_  }π{ _Behind_the_Art_And_Science_ by Pokorny and Gerald.             }π{                                                                 }π  Procedure FractPlasma(il, jl, ih, jh : Integer);π  Varπ    im, jm : Integer;π  Beginπ    im := (il + ih + 1) DIV 2;π    jm := (jl + jh + 1) DIV 2;ππ    If jm < jh thenπ    Beginπ      If P^[il,jm] = 0 Thenπ        P^[il,jm] := Trunc(((P^[il,jl] + P^[il,jh]) / 2) +π                              Random*Rug*(jh-jl));π      If il < ih Thenπ        P^[ih,jm] := Trunc(((P^[ih,jl] + P^[ih,jh]) / 2) +π                              Random*Rug*(jh-jl));π    End;ππ    If im < ih thenπ    Beginπ      If P^[im,jl] = 0 Thenπ        P^[im,jl] := Trunc(((P^[il,jl] + P^[ih,jl]) / 2) +π                              Random*Rug*(ih-il));π      If jl < jh Thenπ        P^[im,jh] := Trunc(((P^[il,jh] + P^[ih,jh]) / 2) +π                              Random*Rug*(jh-jl));π    End;ππ    If (im < ih) AND (jm < jh) Thenπ      P^[im,jm] := Trunc(((P^[il,jl] + P^[ih,jl] +π                           P^[il,jh] + P^[ih, jh]) / 4) +π                           Random*Rug*(ABS(ih-il)+abs(jh-jl)));π    If (im < ih) OR (jm < jh) Thenπ    Beginπ      FractPlasma(il, jl, im, jm);π      FractPlasma(il, jm, im, jh);π      FractPlasma(im, jl, ih, jm);π      FractPlasma(im, jm, ih, jh);π    End;π  End;ππBeginπ  FractPlasma(0, 0, 199, 319);πEnd;ππProcedure InitVGA13h; Assembler;πAsmπ  MOV AX, $0013π  INT $10πEnd;ππProcedure CalculatePalette(Var PalOut : PaletteType);πVarπ  RA, GA, BA : Integer;π  RF, GF, BF : Integer;π  RS, GS, BS : Integer;π  Counter    : Word;πBeginπ  RA := 16 + Random(32-16);π  GA := 16 + Random(32-16);π  BA := 16 + Random(32-16);ππ  RF := 2 + Random(5);π  GF := 2 + Random(5);π  BF := 2 + Random(5);ππ  RS := Random(64);π  GS := Random(64);π  BS := Random(64);πππ  For Counter := 0 to 255 doπ  With PalOut[Counter] doπ  Beginπ    Red   := 32 + Round(RA * Sin((RS + Counter * RF) * Pi / 128));π    Green := 32 + Round(GA * Sin((GS + Counter * GF) * Pi / 128));π    Blue  := 32 + Round(BA * Sin((BS + Counter * BF) * Pi / 128));π  End;πEnd;ππProcedure RotatePalette(Var PalIn : PaletteType);πVarπ  TRGB : PaletteRec;πBeginπ  TRGB := PalIn[0];π  Move (PalIn[1], PalIn[0], 255 * 3);π  PalIn[255] := TRGB;πEnd;ππVarπ  Int : Integer;π  Key : Char;πBeginπ  DirectVideo := False;π  Randomize;ππ  InitVGA13h;ππ  Screen := Ptr($A000,$0000);π  New(PlasmaMap);ππ  { Initialize Workspace }π  FillChar(PlasmaMap^, 320 * 200 , 0);ππ  { Calculate Smooth Random Colors }π  CalculatePalette(PlasmaPal);ππ  GotoXY(12, 12);π  Writeln('Generating Plasma');π  GotoXY(14, 14);π  Writeln('Please Wait...');ππ  GeneratePlasma(PlasmaMap);ππ  { Set All Colors to Black }π  BlackPalette;π  { Copy Fractal To Screen }π  Screen^ := PlasmaMap^;ππ  { Rotate Palette And Fade It In Slowly }π  For Int := 1 to 32 doπ  Beginπ    RotatePalette(PlasmaPal);π    FadeInFromBlackQ(PlasmaPal, Int);π  End;ππ  { Rotate Full Intensity Palette And Wait For KeyPress }π  Repeatπ    RotatePalette(PlasmaPal);π    SetPalette(PlasmaPal);π  Until KeyPressed;ππ  { Rotate Palette and Fade It Out Slowly }π  For Int := 31 downto 0 doπ  Beginπ    RotatePalette(PlasmaPal);π    FadeInFromBlackQ(PlasmaPal, Int);π  End;ππ  Dispose(PlasmaMap);ππ  TextMode(C80);ππ  { Flush Keyboard Buffer }π  While KeyPressed doπ    Key := ReadKey;πEnd.π                                                                                      59     01-27-9412:18ALL                      SEAN PALMER              Poly Drawing             SWAG9402            30     ╓   (*π> It's not that slow. I can get about 60 good-sizedπ> poly's in a second on my dinky 386sx-20. It also doesπ> ^ ^ ^^ ^^ ^^^^^^^^^^^^^^^^^^^^^^^^π> I don't know what a good speed is for polyfills, but this sounds quiteπ> good! Thanks heaps (and stacks?  :^) for the post!ππYou're welcome. I just now converted it to 99% assembler, 386+, just gottaπtest it out.ππ> One question to follow:ππ> {  fillWord(mem[$A000:0],64000,0);  {clear}π> ^^^                                ^stick closer ("}") hereππ> You'll probably recognize the above as the main routine of the polygonπ> fill snippet (the tester part).  Please note the part I under-caretedπ> (or -caretted).  There is no closing comment before the next openingπ> comment. Should the closer be placed where indicated by me?  Orπ> was the opener a typo?π> Not a big deal, but I want this to work so I can be impressed!  :^)ππIt works like that, at least in TP/BP. The open comment in effect keeps theπcompiler from ever seeing the next open brace. So the second brace's closingπbrace actually closes the first one. A trick I learned since I started atπdeltaComm. No, I actually wanted that commented out, because clearing theπscreen between each one slows it down.ππActually, I noticed a strange behaviour in the fill, where if you have oneπvertex = (x,y) and the next vertex = (x+40,y+1) then you'll end up with a dotπon one line and the next line entirely filled. Not what was intended. I came upπwith a fix for it:ππIt basically just centers the stairstep zigzag by adding half a step before itπstarts.π*)ππfunction lSar(L:longint):longint;assembler;asmπ db $66; mov ax,L       {mov eax,L}π db $66; sar ax,1       {sar eax,1}π db $66,$0F,$A4,$C2,$10 {shld edx,eax,16}π end;πππprocedure draw(color:byte);πvar i,l,r,lv,rv,top,bottom,topVert:integer; var lstep,lpos,rstep,rpos:fixed;πvar ldest,rdest:tPoint; beginπ {find top and bottom vertices}π topVert:=numVerts-1;π top:=vertex[topVert].y; bottom:=top;π for i:=numVerts-2 downto 0 doπ   if (vertex[i].Y < top) then beginπ    top:=vertex[i].Y;π    topVert:=i;π    endπ   else if (vertex[i].Y > bottom) thenπ    bottom:=vertex[i].Y;π if bottom>maxY then bottom:=maxY;       {clip bottom}π if top>bottom then exit;π lv:=topVert; rv:=topVert;π ldest:=vertex[topVert]; rdest:=ldest;π i:=top;π repeatπ  if i<bottom then beginππ{π^^^^^^^^^^^^^^^^^^^^^^^^^ keep from getting wierd effects from theπ                          adjustment on the last row.π}π   if i>=ldest.y then beginπ    lpos.f:=0; lpos.i:=ldest.x;π    dec(lv); if lv<0 then lv:=numVerts-1;π    ldest:=vertex[lv];π    if ldest.y=i then beginπ      if ldest.x<lpos.i then lpos.i:=ldest.x;π      lstep.l:=0;π      endπ    else beginπ      lstep.l:=fixedDiv(ldest.x-lpos.i,ldest.y-i);π      inc(lpos.l,lSar(lstep.l));ππ      ^^^^^^^^^^^^^^^^^^^^^^^^^^  Center the stairstep patternππ      end;π    end;π   if i>=rdest.y then beginπ    rpos.f:=0; rpos.i:=rdest.x;π    inc(rv); if rv>=numVerts then rv:=0;π    rdest:=vertex[rv];π    if rdest.y=i then beginπ      if rdest.x>rpos.i then rpos.i:=rdest.x;π      rstep.l:=0;π      endπ    else beginπ      rstep.l:=fixedDiv(rdest.x-rpos.i,rdest.y-i);π      inc(rpos.l,lSar(rStep.l));ππ      ^^^^^^^^^^^^^^^^^^^^^^^^^^  Center the stairstep patternππ      end;π    end;π   end;π  if i>=minY then begin                             {clip top}π   if lpos.i>minX then l:=lpos.i else l:=minX;      {clip left}π   if rpos.i<maxX then r:=rpos.i else r:=maxX;      {clip right}π   if (l<=r) thenπ    fillWord(mem[$A000:i*320+l],r-l+1,color);π   end;π  inc(lpos.l,lstep.l);π  inc(rpos.l,rstep.l);π  inc(i);π  until i>bottom;π end;π                                                                                       60     01-27-9412:20ALL                      KAI ROHRBACHER           COD Images               SWAG9402            16     ╓   {π> This doesn't have anything to do with the flicker problem, but I wasπ> wondering if you could tell me how to scale and rotate .COD images.ππAlthough  I  posted  some code to flip COD's horizontally & verticallyπsome  time  ago,  I  won't make it a regular feature of AniVGA, as I'mπworking on compiled bitmaps and thus, altering the "data" after havingπit compiled into a procedure is close to impossible...πHowever,  if  you are speaking about scaling & rotation in MAKES: yes,πone  could  include  it.  To be honest, I was just to lazy to code allπthat matrix crap necessary.πFor  the  interested  reader: to scale the points (x,y) of a matrix byπsome factor f, you just have to apply the matrixπ(f 0)π(0 f)πto all its points.πA  rotation  by  an  angle  of  z  degrees  counterclockwise about theπrotation  center (u,v) is more complex: one first has to transform theπpoint coordinates to homogeneous coordinates (that is: append a one asπthe  3rd  component: (x,y) -> (x,y,1); if during computations this 3rdπcomponent  "c"  of  a vector (a,b,c) becomes <>1, then renormalize theπvector to (a/c,b/c,1)).πHaving done so, the rotation consists of three steps:πa) make (u,v) the new origin of your pixels (instead of (0,0))πb) rotate the data by z degrees about the new origin (0,0)πc) retransform the true (0,0) originππStep  a)  consists  of  applying the following matrix M1 to the pixelsπ(x,y,1):π( 1  0 0)π( 0  1 0)π(-u -v 1)ππLikewise, step b) is done by the matrix M2:π( cos(z) sin(z) 0 )π(-sin(z) cos(z) 0 )π(   0      0    1 )ππAnd step c) is done by M3:π( 1  0 0)π( 0  1 0)π(+u +v 1)ππThese  three  steps  can  be  squeezed  into one matrix application byπcombining  the  three  matrices into one matrix M=M1*M2*M3 (with "*" =πmatrix multiplication operator from linear algebra).ππ                                                                                                                            61     01-27-9412:21ALL                      BAS VAN GAALEN           Shade Bobs               SWAG9402            26     ╓   {π>> 1. Scrolling 256c fonts Fast and Smooth.π>> 2. Now to do it on top of graphics...π>> 3. 3D object engine - If someone can post me one or direct meπ>> to build one.π>> 4. Shade Bobs/Whatever it called - Taking a shape and moving itπ>> across the screen when it leaves trail.  Then, moving againπ>> on the trail will couse a stronger color to appear. n' on...π>> 5. Moving floor that is NOT a couse of a palette rotetion.π>> 6. 2D Scale procedure.π>> 7. Centered Stars. And SMOOTH ones.π>> 8. Vector BallsππI don't want to give it all away, but I just made some Shaded-bobs (orπwhatever). It realy isn't difficult. It worked right away. Now YOU make a nicerπsin-curve and palette. Here's some source:π}ππ{$G+}ππprogram ShadingBobs;πconstπ  Gseg : word = $a000;π  Sofs = 75; Samp = 75; Slen = 255;π  SprPic : array[0..15,0..15] of byte = (π    (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0),π    (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),π    (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),π    (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),π    (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),π    (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),π    (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),π    (1,1,1,1,2,2,3,4,4,3,2,2,1,1,1,1),π    (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),π    (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),π    (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),π    (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),π    (0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0),π    (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),π    (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),π    (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0));πtype SinArray = array[0..Slen] of word;πvar Stab : SinArray;ππprocedure CalcSinus; var I : word; beginπ  for I := 0 to Slen do Stab[I] := round(sin(I*4*pi/Slen)*Samp)+Sofs; end;ππprocedure SetGraphics(Mode : word); assembler; asmπ  mov ax,Mode; int 10h end;ππfunction keypressed : boolean; assembler; asmπ  mov ah,0bh; int 21h; and al,0feh; end;ππprocedure DrawSprite(X,Y : integer; W,H : byte; Sprite : pointer); assembler;πasmπ  push dsπ  lds si,[Sprite]π  mov es,Gsegπ  cldπ  mov ax,[Y]π  shl ax,6π  mov di,axπ  shl ax,2π  add di,axπ  add di,[X]π  mov bh,[H]π  mov cx,320π  sub cl,[W]π  sbb ch,0π @L:π  mov bl,[W]π @L2:π  lodsbπ  or al,alπ  jz @Sπ  mov dl,[es:di]π  add dl,alπ  mov [es:di],dlπ @S:π  inc diπ  dec blπ  jnz @L2π  add di,cxπ  dec bhπ  jnz @Lπ  pop dsπend;ππprocedure Retrace; assembler; asmπ  mov dx,3dah;π  @l1: in al,dx; test al,8; jnz @l1;π  @l2: in al,dx; test al,8; jz @l2; end;ππprocedure Setpalette;πvar I : byte;πbeginπ  for I := 0 to 255 do beginπ    port[$3c8] := I;π    port[$3c9] := I div 3;π    port[$3c9] := I div 2;π    port[$3c9] := I;π  end;πend;ππprocedure Bobs;πvar X,Y : integer; I,J : byte;πbeginπ  I := 0; J := 25;π  repeatπ    X := 2*Stab[I]; Y := Stab[J];π    inc(I); inc(J);π    Retrace;π    DrawSprite(X,Y,16,16,addr(SprPic));π  until keypressed;πend;ππbeginπ  CalcSinus;π  SetGraphics($13);π{  SetPalette;}π  Bobs;π  SetGraphics(3);πend.ππ{ DrawSprite procedure taken from Sean Palmer (again).π  It contained some minor bugs: [X] was added to AX, should be DI, andπ  jz @S was jnz @S, so the sprite wasn't drawn. Now it is...π  And of course it was changed to INCREASE the video-mem, not to poke it.ππ  If you get rid of the Retrace it goes a LOT faster. }ππ                               62     01-27-9412:22ALL                      SEAN PALMER              Sprite Talk              SWAG9402            22     ╓   {π>Try converting it to use pointers instead of accessing the array withπ>indexes, and use a pointer to video memory for direct plotsπ>instead of using the putPixel routine. Also it's quicker toπ>check against 0 for the background than to check againstπ>255.ππ> I found a copy of "The Visible Computer: 8088" in my bookshelves andπ> tried rewriting my assembly routines.  Here's what I finally got:ππ> procedure MaskPut(x,y: word; p: pointer); assembler;π> varπ> XX,YY: byte;π> asmπ> LES SI,pπ> MOV [XX],0π> MOV [YY],0π> MOV CX,256π> XOR DX,DXπ> CLDπ> @Loopit:SEGES LODSBπ> MOV DL,ALπ> PUSH ESπ> PUSH SIπ> CMP DL,255π> JZ @Doneπ> MOV AX,0A000hπ> MOV ES,AXπ> MOV AX,320π> MOV BX,[Y]π> ADD BL,[YY]π> PUSH DXπ> MUL BXπ> POP DXπ> MOV BX,[X]π> ADD BL,[XX]π> ADD AX,BXπ> MOV SI,AXπ> MOV ES:[SI],DLπ> @Done:  INC [XX]π> CMP [XX],16π> JNZ @Okayπ> MOV [XX],0π> INC [YY]π> @Okay:  POP SIπ> POP ESπ> LOOP @Loopitπ> end;ππ> It works fine.  I didn't notice much of a difference in speed though.π> I tested it and I can plot about 1103 sprites/second in ASM and 828π> sprites/sec. with my original TP code.  Please keep in mind I'm notπ> much of an assembly programmer. Can anyone help me optimize this codeπ> (into 286 would be good too). Thanx for your help!ππI'll try. I notice you're using memory variables for loop counters in thatπcode. Also seem to be reloading the segment registers each time through theπloop, and general sundry pushes, pops, and such which are unnecesary. I don'tπhave time to rewrite your code from scratch today but I'll post my transparentπbitmap routine for Mode 13 for you to use/learn from. K?ππthis is untested, I was fixing it up after I found it my optimization getsπbetter over time, and it's been a while since I've worked on this Mode 13hπstuff.π}ππ{$G+}ππprocedure drawSprite(x, y : integer; w, h : byte; sprite : pointer); assembler;πasmπ push dsπ lds si,[sprite]π mov ax,$A000π mov es,axπ cldπ mov ax,[y]     {y * 320}π shl ax,6π mov di,axπ shl ax,2π add di,axπ add ax,[x]     {+ x}π mov bh,[h]π mov cx,320     {dif between rows}π sub cl,[w]π sbb ch,0π@L:π mov bl,[w]π@L2:π lodsbπ or al,al       {test for 0. For 255 you'd use inc al here instead}π                {heck dx and ah are free, you could store theπ                  comparison value in one of those}π jnz @Sπ                {for 255 you'd also need a dec al here}π mov [es:di],alπ@S:π inc diπ dec blπ jnz @L2π add di,cxπ dec bhπ jnz @Lπ pop dsπ end;ππ{πAnd I'll bet you notice a difference in speed with this puppy. 8)ππIf you could guarantee that the width would be an even number you couldπoptimize it to use word moves, otherwise it wouldn't be worth it.π}π                                      63     01-27-9412:22ALL                      HARALDS JAKOVELS         Sprite Info              SWAG9402            24     ╓   {π> Another problem is plotting sprites with "invisible" pixels.  In otherπ> words, all pixels in the sprite are plotted except for ones with a colorπ> of 255 (I think I've heard that Origin used this method in Ultima 6).π> Because of my unsuccessful try with asm earlier, I didn't even bother toπ> try this in asm.  Unfortunately, the following is MUCH too slow:ππtry this!π}πuses crt;πtype SpriteType = array[0..15,0..15] of byte;ππvar sprite : spritetype;π    f : file of spritetype;     {sprite's image is stored in file}π    x, y : word;ππprocedure putinvspriteinasm(x, y : word; sprite : spritetype);πvar p : pointer;π    segm, offs : word;π    {these are used to calculate destination addressπ     in video memory}ππbeginπ  p := addr(sprite[0,0]);π  {this pointer is used only to cheat tp. tp doesn't allow to use addr orπ   @ operators in inline asm - or i don't know how to do it}π  segm := $a000 + (320 * y) div 16;π  offs := x;π  {segm:offs is address of upper left corner of sprite in video RAM}π      asmπ          push   dsπ  {ds is one of the important registers in tp and must be saved}π          lds    si, pπ  {ds:si now is source address for sprite's array}π          mov    es, segmπ          mov    di, offsπ  {es:di now is target address in VRAM}π          mov    bh, 16π  {counter for outer loop}π@loop2:   mov    bl, 16π@loop1:   mov    al, [ds:si]π  {innner loop (marked with label @loop1) is used to draw each line ofπ   sprite}π          cmp    al, $ffπ   {make sure if pixel is $ff or not}π          je     @skipπ   {it is - so we don't draw it}π          mov    [es:di], alπ   {no, it's not - draw!}π@skip:    inc    siπ          inc    diπ          dec    blπ          jnz    @loop1π   {we haven't finished to draw this line if bl > 0}π          dec    bhπ   {we haven't finished to draw all image if bh > 0}π          jz     @endπ          add    di, 320 - 16π   {calculate beginning of next line}π          jmp    @loop2π@end:π          pop    dsππ      endπend;ππbeginπ  asm mov ax, 0013hπ      int 10hπ  end;π  assign(f, 'sprite');π  reset(f);π  read(f, sprite);π  close(f);π  randomize;π  repeatπ    x := random(320);π    y := random(200);π    putinvspriteinasm(x, y, sprite);π  until keypressed;πend.π{πi added into code some quick'n'dirty comments to let you understandπhow assembly works. i've tested this code and found that it won't work withπMicrosoft's workgrp.sys driver - the programm simply crashes when you press aπkey. (workgrp.sys driver is one of the Windows for Workgroups drivers).πstrange... with all other things (qemm386, lan drivers etc.) programm seems toπwork fine. one more thing i must add that better is to pass to procedureπputsprite not array with sprite's data but only pointer to it - because tpπmoves all this data around memory - and in this case it's 256 bytes.π}π                                                                                                                 64     01-27-9412:23ALL                      VARIOUS - SEE BELOW      Textures                 SWAG9402            51     ╓   π{πANDREW FORTπ> That's fast, but that's just one bitmap. I really need to sit down andπ> optimize my texture mapper...ππ> You have to use 386 instructions cuz 32-bit division is way too slowπ> otherwise. I'd have to see the code to tell if it's efficient or not. It'sπ> a simple algorithm, just figuring out where in the bitmap to start andπ> what the step value is for each scan line is the hard part. Then just doπ> 320 pixels real quick... don't worry, cuz with 256x256 bitmaps, everythingπ> just works itself out real nice.ππyes i realize it works out real nice with 256x256 bitmaps, because you canπshift/carry or whatever to get the particular point in the bitmap you wantπeasily.ππyes it uses 32 bit instructions, but since it's so short, it's not a problemπcoding it in BASM.. and here it is:ππ** this code was written by The Faker of Aardvark **π}ππPROCEDURE PutTexture(IncX, IncY : Integer; P : Pointer);πVARπ  Y, PosX,π  PosY,π  PX, PY : Integer;πBEGINπ  PosX := -(ScreenX SHR 1) * IncX;   { ScreenX,-Y are size of screen    }π  PosY := -(ScreenY SHR 1) * IncY;   { PosX,y set so rotation is around }π  FOR Y := 0 TO ScreenY-1 DO       { the middle (of 'p')              }π  BEGINπ    PX := PosX;   { PosX,-Y is updated every line, PX,-y derived   }π    PY := PosY;π    ASMπ      push dsπ      mov  ax, 0a000hπ      mov  es, axπ      mov  ax, yπ      xchg al, ahπ      mov  di, axπ      shr  di, 2π      add  di, axπ      lds  si, p   { in P there should be a 256x256 bitmap }π      mov  cx, screenx shr 1π      cldπ      mov  ax, incxπ      shl  eax, 16π      mov  ax, incyπ      mov  esi, eaxπ      mov  dx, pxπ      shl  edx, 16π      mov  dx, pyπ     @1:π      add  edx, esiπ      mov  ebx, edxπ      shr  ebx, 16π      mov  bl, dhπ      mov  al, [bx]π      add  edx, esiπ      mov  ebx, edxπ      shr  ebx, 16π      mov  bl, dhπ      mov  ah, [bx]π      stoswπ      dec  cxπ      jnz  @1π      pop  dsπ    END;π    Inc(PosX, IncY);π    Inc(PosY, -IncX);π  END;πEND;ππ{πas you can see, very methodical coding, but it's quite fast, and does theπjob....ππ>> It was coded before 2nd reality was released, but didn't get releasedπ>> till after because of distribution problems..ππ> Second Reality was ok, but they coulda done better. I did like theπ> bubbling landscape demo (voxel stuff)ππtry, although i was disappointed that they didn't really do much new (thoseπblue bolls were nice though, although they flickered quite alot.. but hey! i'mπhardly paying for the demo, am i!)ππbut yeah, the voxel stuff was nice.. after reciving email from Lord Logics (ofπAvalanche), he says that he's been working on some voxel stuff, although heπdidn't get it finished because of getting a job, although he intends to finishπit and release it in a demo for avalanche.. so that'd be nice to see..ππtell me if the code is efficent or not! :-)π}ππ(*πSEAN PALMERππ> yes i realize it works out real nice with 256x256 bitmaps, because youπ> can shift/carry or whatever to get the particular point in theπ> bitmap you want easily.ππNo, you don't have to do diddly squat to extract it. Just move the byte out.πSince one's in the hi byte of a 32-bit register though, it's harder to extract.ππ> yes it uses 32 bit instructions, but since it's so short, it's not aπ> problem coding it in BASM.. and here it is:ππOf course you know that BP 7.0 won't do 386 instructions. So this wouldn'tπcompile as is. Needs a lot of DB $66's, etc.ππ> ** this code was written by The Faker of Aardvark **ππHi Faker! Sorry to botch your code below. 8)ππ> PROCEDURE PutTexture(IncX,IncY:Integer; P:Pointer);π> VARπ> Y,PosX,PosY,PX,PY:Integer;π> BEGINπ> PosX:=-(ScreenX SHR 1)*IncX;   { ScreenX,-Y are size of screen}π> PosY:=-(ScreenY SHR 1)*IncY;   { PosX,y set so rotation is around}π> FOR Y:=0 TO ScreenY-1 DO       { the middle (of 'p')}π> BEGINπ> PX:=PosX;   { PosX,-Y is updated every line, PX,-y derived}π> PY:=PosY;π> ASMπ> push dsπ> mov ax,0a000hπ> mov es,axπ> mov ax,yπ     shl ax,8    {this is same speed, but cleaner}π> mov di,ax      {lessee... ends up y*320. Faster than MUL. But should}π> shr di,2       {be incrementally calculated instead.}π> add di,axπ> lds si,p       { in P there should be a 256x256 bitmap }π> mov cx,screenx shr 1π> cldπ                        {cleaned out the intermediate use of eax}π     mov si,incxπ     shl esi,16π     mov si,incyπ> mov dx,pxπ> shl edx,16π> mov dx,pyπ> @1: add edx,esiπ     shld ebx,edx,16    {do move and shift all at once. Save 2 cycles}π> mov bl,dhπ> mov al,[bx]π> add edx,esiπ     shld ebx,edx,16    {ditto. I like this unrolled loop! 8) }π> mov bl,dhπ> mov ah,[bx]π> stosw              {word access. Sweet.}π> dec cx             {better than LOOP on a 386+}π> jnz @1π> pop dsπ> END;π> Inc(PosX,IncY);π     Dec(PosY,IncX);    {avoid neg operation}π> END;π> END;ππ> as you can see, very methodical coding, but it's quite fast, and doesπ> the job....ππYep. I haven't coded it up where it'll compile and run it yet, but Should BeπPretty Darn Quick. Seems like it's gonna have a problem with the carry from dxπto the hi word of edx (your position will be off, barely, every time itπwraps.... shouldn't matter much)ππ> but yeah, the voxel stuff was nice.. after reciving email from Lordπ> Logics (of Avalanche), he says that he's been working on someπ> voxel stuff, although he didn't get it finished because ofπ> getting a job, although he intends to finish it and release itπ> in a demo for avalanche.. so that'd be nice to see..ππI'm gonna have to code something like that up for a BattleTech type game. Bestπidea I've seen so far for terrain... If you see any code to get me started,πplease route it my way.ππ> tell me if the code is efficent or not! :-)ππOnly one optimization I can spot right now (aside from coding the outer loop inπASM as well...) Is that he has to shift the 32-bit registers around to get atπthe upper word. (the 386 needs more data registers!!!!!! ARE YOU LISTENINGπINTEL!!!) So using the SHLD instruction like I re-coded above should speed itπup some. Avoid the intermediate register move.ππI've commented above. You could put alot of the setup stuff outside the loop ifπyou wrote it all in BASM. Wouldn't have to push/pop for each scan line, etc.πBut that's a minor speedup.ππIn the future, try to gain access to the FIDO 80XXX echo. It's a much betterπplace to talk about (mostly) assembly stuff.ππ*)                                       65     01-27-9412:25ALL                      WILLIAM PLANKE           PCX Writing              SWAG9402            99     ╓   {πAs I follow this forum, many requests are made for PCX graphicsπfile routines. Those that are looking for Read_PCX info canπfind it on the ZSoft BBS in a wonderful Pascal example: ShowPCX.ππOn the other hand, there is next to zilch out there on how toπWrite_PCX files. I know.... I searched and searched and couldn'tπfind a thing! So with a little brute force  and a few ZSoftπC language snippets <groan>, I got this together:ππPCX_W.Write_PCX (Name:Str80);πgiven to the public domain and commonweal.πpseudocode:π           set 640x480x16 VGAhi graphics mode only for nowπ           getimage 1 row at a timeπ           reorganize the BGI color planes into PCX format orderπ           encode the raw PCX line into a run length limitedπ             compressed PCX lineπ           blockwrite the compressed PCX line to your.PCX fileπ}ππ{$R-}    {Range checking, turn off when debugged}ππunit PCX_W;ππ{ --------------------- Interface ----------------- }ππinterfaceππtypeπ    Str80 = string [80];ππprocedure Write_PCX  (Name:Str80);πππ{ ===================== Implementation ============ }ππimplementationππusesπ    Graph;πππ{-------------- Write_PCX --------------}ππprocedure Write_PCX (Name:Str80);ππconstπ     RED1   = 0;π     GREEN1 = 1;π     BLUE1  = 2;ππtypeπ    ArrayPal   = array [0..15, RED1..BLUE1] of byte;ππconstπ     MAX_WIDTH  = 4000;    { arbitrary - maximum width (in bytes) ofπ                             a PCX image }π     INTENSTART =   $5;π     BLUESTART  =  $55;π     GREENSTART =  $A5;π     REDSTART   =  $F5;ππtypeπ    Pcx_Header = recordπ    {comments from ZSoft ShowPCX pascal example}ππ        Manufacturer: byte;     { Always 10 for PCX file }ππ        Version: byte;          { 2 - old PCX - no palette (not usedπ                                      anymore),π                                  3 - no palette,π                                  4 - Microsoft Windows - no paletteπ                                      (only in old files, new Windowsπ                                      version uses 3),π                                  5 - with palette }ππ        Encoding: byte;         { 1 is PCX, it is possible that we mayπ                                  add additional encoding methods in theπ                                  future }ππ        Bits_per_pixel: byte;   { Number of bits to represent a pixelπ                                  (per plane) - 1, 2, 4, or 8 }ππ        Xmin: integer;          { Image window dimensions (inclusive) }π        Ymin: integer;          { Xmin, Ymin are usually zero (not always)}π        Xmax: integer;π        Ymax: integer;ππ        Hdpi: integer;          { Resolution of image (dots per inch) }π        Vdpi: integer;          { Set to scanner resolution - 300 isπ                                  default }ππ        ColorMap: ArrayPal;π                                { RGB palette data (16 colors or less)π                                  256 color palette is appended to endπ                                  of file }ππ        Reserved: byte;         { (used to contain video mode)π                                  now it is ignored - just set to zero }ππ        Nplanes: byte;          { Number of planes }ππ        Bytes_per_line_per_plane: integer;   { Number of bytes toπ                                               allocate for a scanlineπ                                               plane. MUST be an an EVENπ                                               number! Do NOT calculateπ                                               from Xmax-Xmin! }ππ        PaletteInfo: integer;   { 1 = black & white or color image,π                                  2 = grayscale image - ignored in PB4,π                                      PB4+ palette must also be set toπ                                      shades of gray! }ππ        HscreenSize: integer;   { added for PC Paintbrush IV Plusπ                                  ver 1.0,  }π        VscreenSize: integer;   { PC Paintbrush IV ver 1.02 (and later)}π                                { I know it is tempting to use theseπ                                  fields to determine what video modeπ                                  should be used to display the imageπ                                  - but it is NOT recommended since theπ                                  fields will probably just containπ                                  garbage. It is better to have theπ                                  user install for the graphics mode heπ                                  wants to use... }ππ        Filler: array [74..127] of byte;     { Just set to zeros }π    end;ππ    Array80    = array [1..80]        of byte;π    ArrayLnImg = array [1..326]       of byte; { 6 extra bytes atπ     beginng of line that BGI uses for size info}π    Line_Array = array [0..MAX_WIDTH] of byte;π    ArrayLnPCX = array [1..4]         of Array80;ππvarπ   PCXName   : File;π   Header    : Pcx_Header;                 { PCX file header }π   ImgLn     : ArrayLnImg;π   PCXLn     : ArrayLnPCX;π   RedLn,π   BlueLn,π   GreenLn,π   IntenLn   : Array80;π   Img       : pointer;πππ{-------------- BuildHeader- -----------}ππprocedure BuildHeader;ππconstπ     PALETTEMAP: ArrayPal=π                 {  R    G    B                    }π                (($00, $00, $00),  {  black        }π                 ($00, $00, $AA),  {  blue         }π                 ($00, $AA, $00),  {  green        }π                 ($00, $AA, $AA),  {  cyan         }π                 ($AA, $00, $00),  {  red          }π                 ($AA, $00, $AA),  {  magenta      }π                 ($AA, $55, $00),  {  brown        }π                 ($AA, $AA, $AA),  {  lightgray    }π                 ($55, $55, $55),  {  darkgray     }π                 ($55, $55, $FF),  {  lightblue    }π                 ($55, $FF, $55),  {  lightgreen   }π                 ($55, $FF, $FF),  {  lightcyan    }π                 ($FF, $55, $55),  {  lightred     }π                 ($FF, $55, $FF),  {  lightmagenta }π                 ($FF, $FF, $55),  {  yellow       }π                 ($FF, $FF, $FF) );{  white        }ππvarπ   i : word;ππbeginπ     with Header doπ          beginπ               Manufacturer  := 10;π               Version  := 5;π               Encoding := 1;π               Bits_per_pixel := 1;π               Xmin := 0;π               Ymin := 0;π               Xmax := 639;π               Ymax := 479;π               Hdpi := 640;π               Vdpi := 480;π               ColorMap := PALETTEMAP;π               Reserved := 0;π               Nplanes  := 4; { Red, Green, Blue, Intensity }π               Bytes_per_line_per_plane := 80;π               PaletteInfo := 1;π               HscreenSize := 0;π               VscreenSize := 0;π               for i := 74 to 127 doπ                   Filler [i] := 0;π          end;πend;πππ{-------------- GetBGIPlane ------------}ππprocedure GetBGIPlane (Start:word; var Plane:Array80);ππvarπ   i : word;ππbeginπ     for i:= 1 to Header.Bytes_per_line_per_plane doπ         Plane [i] := ImgLn [Start +i -1]πend;ππ{-------------- BuildPCXPlane ----------}ππprocedure BuildPCXPlane (Start:word; Plane:Array80);ππvarπ   i : word;ππbeginπ     for i := 1 to Header.Bytes_per_line_per_plane doπ         PCXLn [Start] [i] := Plane [i];πend;πππ{-------------- EncPCXLine -------------}ππprocedure EncPCXLine (PlaneLine : word); { Encode a PCX line }ππvarπ   This,π   Last,π   RunCount : byte;π   i,π   j        : word;πππ  {-------------- EncPut -----------------}ππ  procedure EncPut (Byt, Cnt :byte);ππ  constπ       COMPRESS_NUM = $C0;  { this is the upper two bits thatπ                              indicate a count }ππ  varπ     Holder : byte;ππ  beginπ  {$I-}π       if (Cnt = 1) and (COMPRESS_NUM <> (COMPRESS_NUM and Byt)) thenπ          blockwrite (PCXName, Byt,1)          { single occurance }π          {good place for file error handler!}π       elseπ           beginπ                Holder := (COMPRESS_NUM or Cnt);π                blockwrite (PCXName, Holder, 1); { number of times theπ                                                   following colorπ                                                   occurs }π                blockwrite (PCXName, Byt, 1);π           end;π  {$I+}π  end;πππbeginπ     i := 1;         { used in PCXLn }π     RunCount := 1;π     Last := PCXLn [PlaneLine][i];π     for j := 1 to Header.Bytes_per_line_per_plane -1 doπ         beginπ              inc (i);π              This := PCXLn [PlaneLine][i];π              if This = Last thenπ                 beginπ                      inc (RunCount);π                      if RunCount = 63 then   { reached PCX run lengthπ                                                limited max yet? }π                         beginπ                              EncPut (Last, RunCount);π                              RunCount := 0;π                         end;π                 endπ              elseπ                  beginπ                       if RunCount >= 1 thenπ                          Encput (Last, RunCount);π                       Last := This;π                       RunCount := 1;π                  end;π         end;π     if RunCount >= 1 then  { any left over ? }π        Encput (Last, RunCount);πend;ππ            { - - -W-R-I-T-E-_-P-C-X- - - - - - - - }ππconstπ     XMAX = 639;π     YMAX = 479;ππvarπ   i, j, Size : word;ππbeginπ     BuildHeader;π     assign     (PCXName,Name);π{$I-}π     rewrite    (PCXName,1);π     blockwrite (PCXName,Header,sizeof (Header));π     {good place for file error handler!}π{$I+}π     setviewport (0,0,XMAX,YMAX, ClipOn);π     Size := imagesize (0,0,XMAX,0); { size of a single row }π     getmem (Img,Size);ππ     for i := 0 to YMAX doπ         beginπ              getimage (0,i,XMAX,i,Img^);  { Grab 1 line from theπ                                             screen store in Imgπ                                             buffer  }π              move (Img^,ImgLn,Size {326});ππ              GetBGIPlane (INTENSTART, IntenLn);π              GetBGIPlane (BLUESTART,  BlueLn );π              GetBGIPlane (GREENSTART, GreenLn);π              GetBGIPlane (REDSTART,   RedLn  );π              BuildPCXPlane (1, RedLn  );π              BuildPCXPlane (2, GreenLn);π              BuildPCXPlane (3, BlueLn );π              BuildPCXPlane (4, IntenLn); { 320 bytes/lineπ                                            uncompressed }π              for j := 1 to Header.NPlanes doππ                  EncPCXLine (j);π         end;π     freemem (Img,Size);           (* Release the memory        *)π{$I-}π     close (PCXName);              (* Save the Image            *)π{$I+}πend;ππend {PCX.TPU} .πππ{ -----------------------Test Program -------------------------- }ππprogram WritePCX;ππusesπ    Graph, PCX_W;ππ{-------------- DrawHorizBars ----------}ππprocedure DrawHorizBars;ππvarπ   i, Color : word;ππbeginπ     cleardevice;π     Color := 15;π     for i := 0 to 15 doπ         beginπ              setfillstyle (solidfill,Color);π              bar (0,i*30,639,i*30+30);       { 16*30 = 480 }π              dec (Color);π         end;πend;ππ{-------------- Main -------------------}ππvarπ   NameW : Str80;π   Gd,π   Gm    : integer;ππbeginπ     writeln;π     if (ParamCount = 0) then           { no DOS command lineπ                                          parameters }π        beginπ             write ('Enter name of PCX picture file to write: ');π             readln (NameW);π             writeln;π        endπ     elseπ         beginπ              NameW := paramstr (1);  { get filename from DOSπ                                        command line }π         end;ππ     if (Pos ('.', NameW) = 0) then   { make sure the filenameπ                                        has PCX extension }π        NameW := Concat (NameW, '.pcx');ππ     Gd:=VGA;π     Gm:=VGAhi; {640x480, 16 colors}π     initgraph (Gd,Gm,'..\bgi');  { path to your EGAVGA.BGI }ππ     DrawHorizBars;ππ     readln;π     Write_PCX (NameW); { PCX_W.TPU }π     closegraph;                    { Close graphics    }π     textmode (co80);               { back to text mode }πend.  { Write_PCX }ππ{πOK, everybody, I hope this gets you started. I had a lot ofπfun setting it up. There are some obvious places that needπoptimization... especially the disk intensive blockwrites. Ifπsomeone could please figure out holding about 4k or so in pointersπof the encoded PCX file before writing, I'd sure appreciate it!.π(please post for everyone, if you do.)ππ}                                                                           66     01-27-9413:32ALL                      GREG ESTABROOKS          Mode 13 Demo             SWAG9402            12     ╓   PROGRAM Mode13Demo;             { Oct 10/93, Greg Estabrooks.       }πVARπ   CurCol,π   OldMode:BYTE;π   CurPos,π   X,Y :WORD;π   ScrBuff :ARRAY[1..64000] OF BYTE;ππPROCEDURE SetVidMode( Mode :BYTE ); ASSEMBLER;π                {  Routine to set video mode                        }πASMπ  Mov AH,00                     {  Function to set mode             }π  Mov AL,Mode                   {  Mode to change to                }π  Int $10                       {  Call dos                         }πEND;{SetVidMode}ππPROCEDURE PutPixel( X,Y :WORD; Color :BYTE );πBEGINπ  Mem[$A000:(320*Y)+X]:= Color;πEND;ππBEGINπ  SetVidMode($13);              { Set Mode to 320x200x256.          }π  FOR Y := 0 To 199 DO          { Loop through all lines.           }π    FOR X := 0 To 319 DO        { Loop through all columns.         }π        PutPixel(X,Y,Random(255));π  CurCol := 0;π  CurPos := 0;π  FOR Y := 0 To 199 DO          { Loop through all lines.           }π   BEGINπ    Inc(CurCol);π    FOR X := 0 To 319 DO        { Loop through all columns.         }π     BEGINπ       Inc(CurPos);π       ScrBuff[CurPos] := CurCol;π     END;π   END;π  Writeln('Press Enter to see the Faster way!');π  Readln;π  Move(ScrBuff,Mem[$A000:0],SizeOf(ScrBuff));π  Readln;π  SetVidMode(3);                { Set Mode 3,80x25.                 }πEND.π                                                                                    67     01-27-9413:32ALL                      GREG ESTABROOKS          Misc Graphic Functions   SWAG9402            46     ╓   UNIT GrStuff;       {  Misc Graphic Functions, Last Updated  Nov 11/93 }π                    {  Copyright (C), Greg Estabrooks, 1993            }ππINTERFACEπ(***********************************************************************)ππFUNCTION MonitorType :BYTE;               {  Determines Monitor In Use  }πPROCEDURE SetVidMode( Mode :BYTE );       {  Set video mode             }πPROCEDURE SetPage( Page :BYTE );          {  Set current screen page    }πPROCEDURE BiosPutPix( Col,Page :BYTE;X,Y :WORD ); { Plot pixel at X,Y   }πFUNCTION TSeng :BOOLEAN;        {  Determine if graph card a TSENG labs }πFUNCTION GetVideoMode :BYTE;π                      {  Routine to determine current video mode        }πPROCEDURE Set80x30Mode;πPROCEDURE DrawBar( X1,Y1,X2,Y2 :WORD; Color :BYTE );πPROCEDURE SetColor( Color2Set, Red, Green, Blue :BYTE );πPROCEDURE GetColor( Color2Get :BYTE; VAR Red,Green,Blue :BYTE );ππIMPLEMENTATIONπ(***********************************************************************)πFUNCTION MonitorType :BYTE; ASSEMBLER;π                           {  Determines Type of Monitor In Use.        }πASMπ  Mov AH,$1A                    {  Function Determine Display Code      }π  Mov AL,0                      {  AL,0 = Read Code  AL,1 = Set Code    }π  Int $10                       {  Call Dos                             }π  Mov AL,BL;                    {  Move result to proper register       }π        {  0 - no Display       4 - Ega Standard Color     7 - VGA MONO }π        {  1 - MDA              5 - Ega MonoChrome         8 - VGA      }π        {  2 - CGA              6 - PGA                                 }πEND;{MonitorType}ππPROCEDURE SetVidMode( Mode :BYTE ); ASSEMBLER;π                {  Routine to set video mode                            }πASMπ  Mov AH,00                     {  Function to set mode                 }π  Mov AL,Mode                   {  Mode to change to                    }π  Int $10                       {  Call dos                             }πEND;{SetVidMode}ππPROCEDURE SetPage( Page :BYTE ); ASSEMBLER;π                {  Routine to change screen pages                       }πASMπ  Mov AH,$05                    {  Function to change pages             }π  Mov AL,Page                   {  Page to change to                    }π  Int $10                       {  Call dos                             }πEND;{SetPage}ππPROCEDURE BiosPutPix( Col,Page :BYTE; X,Y :WORD ); ASSEMBLER;π                {  Routine to plot a pixel on the screen using INT 10h. }πASMπ  Mov AH,$0C                    {  Function to plot a pixel             }π  Mov AL,Col                    {  Color to make it                     }π  Mov BH,Page;                  {  Page to write it to                  }π  Mov CX,X                      {  Column to put it at                  }π  Mov DX,Y                      {  Row to place it                      }π  Int $10                       {  call dos                             }πEND;{BiosPutPix}ππFUNCTION TSeng :BOOLEAN;π                {  Routine to determine if Graphics card is a TSENG labs}πVARπ        Old,New :BYTE;πBEGINπ  Old := Port[$3CD];            {  Save original card register value    }π  Port[$3CD] := $55;            {  change it                            }π  New := Port[$3CD];            {  read in new value                    }π  Port[$3CD] := Old;            {  restore old value                    }π  TSENG := ( New = $55 );       {  if value same as what we sent (TRUE) }πEND;ππFUNCTION GetVideoMode :BYTE; ASSEMBLER;π                      {  Routine to determine current video mode        }πASMπ  Mov AX,$0F00                  {  SubFunction Return Video Info        }π  Int $10                       {  Call Dos                             }πEND;{GetVideoMode}ππPROCEDURE Set80x30Mode;πVAR CrtcReg:ARRAY[1..8] OF WORD;π    Offset :WORD;π    I,Data :BYTE;πBEGINπ  CrtcReg[1]:=$0C11;           {Vertical Display End (unprotect regs. 0-7)}π  CrtcReg[2]:=$0D06;           {Vertical Total}π  CrtcReg[3]:=$3E07;           {Overflow}π  CrtcReg[4]:=$EA10;           {Vertical Retrace Start}π  CrtcReg[5]:=$8C11;           {Vertical Retrace End (& protect regs. 0-7)}π  CrtcReg[6]:=$DF12;           {Vertical Display Enable End}π  CrtcReg[7]:=$E715;           {Start Vertical Blanking}π  CrtcReg[8]:=$0616;           {End Vertical Blanking}ππ  MemW[$0040:$004C]:=8192;     {Change page size in bytes}π  Mem[$0040:$0084]:=29;        {Change page length}π  Offset:=MemW[$0040:$0063];   {Base of CRTRC}π  ASMπ    Cli                        {Clear Interrupts}π  END;ππ  FOR I:=1 TO 8 DOπ    PortW[Offset]:=CrtcReg[i]; {Load Registers}ππ  Data:=PORT[$03CC];π  Data:=Data AND $33;π  Data:=Data OR $C4;π  PORT[$03c2]:=Data;π  ASMπ   Sti                         {Set Interrupts}π   Mov AH,12h                  {Select alternate printing routine}π   Mov BL,20hπ   Int 10hπ  END;πEND; {Of Procedure}ππPROCEDURE DrawBar( X1,Y1,X2,Y2 :WORD; Color :BYTE );π                   { Bar drawing routine. Specifically set up for mode  }π                   { 13h. Much faster than the BGI one.                 }πVARπ   Row     :WORD;πBEGINπ  FOR Row := Y1 TO Y2 DOπ    FillChar(MEM[$A000:(320*Row)+X1],X2-X1,Color);πEND;πππPROCEDURE SetColor( Color2Set, Red, Green, Blue :BYTE );π                    { Routine to Change the palette value of Color2Set. }πBEGINπ    PORT[$3C8] := Color2Set;π    PORT[$3C9] := Red;π    PORT[$3C9] := Green;π    PORT[$3C9] := Blue;πEND;ππPROCEDURE GetColor( Color2Get :BYTE; VAR Red,Green,Blue :BYTE );π                    { Routine to determine the Palette value of Color2Get}πBEGINπ    PORT[$3C8] := Color2Get;π    Red := PORT[$3C9];π    Green := PORT[$3C9];π    Blue := PORT[$3C9];πEND;ππBEGINπEND.π                                                    68     01-27-9417:32ALL                      PETER KOLDING            3D Graphics Box          SWAG9402            52     ╓   {πFrom: PETER KOLDINGπSubj: 3D GraphicsππMB>  Hello, I'm trying to write a simple program that will plot points in threeπMB>  dimensions and allow you to rotate them,or view them from differentπangles.πMB>  need a lot of help. I'm trying to make a data file of points in the formatπMB>  (x,y,z) and then have the program read the points in to display. So far noπMB>  luck. If anyone has any code that is simple enough for me to understand IπMB>  would appreciate it. Also if anyone has any code for doing fast vgaπMB>  animations(in assembly) could they please post it? Thanks in advance.π}ππprogram boxrot;ππ{PUBLIC DOMAIN  1993 Peter M. Gruhn}ππ{Program draws a box on screen. Allows user to rotate the box aroundπ the three primary axes. Viewing transform is simple ignore z.}ππ{I used _Computer_Graphics:_Principles_and_Practice_, Foley et alπ ISBN 0-201-12110-7 as a reference}ππ{RUNNING:π Borland Pascal 7. Should run on any graphics device supported by BGI.π If you have smaller than 280 resolution, change '+200' to somethingπ smaller and/or change 75 to something smaller.ππ Since this machine isπ not really set up for doing DOS graphics, I hard coded my BGI path, soπ you have to find 'initgraph' and change the bgi path to something thatπ works on your machine. Try ''.πππ{Okey dokey. This is kinda slow, and does a nice job of demonstrating theπ problems of repeatedly modifying the same data set. That is, the more andπ more you rotate the box, the more and more distorted it gets. This isπ because computers are not perfect at calculations, and all of those littleπ errors add up quite quickly.ππ It's because of that that I used reals, not reals. I used floating pointπ because the guy doesn't know what is going on at all with 3d, so better toπ look at only the math that is really happening. Besides, I still have toπ think to use fixed point. Whaddaya want for .5 hour programming.ππ DIRECTIONS:π   ',' - rotates around the x axisπ   '.' - rotates around the y axisπ   '/' - rotates around the z axisπ   'q' - quitsππ   All rotations are done around global axes, not object axes.}ππuses graph,crt;ππconst radtheta=1{degrees}*3.1415926535{radians}/180{per degrees};π      {sin and cos on computers are done in radians.}ππtype tpointr=record   {Just a record to hold 3d points}π       x,y,z:real;π       end;ππvar box:array[0..7] of tpointr;   {The box we will manipulate}π    c:char;                    {Our input mechanism}ππprocedure init;πvar gd,gm:integer;π{turns on graphics and creates a cube. Since the rotation routinesπ rotate around the origin, I have centered the cube on the origin, soπ that it stays in place and only spins.} beginπ  gd:=detect; initgraph(gd,gm,'d:\turbo\tp\');π  box[0].x:=-75;  box[0].y:=-75;  box[0].z:=-75;π  box[1].x:=75;   box[1].y:=-75;  box[1].z:=-75;π  box[2].x:=75;   box[2].y:=75;   box[2].z:=-75;π  box[3].x:=-75;  box[3].y:=75;   box[3].z:=-75;π  box[4].x:=-75;  box[4].y:=-75;  box[4].z:=75;π  box[5].x:=75;   box[5].y:=-75;  box[5].z:=75;π  box[6].x:=75;   box[6].y:=75;   box[6].z:=75;π  box[7].x:=-75;  box[7].y:=75;   box[7].z:=75; end;ππprocedure myline(x1,y1,z1,x2,y2,z2:real); {Keeps the draw routine pretty.πPixels are integers, so I round. Since theπ cube is centered around 0,0 I move it over 200 to put it on screen.} beginπ{if you think those real mults are slow, here's some rounds too...}ππ{hey, you may wonder, what happened to the stinking z coordinate? Ah, says I,π this is the simplest of 3d viewing transforms. You just take the z coord outπ of things and boom. Looking straight down the z axis on the object. If I getπ inspired, I will add simple perspective transform to these.} {There, gotπinspired. Made mistakes. Foley et al are not very good atπ tutoring perspective and I'm kinda ready to be done and post this.}π  line(round(x1)+200,round(y1)+200,π       round(x2)+200,round(y2)+200);πend;ππprocedure draw;π{my model is hard coded. No cool things like vertex and edge and faceπ lists.}ππbeginπ  myline(box[0].x,box[0].y,box[0].z, box[1].x,box[1].y,box[1].z);π  myline(box[1].x,box[1].y,box[1].z, box[2].x,box[2].y,box[2].z);π  myline(box[2].x,box[2].y,box[2].z, box[3].x,box[3].y,box[3].z);π  myline(box[3].x,box[3].y,box[3].z, box[0].x,box[0].y,box[0].z);ππ  myline(box[4].x,box[4].y,box[4].z, box[5].x,box[5].y,box[5].z);π  myline(box[5].x,box[5].y,box[5].z, box[6].x,box[6].y,box[6].z);π  myline(box[6].x,box[6].y,box[6].z, box[7].x,box[7].y,box[7].z);π  myline(box[7].x,box[7].y,box[7].z, box[4].x,box[4].y,box[4].z);ππ  myline(box[0].x,box[0].y,box[0].z, box[4].x,box[4].y,box[4].z);π  myline(box[1].x,box[1].y,box[1].z, box[5].x,box[5].y,box[5].z);π  myline(box[2].x,box[2].y,box[2].z, box[6].x,box[6].y,box[6].z);π  myline(box[3].x,box[3].y,box[3].z, box[7].x,box[7].y,box[7].z);ππ  myline(box[0].x,box[0].y,box[0].z, box[5].x,box[5].y,box[5].z);π  myline(box[1].x,box[1].y,box[1].z, box[4].x,box[4].y,box[4].z); end;ππprocedure rotx;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x   [ 1  0  0  0   [x',y',z',1]π  y     0  c -s  0 =π  z     0  s  c  0π  1]    0  0  0  1]π}πvar i:integer;πbeginπ  setcolor(0);π  draw;π  for i:=0 to 7 doπ    beginπ    box[i].x:= box[i].x;π    box[i].y:= box[i].y*cos(radTheta) + box[i].z*sin(radTheta);π    box[i].z:=-box[i].y*sin(radTheta) + box[i].z*cos(radTheta);π    end;π  setcolor(15);π  draw;πend;ππprocedure roty;π{if you know your matrix multiplication, the following equationsπ are derived fromπ [x   [ c  0  s  0   [x',y',z',1]π  y     0  1  0  0 =π  z    -s  0  c  0π  1]    0  0  0  1]π}πvar i:integer;πbeginπ  setcolor(0);π  draw;π  for i:=0 to 7 doπ    beginπ    box[i].x:= box[i].x*cos(radTheta) - box[i].z*sin(radTheta);π    box[i].y:= box[i].y;π    box[i].z:= box[i].x*sin(radTheta) + box[i].z*cos(radTheta);π    end;π  setcolor(15);π  draw;πend;ππprocedure rotz;π{if you know your matrix multiplication, the following equationsπ are derived fromππ [x   [ c -s  0  0   [x',y',z',1]π  y     s  c  0  0 =π  z     0  0  1  0π  1]    0  0  0  1]π}πvar i:integer;πbeginπ  setcolor(0);π  draw;π  for i:=0 to 7 doπ    beginπ    box[i].x:= box[i].x*cos(radTheta) + box[i].y*sin(radTheta);π    box[i].y:=-box[i].x*sin(radTheta) + box[i].y*cos(radTheta);π    box[i].z:= box[i].z;π    end;π  setcolor(15);π  draw;πend;πππbeginπ  init;π  setcolor(14); draw;π  repeatπ    c:=readkey;π    case c ofπ      ',' : rotx;π      '.' : roty;π      '/' : rotz;π      else {who gives a};π      end; {case}π  until c='q';π  closegraph;πend.π                       69     01-27-9417:37ALL                      BAS VAN GAALEN           Moving a Shape across CRTSWAG9402            28     ╓   {πFrom: BAS VAN GAALENπSubj: Sin-curver Spritesπ---------------------------------------------------------------------------ππ OB>> 1. Scrolling 256c fonts Fast and Smooth.π OB>> 2. Now to do it on top of graphics...π OB>> 3. 3D object engine - If someone can post me one or direct meπ OB>> to build one.π OB>> 4. Shade Bobs/Whatever it called - Taking a shape and moving itπ OB>> across the screen when it leaves trail.  Then, moving againπ OB>> on the trail will couse a stronger color to appear. n' on...π OB>> 5. Moving floor that is NOT a couse of a palette rotetion.π OB>> 6. 2D Scale procedure.π OB>> 7. Centered Stars. And SMOOTH ones.π OB>> 8. Vector BallsππI don't want to give it all away, but I just made some Shaded-bobs (orπwhatever). It realy isn't difficult. It worked right away. Now YOU make a nicerπsin-curve and palette. Here's some source:ππ{ --- cut here --- }ππ{$G+}ππprogram ShadingBobs;πconstπ  Gseg : word = $a000;π  Sofs = 75; Samp = 75; Slen = 255;π  SprPic : array[0..15,0..15] of byte = (π    (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0),π    (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),π    (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),π    (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),π    (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),π    (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),π    (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),π    (1,1,1,1,2,2,3,4,4,3,2,2,1,1,1,1),π    (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),π    (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),π    (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),π    (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),π    (0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0),π    (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),π    (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),π    (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0));πtype SinArray = array[0..Slen] of word;πvar Stab : SinArray;ππprocedure CalcSinus; var I : word; beginπ  for I := 0 to Slen do Stab[I] := round(sin(I*4*pi/Slen)*Samp)+Sofs; end;ππprocedure SetGraphics(Mode : word); assembler; asmπ  mov ax,Mode; int 10h end;ππfunction keypressed : boolean; assembler; asmπ  mov ah,0bh; int 21h; and al,0feh; end;ππprocedure DrawSprite(X,Y : integer; W,H : byte; Sprite : pointer); assembler;πasmπ  push dsπ  lds si,[Sprite]π  mov es,Gsegπ  cldπ  mov ax,[Y]π  shl ax,6π  mov di,axπ  shl ax,2π  add di,axπ  add di,[X]π  mov bh,[H]π  mov cx,320π  sub cl,[W]π  sbb ch,0π @L:π  mov bl,[W]π @L2:π  lodsbπ  or al,alπ  jz @Sπ  mov dl,[es:di]π  add dl,alπ  mov [es:di],dlπ @S:π  inc diπ  dec blπ  jnz @L2π  add di,cxπ  dec bhπ  jnz @Lπ  pop dsπend;ππprocedure Retrace; assembler; asmπ  mov dx,3dah;π  @l1: in al,dx; test al,8; jnz @l1;π  @l2: in al,dx; test al,8; jz @l2; end;ππprocedure Setpalette;πvar I : byte;πbeginπ  for I := 0 to 255 do beginπ    port[$3c8] := I;π    port[$3c9] := I div 3;π    port[$3c9] := I div 2;π    port[$3c9] := I;π  end;πend;ππprocedure Bobs;πvar X,Y : integer; I,J : byte;πbeginπ  I := 0; J := 25;π  repeatπ    X := 2*Stab[I]; Y := Stab[J];π    inc(I); inc(J);π    Retrace;π    DrawSprite(X,Y,16,16,addr(SprPic));π  until keypressed;πend;ππbeginπ  CalcSinus;π  SetGraphics($13);π  SetPalette;π  Bobs;π  SetGraphics(3);πend.ππ{ DrawSprite procedure taken from Sean Palmer (again).π  It contained some minor bugs: [X] was added to AX, should be DI, andπ  jz @S was jnz @S, so the sprite wasn't drawn. Now it is...π  And of course it was changed to INCREASE the video-mem, not to poke it.ππ  If you get rid of the Retrace it goes a LOT faster. }ππ                                                                                                                 70     01-27-9417:46ALL                      SEAN PALMER              3D Landscape Source      SWAG9402            23     ╓   {πFrom: SEAN PALMERπSubj: 3d Landscape srcπ---------------------------------------------------------------------------πCheck it out! Clean-room reverse-engineering of something pretty damnπsimilar to Comanche's patented Voxel-space technology... In Turbo!!ππ{by Sean Palmer}π{use I,J,K,L to look around, ESC ends}ππuses crt;ππconstπ xSize=256;           {90 degrees}π ySize=128;           {60 degrees}π angleMask=xSize*4-1; {xSize must be power of 2 or and's won't work}π mapSize=128;ππvarπ sinTab:array[0..angleMask]of integer;  {sin(xyAngle)*$7FFF}π tanTab:array[0..ySize-1]of integer; {tan(zAngle)*$7FFF}ππ map:array[0..mapSize-1,0..mapSize-1]of byte;ππtypeπ fixed=record case boolean ofπ  false:(l:longint);π  true:(f:word;i:integer);π  end;ππprocedure drawScene(x,y,z,rot:integer);πvar lastTan,lastAngle,h:integer;π    mapTan:longint;πvar scrn:word;πvar color,height:byte;πvar xs,ys,ds:longint;πvar xp,yp,dp:fixed;πbeginπ fillchar(mem[$A000:0],320*200,0);π for h:=0 to xSize-1 do beginπ  lastAngle:=0;π  scrn:=h+320*(ySize-1);π  lastTan:=tanTab[lastAngle];π  xp.i:=x; xp.f:=0;π  yp.i:=y; yp.f:=0;π  dp.l:=0;π  xs:=longint(sinTab[(h+rot-(xSize shr 1))and angleMask])*2;π  ys:=longint(sinTab[(h+rot-(xSize shr 1)+xSize)and angleMask])*2; {cos}π  ds:=$FFFE;π  inc(xp.l,xs*16);π  inc(yp.l,ys*16);π  inc(dp.l,ds*16);π  while lastAngle<ySize do beginπ   inc(xp.l,xs*2);π   inc(yp.l,ys*2);π   inc(dp.l,ds*2);π   inc(xs,xs div 32);π   inc(ys,ys div 32);π   inc(ds,ds shr 5);π   if word(xp.i)>mapSize-1 thenπ    break;π   if word(yp.i)>mapSize-1 thenπ    break;π   height:=map[xp.i,yp.i];π   mapTan:=(longint(height-z)*$7FFF)div dp.i;π   color:=32+(z-height);π   while(lastTan<=mapTan)and(lastAngle<ySize)do beginπ    mem[$A000:scrn]:=color;π    dec(scrn,320);π    inc(lastAngle);π    lastTan:=tanTab[lastAngle];π    end;π   end;π  end;π end;πππprocedure initTables; var i:integer; r:real; beginπ for i:=0 to angleMask doπ  sinTab[i]:=round(sin(i*pi/512)*$7FFF);π for i:=0 to ySize-1 do beginπ  r:=(i-64)*pi/(3*ySize);π  tanTab[i]:=round(sin(r)/cos(r)*$7FFF);π  end;π end;ππprocedure initMap; var x,y:integer; beginπ for x:=0 to 127 doπ  for y:=0 to 127 doπ   map[x,y]:=((longint(sinTab[(y*21-12)and angleMask])+sinTab[(x*31+296)and angleMask]div 2)shr 12)+120;π end;πππvar c:char;π x,y,z,r,a:integer;π i:word;ππbeginπ asm mov ax,$13; int $10; end;π initTables;π initMap;π randomize;π x:=50+random(29);π y:=50+random(29);π z:=125+random(10);π r:=random(angleMask);π a:=64;π repeatπ  drawScene(x,y,z,r);π  c:=upcase(readkey);π  case c ofπ   'I':if tanTab[ySize-1]<30000 then for i:=0 to ySize-1 do inc(tanTab[i],500);π   'K':if tanTab[0]>-30000 then for i:=0 to ySize-1 do dec(tanTab[i],500);π   'J':r:=(r-32)and angleMask;π   'L':r:=(r+32)and angleMask;π   end;π  until c=^[;π textMode(lastMode);π end.ππ                71     01-27-9417:46ALL                      BERNIE PALLEK            MODE 13H Graphics Unit   SWAG9402            60     ╓   {πFrom: BERNIE PALLEKπSubj: GRAF_13H.PASπ---------------------------------------------------------------------------π}π(**************************************************)π(*                                                *)π(*         GRAPHICS ROUTINES FOR MODE 13H         *)π(*         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~         *)π(*        320x200x256 (linearly-addressed)        *)π(*  Collected from routines in the Public Domain  *)π(*          Assembled by Bernie Pallek            *)π(*                                                *)π(**************************************************)ππ{ DISCLAIMER: Use this unit at your own risk.  I will not be liableπ              for anything negative resulting from use of this unit. }ππUNIT Graf_13h;ππINTERFACEππCONSTπ  Color : Byte = 0;ππTYPEπ  RGBPalette = Array[0..767] of Byte;ππFUNCTION  GetVideoMode : Byte;πPROCEDURE SetVideoMode(desiredVideoMode : Byte);πFUNCTION  GetPixel(pix2get_x, pix2get_y : Word) : Byte;πPROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);πPROCEDURE Ellipse(exc, eyc, ea, eb : Integer);πPROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);πPROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);πPROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);πPROCEDURE BurstSetPalette(burstPalette : RGBPalette);πPROCEDURE ScaleBitmap(VAR bmp2scale; bwidth, bheight : Byte;π  bstrtx, bstrty, bendx, bendy : Word);πPROCEDURE WaitForRetrace;πPROCEDURE ClearScr;πππIMPLEMENTATIONπππ{ private type used by ScaleBitmap() }πTYPEπ  Fixed = RECORD CASE Boolean OFπ    True  : (w : LongInt);π    False : (f, i : Word);π  END;ππFUNCTION GetVideoMode : Byte;πVARπ  tempVMode : Byte;πBEGINπ  ASMπ    mov ah,$0fπ    int $10π    mov tempvmode,alπ  END;π  GetVideoMode := tempVMode;πEND;ππPROCEDURE SetVideoMode(desiredVideoMode : Byte);π{ desiredVideoMode = $03 : 80x25 colour textπ                     $13 : 320x200x256 monoplanedπ                           video data from $A000:0000 to $A000:FFFFπ}πBEGINπ  ASMπ    mov ah,0π    mov al,desiredvideomode;π    int $10π  END;πEND;ππFUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;πBEGINπ  GetPixel := Mem[$A000 : pix2get_y * 320 + pix2get_x];πEND;ππPROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);πBEGINπ  Mem[$A000 : pix2set_y * 320 + pix2set_x] := pix2set_c;πEND;ππ{ originally by Sean Palmer, I just mangled it  :^) }πPROCEDURE Ellipse(exc, eyc, ea, eb : Integer);πVARπ  elx, ely : Integer;π  aa, aa2, bb, bb2, d, dx, dy : LongInt;πBEGINπ  elx := 0; ely := eb; aa := LongInt(ea) * ea; aa2 := 2 * aa;π  bb := LongInt(eb) * eb; bb2 := 2 * bb;π  d := bb - aa * eb + aa DIV 4; dx := 0; dy := aa2 * eb;π  SetPixel(exc, eyc - ely, Color); SetPixel(exc, eyc + ely, Color);π  SetPixel(exc - ea, eyc, Color); SetPixel(exc + ea, eyc, Color);ππ  WHILE (dx < dy) DO BEGINπ    IF (d > 0) THEN BEGIN Dec(ely); Dec(dy, aa2); Dec(d, dy); END;π    Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);π    SetPixel(exc + elx, eyc + ely, Color);π    SetPixel(exc - elx, eyc + ely, Color);π    SetPixel(exc + elx, eyc - ely, Color);π    SetPixel(exc - elx, eyc - ely, Color);π  END;π  Inc(d, (3 * (aa - bb) DIV 2 - (dx + dy)) DIV 2);π  WHILE (ely > 0) DO BEGINπ    IF (d < 0) THEN BEGIN Inc(elx); Inc(dx, bb2); Inc(d, bb + dx); END;π    Dec(ely); Dec(dy, aa2); Inc(d, aa - dy);π    SetPixel(exc + elx, eyc + ely, Color);π    SetPixel(exc - elx, eyc + ely, Color);π    SetPixel(exc + elx, eyc - ely, Color);π    SetPixel(exc - elx, eyc - ely, Color);π  END;πEND;ππ{ originally by Sean Palmer, I just mangled it }πPROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);πVARπ  lndd, lndx, lndy, lnai, lnbi, lnxi, lnyi : Integer;πBEGINπ  IF (lnx1 < lnx2) THEN BEGIN lnxi := 1; lndx := lnx2 - lnx1;π  END ELSE BEGIN lnxi := (-1); lndx := lnx1 - lnx2; END;π  IF (lny1 < lny2) THEN BEGIN lnyi := 1; lndy := lny2 - lny1;π  END ELSE BEGIN lnyi := (-1); lndy := lny1 - lny2; END;π  SetPixel(lnx1, lny1, Color);π  IF (lndx > lndy) THEN BEGIN lnai := (lndy - lndx) * 2;π    lnbi := lndy * 2;π    lndd := lnbi - lndx;π    REPEAT IF (lndd >= 0) THEN BEGIN Inc(lny1, lnyi);π      Inc(lndd, lnai); END ELSE Inc(lndd, lnbi);π      Inc(lnx1, lnxi); SetPixel(lnx1, lny1, Color);π    UNTIL (lnx1 = lnx2);π  END ELSE BEGIN lnai := (lndx - lndy) * 2; lnbi := lndx * 2;π    lndd := lnbi - lndy;π    REPEAT IF (lndd >= 0) THEN BEGIN Inc(lnx1, lnxi);π      Inc(lndd, lnai); END ELSE Inc(lndd, lnbi);π      Inc(lny1, lnyi); SetPixel(lnx1, lny1, Color);π    UNTIL (lny1 = lny2);π  END;πEND;ππPROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);π{ returns the r, g, and b values of a palette index }πBEGINπ  Port[$3C7] := index2get;π  r_inte := Port[$3C9];π  g_inte := Port[$3C9];π  b_inte := Port[$3C9];πEND;ππPROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);π{ sets the r, g, and b values of a palette index }πBEGINπ  Port[$3C8] := index2set;π  Port[$3C9] := r_inte;π  Port[$3C9] := g_inte;π  Port[$3C9] := b_inte;πEND;ππPROCEDURE BurstSetPalette(burstPalette : RGBPalette);πVARπ  burstCount : Word;πBEGINπ  Port[$3C8] := 0;π  FOR burstCount := 0 TO 767 DO Port[$3C9] := burstPalette[burstCount];πEND;ππ{ originally by Sean Palmer, I just mangled it }πPROCEDURE ScaleBitmap(VAR bmp2scale; bwidth, bheight : Byte;π  bstrtx, bstrty, bendx, bendy : Word);π{ - bmp2scale is an array [0..bwidth, 0..bheight] of byte      }π{   which contains the original bitmap                         }π{ - bwidth and bheight are the actual width - 1 and the actual }π{   height - 1 of the normal bitmap                            }π{ - bstrtx and bstrty are the x and y values for the upper-    }π{   left-hand corner of the scaled bitmap                      }π{ - bendx and bendy are the lower-right-hand corner of the     }π{   scaled version of the original bitmap                      }π{ - eg. to paste an unscaled version of a bitmap that is 64x64 }π{   pixels in size in the top left-hand corner of the screen,  }π{   fill the array with data and call:                         }π{     ScaleBitmap(bitmap, 64, 64, 0, 0, 63, 63);               }π{ - to create an array for the bitmap, make it like this:      }π{     VAR myBitmap : Array[0..bmpHeight, 0..bmpWidth] of Byte; }π{   where bmpHeight is the actual height of the normal-size    }π{   bitmap less one, and bmpWidth is the actual width less one }πVARπ  bmp_sx, bmp_sy, bmp_cy : Fixed;π  bmp_s, bmp_w, bmp_h    : Word;ππBEGINπ  bmp_w := bendx - bstrtx + 1; bmp_h := bendy - bstrty + 1;π  bmp_sx.w := bwidth * $10000 DIV bmp_w;π  bmp_sy.w := bheight * $10000 DIV bmp_h;π  bmp_s := 320 - bmp_w; bmp_cy.w := 0;π  ASMπ    push ds; mov ds,word ptr bmp2scale + 2;π    mov ax,$a000; mov es,ax; cld; mov ax,320;π    mul bstrty; add ax,bstrtx; mov di,ax;π   @l2:π    mov ax,bmp_cy.i; mul bwidth; mov bx,ax;π    add bx,word ptr bmp2scale;π    mov cx,bmp_w; mov si,0; mov dx,bmp_sx.f;π   @l:π    mov al,[bx]; stosb; add si,dx; adc bx,bmp_sx.i;π    loop @l;π    add di,bmp_s; mov ax,bmp_sy.f; mov bx,bmp_sy.i;π    add bmp_cy.f,ax; adc bmp_cy.i,bx;π    dec word ptr bmp_h; jnz @l2; pop ds;π  END;πEND;ππPROCEDURE WaitForRetrace;π{ waits for a vertical retrace to reduce flicker }πBEGINπ  REPEAT UNTIL (Port[$3DA] AND 8) = 8;πEND;ππPROCEDURE ClearScr;πBEGINπ  FillChar(Mem[$A000:0000], 64000, 0);πEND;ππEND.  { of unit }ππThat's it!  It's not complete, but it's meant as a starter for all who areπinterested in VGA graphics.  Happy programming!ππBernie.πππ--- Maximus/2 2.01wbπ * Origin: * idiot savant * [phone] * (1:247/128)π                                     72     02-03-9409:18ALL                      SEAN PALMER              RIP Bezier Curves        SWAG9402            23     ╓   {πFrom: SEAN PALMERπSubj: RIP Bezier Curveπ---------------------------------------------------------------------------π NO> Does anyone have any code for constructing a RIP Bezier curve that isπ NO> exactly the same as the one used by Telegrafix developers. I have someπ NO> code that comes close, but close isn't good enough. I need this to beπ NO> dead on accurate.π NO> PS. I'm willing to share my code with others that are interested inπ NO> RIP.ππ{Public domain by Sean Palmer}π{converted from Steve Enns' original Basic subroutines by Sean Palmer}ππvar color:byte;πprocedure plot(x,y:word);beginπ mem[$A000:y*320+x]:=color;π end;ππtypeπ coord=record x,y:integer; end;π CurveDataRec=array[0..65521 div sizeof(coord)]of coord;ππprocedure drawBSpline(var d0:coord;nPoints,nSteps:word);π const nsa=1/6; nsb=2/3;π varπ  i,i2,xx,yy:integer;π  t,ta,t2,t2a,t3,t3a,nc1,nc2,nc3,nc4,step:real;π  d:curveDataRec absolute d0;πbeginπ step:=1/nSteps;π for i:=0 to nPoints-4 do beginπ  color:=i+32+2;π  t:=0.0;π  for i2:=pred(nSteps)downto 0 do beginπ   t:=t+step;π   ta:=t*0.5; t2:=t*t; t2A:=t2*0.5; t3:=t2*t; t3A:=t3*0.5;π   nc1:=-nsa*t3+t2A-ta+nsa;π   nc2:=t3a-t2+nsb;π   nc3:=-t3a+t2a+ta+nsa;π   nc4:=nsa*t3;π   xx:=round(nc1*d[i].x+nc2*d[succ(i)].x+nc3*d[i+2].x+nc4*d[i+3].x);π   yy:=round(nc1*d[i].y+nc2*d[succ(i)].y+nc3*d[i+2].y+nc4*d[i+3].y);π   plot(xx,yy);π   end;π  end;π end;ππprocedure drawBezier(var d0:coord;nPoints,nSteps:word);π const nsa=1/6; nsb=2/3;π varπ  i,i2,i3,xx,yy:integer;π  t,tm3,t2,t2m3,t3,t3m3,nc1,nc2,nc3,nc4,step:real;π  d:curveDataRec absolute d0;πbeginπ step:=1/nSteps;π for i2:=0 to pred(nPoints) div 4 do beginπ  i:=i2*4;π  t:=0.0;π  for i3:=pred(nSteps) downto 0 do beginπ   t:=t+step;π   tm3:=t*3.0; t2:=t*t; t2m3:=t2*3.0; t3:=t2*t; t3m3:=t3*3.0;π   nc1:=1-tm3+t2m3-t3;π   nc2:=t3m3-2.0*t2m3+tm3;π   nc3:=t2m3-t3m3;π   nc4:=t3;ππ   xx:=round(nc1*d[i].x+nc2*d[succ(i)].x+nc3*d[i+2].x+nc4*d[i+3].x);π   yy:=round(nc1*d[i].y+nc2*d[succ(i)].y+nc3*d[i+2].y+nc4*d[i+3].y);π   plot(xx,yy);π   end;π  end;π end;ππconst numpoints=40;ππvar c:array[-1..2+numPoints]of coord;πvar i:integer;πbeginπ asm mov ax,$13; int $10; end;  {init vga/mcga graphics}π randomize;π for i:=1 to numPoints do with c[i] do beginπ  x:=i*(319 div numPoints);    {for precision demo}π {x:=random(320);}             {for fun demo}π  y:=random(200);π  end;π for i:=1 to numPoints div 2 do c[i*2+1].y:=c[i*2].y;    {fit closer}π for i:=1 to numPoints do with c[i] do begin color:=i+32; plot(x,y); end;π c[-1]:=c[1]; c[0]:=c[1];  {replicate end points so curves fit to input}π c[numPoints+1]:=c[numPoints]; c[numPoints+2]:=c[numPoints];π drawBSpline(c[-1],numPoints+4,256); {set third parm to 256 for precision, 64 f}π readln;π asm mov ax,3; int $10; end;  {text mode again}π end.ππ                                           73     02-03-9409:19ALL                      SCOTT BRADSHAW           More RIP Bezier Curves   SWAG9402            11     ╓   {πFrom: SCOTT BRADSHAWπSubj: RIP BEZIER CURVESπ---------------------------------------------------------------------------πWell, I had a whole RIP unit I made for Turbo Pascal over the modem,πbut it got lost in a HD crash. I am really not that interested inπRIP anymore, but I will give you mu source to the Bezier Curve. Itπshould be pretty close to what your looking for...π}πprogram bezier;πuses graph,crt;ππprocedure Bezier_2D_Curve( x, y, cx,cy,a,b,ca,cb:integer;incr:real);πvarπ   qx, qy :real;π   q1, q2, q3, q4:real;π   plotx, ploty:integer;π   t:real;ππ    beginπ      t := 0;π    while (t <= 1) do beginπ      q1 := t*t*t*-1 + t*t*3 + t*-3 + 1;π      q2 := t*t*t*3 + t*t*-6 + t*3;π      q3 := t*t*t*-3 + t*t*3;π      q4 := t*t*t;π      qx := q1*x + q2*cx + q3*a + q4*ca;π      qy := q1*y + q2*cy + q3*b + q4*cb;π      plotx := round(qx);π      ploty := round(qy);π      putpixel( plotx, ploty, 15);π      t := t + incr;π   end;πend;ππvar gd,gm:integer;π    c:char;πbeginπ   gd := VGA;π   gm := VGAHI;π   initgraph(gd,gm,'\turbo\tp');π   setcolor( BLUE );π   Bezier_2D_Curve( 100, 400, 25, 450, 120, 275, 300, 455,0.003 );π   c:=readkey;π   Bezier_2D_Curve( 310, 200, 360, 150, 510, 200, 460, 250,0.003 );π   c:=readkey;πend.ππ                                            74     02-03-9409:19ALL                      NICK ONOUFRIOU           Another Bezier Curve     SWAG9402            12     ╓   {πFrom: NICK ONOUFRIOUπSubj: RIP Bezier Curvesπ---------------------------------------------------------------------------πSP> I can't post the code I have that IS Telegrafix-compatible (for obviousπSP> reasons) but if you post your code I can try and modify it to make itπSP> work correctly.ππHere it is. It comes close, but can't get it to create the same curves thatπTelegrafix creates. Thanks for any help Sean. Are you writing the RIP codeπfor TELIX?π}ππprocedure DrawBezierCurve(px1,py1,px2,py2,px3,py3,px4,py4,count : integer);ππfunction pow(x : real; y : word) : real;πvarπ  nt     : word;π  result : real;πbeginπ result := 1;π for nt := 1 to y doπ     result := result * x;π pow := result;πend;ππprocedure Bezier(t : real; var x, y : integer);πbeginπ x := round(pow(1 - t, 3) * px1 + 3 * t * pow(1 - t, 2) * px2 +π                3 * t * t * (1 - t) * px3 + pow(t, 3) * px4);π y := round(pow(1 - t, 3) * py1 + 3 * t * pow(1 - t, 2) * py2 +π                3 * t * t * (1 - t) * py3 + pow(t, 3) * py4);πend;ππvarπ resolution,t : real;π xc, yc       : integer;πbeginπ        if count = 0 then exit;π        resolution:=1/count;ππ        Moveto(px1,py1);π        t := 0;π        while t < 1 do beginπ           Bezier(t, xc, yc);π           lineto(xc, yc);π           t := t + resolution;π        end;π        LineTo(px4,py4);πend;ππ                                                                     75     02-03-9410:55ALL                      FIASAL JUMA              Fire Graphic             SWAG9402            89     ╓   {π---------------------------------------------------------------------------ππ    This is a PD source that I came across not too long ago.. It displays aπsimulation of flames or fire.. Its pretty good..π}ππ{*        credit were given, however. If you have any improvements,       *}π{*        find any bugs etc. mail me at [e-mail]        *}π{*        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 [e-mail]        *}π{*        with MARK: in the subject header.                               *}π{*                                                                        *}π{**************************************************************************}πππuses crt;ππConst pal : array [1..768] of Byte =( 0,  0,  0,  0,  0, 24,  0,  0, 24,  0,π0, 28,π                          0,  0, 32,  0,  0, 32,  0,  0, 36,  0,  0, 40,π                           8,  0, 40, 16,  0, 36, 24,  0, 36, 32,  0, 32,π                          40,  0, 28, 48,  0, 28, 56,  0, 24, 64,  0, 20,π                          72,  0, 20, 80,  0, 16, 88,  0, 16, 96,  0, 12,π                         104,  0,  8,112,  0,  8,120,  0,  4,128,  0,  0,π                         128,  0,  0,132,  0,  0,136,  0,  0,140,  0,  0,π                         144,  0,  0,144,  0,  0,148,  0,  0,152,  0,  0,π                         156,  0,  0,160,  0,  0,160,  0,  0,164,  0,  0,π                         168,  0,  0,172,  0,  0,176,  0,  0,180,  0,  0,π                         184,  4,  0,188,  4,  0,192,  8,  0,196,  8,  0,π                         200, 12,  0,204, 12,  0,208, 16,  0,212, 16,  0,π                         216, 20,  0,220, 20,  0,224, 24,  0,228, 24,  0,π                         232, 28,  0,236, 28,  0,240, 32,  0,244, 32,  0,π                         252, 36,  0,252, 36,  0,252, 40,  0,252, 40,  0,π                         252, 44,  0,252, 44,  0,252, 48,  0,252, 48,  0,π                         252, 52,  0,252, 52,  0,252, 56,  0,252, 56,  0,π                         252, 60,  0,252, 60,  0,252, 64,  0,252, 64,  0,π                         252, 68,  0,252, 68,  0,252, 72,  0,252, 72,  0,π                         252, 76,  0,252, 76,  0,252, 80,  0,252, 80,  0,π                         252, 84,  0,252, 84,  0,252, 88,  0,252, 88,  0,π                         252, 92,  0,252, 96,  0,252, 96,  0,252,100,  0,π                         252,100,  0,252,104,  0,252,104,  0,252,108,  0,π                         252,108,  0,252,112,  0,252,112,  0,252,116,  0,π                         252,116,  0,252,120,  0,252,120,  0,252,124,  0,π                         252,124,  0,252,128,  0,252,128,  0,252,132,  0,π                         252,132,  0,252,136,  0,252, 136,   0,252, 140,   0,π                         252, 140,   0,252, 144,   0,252, 144,   0,252, 148,π0,π                         252, 152,   0,252, 152,   0,252, 156,   0,252, 156,π0,π                         252, 160,   0,252, 160,   0,252, 164,   0,252, 164,π0,π                         252, 168,   0,252, 168,   0,252, 172,   0,252, 172,π0,π                         252, 176,   0,252, 176,   0,252, 180,   0,252, 180,π0,π                         252, 184,   0,252, 184,   0,252, 188,   0,252, 188,π0,π                         252, 192,   0,252, 192,   0,252, 196,   0,252, 196,π0,π                         252, 200,   0,252, 200,   0,252, 204,   0,252, 208,π0,π                         252, 208,   0,252, 208,   0,252, 208,   0,252, 208,π0,π                         252, 212,   0,252, 212,   0,252, 212,   0,252, 212,π0,π                         252, 216,   0,252, 216,   0,252, 216,   0,252, 216,π0,π                         252, 216,   0,252, 220,   0,252, 220,   0,252, 220,π0,π                         252, 220,   0,252, 224,   0,252, 224,   0,252, 224,π0,π                         252, 224,   0,252, 228,   0,252, 228,   0,252, 228,π0,π                         252, 228,   0,252, 228,   0,252, 232,   0,252, 232,π0,π                         252, 232,   0,252, 232,   0,252, 236,   0,252, 236,π0,π                         252, 236,   0,252, 236,   0,252, 240,   0,252, 240,π0,ππ--- Maximus 2.01wbπ * Origin: *THE K-W AMATEUR RADIO BBS-(VE3MTS)* ->DS16.8<- (1:221/177)π===========================================================================π BBS: Canada Remote SystemsπDate: 12-02-93 (17:45)             Number: 46963πFrom: FIASAL JUMA                  Refer#: NONEπ  To: ALL                           Recvd: NO  πSubj: Fire II                        Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πContinue.....ππ                252, 244,   0,252, 244,   0,252, 244,   0,252, 248,   0,π                252, 248,   0,252, 248,   0,252, 248,   0,252, 252,   0,π                252, 252,   4,252, 252,   8,252, 252,  12,252, 252,  16,π                252, 252,  20,252, 252,  24,252, 252,  28,252, 252,  32,π                252, 252,  36,252, 252,  40,252, 252,  40,252, 252,  44,π                252, 252,  48,252, 252,  52,252, 252,  56,252, 252,  60,π                252, 252,  64,252, 252,  68,252, 252,  72,252, 252,  76,π                252, 252,  80,252, 252,  84,252, 252,  84,252, 252,  88,π                252, 252,  92,252, 252,  96,252, 252, 100,252, 252, 104,π                252, 252, 108,252, 252, 112,252, 252, 116,252, 252, 120,π                252, 252, 124,252, 252, 124,252, 252, 128,252, 252, 132,π                252, 252, 136,252, 252, 140,252, 252, 144,252, 252, 148,π                252, 252, 152,252, 252, 156,252, 252, 160,252, 252, 164,π                252, 252, 168,252, 252, 168,252, 252, 172,252, 252, 176,π                252, 252, 180,252, 252, 184,252, 252, 188,252, 252, 192,π                252, 252, 196,252, 252, 200,252, 252, 204,252, 252, 208,π                252, 252, 208,252, 252, 212,252, 252, 216,252, 252, 220,π                252, 252, 224,252, 252, 228,252, 252, 232,252, 252, 236,π                252, 252, 240,252, 252, 244,252, 252, 248,252, 252, 252);πππtype bigarr=array[0..102,0..159] of integer;πvar f:bigarr;π    i,j,k,l:word;π    delta:integer;π    pal:array[0..255,1..3] of byte;π    ch:char;ππprocedure setmode13;πassembler;πasmπ  mov ax,13hπ  int 10hπend;ππprocedure setpalette;πvar mapfile:text;π    i,j:integer;ππbeginπ  for j:=1 to 768 doπ  beginπ    pal[j]:=pal[j] shr 2;π  end;ππ  asmπ    mov si,offset palπ    mov cx,768π    mov dx,03c8hπ    xor al,alπ    out dx,alπ    inc dxπ@1:π    outsbπ    dec cxπ    jnz @1π  end;πend;ππbeginπ  setmode13;π  setpalette;π  randomize;π  ch:=' ';π  for i:=0 to 102 doπ  for j:=0 to 159 doπ    f[i,j]:=0;        {initialise array}ππ  repeatπ    asm                {move lines up, averaging}π      mov cx,16159;    {no. elements to change}π      mov di,offset fπ      add di,320   {di points to 1st element of f in upper row (320 bytes/row)}π@1:π      mov ax,ds:[di-2]π      add ax,ds:[di]π      add ax,ds:[di+2]π      add ax,ds:[di+320]π      shr ax,2     {divide by 4: average 4 elements of f}π      jz @2π      sub ax,1π@2:   mov word ptr ds:[di-320],axπ      add di,2π      dec cxπ      jnz @1    {faster than _loop_ on 486}π    end;πππ    for j:=0 to 159 do  {set new bottom line}π    beginπ      if random<0.4 thenπ        delta:=random(2)*255;π      f[101,j]:=delta;π      f[102,j]:=delta;π    end;ππ--- Maximus 2.01wbπ * Origin: *THE K-W AMATEUR RADIO BBS-(VE3MTS)* ->DS16.8<- (1:221/177)π===========================================================================π BBS: Canada Remote SystemsπDate: 12-02-93 (17:47)             Number: 46964πFrom: FIASAL JUMA                  Refer#: NONEπ  To: ALL                           Recvd: NO  πSubj: Fire III                       Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πContinue..ππ    asm                 {output to screen}π      mov si,offset fπ      mov ax,0a000hπ      mov es,axπ      mov di,0π      mov dx,100π@3:π      mov bx,2π@2:π      mov cx,160π@1:π      mov al,[si]π      mov ah,alπ      mov es:[di],ax     {word aligned write to display mem}π      add di,2π      add si,2π      dec cxπ      jnz @1ππ      sub si,320π      dec bxπ      jnz @2ππ      add si,320π      dec dxπ      jnz @3π    end;π    if keypressed then ch:=readkey;π  until ch=#27;π  asm   {restore text mode}π    mov ax,03hπ    int 10hπ  end;πend.ππ      There is a million things you can do to modify that code to look betterπor run faster.. Making it work in modex is one good possibility and its notπthat hard.. laterπ                                                                                                               76     02-03-9410:58ALL                      SWAG SUPPORT TEAM        Writing Text in Graphics SWAG9402            31     ╓   (*πWrite a unit, that assigns an text file to the Graphics Screen and thenπassign output with this proc, then use rewrite(output) and you canπuse write/writeln in Graphics mode as well. Don't forgetπAssign(output,'');rewrite(output) orπCrtAssign(output);rewrite(output) when back in Text Mode!πYou can even implement read/readln in graphics mode, but this is moreπ complicated.πOne difference to text mode: use MoveTo instead of GotoXY!ππI've neither my unit nor the TP manual available just now,πbut it works like this (output only!):π*)πunit GrpWrite;ππinterfaceππuses Graph,Dos,BGIFont,BGIDriv;ππprocedure GraphAssign(var F:text);ππimplementationπ{$R-,S-}ππvarπ  GraphDriver, GraphMode, Error : integer;π  a : string;ππprocedure Abort(Msg : string);πbeginπ  Writeln(Msg, ': ', GraphErrorMsg(GraphResult));π  Halt(1);πend;ππ{$F+} {DO NOT FORGET}ππfunction GraphFlush(var F:TextRec):integer;πbeginπ  GraphFlush := 0;πend;ππfunction GraphClose(var F:TextRec):integer;π beginπ   GraphClose := 0;π end;       {There's nothing to close}πππfunction GraphWrite(var F:TextRec):integer;π varπ  s : string;π  P : word;π beginπ with F doπ beginπ   P := 0;π   while P<BufPos doπ   beginπ     OutText(BufPtr^[P]);π     Inc(P);π   end;π   BufPos := 0;π end;π{               (may need more than one OutText...)}π  (*... {Clear buffer}*)π  GraphWrite := 0;π end;πππfunction GraphOpen(var F:TextRec):integer;π beginπ   { Register all the drivers }π  if RegisterBGIdriver(@CGADriverProc) < 0 thenπ    Abort('CGA');π  if RegisterBGIdriver(@EGAVGADriverProc) < 0 thenπ    Abort('EGA/VGA');π  if RegisterBGIdriver(@HercDriverProc) < 0 thenπ    Abort('Herc');π  if RegisterBGIdriver(@ATTDriverProc) < 0 thenπ    Abort('AT&T');π  if RegisterBGIdriver(@PC3270DriverProc) < 0 thenπ    Abort('PC 3270');πππ  { Register all the fonts }π  if RegisterBGIfont(@GothicFontProc) < 0 thenπ    Abort('Gothic');π  if RegisterBGIfont(@SansSerifFontProc) < 0 thenπ    Abort('SansSerif');π  if RegisterBGIfont(@SmallFontProc) < 0 thenπ    Abort('Small');π  if RegisterBGIfont(@TriplexFontProc) < 0 thenπ    Abort('Triplex');ππ  GraphDriver := Detect;                  { autodetect the hardware }π  InitGraph(GraphDriver, GraphMode, '');  { activate graphics }π  if GraphResult <> grOk then             { any errors? }π  beginπ    Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));π    Halt(1);π  end;π  with F doπ  beginπ  Closefunc:=@GraphClose;π  InOutFunc:=@GraphWrite;π  FlushFunc:=@GraphFlush;π  end;π  GraphOpen := 0;π(*  ... {Initialisations, see your TP manual}*)π end;π{$F-}πprocedure GraphAssign;π beginπ  with TextRec(F) doπ   beginπ     Mode := fmClosed;π     BufSize := SizeOf(Buffer);π     BufPtr := @Buffer;π     Name[0] := #0;π     OpenFunc:= @GraphOpen;π    {You can make some initialisations already here}π   endπ end;πend.π=================WRTGRTST.PAS follows==================π{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}π{$M 16384,0,655360}πuses Crt,π     Graph,     { library of graphics routines }π     GrWrite;πvarπ  GraphDriver, GraphMode, Error : integer;π  a : string;π  GrOutput:Text;ππprocedure Abort(Msg : string);πbeginπ  Writeln(Msg, ': ', GraphErrorMsg(GraphResult));π  Halt(1);πend;ππbeginπ GraphAssign(Output);  {Standard output to graphics screen}π {$I-}π rewrite(Output); {actually calls GraphOpen}π  {$I+}π if IoResult <> 0 then halt;ππ(* ....*)π MoveTo(65,90);π a := 'this is a string';π write('this is an embedded string');   {write to graphics screen}π MoveTo(65,120);π write(' and this is the second');π Close(Output); {nothing shows on the screen until this is executed}π ReadLn(a);π CloseGraph;π {Standard output to text screen}π Assign(output,'');π rewrite(output);π GotoXY(5,20); {THIS WORKS}π write(a);{nothing happens here}             {write to textscreen}πend.ππ                                        77     02-03-9416:17ALL                      OLAF BARTELT             Loading PCX Files        SWAG9402            24     ╓   {ππ SL> Does someone has a pascalsource for showing a PCX file with a resolutionπ SL> of 640x400x256 /or a automatic build-in convertor who wil let the drawingππSure thing, the following code will load PCX files with 256 colors and variableπheight and width (it looks into the header):  (Sorry about the german comments,πbut I've got no time to erase them right now :-(( ) }ππUNIT uVESAPcx;                                { (c) 1993 by NEBULA-Software }π     { PCX-Darstellungsroutinen f. VESA     } { Olaf Bartelt & Oliver Carow }ππINTERFACE                                     { Interface-Teil der Unit     }ππ{ ───────────────────────────────── Typen ───────────────────────────────── }πTYPE  pVESAPcx   = ^tVESAPcx;                 { Zeiger auf Objekt           }π      tVESAPcx   = OBJECT                     { Objekt für PCX-Dateien      }π                     PROCEDURE load(f : STRING; dx, dy : WORD);π                   END;ππ{ ──────────────────────────────── Variablen ────────────────────────────── }πVAR   vVESAPcx  : pVESAPcx;                   { Instanz des Objekts tPcx    }πππIMPLEMENTATION                                { Implementation-Teil d. Unit }ππUSES uVesa;                                   { Einbinden der Units         }π{ CAN BE FOUND IN SWAG }ππ{ ──────────────────────────────── tVESAPcx ─────────────────────────────── }πPROCEDURE  tVESAPcx.load(f : STRING; dx, dy : WORD);πVAR q                          : FILE;π    b                          : ARRAY[0..2047] OF BYTE;π    anz, pos, c, w, h, e, pack : WORD;π    x, y                       : WORD;ππLABEL ende_background;ππBEGINπ  x := 0; y := 0;ππ  ASSIGN(q, f); {$I-} RESET(q, 1); {$I+}π  IF IORESULT <> 0 THENπ    GOTO ende_background;ππ  BLOCKREAD(q, b, 128, anz);π  IF (b[0] <> 10) OR (b[3] <> 8) THENπ  BEGINπ    CLOSE(q);π    EXIT;π  END;π  w := SUCC((b[9] - b[5]) SHL 8 + b[8] - b[4]);π  h := SUCC((b[11] - b[7]) SHL 8 + b[10] - b[6]);π  pack := 0; c := 0; e := y + h;π  REPEATπ    BLOCKREAD(q, b, 2048, anz);π    pos := 0;π    WHILE (pos < anz) AND (y < e) DOπ    BEGINπ      IF pack <> 0 THENπ      BEGINπ        FOR c := c TO c + pack DOπ          vVesa^.putpixel(x + c+dx, y+dy, b[pos]);π        pack := 0;π      ENDπ      ELSEπ        IF (b[pos] AND $C0) = $C0 THENπ          pack := b[pos] AND $3Fπ        ELSEπ        BEGINπ          vVesa^.putpixel(x + c+dx, y+dy, b[pos]);π          INC(c);π        END;π      INC(pos);π      IF c = w THENπ      BEGINπ        c := 0;π        INC(y);π      END;π    END;π  UNTIL (anz = 0) OR (y = e);π  SEEK(q, FILESIZE(q) - 3 SHL 8 - 1);π  BLOCKREAD(q, b, 3 SHL 8 + 1);π  IF b[0] = 12 THENπ    FOR x := 1 TO 3 SHL 8 + 1 DOπ      b[x] := b[x] SHR 2;π  CLOSE(q);ππ  ende_background:πEND;πππ{ ────────────────────────────── Hauptprogramm ──────────────────────────── }πBEGINπ  NEW(vVESAPcx);πEND.ππRemember to put in *your* putpixel routines there!ππscroll from top till bottom.(VGA/SVGAcompat./TPASCAL6.0)ππ     78     02-03-9416:18ALL                      DON LABARRE              Making VGA Rain          SWAG9402            13     ╓   {πIt's not often that I post anything but since I started getting into it Iπfigured I'd post something worth while. Heres some code I wrote to produce someπ"blood" rain. It isn't much but it's cool to look at :)ππ{This code is release freely to anyone that wants it. I couldn't care lessπ what you do with it. It is being used in my demo so if I see it in yoursπ i will find you and kill you. Nemesis 1994}ππprogram rain;πvar p:integer;ππfunction keypressed : boolean; assembler; asmπ  mov ah,0bh; int 21h; and al,0feh; end;ππProcedure RotatePal;πVar a:Word;πBeginπ  inc(p);π  port[968]:=35;π  a:=100;ππ  while port[$3da] and 8 <> 0 do;π  while port[$3da] and 8 = 0 do;ππ  while a>1 doπ  beginπ    port[969]:=1-((a+p) and 60);π    port[969]:=0;π    {If you want a better palette selection and more play then removeπ     the above line and replace with the one below. It will allow youπ     to get to the blues and greens and yellows but I made mine red soπ     did not require those}π    {port[969]:=1-((a+p) and 60);}π    port[969]:=1-((a+p) and 65);π    dec(a);π    end;πend;ππProcedure makerain;πVarπ  x,y,c,d:word;πbeginπ  d:=1;π  randomize;π  for x:=0 to 320 doπ  Beginπ    c:=random(65);π    for y:=0 to 200 doπ    Beginπ      if c>64 then c:=1;π      mem[$a000:x+320*y]:=c+35;π      inc(c,d);π    end;π    d:=random(5)+1;π  end;πend;πππbeginπasmπ  mov ax,$0013π  int 10hπ  end;πmakerain;πrepeatπRotatePal;πuntil keypressed;πasmπ  mov ax,$0002π  int 10hπend;πend.ππ                                                                 79     02-03-9416:19ALL                      BAS VAN GAALEN           Vector coding            SWAG9402            39     ╓   π{$g+}πprogram rotationalfield;π{ Source by Bas van Gaalen, Holland, PD }πuses crt,dos;πconstπ  gseg : word = $a000;π  dots = 459;π  dist : word = 250;π  sintab : array[0..255] of integer = (π    0,3,6,9,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,60,63,66,68,π    71,74,76,79,81,84,86,88,91,93,95,97,99,101,103,105,106,108,110,111,π    113,114,116,117,118,119,121,122,122,123,124,125,126,126,127,127,127,π    128,128,128,128,128,128,128,127,127,127,126,126,125,124,123,122,122,π    121,119,118,117,116,114,113,111,110,108,106,105,103,101,99,97,95,93,π    91,88,86,84,81,79,76,74,71,68,66,63,60,58,55,52,49,46,43,40,37,34,31,π    28,25,22,19,16,13,9,6,3,0,-3,-6,-9,-13,-16,-19,-22,-25,-28,-31,-34,π    -37,-40,-43,-46,-49,-52,-55,-58,-60,-63,-66,-68,-71,-74,-76,-79,-81,π    -84,-86,-88,-91,-93,-95,-97,-99,-101,-103,-105,-106,-108,-110,-111,π    -113,-114,-116,-117,-118,-119,-121,-122,-122,-123,-124,-125,-126,π    -126,-127,-127,-127,-128,-128,-128,-128,-128,-128,-128,-127,-127,π    -127,-126,-126,-125,-124,-123,-122,-122,-121,-119,-118,-117,-116,π    -114,-113,-111,-110,-108,-106,-105,-103,-101,-99,-97,-95,-93,-91,π    -88,-86,-84,-81,-79,-76,-74,-71,-68,-66,-63,-60,-58,-55,-52,-49,π    -46,-43,-40,-37,-34,-31,-28,-25,-22,-19,-16,-13,-9,-6,-3);πtypeπ  dotrec = record x,y,z : integer; end;π  dotpos = array[0..dots] of dotrec;πvar dot : dotpos;ππ{----------------------------------------------------------------------------}ππprocedure setpal(col,r,g,b : byte); assembler; asmπ  mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,rπ  out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;ππprocedure setvideo(mode : word); assembler; asmπ  mov ax,mode; int 10h end;ππfunction esc : boolean; beginπ  esc := port[$60] = 1; end;ππ{----------------------------------------------------------------------------}ππprocedure init;πvar i : word; x,z : integer;πbeginπ  i := 0;π  z := -100;π  while z < 100 do beginπ    x := -100;π    while x < 100 do beginπ      dot[i].x := x;π      dot[i].y := -45;π      dot[i].z := z;π      inc(i);π      inc(x,10);π    end;π    inc(z,9);π  end;π  for i := 0 to 63 do setpal(i,0,i,i);πend;ππ{----------------------------------------------------------------------------}ππprocedure rotation;πconst yst = 1;πvarπ  xp : array[0..dots] of word;π  yp : array[0..dots] of byte;π  x,z : integer; n : word; phiy : byte;πbeginπ  asm mov phiy,0; mov es,gseg; cli; end;π  repeatπ    asmπ      mov dx,03dahπ     @l1:π      in al,dxπ      test al,8π      jnz @l1π     @l2:π      in al,dxπ      test al,8π      jz @l2π    end;π    setpal(0,0,0,10);π    for n := 0 to dots do beginπ      asmπ        mov si,nπ        mov al,byte ptr yp[si]π        cmp al,200π        jae @skipπ        shl si,1π        mov bx,word ptr xp[si]π        cmp bx,320π        jae @skipπ        shl ax,6π        mov di,axπ        shl ax,2π        add di,axπ        add di,bxπ        xor al,alπ        mov [es:di],alπ       @skip:π      end;ππ      x := (sintab[(phiy+192) mod 255] * dot[n].xπ     {^^^^  ^^^^^^^^^^^^^^^^^^^^^^^^^^ ^ ^^^^^^^^π      9     1                          3 2 }ππ            - sintab[phiy] * dot[n].z) div 128;π          { ^ ^^^^^^^^^^^^ ^ ^^^^^^^^  ^^^^^^^π            7 4            6 5         8 }ππ      (*π      asmπ        xor ah,ah                      { 1 }π        mov al,phiyπ        add al,192π        mov si,axπ        mov ax,word ptr sintab[si]π        mov si,n                       { 2 }π        mov dx,word ptr dot[si].xπ        mul dx                         { 3 }π        mov cx,axπ        mov dx,word ptr dot[si].z      { 5 }π        mov al,phiy                    { 4 }π        mov si,axπ        mov ax,word ptr sintab[si]π        mul dx                         { 6 }π        sub cx,ax                      { 7 }π        shr cx,7                       { 8 }π        mov x,cx                       { 9 }π      end;π      *)ππ      z := (sintab[(phiy+192) mod 255]*dot[n].z+sintab[phiy]*dot[n].x) div 128;π      xp[n] := 160+(x*dist) div (z-dist);π      yp[n] := 100+(dot[n].y*dist) div (z-dist);ππ      {π      asmπ        mov ax,xπ        mov dx,distπ        mul dxπ        mov dx,zπ        sub dx,distπ        div dxπ        add ax,160ππ        (* can't assign ax to xp[n] !? *)ππ      end;π      }ππ      asmπ        mov si,nπ        mov al,byte ptr yp[si]π        cmp al,200π        jae @skipπ        shl si,1π        mov bx,word ptr xp[si]π        cmp bx,320π        jae @skipπ        shl ax,6π        mov di,axπ        shl ax,2π        add di,axπ        add di,bxπ        mov ax,zπ        shr ax,3π        add ax,30π        mov [es:di],alπ       @skip:π      end;π    end;π    asm inc phiy end;π    setpal(0,0,0,0);π  until esc;π  asm sti end;πend;ππ{----------------------------------------------------------------------------}ππbeginπ  setvideo($13);π  Init;π  rotation;π  textmode(lastmode);πend.π        80     02-05-9407:56ALL                      BAS VAN GAALEN           Moving landscape         SWAG9402            41     ╓   π{ NEEDS A MOUSE !!!πAnd here as promised to several fellows, the moving landscape!πIt needs a mouse, as you can see...πAgain nothing realy nifty (imho), no bankswitching, no mode-x, no virtualπscreens, no palette tricks, just some hard math! ;-) Have fun with it...ππ--- cut here ---}ππprogram landscape_2d;π{ 2D landscape (without rotating). Made by Bas van Gaalen, Holland, PD }πconstπ  vseg = $a000;π  a_density = 4;π  roughness = 20;π  maxx_scape = 320; maxy_scape = 200;π  maxh = 128;π  maxx = 250 div a_density; maxy = 110 div a_density;πvar landscape : array[0..maxx_scape*maxy_scape] of byte;ππ{ mouse routines ------------------------------------------------------------}ππfunction mouseinstalled : boolean; assembler; asmπ  xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;ππfunction getmousex : word; assembler; asmπ  mov ax,3; int 33h; mov ax,cx end;ππfunction getmousey : word; assembler; asmπ  mov ax,3; int 33h; mov ax,dx end;ππfunction leftpressed : boolean; assembler; asmπ  mov ax,3; int 33h; and bx,1; mov ax,bx end;ππprocedure mousesensetivity(x,y : word); assembler; asmπ  mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;ππprocedure mousewindow(l,t,r,b : word); assembler; asmπ  mov ax,7; mov cx,l; mov dx,r; int 33h; mov ax,8π  mov cx,t; mov dx,b; int 33h end;ππ{ lowlevel video routines ---------------------------------------------------}ππprocedure setvideo(m : word); assembler; asmπ  mov ax,m; int 10h end;ππprocedure putpixel(x,y : word; c : byte); assembler; asmπ  mov ax,vseg; mov es,ax; mov ax,y; mov dx,320; mul dxπ  mov di,ax; add di,x; mov al,c; mov [es:di],al end;ππfunction getpixel(x,y : word) : byte; assembler; asmπ  mov ax,vseg; mov es,ax; mov ax,y; mov dx,320; mul dxπ  mov di,ax; add di,x; mov al,[es:di] end;ππprocedure setpal(c,r,g,b : byte); assembler; asmπ  mov dx,03c8h; mov al,c; out dx,al; inc dx; mov al,rπ  out dx,al; mov al,g; out dx,al; mov al,b; out dx,al end;ππprocedure retrace; assembler; asmπ  mov dx,03dah; @l1: in al,dx; test al,8; jnz @l1π  @l2: in al,dx; test al,8; jz @l2 end;ππ{ initialize palette colors -------------------------------------------------}ππprocedure initcolors;πvar i : byte;πbeginπ  for i := 0 to 63 do beginπ    setpal(i+1,21+i div 3,21+i div 3,63-i);π    setpal(i+65,42-i div 3,42+i div 3,i div 3);π  end;πend;ππ{ landscape generating routines ---------------------------------------------}ππprocedure adjust(xa,ya,x,y,xb,yb : integer);πvar d,c : integer;πbeginπ  if getpixel(x,y) <> 0 then exit;π  d := abs(xa-xb)+abs(ya-yb);π  c := (50*(getpixel(xa,ya)+getpixel(xb,yb))+trunc((10*random-5)*d*roughness))πdiv 100;π  if c < 1 then c := 1;π  if c >= maxh then c := maxh;π  putpixel(x,y,c);πend;ππprocedure subdivide(l,t,r,b : integer);πvar x,y : integer; c : integer;πbeginπ  if (r-l < 2) and (b-t < 2) then exit;π  x := (l+r) div 2; y := (t+b) div 2;π  adjust(l,t,X,t,r,t);π  adjust(r,t,r,Y,r,b);π  adjust(l,b,X,b,r,b);π  adjust(l,t,l,Y,l,b);π  if getpixel(x,y) = 0 then beginπ    c := (getpixel(l,t)+getpixel(r,t)+getpixel(r,b)+getpixel(l,b)) div 4;π    putpixel(x,y,c);π  end;π  subdivide(l,t,x,y);π  subdivide(x,t,r,y);π  subdivide(l,y,x,b);π  subdivide(x,y,r,b);πend;ππprocedure generatelandscape;πvar image : file; vidram : byte absolute vseg:0000; i : word;πbeginπ  assign(image,'plasma.img');π  {$I-} reset(image,1); {$I+}π  if ioresult <> 0 then beginπ    randomize;π    putpixel(0,0,random(maxh));π    putpixel(maxx_scape-1,0,random(maxh));π    putpixel(maxx_scape-1,maxy_scape-1,random(maxh));π    putpixel(0,maxy_scape-1,random(maxh));π    subdivide(0,0,maxx_scape,maxy_scape);π    rewrite(image,1);π    blockwrite(image,mem[vseg:0],maxx_scape*maxy_scape);π  end else blockread(image,mem[vseg:0],maxx_scape*maxy_scape);π  close(image);π  move(vidram,landscape,sizeof(landscape));π  fillchar(vidram,maxx_scape*maxy_scape,0);π  for i := 0 to maxx_scape*maxy_scape-1 do landscape[i] := 110+Landscape[i] divπ2;πend;ππ{ the actual displaying of the whole thing! ---------------------------------}ππprocedure displayscape;πvar i,j,previ,prevj,n : word; x : integer;πbeginπ  i := 0; j := 0;π  repeatπ    {retrace;}π    previ := i; i := getmousex; prevj := j; j := getmousey;π    for n := 0 to maxx*maxy-1 do beginπ      x := -(a_density*(integer(n mod maxx)-(maxx shr 1)-1)*45) div (integer(nπdiv maxx)-45)-90;π      if (x >= -250) and (X <= 60) then beginπ        mem[vseg:320*(a_density*integer(n div maxx)-landscape[n modπmaxx+previ+(n div maxx+prevj)*maxx_scape])+x] := 0;π        mem[vseg:320*(a_density*integer(n div maxx)-landscape[n mod maxx+i+(nπdiv maxx+j)*maxx_scape])+x] :=π          landscape[(integer(n mod maxx)+i)+(integer(n divπmaxx)+j)*maxx_scape]-100;π      end;π    end;π  until leftpressed;πend;ππ{ main routine --------------------------------------------------------------}ππbeginπ  if mouseinstalled then beginπ    setvideo($13);π    initcolors;π    generatelandscape;π    mousewindow(0,0,maxx_scape-maxx,maxy_scape-maxy);π    mousesensetivity(25,25);π    displayscape;π    setvideo(3);π  end else writeln('This interactive thing realy needs a mouse...');πend.ππ                        81     02-09-9411:50ALL                      DAVID DAHL               CheckerBoard             SWAG9402            46     ╓   πProgram CheckerBoard;ππ{=============================================ππ             CheckerBoard Exampleπ           Programmed by David Dahlπ                  01/06/94π   This program and source are PUBLIC DOMAINππ ---------------------------------------------ππ   This program is an example of how to makeπ   a moving 3D checkerboard pattern on theπ   screen like many demos do.ππ   This program requires VGA.ππ =============================================}ππUses CRT;ππConst TileMaxX = 10;  { Horiz Size Of Tile }π      TileMaxY = 10;  { Vert Size Of Tile }ππ      ViewerDist = 400;  { Distance Of Viewer From Screen }ππType TileArray = Array [0..TileMaxX-1, 0..TileMaxY-1] of Byte;ππ     PaletteRec  = Recordπ                         Red,π                         Green,π                         Blue  : Byte;π                   End;π     PaletteType = Array[0..255] of PaletteRec;πππVar Tile    : TileArray;π    TilePal : PaletteType;ππProcedure GoMode13; Assembler;πASMπ   MOV AX, $0013π   INT $10πEnd;ππ{-[ Set Value Of All DAC Registers ]--------------------------------------}πProcedure SetPalette (Var PalBuf : PaletteType); Assembler;πAsmπ    PUSH DSππ    XOR AX, AXπ    MOV CX, 0300h / 2π    LDS SI, PalBufππ    MOV DX, 03C8hπ    OUT DX, ALππ    INC DXπ    MOV BX, DXπ    CLDππ    MOV DX, 03DAhπ    @VSYNC0:π      IN   AL, DXπ      TEST AL, 8π    JZ @VSYNC0ππ    MOV DX, BXπ    repπ       OUTSBππ    MOV BX, DXπ    MOV CX, 0300h / 2πππ    MOV DX, 03DAhπ    @VSYNC1:π      IN   AL, DXπ      TEST AL, 8π    JZ @VSYNC1ππ    MOV DX, BXπ    REPπ       OUTSBππ    POP DSπEnd;π{-[ Get Value Of All DAC Registers ]--------------------------------------}πProcedure GetPalette (Var PalBuf : PaletteType); Assembler;πAsmπ    PUSH DSππ    XOR AX, AXπ    MOV CX, 0300hπ    LES DI, PalBufππ    MOV DX, 03C7hπ    OUT DX, ALπ    INC DXππ    REPπ       INSBππ    POP DSπEnd;π{-[ Only Set DAC Regs 1 Through (TileMaxX * TileMaxY) ]-------------------}πProcedure SetTileColors (Var PalBuf : PaletteType); Assembler;πASMπ   PUSH DSππ   MOV CX, TileMaxX * TileMaxY * 3π   MOV AX, 1π   LDS SI, PalBufπ   INC SIπ   INC SIπ   INC SIπ   MOV DX, 03C8hπ   OUT DX, ALπ   INC DXπ   MOV BX, DXππ   MOV DX, 03DAhπ   @VSYNC0:π     IN   AL, DXπ     TEST AL, 8π   JZ @VSYNC0ππ   MOV DX, BXπ   REPπ      OUTSBππ   POP DSπEnd;π{-[ Define The Bitmap Of The Tile ]---------------------------------------}πProcedure DefineTile;πVar CounterX,π    CounterY  : Word;πBeginπ     For CounterY := 0 to TileMaxY-1 doπ         For CounterX := 0 to TileMaxX-1 doπ             Tile[CounterX, CounterY] := 1 + CounterX +π                                         (CounterY * TileMaxX);πEnd;π{-[ Define The Colors Of The Tile ]---------------------------------------}πProcedure DefinePalette;πVar PalXCounter : Byte;π    PalYCounter : Byte;π    PalSize     : Byte;πBeginπ     GetPalette (TilePal);ππ     PalSize := (TileMaxX * TileMaxY);ππ     For PalYCounter := 1 to PalSize doπ     With TilePal[PalYCounter] doπ     Beginπ          Red   := 0;π          Green := 0;π          Blue  := 63;π     End;ππ     For PalYCounter := 0 to ((TileMaxY - 1) DIV 2) doπ         For PalXCounter := 0 to ((TileMaxX - 1) DIV 2) doπ         Beginπ              With TilePal[1 + PalXCounter + (PalYCounter*TileMaxX)] doπ              Beginπ                   Red   := 63;π                   Green := 63;π                   Blue  := 63;π              End;ππ              With TilePal[1 + (TileMaxX DIV 2) +π                               PalXCounter +π                               ((TileMaxY DIV 2) * TileMaxX) +π                               (PalYCounter*TileMaxX)] doπ              Beginπ                   Red   := 63;π                   Green := 63;π                   Blue  := 63;π              End;π         End;ππEnd;π{-[ Display Tiles On Screen ]---------------------------------------------}πProcedure DisplayCheckerBoard;πVar CounterX,π    CounterY  : Integer;ππ    X,π    Y,π    Z         : LongInt;πBeginπ     For CounterY := 110 to 199 doπ     Beginπ          Z := -1600 + (CounterY * 16) + ViewerDist;ππ          If Z = 0 THEN Z :=1;ππ          For CounterX := 0 to 319 doπ          Beginππ               X := 159 + (longInt(CounterX - 159 ) * ViewerDist) DIV Z;ππ               Y := (LongInt(CounterY + 100) * ViewerDist) DIV Z;ππ               MEM[$A000:CounterX + (CounterY * 320)] :=π                   Tile[X MOD TileMaxX, Y MOD TileMaxY]π          End;π     End;ππEnd;π{-[ Rotate The Palette Of The Board To Give Illusion Of Movement Over It ]-}πProcedure MoveForwardOverBoard;πType  TempPalType = Array[1..TileMaxX] of PaletteRec;πVar   TempPal     : TempPalType;π      CounterX,π      CounterY    : Word;πBeginπ     For CounterX := 1 to TileMaxX doπ         TempPal[CounterX] := TilePal[CounterX];ππ     For CounterY := 0 to (TileMaxY-1) doπ         For CounterX := 0 to (TileMaxX-1) doπ             TilePal[1 + CounterX + (CounterY * TileMaxX)] :=π                    TilePal[1 + CounterX + ((CounterY+1) * TileMaxX)];ππ     For CounterX := 1 to TileMaxX doπ         TilePal[CounterX + ((TileMaxY-1) * TileMaxX)] :=π                TempPal[CounterX];πEnd;π{-[ Flush the Keyboard Buffer ]--------------------------------------------}πProcedure FlushKeyboard;πVar Key : Char;πBeginπ     While KeyPressed doπ           Key := ReadKey;πEnd;ππ{=[ Main Program ]=========================================================}πBeginππ     GoMode13;π     DefineTile;π     DefinePalette;ππ     SetPalette(TilePal);ππ     DisplayCheckerboard;ππ     FlushKeyboard;ππ     Repeatπ           MoveForwardOverBoard;π           SetTileColors(TilePal);π     Until KeyPressed;ππ     FlushKeyboard;ππ     TextMode(C80);πEnd.π                                                                                           82     02-18-9406:59ALL                      LENNERT BAKKER           Textmode Effects         SWAG9402            128    ╓   π{Hi Dudes...ππDunno if you can do anything with this code; It sure is crappy!πAnywayzz, this kinda looks nice on my computer but I'm not sureπon how the timing will be on other systems... Might cause aπhelluvalot of flicker...ππWell, what can I say? Have Phun 8-)}ππProgram LooksLikeSomeTextModeEffectsToMe_YeahIGuessSo;ππ{$X+,E-,N-,I-,S-,R-,O-}ππType BigChar=Array[1..3,1..3] of Byte;π     MoveRecord = Recordπ                   XPos,YPos : Integer;π                   XSpeed,YSpeed : Integer;π                   Counter : Word;π                  End;ππConst BigFont : Array[1..40] of BigChar = (π      ((192,196,182),(195,196,191),(188,032,188)), {A}π      ((192,196,182),(195,196,191),(193,196,183)), {B}π      ((192,196,190),(187,032,032),(193,196,190)), {C}π      ((192,190,187),(187,032,187),(193,196,183)), {D}π      ((192,196,190),(195,190,032),(193,196,190)), {E}π      ((192,196,190),(195,190,032),(188,032,032)), {F}π      ((192,196,190),(187,194,182),(193,196,183)), {G}π      ((189,032,189),(195,196,191),(188,032,188)), {H}π      ((194,196,190),(032,187,032),(194,196,190)), {I}π      ((192,196,182),(195,196,191),(188,032,198)), {J}π      ((192,196,182),(195,196,191),(188,032,198)), {K}π      ((189,032,032),(187,032,032),(193,196,190)), {L}π      ((192,196,182),(187,189,187),(188,188,188)), {M}π      ((192,196,182),(187,032,187),(188,032,188)), {N}π      ((192,196,182),(187,032,187),(193,196,183)), {O}π      ((192,196,182),(187,032,187),(187,194,183)), {P}π      ((192,196,182),(195,196,191),(188,032,198)), {Q}π      ((192,196,182),(195,196,198),(188,032,197)), {R}π      ((192,196,190),(193,196,182),(194,196,183)), {S}π      ((194,196,190),(032,187,032),(032,188,032)), {T}π      ((189,032,189),(187,032,187),(193,196,183)), {U}π      ((189,032,187),(188,032,187),(194,196,183)), {V}π      ((189,189,189),(187,188,187),(193,196,183)), {W}π      ((189,032,189),(192,196,183),(188,032,187)), {X}π      ((189,032,189),(193,196,183),(032,188,032)), {Y}π      ((192,196,182),(195,196,191),(188,032,198)), {Z}π      ((032,032,032),(032,032,032),(185,185,185)), {...}π      ((032,187,032),(032,188,032),(032,185,032)), {!}π      ((192,196,182),(187,186,187),(193,196,183)), {0}π      ((194,182,032),(032,187,032),(194,196,190)), {1}π      ((194,196,182),(192,196,183),(193,196,190)), {2}π      ((194,196,182),(032,194,191),(194,196,183)), {3}π      ((189,032,189),(193,196,191),(032,032,188)), {4}π      ((192,196,190),(193,196,182),(194,196,183)), {5}π      ((192,196,190),(195,196,182),(193,196,183)), {6}π      ((194,196,182),(032,032,187),(032,032,188)), {7}π      ((192,196,182),(195,196,191),(193,196,183)), {8}π      ((192,196,182),(193,196,191),(194,196,183)), {9}π      ((032,032,032),(194,196,190),(032,032,032)), {-}π      ((032,032,032),(032,032,032),(032,032,032)));{ }ππ      ScrWidth : Word = 160;π      StartDat : Array[0..15] of Byte = (8,0,1,2,3,4,5,6,7,6,5,4,3,2,1,0);π      BarRes   = 270;π      BarRad   = 260 Div 2;π      Mes      : String = '';ππ      ScrollMessage : String = 'Hi there possoms! howst hanging. How about some simple TextMode Scroller.    ';π      ScrollOfs     : Byte = 9;π      ScrollPos     : Byte = 0;π      CharOfs       : Byte = 2;πππVar BarCols  : Array[0..399] of Byte;π    Bars     : Array[1..4] of Recordπ                               StartCol : Byte;π                               YPos     : Integer;π                              End;π    BarPos   : Array[1..BarRes] of Integer;π    MyPal    : Array[0..767] of Byte;π    MoveMes,MoveSplit : MoveRecord;ππProcedure CharMap; Assembler;πAsmπ  db      0,0,0,0,0,0,192,240,248,252,252,60,60,60,60,60           {┐}π  db      60,60,60,60,60,252,252,248,240,192,0,0,0,0,0,0           {┘}π  db      24,60,60,60, 60,60,60,60, 60,60,60,24, 0,0,0,0π  db      0,0,0,0, 60,126,255,255, 255,255,126,60, 0,0,0,0π  db      96,240,240,248, 248,120,124,60, 60,62,30,31, 31,15,15,6π  db      60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60π  db      60,60,60,60,60,60,60,60,60,60,60, 24, 0,0,0,0π  db      0,0,0,0, 24,60,60,60,60,60,60,60,60,60,60,60π  db      0,0,0,0,0,0,254,255,255,254,0,0,0,0,0,0           {->}π  db      60,60,60,60,60,124,252,252,252,252,124,60,60,60,60,60π  db      0,0,0,0,0,0,3,15,31,63,62,62,60,60,60,60          {┌}π  db      60,60,60,60,62,62,63,31,15,3,0,0,0,0,0,0          {└}π  db      0,0,0,0,0,0,127,255,255,127,0,0,0,0,0,0           {<-}π  db      60,60,60,60,60,62,63,63, 63,63,62,60, 60,60,60,60 {├}π  db      0,0,0,0,0,0,255,255,255,255,0,0,0,0,0,0           {─}π  db      240,120,120,120,120,120,60,60, 60,60,60,24, 0,0,0,0   {\}π  db      60,60,60,60,60,252,252,248,240,224,224,240,240,240,240,240πEnd;ππProcedure SetCharset; Assembler;πAsmπ Push Bpπ mov ax,cs                       { Set character set for logo }π mov es,axπ mov bp,cs:offset charmapπ mov ax,1100hπ mov bx,1000hπ mov cx,17π mov dx,182π int 10hπ Pop BpπEnd;ππProcedure Standard_Palette; Assembler;  { DP ][ Ext. Compatible }πAsmπdb 0,0,0,0,0,42,0,42,0,0,42,42,42,0,0,42,0,42,42,21,0,42,42πdb 42,21,21,21,21,21,63,21,63,21,21,63,63,63,21,21,63,21,63,63,63,21,63πdb 63,63,59,59,59,55,55,55,52,52,52,48,48,48,45,45,45,42,42,42,38,38,38πdb 35,35,35,31,31,31,28,28,28,25,25,25,21,21,21,18,18,18,14,14,14,11,11πdb 11,8,8,8,63,0,0,59,0,0,56,0,0,53,0,0,50,0,0,47,0,0,44πdb 0,0,41,0,0,38,0,0,34,0,0,31,0,0,28,0,0,25,0,0,22,0,0πdb 19,0,0,16,0,0,63,54,54,63,46,46,63,39,39,63,31,31,63,23,23,63,16πdb 16,63,8,8,63,0,0,63,42,23,63,38,16,63,34,8,63,30,0,57,27,0,51πdb 24,0,45,21,0,39,19,0,63,63,54,63,63,46,63,63,39,63,63,31,63,62,23πdb 63,61,16,63,61,8,63,61,0,57,54,0,51,49,0,45,43,0,39,39,0,33,33πdb 0,28,27,0,22,21,0,16,16,0,52,63,23,49,63,16,45,63,8,40,63,0,36πdb 57,0,32,51,0,29,45,0,24,39,0,54,63,54,47,63,46,39,63,39,32,63,31πdb 24,63,23,16,63,16,8,63,8,0,63,0,0,63,0,0,59,0,0,56,0,0,53πdb 0,1,50,0,1,47,0,1,44,0,1,41,0,1,38,0,1,34,0,1,31,0,1πdb 28,0,1,25,0,1,22,0,1,19,0,1,16,0,54,63,63,46,63,63,39,63,63πdb 31,63,62,23,63,63,16,63,63,8,63,63,0,63,63,0,57,57,0,51,51,0,45πdb 45,0,39,39,0,33,33,0,28,28,0,22,22,0,16,16,23,47,63,16,44,63,8πdb 42,63,0,39,63,0,35,57,0,31,51,0,27,45,0,23,39,54,54,63,46,47,63πdb 39,39,63,31,32,63,23,24,63,16,16,63,8,9,63,0,1,63,0,0,63,0,0πdb 59,0,0,56,0,0,53,0,0,50,0,0,47,0,0,44,0,0,41,0,0,38,0πdb 0,34,0,0,31,0,0,28,0,0,25,0,0,22,0,0,19,0,0,16,60,54,63πdb 57,46,63,54,39,63,52,31,63,50,23,63,47,16,63,45,8,63,42,0,63,38,0πdb 57,32,0,51,29,0,45,24,0,39,20,0,33,17,0,28,13,0,22,10,0,16,63πdb 54,63,63,46,63,63,39,63,63,31,63,63,23,63,63,16,63,63,8,63,63,0,63πdb 56,0,57,50,0,51,45,0,45,39,0,39,33,0,33,27,0,28,22,0,22,16,0πdb 16,63,58,55,63,56,52,63,54,49,63,53,47,63,51,44,63,49,41,63,47,39,63πdb 46,36,63,44,32,63,41,28,63,39,24,60,37,23,58,35,22,55,34,21,52,32,20πdb 50,31,19,47,30,18,45,28,17,42,26,16,40,25,15,39,24,14,36,23,13,34,22πdb 12,32,20,11,29,19,10,27,18,9,23,16,8,21,15,7,18,14,6,16,12,6,14πdb 11,5,10,8,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πdb 0,0,0,0,0,0,49,10,10,49,19,10,49,29,10,49,39,10,49,49,10,39,49πdb 10,29,49,10,19,49,10,10,49,12,10,49,23,10,49,34,10,49,45,10,42,49,10πdb 31,49,10,20,49,11,10,49,22,10,49,33,10,49,44,10,49,49,10,43,49,10,32πdb 49,10,21,49,10,10,63,63,63πEnd;ππFunction KeyPressed : Boolean; Assembler;πAsmπ Mov Ah,0Bhπ Int 21hπEnd;ππProcedure WriteBigMessage(X,Y,Color:Byte; Message:String);πVar B,D    : Byte;π    ScrOfs : Word;ππConst TransTab : Array[0..255] of Byte =π      (32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32, {15}π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32, {31}π       40,28,32,32,32,32,32,32,32,32,32,32,32,39,27,32, {47}π       29,30,31,32,33,34,35,36,37,38,32,32,32,32,32,32, {63}π       32, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, {79}π       16,17,18,19,20,21,22,23,24,25,26,32,32,32,32,32, {95}π       32, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, {111}π       16,17,18,19,20,21,22,23,24,25,26,32,32,32,32,32, {127}π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,π       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32);ππBeginπ Mes:=Message;π D:=Length(Mes);π If D=0 then Exit;π ScrOfs:=(Y-1)*ScrWidth+2*X+2;ππ  Asmπ    Mov Ax,$B800              { Set starting address on screen }π    Mov Es,Axπ    Mov Di,ScrOfsππ    Mov B,1                   { Start with first character ;-) }π   @StringLoop:π    Xor Bh,Bhπ    Mov Bl,Bπ    Mov Al,Ds:[Offset Mes+Bx] { Get Next Character from String }π    Mov Bx,Offset TransTabπ    XLat                      { And translate into real value }ππ    Dec Alπ    Mov Bl,9π    Mul Blπ    Mov Si,Offset BigFont     { Character offset in Font-Table }π    Add Si,Axππ    Mov Ah,Colorπ    Mov Dx,3π   @FontColumn:               { Loop three Rows... }π    Mov Cx,3π   @FontRow:                  { and three columns }π    LodsBπ    StosWπ    Loop @FontRowπ    Add Di,ScrWidthπ    Sub Di,6π    Dec Dxπ    Jnz @FontColumnππ    Mov Ax,3                  { prepare screen address for next character }π    Mul ScrWidthπ    Sub Di,Axπ    Add Di,8ππ    Inc Bπ    Mov Al,Dπ    Cmp B,Alπ    Jng @StringLoopπ   End;πEnd;ππProcedure WriteCenteredBig(Y,Color:Byte; Message:String);πBeginπ WriteBigMessage(((ScrWidth Div 4)+2)-(Length(Message)*2),Y,Color,Message);πEnd;ππProcedure MakePal;πVar A:Word;πBeginπ For A:=0 to 255 doπ  Beginπ   Mypal[A]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3];π   Mypal[A+256]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3+1];π   Mypal[A+512]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3+2];π  End;πEnd;ππProcedure SetupBars;πVar V : Integer;πBeginπ  For V:=1 To BarRes Doπ   BarPos[V]:=Round(BarRad*Sin((2*Pi/BarRes)*V))+BarRad+1;π For V:=1 to 4 doπ  With Bars[V] doπ   Beginπ    StartCol:=V*16;π    if v=3 then startcol:=96;π    if v=4 then startcol:=144;π    if v=5 then startcol:=160;π    YPos:=14*V;π   End;π For V:=304 to 319 do Barcols[V]:=(15-(V mod 16))+160;π For V:=320 to 335 do Barcols[V]:=V mod 16+160;πEnd;ππProcedure UpdateBars;πVar V,U,Y : Integer;πBeginπ  For V:=1 To 4 doπ   For U:=0 to 31 do BarCols[barpos[Bars[V].YPos]+U]:=0;π For V:=1 To 4 doπ  Beginπ   Inc(Bars[V].YPos);π    If Bars[V].YPos>BarRes then Bars[V].YPos:=1;π   Y:=BarPos[Bars[V].YPos];π   For U:=0 to 15 do BarCols[Y+U]:=Bars[V].StartCol+15-U;π   For U:=16 to 31 do BarCols[Y+U]:=Bars[V].StartCol+U-16;π  End;πEnd;ππProcedure ColorBars; Assembler;πAsmπ  MOV DX,$03DAπ  In AL,DXπ  MOV DX,$03C0   { assume color nr 0 = default Text background.. }π  MOV AL,$20+0   { set color nr 0 .. }π  OUT DX,ALπ  MOV AL,0       { .. to DAC color 0 }π  OUT DX,ALππ  Xor SI,SIπ  CLIπ  MOV DX,$03DAπ  MOV AH,8π@Wau: in AL,DXπ  TEST AL,AHπ  JNZ @Wau       { wait Until out of retrace }π@Wai: in AL,DXπ  TEST AL,AHπ  JZ @Wai        { wait Until inside retrace }π@Doline:π  STIπ  Mov Bl,[Offset BarCols+Si]π  Mov Di,Offset MyPalπ  Add Di,Bxππ  MOV DX,$03C8  { point to DAC[0] }π  MOV AL,0π  OUT DX,ALππ  CLIπ  MOV DX,$03DAπ@Whu: in AL,DXπ  RCR AL,1π  JC @Whu       { wait Until out of horizontal retrace }π@Whi: in AL,DXπ  RCR AL,1π  JNC @Whi      { wait Until inside retrace }ππ  Inc Si        { line counter }π                { prepare For color effect }ππ  MOV DX,$03C9π  Mov Al,[Di]π  OUT DX,Al   { Dynamic Red }π  Mov Al,[Di+256]π  OUT DX,AL   { Dynamic Green }π  mov Al,[Di+512]π  OUT DX,AL   { Dynamic Blue }ππ  CMP SI,296  { Paint just about 3/4 screen }π  JBE  @dolineπ  STIπEnd;ππPROCEDURE Split(Row:Integer);πBEGINπ     ASMπ        mov dx,$3d4π        mov ax,rowπ        mov bh,ahπ        mov bl,ahπ        and bx,201hπ        mov cl,4π        shl bx,clπ        mov ah,alπ        mov al,18hπ        out dx,axπ        mov al,7π        cliπ        out dx,alπ        inc dxπ        in al,dxπ        stiπ        dec dxπ        mov ah,alπ        and ah,0efhπ        or ah,blπ        mov al,7π        out dx,axπ        mov al,9π        cliπ        out dx,alπ        inc dxπ        in al,dxπ        stiπ        dec dxπ        mov ah,alπ        and ah,0bfhπ        shl bh,1π        shl bh,1π        or ah,bhπ        mov al,9π        out dx,axπ     END;πEND;ππProcedure FastWrite(Col,Row,Attrib:Byte; Str:String);πVar MemPos : Word;π    A      : Byte;πBeginπ MemPos:=(Col*2)+(Row*ScrWidth)-ScrWidth-2;π A:=Length(Str);π  For A:=1 to Length(Str) doπ   Beginπ    MemW[$B800:MemPos]:=Ord(Str[A])+Attrib*256;π    MemPos:=MemPos+2;π   End;πEnd;ππProcedure CenterWrite(Y,Color:Byte;Mes:String);πBeginπ FastWrite(41-((Length(Mes)-1) Div 2),Y,Color,Mes);πEnd;ππProcedure CursorOff; Assembler;πAsmπ  Mov Ax,0100hπ  Mov Cx,2000hπ  Int 10hπEnd;ππProcedure CursorOn; Assembler;πAsmπ  Mov Ax,0100hπ  Mov Cx,0607hπ  Int 10hπEnd;ππProcedure ScrollText(Nr:Word); Assembler;πAsmπ  mov ax,nrπ  mov cx,$40π  mov es,cxπ  mov cl,es:[$85]π  div clπ  mov cx,axπ  mov dx,es:[$63]π  push dxπ  mov al,$13π  cliπ  out dx,alπ  inc dxπ  in al,dxπ  stiπ  mul clπ  shl ax,1π  mov es:[$4e],axπ  pop dxπ  mov cl,alπ  mov al,$cπ  out dx,axπ  mov al,$dπ  mov ah,clπ  out dx,axπ  mov ah,chπ  mov al,8π  out dx,axπEnd;πππFunction ReadKey : Char; Assembler;πAsmπ Mov Ah,07hπ Int 21hπEnd;ππProcedure SetHorizOfs(Count:Byte);πVar I : Byte;πBeginπ I:=Port[$3DA];π Port[$3C0]:=$33;π Port[$3C0]:=StartDat[Count Mod 16];πEnd;ππProcedure Sync; Assembler;πAsmπ  Mov Dx,3DAhπ@LoopIt:π  In Al,Dxπ  Test Al,8π  Jz @LoopItπEnd;ππProcedure DoubleWidth; Assembler;πAsmπ Mov Dx,3D4hπ Mov Ax,5013hπ Out Dx,Axπ Mov ScrWidth,320πEnd;ππProcedure SetPELReset; Assembler;πAsmπ Mov Dx,3DAhπ In Al,Dxπ Mov Dx,3C0hπ Mov Al,30hπ Out Dx,Alπ Mov Al,2Chπ Out Dx,AlπEnd;ππProcedure SetView(X,Y:Word);πVar PelPos:Byte;πBeginπ PelPos:=StartDat[X Mod 9];π X:=(X Div 9)+(Y Div 16)*160;π  Asmπ    Mov Dx,3D4h    { Set Screen offset in bytes:}π    Mov Bx,Xπ    Mov Ah,Bhπ    Mov Al,0Chπ    Out Dx,Axπ    Mov Ah,Blπ    Inc Alπ    Out Dx,Axππ    Mov Al,8       { Set Y-Offset within Character-Row: }π    Mov Bx,Yπ    And Bl,15π    Mov Ah,Blπ    Out Dx,Axππ    Mov Dx,3C0h    { Set X-Offset within Character-Column: }π    Mov Al,33hπ    Out Dx,Alπ    Mov Al,PelPosπ    Out Dx,Alπ End;πEnd;ππProcedure UpDateScroller;πBeginπ If ScrollOfs=9 thenπ  Beginπ   ScrollOfs:=0;ππ   Move(Mem[$B800:14*320+2],Mem[$B800:14*320],3*320-2);π   Inc(CharOfs);π   If CharOfs=4 thenπ    Beginπ     Inc(ScrollPos);π     WriteBigMessage(84-CharOfs,15,14,ScrollMessage[ScrollPos]);π     If ScrollPos=Length(ScrollMessage) Then ScrollPos:=0;π     CharOfs:=0;π    End;π  Endπ elseπ  Inc(ScrollOfs,9);π SetHorizOfs(ScrollOfs);πEnd;ππππBeginπ CursorOff;π FillChar(Mem[$B800:0000],4000,0);ππ  With MoveMes doπ   Beginπ    YPos:=110;π    YSpeed:=2;π    XPos:=40*8;π    XSpeed:=3;π    Counter:=0;π   End;ππ  With MoveSplit Doπ   Beginπ    YPos:=295;π    YSpeed:=2;π   End;ππ DoubleWidth;π SetPelReset;π ScrollText(MoveMes.YPos);π Split(MoveSplit.YPos);π Setupbars;π MakePal;π SetCharSet;π Sync;π CenterWrite(1,14,#194'─────────────────────────────────────────────────────────────────────────────'#190);π WriteBigMessage(1,2,4,'GAME - Gotta Get it!');π CenterWrite(5,14,#194'─────────────────────────────────────────────────────────────────────────────'#190);ππ  Repeatπ    With MoveMes doπ     Beginπ       If (YPos>80) and (YPos<200) thenπ        Inc(YPos,YSpeed)π       elseπ        Beginπ         YSpeed:=-YSpeed;π         YPos:=YPos+YSpeed;π        End;π      Counter:=1-Counter;π       If Odd(Counter) thenπ        Beginπ         If (XPos<40*8) or (XPos>40*8+150) then XSpeed:=-XSpeed;π         Inc(XPos,XSpeed);π        End;π     End;ππ    With MoveSplit doπ     Beginπ       If (YPos>290) and (YPos<325) thenπ        Inc(YPos,YSpeed)π       elseπ        Beginπ         YSpeed:=-YSpeed;π         YPos:=YPos+YSpeed;π        End;π     End;ππ   UpdateBars;π   ScrollText(MoveMes.YPos);π   UpDateScroller;π   Split(MoveSplit.YPos);π   ColorBars;π  Until KeyPressed;ππ  While KeyPressed do Readkey;π Split(400);π SetView(0,0);π ScrollText(0);π  Asmπ   Mov Ax,3π   Int 10hπ  End;π FastWrite(1,1,15,'Bye from World of Wonders!');π Writeln;π CursorOn;πEnd.π