{$M 32768,0,158000}
{Viewer for ASC23DP by ECH/ATC and Joker/ATC}
uses dos,math3d,MSE_TP,crt,lzh;

Var   SinTable,CosTable: Array[0..255] of integer;
      Time         : Longint ABSOLUTE $0040:$006C;
      time2        : longint;
      Sin2Table,Cos2Table: Array[0..255] of integer;
      letter   :char;
      bitp     :pointer;
      nomusic  : boolean;
      bitm     :word;
      filein   :file;
      fileout  :file;
const
 Black        =0;
 Blue         =1;
 Green        =2;
 Cyan         =3;
 Red          =4;
 Magenta      =5;
 Brown        =6;
 LightGray    =7;
 DarkGray     =8;
 LightBlue    =9;
 LightGreen   =10;
 LightCyan    =11;
 LightRed     =12;
 LightMagenta =13;
 Yellow       =14;
 White        =15;

const
  felles=7;
  forsinkelse=0;
  modname='musikk.gdm';
Type
 FaceType               = Record
                           Null,  {Is just set to nill, so FaceType = 8 byte}
                           A,
                           B,
                           C        : Word;
                          End;


 VertexType             = Record
                           X,
                           Y,
                           Z,
                           Dist     : Word;    {Dist = Distance from Origo}
                          End;
type
  tScr = array[0..63999] of Byte;

Const
  MaxFaces      = 700;
  MaxVertices   = 700;

var colorarr   : array[0..256] of char;
    textbuffer : pointer;
    txtbuff    : word;
    screensht1 : pointer;
    y80        : array[0..50] of word;
    shot1      : word;
    screensht2 : pointer;
    shot2      : word;
    democounter: integer;
    col        : array[0..256] of byte;
    x,y,z      : word;
    r,g,b      : byte;
    f          : text;
    x1,x2,y1,y2          : integer;
    hy1,hy2,hx1,hx2      : char;
    x1p,x2p              : shortint;
    y1p,y2p              : shortint;
    startx,endx     : array[0..1100] of integer;
    startcol,endcol : array[0..1100] of integer;
    t,t2,t3,t4,t5   : integer;
    tab1,tab2  : array[0..511] of byte;
    moded      : array[0..255] of byte;
    color      : byte;
    i1,j1      : byte;
    a1,a2      : word;
    i4,j5      : byte;
    a4,a5      : word;
    i2,j2      : word;
    c,qc       : word;
 xax           : integer;
 FaceList      : Array[0..MaxFaces] of FaceType;
 VertexList    : Array[0..MaxVertices] of VertexType;

 NbrOfFace,
 NbrOfVertex   : Word;
 pind          : array[0..maxfaces] of integer;
 coords        : array[0..MaxVertices] of record x,y,z,z2,col:integer;hid:boolean end;
 triangles     : record xs,ys,x,y,pos,rotspeed : integer end;
  SoundCardName : String;
  DMA, IRQ : Byte;
  BaseIO : Word;
  SampleRate : Word;
  DMABuffer : Word;
  Handle : File;
  Header : GDMHeader;
  EMSFlag : Word;
  MusicChannels : Word;
  ChannelCount : Word;
  ExitProgram : Boolean;

Type TE          = Record  X : Integer;
                           px, py : Byte; End;
     Table       = Array[0..599] of TE;
     PTable      = ^Table;
const
  size=70;
  pointnum=7;
  planenum=5;
  points:array[0..pointnum,0..2] of integer=(
    (-size,-size,-size),( size,-size,-size),( size, size,-size),(-size, size,-size),
    (-size,-size, size),( size,-size, size),( size, size, size),(-size, size, size));
  planes:array[0..planenum,0..3] of byte=(
    (0,1,2,3),(5,4,7,6),(1,5,6,2),(4,0,3,7),
    (3,2,6,7),(4,5,1,0));


var
    bitmap                        : array[0..49,0..49] of byte;
    unicolor                      : byte;
    pxstep,pystep                 : integer;
    pxval ,pyval                  : integer;
    o1                            : integer;
    count                         : integer;
    Left, Right                   : Table;
    point                         : array[0..pointnum] of record x,y,z :integer; end;


function sar(num:integer;LR:byte):integer;
var tt:integer;
begin
  asm
    mov ax,num
    mov bl,lr
    sar ax,cl
    mov tt,ax
  end;
  sar:=tt;
end;

procedure writemusic;
begin
  gotoxy(1,1);
  writeln(musicorder($ff));
  writeln(musicrow);
end;

function sal(num:integer;LR:byte):integer;
var tt:integer;
begin
  asm
    mov ax,num
    mov cl,lr
    sal ax,cl
    mov tt,ax
  end;
  sal:=tt;
end;

function DeleteFile(FN : PathStr) : Boolean;
var
  Regs : Registers;
begin
  FN := FN + #0;          { Add NUL chr for DOS }
  Regs.AH := $41;
  Regs.DX := Ofs(FN) + 1; { Add 1 to bypass length byte }
  Regs.DS := Seg(FN);
  MsDos(Regs);
  DeleteFile := NOT (Regs.Flags AND $0 = $0)
end;

procedure flip(fra,til:word);
assembler;
asm
  mov ax,til
  mov es,ax
  mov dx,ds
  mov ax,fra
  mov ds,ax
  xor si,si
  xor di,di
  mov cx,2080
  db $66; rep movsw
  mov ds,dx
end;

procedure clrscr2(segment:word);
begin
  asm
    mov es,segment
    xor di,di
    mov cx,2080
    db $66; xor ax,ax
    db $66; rep stosw
  end;
end;

function getchar(x,y,segment:word) :char;
var temp:char;
begin
  asm
    mov ax,y
    shl ax,4
    mov bx,ax
    shl ax,2
    add ax,bx
    add ax,x
    mov es,segment
    mov si,ax
    mov al,[es:si]
    mov temp,al
  end;
  getchar:=temp;
end;

PROCEDURE RETRACE;
ASSEMBLER;
ASM
  mov dx,3dah
 @@vert1:
  in al,dx
  test al,8
  jz @@vert1
 @@vert2:
  in al,dx
  test al,8
  jnz @@vert2
END;

procedure switch(one,two:longint);
var temp:longint;
begin
  temp:=one;
  one:=two;
  two:=temp;
end;

procedure plot(position:word; value:char;color:byte);
assembler;
asm
  mov ax,txtbuff
  mov es,ax
  mov al,value
  mov ah,color
  mov si,position
  shl si,1
  mov [es:si],ax
end;

PROCEDURE Cursor(On: Boolean);
BEGIN
  IF On=FALSE THEN
  BEGIN
  ASM
    mov  ah, 01h
    mov  cl, 20h
    mov  ch, 20h
    int  10h
  END;
  END
  ELSE
  BEGIN
  ASM
    mov  ah, 01h
    mov  cl, 06h
    mov  ch, 07h
    int  10h
  END;
END;
END;

procedure plotxy(position:word;x,y:byte;value:char;color:byte;segment:word);
assembler;
asm
  mov si,position
  cmp si,65535
  jne @@pos
  xor dh,dh
  mov dl,y
  shl dx,4
  mov ax,dx
  shl dx,2
  add dx,ax
  mov al,x
  xor ah,ah
  add dx,ax
  mov si,dx
@@pos:
  mov es,segment
  mov al,value
  mov ah,color
  shl si,1
  mov [es:si],ax
end;


function moded255(value:integer):byte;
begin
  repeat
    if value<0 then inc(value,255);
    if value>255 then dec(value,255);
  until (value>=0) and (value<=255);
  moded255:=moded[value];
end;

function changecol :char;
begin
case (c mod 32) of
0:  changecol:=' ';
1:  changecol:=' ';
2:  changecol:='�';
3:  changecol:='�';
4:  changecol:=':';
5:  changecol:=';';
6:  changecol:='�';
7:  changecol:='�';
8:  changecol:='O';
9:  changecol:='�';
10: changecol:='&';
11: changecol:='#';
12: changecol:='�';
13: changecol:='�';
14: changecol:='�';
15: changecol:='�';
16: changecol:='�';
17: changecol:='�';
18: changecol:='�';
19: changecol:='�';
20: changecol:='#';
21: changecol:='&';
22: changecol:='�';
23: changecol:='O';
24: changecol:='�';
25: changecol:='�';
26: changecol:=';';
27: changecol:=':';
28: changecol:='�';
29: changecol:='�';
30: changecol:=' ';
31: changecol:=' ';
  end;
  color:=(c div 32)+1;
end;

function synced(patt,row:byte):boolean;
begin
  if nomusic then
  begin
    if (time2+(patt shl 7)+(row shl 1))<time then synced:=true else synced:=false
  end
  else
  begin
    if (musicorder($ff)=patt) and (musicrow>=row) then synced:=true else synced:=false;
    if (musicorder($ff)>patt) then synced:=true;
  end;
end;


Procedure EndProg(ErrorString : String);
Begin
  Writeln;
  Writeln(ErrorString);
  If IOResult <> 0 then Close(Handle);
  Halt(0);
End;


procedure textline  (gx1,gy1,gc1,gx2,gy2,gc2:integer);
var m,x                 : word;
    col,colstep         : word;
    y,tmp               : word;
begin
  if gy1<>gy2 then
  begin
    asm
      mov ax,gy1
      cmp ax,gy2
      jb @@greater1
      mov ax,gy1
      mov bx,gy2
      mov gy1,bx
      mov gy2,ax
      mov ax,gx1
      mov bx,gx2
      mov gx1,bx
      mov gx2,ax
      mov ax,gc1
      mov bx,gc2
      mov gc1,bx
      mov gc2,ax
    @@greater1:
      mov ax,gx1
      shl ax,felles
      mov x,ax
      mov ax,gc1
      shl ax,felles
      mov col,ax
    end;       {}
    m:=((gx2-gx1)shl felles) div (gy2-gy1);
    colstep:=((gc2-gc1)shl felles) div (gy2-gy1);
    asm
      inc x
      inc gy1
      mov cx,gy1
      mov y,cx
    @@loopback:
      inc y
      cmp y,0
      jnae @@ending2
      cmp y,1100
      jnb  @@ending2
      mov si,offset startx
      mov dx,y
      shl dx,1
      add si,dx
      mov ax,-16000
      cmp [ds:si],ax
      jne @@endpart
      mov di,si
      mov bx,ds
      mov es,bx
      mov ax,x
      shr ax,felles
      stosw
      mov di,offset startcol
      add di,dx
      mov ax,col
      shr ax,felles
      stosw
      jmp @@ending
    @@endpart:
      mov di,offset endx
      mov dx,y
      shl dx,1
      add di,dx
      mov bx,ds
      mov es,bx
      mov ax,x
      shr ax,felles
      stosw
      mov di,offset endcol
      add di,dx
      mov ax,col
      shr ax,felles
      stosw
    @@ending:
      mov ax,x
      add ax,m
      mov x,ax
      mov ax,col
      add ax,colstep
      mov col,ax
    @@ending2:
      mov cx,gy2
      cmp y,cx
      jle @@loopback
    end;
  end;
end;

procedure textpoly3(sx1,sy1,sc1,sx2,sy2,sc2,sx3,sy3,sc3:integer);
var i,i2:word;
label loop1,loop2;
var numcolors                       : word;
    colorvalue,step                 : word;
    len,t2,x                        : word;
    dist                            : word;
    tmp                             : integer;
    c1,c2                           : word;
    x1,x2                           : word;
    y                               : word;
    deadcount                       : word;
begin
  asm
    add sx1,400
    add sy1,400
    add sx2,400
    add sy2,400
    add sx3,400
    add sy3,400
    mov cx,400
    mov ax,-16000
    db $66; shl ax,16
    mov ax,-16000
    mov di,offset startx
    mov dx,ds
    mov es,dx
    db $66; rep stosw
    mov cx,400
    db $66; rep stosw
    mov di,offset endx
  end;
  textline(sx1,sy1,sc1,sx2,sy2,sc2);
  textline(sx2,sy2,sc2,sx3,sy3,sc3);
  textline(sx3,sy3,sc3,sx1,sy1,sc1);
  for i:=400 to 449 do
  begin
    asm
      mov ax,i
      mov bx,ax
      shl bx,1    { Get 16-bit value for 'I'}
      sub ax,400
      mov i2,ax   { Set I2 to (i-200) for the clipping part }

      mov si,offset startx  { get startpoint of this Y-value (I2=Yvalue)}
      add si,bx
      lodsw
      mov x1,ax
      mov si,offset endx { Get endpoint of this Y-value }
      add si,bx
      lodsw
      mov x2,ax

      mov bx,i
      shl bx,1
      mov si,offset startcol
      add si,bx
      lodsw
      mov c1,ax

      mov si,offset endcol
      add si,bx
      lodsw
      mov c2,ax
      mov tmp,0
    end;
    if startx[i]=-16000 then else
      if endx[i]=-16000 then else
      begin
        if x1>x2 then
        asm
          mov ax,c1
          mov bx,c2
          mov c1,bx
          mov c2,ax

          mov ax,x1
          mov bx,x2
          mov x1,bx
          mov x2,ax
        end;
        len:=abs(x2-x1)+1;
        if len>0 then
        begin
          asm
            mov ax,c2
            sub ax,c1
            shr ax,8
            mov numcolors,ax

            mov ax,c1
            shl ax,8
            mov colorvalue,ax

          end;{}
          step:=numcolors div len;
          for tmp:=x1 to x2 do
          begin
            IF (tmp-400<80) and (tmp-400>-1) and (i2<50) and (i2>-1) then
            plotxy(65535,tmp-400,i2,colorarr[colorvalue shr 8],
                                         lightgray,txtbuff);
            asm
              mov ax,colorvalue
              add ax,step
              mov colorvalue,ax
            end;
          end;
        end;
    end;
  end;
end;

procedure textpoly4(sx1,sy1,sc1,sx2,sy2,sc2,sx3,sy3,sc3,sx4,sy4,sc4:integer);
var i,i2:word;
label loop1,loop2;
var numcolors                       : word;
    colorvalue,step                 : word;
    len,t2,x                        : word;
    dist                            : word;
    tmp                             : integer;
    c1,c2                           : word;
    x1,x2                           : word;
    y                               : word;
    deadcount                       : word;
begin
  asm
    add sx1,600
    add sy1,600
    add sx2,600
    add sy2,600
    add sx3,600
    add sy3,600

    mov cx,550
    mov ax,-16000
    db $66; shl ax,16
    mov ax,-16000
    mov di,offset startx
    mov dx,ds
    mov es,dx
    db $66; rep stosw
    mov cx,550
    db $66; rep stosw
    mov di,offset endx
  end;
  textline(sx1,sy1,sc1,sx2,sy2,sc2);
  textline(sx2,sy2,sc2,sx3,sy3,sc3);
  textline(sx3,sy3,sc3,sx4,sy4,sc4);
  textline(sx4,sy4,sc4,sx1,sy1,sc1);
  for i:=600 to 649 do
  begin
    asm
      mov ax,i
      mov bx,ax
      shl bx,1    { Get 16-bit value for 'I'}
      sub ax,600
      mov i2,ax   { Set I2 to (i-200) for the clipping part }

      mov si,offset startx  { get startpoint of this Y-value (I2=Yvalue)}
      add si,bx
      lodsw
      mov x1,ax
      mov si,offset endx { Get endpoint of this Y-value }
      add si,bx
      lodsw
      mov x2,ax

      mov bx,i
      shl bx,1
      mov si,offset startcol
      add si,bx
      lodsw
      mov c1,ax

      mov si,offset endcol
      add si,bx
      lodsw
      mov c2,ax
      mov tmp,0
    end;
    if startx[i]=-16000 then else
      if endx[i]=-16000 then else
      begin
        if x1>x2 then
        asm
          mov ax,c1
          mov bx,c2
          mov c1,bx
          mov c2,ax

          mov ax,x1
          mov bx,x2
          mov x1,bx
          mov x2,ax
        end;
        len:=abs(x2-x1)+1;
        if len>0 then
        begin
          asm
            mov ax,c2
            sub ax,c1
            shr ax,8
            mov numcolors,ax

            mov ax,c1
            shl ax,8
            mov colorvalue,ax

          end;{}
          step:=numcolors div len;
          for tmp:=x1 to x2 do
          begin
            IF (tmp-600<80) and (tmp-600>-1) and (i2<50) and (i2>-1) then
            plotxy(65535,tmp-600,i2,colorarr[colorvalue shr 8],unicolor,txtbuff);
            asm
              mov ax,colorvalue
              add ax,step
              mov colorvalue,ax
            end;
          end;
        end;
    end;
  end;
end;



procedure quicksort(lo,hi:integer);
procedure sort(l,r:integer);
var i,j,x,y:integer;
begin
  i:=l;
  j:=r;
  x:=coords[(l+r) div 2].z2;
  repeat
    while coords[i].z2<x do inc(i);
    while x<coords[j].z2 do dec(j);
    if i<=j then
    begin
      y:=coords[i].z2;
      coords[i].z2:=coords[j].z2;
      coords[j].z2:=y;
      y:=pind[i];
      pind[i]:=pind[j];
      pind[j]:=y;
      inc(i);
      dec(j);
    end;
  until i>j;
  if l<j then sort(l,j);
  if i<r then sort(i,r);
end;

begin
  sort(lo,hi);
end;


Procedure Load(FileName : String);
var
 T1, T2 : Integer;
 C1, C2 : Char;

begin
 for t:=0 to maxfaces do
 begin
   facelist[t].a:=0;
   facelist[t].b:=0;
   facelist[t].c:=0;
 end;
 for t:=0 to maxvertices do
 begin
   vertexlist[t].x:=0;
   vertexlist[t].y:=0;
   vertexlist[t].z:=0;
 end;
 assign(f, FileName);
 reset(f);
 read(f, c1);
 read(f, c2);
 NbrOfVertex := ord(c1) + (ord(c2) * 256);       {Load Nbr Of Vertex}
 read(f, c1);
 read(f, c2);
 NbrOfFace := ord(c1) + (ord(c2) * 256);         {Load Nbr Of Face}
 for t1 := 0 to (NbrOfVertex - 1) do             {Load All Vertices}
  begin
   read(f, c1);
   read(f, c2);
   VertexList[t1].X := ord(c1) + (ord(c2) * 256);
   read(f, c1);
   read(f, c2);
   VertexList[t1].Y := ord(c1) + (ord(c2) * 256);
   read(f, c1);
   read(f, c2);
   VertexList[t1].Z := ord(c1) + (ord(c2) * 256);
   read(f, c1);
   read(f, c2);
   VertexList[t1].Dist := ord(c1) + (ord(c2) * 256);
  end;
 for t1 := 0 to (NbrOfFace - 1) do               {Load All Faces}
  begin
   read(f, c1);
   read(f, c2);
   FaceList[t1].Null := ord(c1) + (ord(c2) * 256);
   read(f, c1);
   read(f, c2);
   FaceList[t1].A := ord(c1) + (ord(c2) * 256);
   read(f, c1);
   read(f, c2);
   FaceList[t1].B := ord(c1) + (ord(c2) * 256);
   read(f, c1);
   read(f, c2);
   FaceList[t1].C := ord(c1) + (ord(c2) * 256);
  end;
 close(f);
end;

Function ToHex(Num : Word) : String;
{ Converts a decimal number to Hexidecimal }

Const
  HexChars : String = '0123456789ABCDEF';

Var
  Temp : String;

Begin
  Temp := '';
  Temp := Temp + HexChars[((Num Shr 8) And 15) + 1];
  Temp := Temp + HexChars[((Num Shr 4) And 15) + 1];
  Temp := Temp + HexChars[((Num Shr 0) And 15) + 1];
  ToHex := Temp + 'h';
End;

procedure initplayer(filename:string);
Begin
  BaseIO:=$FFFF;
  DMA:=$FF;
  IRQ:=$FF;
  WriteLn('Initializing sound hardware...');
  Case LoadMSE(SoundCardName, 0, 45, 4096, BaseIO, IRQ, DMA) of
    1 : EndProg('Base I/O address autodetection failure');
    2 : EndProg('IRQ level autodetection failure');
    3 : EndProg('DMA channel autodetection failure');
    4 : EndProg('DMA channel not supported');
    6 : EndProg('Sound device does not respond');
    7 : EndProg('Memory control blocks destroyed');
    8 : EndProg('Insufficient memory for mixing buffers');
    9 : EndProg('Insufficient memory for MSE file');
    10: EndProg('MSE has invalid identification string');
    11: EndProg('MSE disk read failure');
    12: EndProg('MVSOUND.SYS not loaded');
  End;
  ExitProc := @FreeMSE;              { Call FreeMSE on abnormal program end }
  If EMSExist                      { Check for EMS }
    Then EMSFlag := 1              { Yes, EMS exists, so use it }
    Else EMSFlag := 0;             { EMS does not exist }

{$I-}                              { Turn off I/O checking }
  Assign(Handle,filename);
  Reset(Handle);
{$I+}                              { Turn I/O checking back on }
  If IOResult <> 0 Then
     EndProg('Module does not exist');    { File not found, exit program }
  WriteLn('Loading module...');
  Case LoadGDM(Handle, 0, EMSFlag, Header) of
    1 : EndProg('Module is corrupt');
    2 : EndProg('Could not autodetect module type (N/A)');
    3 : EndProg('Bad file format ID string');
    4 : EndProg('Insufficient memory to load module');
    5 : EndProg('Can not unpack samples');
    6 : EndProg('AdLib instruments not supported');
  End;
  Close(Handle);
  MusicChannels := 0;            { Calculate the number of channels in song }
  For ChannelCount := 1 to 32 do
    Begin
      If Header.PanMap[ChannelCount] <> $FF
        Then MusicChannels := MusicChannels + 1;
    End;
  SampleRate := StartOutput(MusicChannels, 0);
  StartMusic;
end;

procedure stopsound;
begin
  if nomusic then else
  begin
  WriteLn('Stop music');
  StopMusic;
  WriteLn('Stop output');
  StopOutput;
  WriteLn('Unload module');
  UnloadModule;
  WriteLn('Unload hardware support');
  FreeMse;
  WriteLn('Done!');
  end;
end;

procedure mainloop(patt1,pos1,patt2,pos2:word);
var coordy1,coordy2,coordy3 : integeR;
    coordx1,coordx2,coordx3 : integeR;
    democounter2            : word;
begin
  initmath3d;
  setrotangles(90,0,0);
  setdistance(500);
  setrotatespeed(00,18,10);
  democounter:=20;
  democounter2:=0;
  repeat
    inc(democounter);
    if democounter=200 then
    begin
      dec(democounter);
      inc(democounter2);
      if synced(patt1,pos1) then inc(democounter);
    end;
    genrotangles;
    for t:=0 to NbrOfVertex do
    begin
      setpoint(vertexlist[t].x ,democounter-200+vertexlist[t].y ,vertexlist[t].z);{}
      coords[t].x:=(getpointx2d div 2)-43;
      coords[t].y:=(getpointy2d div 2)-26;
      coords[t].z:=-getpointz3d*4+100;
       coords[t].col:=coords[t].z;
       if coords[t].col<0 then coords[t].col:=0;
       if coords[t].col>230 then coords[t].col:=230;
    end;
    for t:=0 to Nbrofface do
    begin
      coords[t].z2:=coords[facelist[t].a].z;
      pind[t]:=t;
    end;
    quicksort(0,NbrOfFace);
    for t:=0 to NbrOfFace do
    begin
      coordy1:=coords[facelist[pind[t]].a].y;
      coordy2:=coords[facelist[pind[t]].b].y;
      coordy3:=coords[facelist[pind[t]].c].y;
      coordx1:=xax+coords[facelist[pind[t]].a].x;
      coordx2:=xax+coords[facelist[pind[t]].b].x;
      coordx3:=xax+coords[facelist[pind[t]].c].x;
      if hidden(coordx1,coordy1,coordx2,coordy2,coordx3,coordy3) then
      textpoly3(coordx1,coordy1,coords[facelist[pind[t]].a].col,
                coordx2,coordy2,coords[facelist[pind[t]].b].col,
                coordx3,coordy3,coords[facelist[pind[t]].c].col);{}
    end;
    {speedchk;  {}
    retrace;
    flip(txtbuff,$b800);
    clrscr2(txtbuff);
  until (synced(patt2,pos2)) or (keypressed);
end;


procedure view(speed:integer);
var coordy1,coordy2,coordy3 : integeR;
    coordx1,coordx2,coordx3 : integeR;
begin
  initmath3d;
  setrotangles(70,0,270);
  setrotatespeed(6,0,0);
  democounter:=0;
  repeat
    inc(democounter,speed);
    genrotangles;
    for t:= 0 to NbrOfVertex do
    begin
      setpoint(vertexlist[t].x,vertexlist[t].y,vertexlist[t].z-200+democounter);
      coords[t].x:=(getpointx2d div 3)-13;
      coords[t].y:=(getpointy2d div 3)-15;
      coords[t].z:=-getpointz3d;
      coords[t].col:=((coords[t].z))+90;
      if coords[t].col<0 then coords[t].col:=0;
      if coords[t].col>230 then coords[t].col:=230;
    end;
    for t:=0 to Nbrofface do
    begin
      coords[t].z2:=coords[facelist[t].a].z;
      pind[t]:=t;
    end;
    quicksort(0,NbrOfFace);
    for t:=0 to NbrOfFace do
    begin
      coordy1:=coords[facelist[pind[t]].a].y;
      coordy2:=coords[facelist[pind[t]].b].y;
      coordy3:=coords[facelist[pind[t]].c].y;
      coordx1:=xax+coords[facelist[pind[t]].a].x;
      coordx2:=xax+coords[facelist[pind[t]].b].x;
      coordx3:=xax+coords[facelist[pind[t]].c].x;
      textpoly3(coordx1,coordy1,coords[facelist[pind[t]].a].col,
                coordx2,coordy2,coords[facelist[pind[t]].b].col,
                coordx3,coordy3,coords[facelist[pind[t]].c].col);{}
    end;
    retrace;
    flip(txtbuff,$b800);
    clrscr2(txtbuff);
  until (keypressed) or (democounter>=410);
end;


procedure plasma;
var cc    : char;
begin
  a1:=0;
  a2:=0;
  democounter:=0;
{  repeat        }
    asm
      inc democounter{}

      mov ax,a1
      add ax,274
      mov i1,ah
      mov a1,ax
      mov ax,a2
      add ax,324
      mov j1,ah
      mov a2,ax

      mov ax,a4
      add ax,395
      mov i4,ah
      mov a4,ax
      mov ax,a5
      add ax,557
      mov j5,ah
      mov a5,ax
    end;
    for y:=0 to 49 do begin
      i2:=tab1[moded255(j2-i1)];
      j2:=tab2[moded255(j1+j5)];
      for x:=0 to 49 do
      begin
        qc:=tab1[moded255(i1+y)]+tab1[moded255(j5-x)];
        c:=moded255(tab2[moded255(i2-y+i4*2)]+tab2[moded255(qc+i4+x)]);
        bitmap[x,y]:=ord(changecol);
      end;
    end;
end;

procedure plasma2(patt,pos:word);
var cc    : char;
begin
  cursor(false);
  a1:=0;
  a2:=0;
  repeat
    asm
      mov ax,a1
      add ax,274
      mov i1,ah
      mov a1,ax
      mov ax,a2
      add ax,324
      mov j1,ah
      mov a2,ax

      mov ax,a4
      add ax,395
      mov i4,ah
      mov a4,ax
      mov ax,a5
      add ax,257
      mov j5,ah
      mov a5,ax
    end;
    for y:=0 to 49 do begin
      i2:=tab1[moded255(j2-i1)];
      j2:=tab2[moded255(j1+j5)];
      for x:=0 to 39 do
      begin
        qc:=tab1[moded255(i1+y)]+tab1[moded255(j5-x)];
        c:=moded255(tab1[moded255(i2-y+i4*2)]+tab2[moded255(qc+i4+x)]) shr 1;
        plot(x*2+y80[y],changecol,(color+1));
        c:=(moded255(tab2[moded255(i2-y)]+tab1[moded255(qc+i4+x)]) shr 1);
        plot(1+x*2+y80[y],changecol,(color+2));
      end;
    end;
    retrace;{}
    flip(txtbuff,segb800);
  until (synced(patt,pos)) or (keypressed);
  cursor(true);
end;

procedure ringnescola(patt,pos:word);
var coordy1,coordy2,coordy3 : integeR;
    coordx1,coordx2,coordx3 : integeR;
    democounter2            : integer;
begin
  load('rm.3dp');
  setrotatespeed(3,6,0);
  setrotangles(0,180,270);
  democounter2:=0;
  democounter:=0;
  repeat
    if (democounter<240) and (democounter2=0) then
    begin
      inc(democounter);
      genrotangles;
    end
    else
    if democounter2=0 then
    begin
      repeat
      until (synced(patt,pos)) or (keypressed);
      democounter2:=1;
      setrotatespeed(3,6,13);
    end
    else
    begin
      dec(democounter,2);
      genrotangles;
    end;
    for t:= 0 to NbrOfVertex do
    begin
      setpoint(vertexlist[t].x,vertexlist[t].y+democounter-130,vertexlist[t].z);
      coords[t].x:=(getpointx2d div 3)-13;
      coords[t].y:=(getpointy2d div 3)-10;
      coords[t].z:=-getpointz3d;
      coords[t].col:=((coords[t].z))+120;
      if coords[t].col<0 then coords[t].col:=0;
      if coords[t].col>230 then coords[t].col:=230;
    end;
    for t:=0 to Nbrofface do
    begin
      coords[t].z2:=coords[facelist[t].a].z;
      pind[t]:=t;
    end;
    quicksort(0,NbrOfFace);
    for t:=0 to NbrOfFace do
    begin
      coordy1:=coords[facelist[pind[t]].a].y;
      coordy2:=coords[facelist[pind[t]].b].y;
      coordy3:=coords[facelist[pind[t]].c].y;
      coordx1:=xax+coords[facelist[pind[t]].a].x;
      coordx2:=xax+coords[facelist[pind[t]].b].x;
      coordx3:=xax+coords[facelist[pind[t]].c].x;
      textpoly3(coordx1,coordy1,coords[facelist[pind[t]].a].col,
                coordx2,coordy2,coords[facelist[pind[t]].b].col,
                coordx3,coordy3,coords[facelist[pind[t]].c].col);{}
    end;
    retrace;
    flip(txtbuff,$b800);
    if (democounter=220) and (democounter2=0) then flip(txtbuff,shot1);
    clrscr2(txtbuff);
  until (keypressed) or (democounter=-100);
end;

Procedure TextureHLine(X1, X2, px1, py1, px2, py2, Y : Integer; Dim : Word);
var tt1,tt2,tt3:integer;
    count:word;
Begin
  asm
   sub y,200
   mov bx,x2
   sub bx,x1
   inc bx
   mov tt1,bx

   mov ax,px2
   sub ax,px1
   shl ax,8
   mov tt2,ax

   mov ax,py2
   sub ax,py1
   shl ax,8
   mov tt3,ax
  end;
  pxStep := tt2 Div tt1;
  pyStep := tt3 Div tt1;
  asm
   mov bx, px1
   shl bx, 8
   mov pxval,bx  {  pxVal := px1 Shl 8;}
   mov bx, py1
   shl bx, 8
   mov pyval,bx  {  pyVal := py1 Shl 8;}
   mov ax,y
   shl ax,4
   mov di,ax
   shl ax,2
   add di,ax
   add di,x1
   mov o1, di
  End;
  For Count := X1 to X2 do
    Begin
     b:=Bitmap[Hi(pxVal),Hi(pyVal)];
     if ( count<80 ) and ( y<50 ) then
     plotxy(65535,count,y,chr(b),unicolor,txtbuff);
     Asm
       mov ax, pxval
       add ax, pxstep
       mov pxval, ax
       mov ax, pyval
       add ax, pystep
       mov pyval, ax
       inc o1
     end;
  End;
End;

Procedure Swap(Var A, B : Integer);
Var t : Integer;
Begin
  t := a;
  a := b;
  b := t;
End;

Procedure Texture(X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer; Dim : Byte);
Var yMin, yMax             : Integer;
    xStart, xEnd           : Integer;
    yStart, yEnd           : Integer;
    pxStart, pxEnd         : Integer;
    pyStart,pyEnd          : Integer;
    XVal, XStep            : Longint;
    pxVal, pxStep          : Integer;
    pyVal, pyStep          : Integer;
    Count                  : Integer;
    Side                   : PTable;
Begin
  asm
    add y1,200
    add y2,200
    add y3,200
    add y4,200

    mov ax,y1
    mov ymin,ax
    mov ax,y1
    mov ymax,ax
    mov ax,y2
    cmp ax,ymax
    jl  @@nabove1
    mov ymax,ax
  @@nabove1:
    mov ax,y3
    cmp ax,ymax
    jl  @@nabove2
    mov ymax,ax
  @@nabove2:
    mov ax,y4
    cmp ax,ymax
    jl  @@nabove3
    mov ymax,ax
  @@nabove3:
    mov ax,y2
    cmp ax,ymin
    ja @@above1
    mov ymin,ax
  @@above1:
    mov ax,y3
    cmp ax,ymin
    ja @@above2
    mov ymin,ax
  @@above2:
    mov ax,y4
    cmp ax,ymin
    ja @@above3
    mov ymin,ax
  @@above3:
    mov ax,x1
    mov xstart,ax
    mov ax,y1
    mov ystart,ax
    mov ax,x2
    mov xend,ax
    mov ax,y2
    mov yend,ax
    mov pxstart,0
    mov pystart,0
    mov al,[dim]
    dec al
    xor ah,ah
    mov pxend,ax
    mov pyend,0
  end;
  If yStart > yEnd Then
  Begin
    Swap(xStart, xEnd);
    Swap(yStart, yEnd);
    Swap(pxStart, pxEnd);
    Side := @Left;
  End
Else
  Side := @Right;
  XVal := Longint(xStart) Shl 8;
  XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  pxVal := pxStart Shl 8;
  pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1);
  For Count := yStart to yEnd do
    Begin
      Side^[Count].x := XVal Shr 8;
      Side^[Count].px := pxVal Shr 8;
      Side^[Count].py := pyStart;
      XVal := XVal + XStep;
      pxVal := pxVal + pxStep;
    End;
    xStart := X2;
    yStart := Y2;
    xEnd := X3;
    yEnd := Y3;
    pxStart := Dim-1;
    pyStart := 0;
    pxEnd := Dim-1;
    pyEnd := Dim-1;
   If yStart > yEnd Then
   Begin
     Swap(xStart, xEnd);
     Swap(yStart, yEnd);
     Swap(pyStart, pyEnd);
     Side := @Left;
   End
   Else Side := @Right;
  XVal := Longint(xStart) Shl 8;
  XStep:=(Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  pyVal := pyStart Shl 8;
  pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1);
  For Count := yStart to yEnd do
    Begin
      Side^[Count].x := XVal Shr 8;
      Side^[Count].py := pyVal Shr 8;
      Side^[Count].px := pxStart; XVal := XVal + XStep;
      pyVal := pyVal + pyStep;
    End;
  xStart := X3;
  yStart := Y3;
  xEnd := X4;
  yEnd := Y4;
  pxStart := Dim-1;
  pyStart := Dim-1;
  pxEnd := 0;
  pyEnd := Dim-1;
  If yStart > yEnd Then
  Begin
    Swap(xStart, xEnd);
    Swap(yStart, yEnd);
    Swap(pxStart, pxEnd);
    Side := @Left;
  End
Else
  Side := @Right;
  XVal := Longint(xStart) Shl 8;
  XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  pxVal := pxStart Shl 8;
  pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1);
  For Count := yStart to yEnd do
    Begin
      Side^[Count].x := XVal Shr 8;
      Side^[Count].px := pxVal Shr 8;
      Side^[Count].py := pyStart;
      XVal := XVal + XStep;
      pxVal := pxVal + pxStep;
    End;
  xStart := X4;
  yStart := Y4;
  xEnd := X1;
  yEnd := Y1;
  pxStart := 0;
  pyStart := Dim-1;
  pxEnd := 0;
  pyEnd := 0;
  If yStart > yEnd Then
  Begin
    Swap(xStart, xEnd);
    Swap(yStart, yEnd);
    Swap(pyStart, pyEnd);
    Side := @Left;
  End
Else
  Side := @Right;
  XVal := Longint(xStart) Shl 8;
  XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  pyVal := pyStart Shl 8;
  pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1);
  For Count := yStart to yEnd do
  Begin Side^[Count].x := XVal Shr 8;
    Side^[Count].py := pyVal Shr 8;
    Side^[Count].px := pxStart;
    XVal := XVal + XStep;
    pyVal := pyVal + pyStep;
  End;
  For Count := yMin to yMax do
    if (count>199) and (count<400) then
    If Left[Count].x < Right[Count].x
      Then TextureHLine(Left[Count].x, Right[Count].x, Left[Count].px, Left[Count].py,
              Right[Count].px, Right[Count].py, Count, Dim)
      Else TextureHLine(Right[Count].x, Left[Count].x, Right[Count].px, Right[Count].py,
              Left[Count].px, Left[Count].py, Count, Dim);
End;


PROCEDURE Syncronize;
ASSEMBLER;
ASM
    @@Tester:
    mov     DX,3DAh
    in      AL,DX
    test    AL,1000b
    jz      @@Tester
END;

procedure tmapping(patt,pos:word);
const
  facx=3;
  facy=3;
var
   temp:integer;
begin
  setrotatespeed(0,0,0);
  setrotangles(0,0,0);
  setdistance(150);
  temp:=660;
  setrotatespeed(3,14,8);
  repeat
    if temp>0 then dec(temp,5);
    retrace;
    flip(txtbuff,segb800);
    clrscr2(txtbuff);
    plasma;
    genrotangles;
    for t:=0 to pointnum do
    begin
      setpoint(points[t,0] div 2,
               points[t,1] div 2,
               points[t,2] div 2);
      point[t].x:=(getpointx2d-90);
      point[t].y:=getpointy2d-pccos(temp)+53;
    end;
    for t:=0 to planenum do
      if not hidden(point[planes[t,0]].x,point[planes[t,0]].y,
                    point[planes[t,1]].x,point[planes[t,1]].y,
                    point[planes[t,2]].x,point[planes[t,2]].y) then
      begin
        unicolor:=t+1;
        texture(point[planes[t,0]].x-30,point[planes[t,0]].y,
                point[planes[t,1]].x-30,point[planes[t,1]].y,
                point[planes[t,2]].x-30,point[planes[t,2]].y,
                point[planes[t,3]].x-30,point[planes[t,3]].y,49);
      end;
  until (synced(patt,pos)) or (keypressed);
end;

procedure viewatc;
var coordy1,coordy2,coordy3 : integeR;
    coordx1,coordx2,coordx3 : integeR;
begin
  initmath3d;
  setrotangles(180,180,0);
  setdistance(250);
  setrotatespeed(6,0,6);
  democounter:=0;
  repeat
    inc(democounter);
    genrotangles;
    for t:= 0 to NbrOfVertex do
    begin
      setpoint(vertexlist[t].x,vertexlist[t].y,vertexlist[t].z);{}
      coords[t].x:=(getpointx2d div 3)-13;
      coords[t].y:=(democounter div 2-60)+(getpointy2d div 3)-10;
      coords[t].z:=-getpointz3d+20;
      coords[t].col:=(round(coords[t].z)*4);
      if coords[t].col<0 then coords[t].col:=0;
      if coords[t].col>230 then coords[t].col:=230;
    end;
    for t:=0 to Nbrofface do
    begin
      coords[t].z2:=coords[facelist[t].a].z;
      pind[t]:=t;
    end;
    quicksort(0,NbrOfFace);
    for t:=0 to NbrOfFace do
    begin
      coordy1:=coords[facelist[pind[t]].a].y;
      coordy2:=coords[facelist[pind[t]].b].y;
      coordy3:=coords[facelist[pind[t]].c].y;
      coordx1:=xax+coords[facelist[pind[t]].a].x;
      coordx2:=xax+coords[facelist[pind[t]].b].x;
      coordx3:=xax+coords[facelist[pind[t]].c].x;
      textpoly3(coordx1,coordy1,coords[facelist[pind[t]].a].col,
                coordx2,coordy2,coords[facelist[pind[t]].b].col,
                coordx3,coordy3,coords[facelist[pind[t]].c].col);{}
    end;
    retrace;
    flip(txtbuff,$b800);
    clrscr2(txtbuff);
  until  (democounter=250) or (keypressed);
end;

procedure viewpresents;
var coordy1,coordy2,coordy3 : integeR;
    coordx1,coordx2,coordx3 : integeR;
begin
  setdistance(250);
  democounter:=0;
  load('pres2.3dp');
  setrotangles(270,180,90);
  setrotatespeed(0,15,0);
  repeat
    inc(democounter);
    genrotangles;
    for t:= 0 to NbrOfVertex do
    begin
      setpoint(vertexlist[t].x ,vertexlist[t].y-60,vertexlist[t].z);
      coords[t].x:=(getpointx2d div 3)-13;
      coords[t].y:=(getpointy2d div 3)-10;
      coords[t].z:=-getpointz3d+20;
      coords[t].col:=(round(coords[t].z)*1)+050;
      if coords[t].col<0 then coords[t].col:=0;
      if coords[t].col>230 then coords[t].col:=230;
    end;
    for t:=0 to Nbrofface do
    begin
      coords[t].z2:=coords[facelist[t].a].z;
      pind[t]:=t;
    end;
    quicksort(0,NbrOfFace);
    for t:=0 to NbrOfFace do
    begin
      coordy1:=coords[facelist[pind[t]].a].y;
      coordy2:=coords[facelist[pind[t]].b].y;
      coordy3:=coords[facelist[pind[t]].c].y;
      coordx1:=xax+coords[facelist[pind[t]].a].x;
      coordx2:=xax+coords[facelist[pind[t]].b].x;
      coordx3:=xax+coords[facelist[pind[t]].c].x;
      textpoly3(coordx1,coordy1,coords[facelist[pind[t]].a].col,
                coordx2,coordy2,coords[facelist[pind[t]].b].col,
                coordx3,coordy3,coords[facelist[pind[t]].c].col);{}
    end;
    retrace;
    flip(txtbuff,$b800);
    clrscr2(txtbuff);
  until  (democounter=192)or (keypressed);
end;

procedure view3d(filename:string;startx,starty,startz,xrot,yrot,zrot,xc,yc,zc,zv:integer);
var xcc,ycc,zcc,cy,cx,cz : integer;
begin
  load(filename);
  setrotangles(startx,starty,startz);
  setrotatespeed(xrot,yrot,zrot);
  democounter:=0;
  xcc:=0;
  ycc:=0;
  zcc:=0;
  cx:=xc div 2;
  cy:=yc div 2;
  cz:=zc div 2;
  repeat
    if xcc<xc then inc(xcc);
    if ycc<yc then inc(ycc);
    if zcc<zc then inc(zcc);
    if xcc>xc then dec(xcc);
    if ycc>yc then dec(ycc);
    if zcc>zc then dec(zcc);
    genrotangles;
    for t:= 0 to NbrOfVertex do
    begin
      setpoint(xcc-cx+vertexlist[t].x,ycc-cy+vertexlist[t].y,zcc-cz+vertexlist[t].z);{}
      coords[t].x:=(getpointx2d div 3)-13;
      coords[t].y:=(getpointy2d div 3)-10;
      coords[t].z:=-getpointz3d+120+zv;
      coords[t].col:=50+(round(coords[t].z));
      if coords[t].col<0 then coords[t].col:=0;
      if coords[t].col>230 then coords[t].col:=230;{}
    end;
    for t:=0 to Nbrofface do
    begin
      coords[t].z2:=coords[facelist[t].a].z;
      pind[t]:=t;
    end;
    quicksort(0,NbrOfFace);
    for t:=0 to NbrOfFace do
      textpoly3(coords[facelist[pind[t]].a].x,coords[facelist[pind[t]].a].y,coords[facelist[pind[t]].a].col,
                coords[facelist[pind[t]].b].x,coords[facelist[pind[t]].b].y,coords[facelist[pind[t]].b].col,
                coords[facelist[pind[t]].c].x,coords[facelist[pind[t]].c].y,coords[facelist[pind[t]].c].col);{}
    retrace;
    flip(txtbuff,$b800);
    clrscr2(txtbuff);
  until ((xc=xcc)and(yc=ycc)and(zcc=zcc)) or (keypressed);
end;

procedure greetings;
begin
  initmath3d;
  view3d('greeting.3dp',0,180,270,3,6,0,0,320,0,0);
  view3d('goto.3dp'    ,0,180,270,3,6,0,0,-400,0,150);
  view3d('gollum.3dp'  ,180,0,270,3,6,6,0,460,0,0);
  view3d('crs.3dp'     ,90,270,270  ,0,6,0,0,330,330,0);
  view3d('crb.3dp'     ,90,0,270 ,0,8,0,0,410,0,0);
  view3d('destiny.3dp' ,0,270,270,6,6,0,0,290,290,0);
  view3d('condenz.3dp' ,270,180,270,6,6,0,0,320,0,0);
  view3d('darkzone.3dp',180,0,180,3,6,9,0,480,0,100);
  view3d('sorrox.3dp'  ,90,0,90,6,6,0,0,350,0,0);
  view3d('exile.3dp'   ,180,90,180,6,6,3,0,400,0,0);
  view3d('inf.3dp'     ,0,270,270,4,6,1,0,-450,0,0);
  view3d('kandu.3dp'   ,0,180,270,3,6,1,0,380,-380,0);
  view3d('scoop.3dp'   ,0,180,270,5,7,2,0,450,0,0);
  view3d('shoxx.3dp'   ,0,180,270,4,6,2,0,295,295,0);
  view3d('tec.3dp'     ,0,180,270,5,10,14,0,350,-350,0);
  view3d('cq.3dp'      ,0,90,270,10,5,10,0,320,-100,80);{}
end;

procedure zoomrot(patt,pos,patt2,pos2:word);
procedure plotxy(position:word;x,y:byte;value:char;color:byte;segment:word);
assembler;
asm
  mov si,position
  cmp si,65535
  jne @@pos
  xor dh,dh
  mov dl,y
  shl dx,4
  mov ax,dx
  shl dx,2
  add dx,ax
  mov al,x
  xor ah,ah
  add dx,ax
  mov si,dx
@@pos:
  mov es,segment
  mov al,value
  mov ah,color
  shl si,1
  mov [es:si],ax
end;


procedure flip(fra,til:word);
assembler;
asm
  mov ax,til
  mov es,ax
  mov dx,ds
  mov ax,fra
  mov ds,ax
  xor si,si
  xor di,di
  mov cx,2000
  db $66; rep movsw
  mov ds,dx
end;



Procedure MakeTables;                   {Creates sin/cos tables}
Var direction:integer;
    angle:real;
begin
  For Direction:=0 to 255 do
  begin   {use 256 degrees in circle}
    angle:=Direction;
    angle:=angle*3.14159265/128;
    SinTable[Direction]:=round(Sin(angle)*256);
    CosTable[Direction]:=round(Cos(angle)*256);
    Sin2Table[Direction]:=round(Sin(angle+3.14159265/2)*256*1.2);
    Cos2Table[Direction]:=round(Cos(angle+3.14159265/2)*256*1.2);
  end;                 { the 1.2 accounts for pixel aspect ratio }
end;

Procedure DrawScreen(x,y,scale:word; rot:byte);
var Temp:Longint;            {used for intermediate large values}
    ddx,ddy,d2x,d2y:integer;
    i,j:word;
    label hloop,vloop,nodraw;

begin
  Temp:=(CosTable[rot]);
  Temp:=(Temp*Scale) shr 8;
  ddx:=Temp;
  Temp:=(SinTable[rot]);
  Temp:=(Temp*Scale) shr 8;
  ddy:=Temp;
  Temp:=(Cos2Table[rot]);
  Temp:=(Temp*SCALE) shr 8;
  d2x:=Temp;
  Temp:=(Sin2Table[rot]);
  Temp:=(Temp*SCALE) shr 8;
  d2y:=Temp;
  i:=x-((ddx shl 5)+(ddx shl 1))-d2x*100;
  j:=y-((ddy shl 5)+(ddy shl 1))-d2y*100;
  ASM
    push ds
    mov  es,bitm
    mov  ax,txtbuff
    mov  ds,ax
    mov  ax,0          {set ds: to upper left corner of}
    mov  di,ax         {the video memory}
    mov  ax,[ddx]      {this is just to speed things up later}
    mov  si,ax         {add ax,si  faster than  add ax,[ddx] }
    mov  cx,50         {Number of rows on Screen}
vloop:
    push cx
    mov  ax, i         {start scanning the source bitmap}
    mov  dx, j         {at i,j which were calculated above.}
    mov  cx,80         {Number of coulumns on screen}
hloop:
    add  ax,si         {add the 'right' vector to the current}
    add  dx,ddy        {bitmap coordinates.  8.8 fixed point}
    mov  bl,ah         {  bx = 256*int(y)+int(x)  }
    mov  bh,dh
    shl  bx,1
    mov  bx,[es:bx]    { load a pixel from source }
    mov  [ds:di],bx    { copy it to destination }
    inc  di            { advance to next destination pixel }
    inc  di            { advance to next destination pixel }
    loop hloop         {End of horizontal loop}
    mov  ax,d2x        { get the 'down' vector }
    mov  dx,d2y
{   add  si,8          {** uncomment this instr. for extra fun **}
    add si,cx
    add  i,ax          { i,j is the starting coords for a line }
    add  j,dx          { so this moves down one line }
    pop  cx            { get the row count back and loop }
    loop vloop         { End of verticle loop }
    pop  ds            { Restore the ds }
  end;
end;

Procedure DrawImage;  {draws a test image which shows some limitations.}
Var   t,t2        : word;
      f           : text;
      cc          : char;
      ch          : char;
Begin
  asm
    mov cx,$ffff
    mov es,bitm
    xor di,di
    rep stosb
  end;
  letter:='*';
  assign(f,'intel.txt');
  reset(f);
  for t:=0 to 127 do
  begin
    for t2:=0 to 256 do
    begin
      read(f,cc);
      read(f,cc);
      if cc<>#0 then cc:=chr(black) else cc:=chr(white);
      if not eof(f) then
      if cc>#0 then
      plotxy(t2+t shl 8,7,7,letter,ord(cc),bitm)
      else
      plotxy(t2+t shl 8,7,7,' ',black,bitm)
    end;
  end;
  close(f);
end;

Var  rot,dr:word;
     x,y,dist,dd:word;
     error:word;
Begin
  textmode(258);
  getmem(bitp,65535);
  bitm:=seg(bitp^);
  initmath3d;
  DrawImage;
  MakeTables;
  x:=29535;
  y:=28535;
  rot:=0;
  dr:=1;
  dist:=2495;
  dd:=5;
  DrawScreen(x,y,(pcsin(dist)+128)*16,lo(rot));
  flip(txtbuff,segb800);
  repeat until (synced(patt,pos)) or (keypressed);
  repeat
    retrace;
    flip(txtbuff,segb800);
    DrawScreen(x,y,(pcsin(dist)+128)*16,lo(rot));
    rot:=rot+dr;
    dist:=dist+dd;
    if dist>2880 then dec(dist,2880);
  until (synced(patt2,pos2)) or (keypressed);
  freemem(bitp,65535);
end;

var cc : Char;

begin
{  SoundCardName:='SB16.MSE';
  SoundCardName:='GUS.MSE';{}
  clrscr;
  gotoxy(20,10);
  write('1....  Gravis Ultrasound');
  gotoxy(20,11);
  write('2....  Sound Blaster 16 ');
  gotoxy(20,12);
  write('3....  Sound Blaster pro');
  gotoxy(20,13);
  write('4....  No loud music, please');
  repeat cc:=readkey until (cc='1') or (cc='2') or (cc='3') or (cc='4');
  nomusic:=false;
  case cc of
  '1' :   SoundCardName:='GUS.MSE';
  '2' :   SoundCardName:='SB16.MSE';
  '3' :   SoundCardName:='SBpro.MSE';
  '4' :   nomusic:=true;
  end;
  time2:=time;
  for t:=0 to 255 do
  begin
    tab1[t]:=round(sin(2*pi*t/255)*30)+15;
    tab2[t]:=round(cos(2*pi*t/255)*30)+15;
  end;
  i1:=50;
  j1:=90;
  for t:=0 to 255 do moded[t]:=t mod 255;
  for t:=0 to  15 do
  begin
    colorarr[t]:=    ' ';
    colorarr[t+16]:= '�';
    colorarr[t+32]:= '�';
    colorarr[t+48]:= ':';
    colorarr[t+64]:= ';';
    colorarr[t+80]:= '|';
    colorarr[t+96]:= '�';
    colorarr[t+112]:='O';
    colorarr[t+128]:='�';
    colorarr[t+144]:='#';
    colorarr[t+160]:='@';
    colorarr[t+176]:='�';
    colorarr[t+192]:='�';
    colorarr[t+208]:='�';
    colorarr[t+224]:='�';
  end;
  for t:=0 to 79 do
  begin
    col[t]:=lightgray;
    col[t+16]:=lightgray;
    col[t+96]:=lightgray;
    col[t+176]:=lightgray;
  end;
  for t:=0 to 50 do y80[t]:=t*80;
  democounter:=0;
  getmem(textbuffer,4160*2);
  txtbuff:=seg(textbuffer^);
  clrscr2(txtbuff);
  getmem(screensht1,4160*2);
  shot1:=seg(screensht1^);
  clrscr2(shot1);
  getmem(screensht2,4160*2);
  shot2:=seg(screensht2^);
  clrscr2(shot2);
  initmath3d;
  textmode(258);
  cursor(false);
    if nomusic then else
    begin
      uncompressfile('musikk1.dat','datafile.dat');{}
      initplayer('datafile.dat');
      deletefile('datafile.dat');
      musicloop(0);
    end;
    load('atclogo2.3dp');
    viewatc;
    viewpresents;
    load('in.3dp');
    view(2);
    load('pure.3dp');
    viewatc;
    load('textmode.3dp');
    view(2);
    ringnescola   (6,0);
    load('torus4.3dp');
    mainloop      (8,00,8,20);
    plasma2       (12,0);
    tmapping      (14,0);
    Zoomrot       (15,0,18,0);
    clrscr;
    if nomusic then else
    begin
      for t:=64 downto 0 do
      begin
        delay(50);
        musicvolume(t);
      end;
      stopsound;                {}
      initplayer('thebass7.gdm');
      musicvolume(64);
    end;
    clrscr;
    greetings;
    view3d('code.3dp'    ,180,180,270,0,6,0,0,-380,0,0);
    view3d('joker.3dp'   ,180,180, 90,6,6,6,0,-380,0,0);
    view3d('music.3dp'   ,  0,180,270,0,8,0,0,350,0,70);
    view3d('lloyd.3dp'   ,180,180,250,0,0,8,0,-380,0,0);
    if nomusic then else
    begin
      for t:=64 downto 0 do
      begin
        delay(50);
        musicvolume(t);
      end;{}
      stopsound; {}
    end;
  asm
    mov ax,3h
    int 10h
  end;
  freemem(textbuffer,4160*2);
  freemem(screensht1,4160*2);
  freemem(screensht2,4160*2);
  cursor(true);
end.