Upload

TUNNELI/BALLGEN.PAS

@@ -0,0 +1,77 @@
+uses crt;
+
+type  bc     = record
+                 x : integer;
+                 y : shortint;
+               end;
+      rengas = record
+                 x,y,r : shortint;
+               end;
+
+
+var   pallo  : array[0..100] of bc;
+      putki  : array[0..400] of rengas;
+      pcalc  : array[0..137,0..63] of bc;
+      t      : word;
+
+procedure plot(x,y:integer;c:byte);
+begin
+    if (x > 0) and (x < 319) and (y > 0) and (y < 199) then
+    mem[$a000:x+y*320] := c;
+    inc(t);
+end;
+
+procedure ball(px,py,r:integer;c:byte);
+var  x,y : word;
+begin
+     for x := 0 to 31 do plot(  px+round(sin(x*pi/16)*round(r*1.1)),  py+round(cos(x*pi/16)*r), x div 8+1 );
+end;
+
+var   x,y,z : integer;
+      x1,y1 : word;
+      a   : word;
+
+procedure clr;
+begin
+    asm
+        mov    ax,$a000
+        mov    es,ax
+        mov    cx,32000
+        mov    di,0
+        xor    ax,ax
+        rep    stosw
+    end;
+end;
+
+var  f : file;
+     r : word;
+begin
+    asm
+        mov  ax,$13
+        int  $10
+    end;
+
+    r := 0;
+    for Z := 10 to 147 do
+     for a := 0 to 63 do
+      with pcalc[z-10][a] do
+       begin
+         x := 160+round(sin(a*pi/32)*round(z*1.6));
+         y := round(cos(a*pi/32)*z);
+       end;
+
+    for x := 0 to 137 do
+     for y := 0 to 63 do plot(pcalc[x][y].x,100+pcalc[x][y].y,15);
+
+    assign(f,'tunnel.dat');
+    rewrite(f,1);
+    blockwrite(f,pcalc,sizeof(pcalc));
+    close(f);
+
+    repeat until keypressed;
+
+    asm
+        mov  ax,$3
+        int  $10
+    end;
+end.

TUNNELI/BALLGEN2.PAS

@@ -0,0 +1,77 @@
+uses crt;
+
+type  bc     = record
+                 x : integer;
+                 y : integer;
+               end;
+      rengas = record
+                 x,y,r : shortint;
+               end;
+
+
+var   pallo  : array[0..100] of bc;
+      putki  : array[0..400] of rengas;
+      pcalc  : array[0..137,0..63] of bc;
+      t      : word;
+
+procedure plot(x,y:integer;c:byte);
+begin
+    if (x > 0) and (x < 319) and (y > 0) and (y < 199) then
+    mem[$a000:x+y*320] := c;
+    inc(t);
+end;
+
+procedure ball(px,py,r:integer;c:byte);
+var  x,y : word;
+begin
+     for x := 0 to 31 do plot(  px+round(sin(x*pi/16)*round(r*1.1)),  py+round(cos(x*pi/16)*r), x div 8+1 );
+end;
+
+var   x,y,z : integer;
+      x1,y1 : word;
+      a   : word;
+
+procedure clr;
+begin
+    asm
+        mov    ax,$a000
+        mov    es,ax
+        mov    cx,32000
+        mov    di,0
+        xor    ax,ax
+        rep    stosw
+    end;
+end;
+
+var  f : file;
+     r : word;
+begin
+    asm
+        mov  ax,$13
+        int  $10
+    end;
+
+    r := 0;
+    for Z := 10 to 147 do
+     for a := 0 to 63 do
+      with pcalc[z-10][a] do
+       begin
+         x := 160+round(sin(a*pi/32)*round(z*1.7));
+         y := 100+round(cos(a*pi/32)*z);
+       end;
+
+    for x := 0 to 137 do
+     for y := 0 to 63 do plot(pcalc[x][y].x,pcalc[x][y].y,15);
+
+    assign(f,'tunnel.dat');
+    rewrite(f,1);
+    blockwrite(f,pcalc,sizeof(pcalc));
+    close(f);
+
+    repeat until keypressed;
+
+    asm
+        mov  ax,$3
+        int  $10
+    end;
+end.

TUNNELI/BALLGEN3.PAS

@@ -0,0 +1,77 @@
+uses crt;
+
+type  bc     = record
+                 x : integer;
+                 y : integer;
+               end;
+      rengas = record
+                 x,y,r : shortint;
+               end;
+
+
+var   pallo  : array[0..100] of bc;
+      putki  : array[0..400] of rengas;
+      pcalc  : array[0..117,0..63] of bc;
+      t      : word;
+
+procedure plot(x,y:integer;c:byte);
+begin
+    if (x > 0) and (x < 319) and (y > 0) and (y < 199) then
+    mem[$a000:x+y*320] := c;
+    inc(t);
+end;
+
+procedure ball(px,py,r:integer;c:byte);
+var  x,y : word;
+begin
+     for x := 0 to 31 do plot(  px+round(sin(x*pi/16)*round(r*1.1)),  py+round(cos(x*pi/16)*r), x div 8+1 );
+end;
+
+var   x,y,z : integer;
+      x1,y1 : word;
+      a   : word;
+
+procedure clr;
+begin
+    asm
+        mov    ax,$a000
+        mov    es,ax
+        mov    cx,32000
+        mov    di,0
+        xor    ax,ax
+        rep    stosw
+    end;
+end;
+
+var  f : file;
+     r : word;
+begin
+    asm
+        mov  ax,$13
+        int  $10
+    end;
+
+    r := 0;
+    for Z := 20 to 137 do
+     for a := 0 to 63 do
+      with pcalc[z-20][a] do
+       begin
+         x := 160+round(sin(a*pi/32)*round(z*1.7));
+         y := 100+round(cos(a*pi/32)*z);
+       end;
+
+    for x := 0 to 117 do
+     for y := 0 to 63 do plot(pcalc[x][y].x,pcalc[x][y].y,15);
+
+    assign(f,'tunnel.dat');
+    rewrite(f,1);
+    blockwrite(f,pcalc,sizeof(pcalc));
+    close(f);
+
+    repeat until keypressed;
+
+    asm
+        mov  ax,$3
+        int  $10
+    end;
+end.

TUNNELI/MAKEOB.BAT

@@ -0,0 +1 @@
+binobj tunnel.dat tunneli tun

TUNNELI/ROUTINES.ASM

@@ -0,0 +1,69 @@
+          .MODEL  large,PASCAL
+          .CODE
+          .386
+
+oldpos    dw     7000 dup (0)
+rows      dw     210 dup(0)
+op        dw     0
+
+rowinit   proc   far
+          PUBLIC rowinit
+          mov    cx,200
+          mov    ax,0
+          mov    bx,0
+@ri:      mov    cs:rows[bx],ax
+          add    ax,320
+          add    bx,2
+          loop   @ri
+          ret
+rowinit   endp
+
+
+init      proc   far
+          PUBLIC init
+          mov    word ptr cs:op,0
+          ret
+init      endp
+
+Putrouts  PROC FAR
+          PUBLIC Putrouts
+          push   ds
+          mov    ds,ax
+
+          mov    ax,0a000h
+          mov    es,ax
+
+;          mov    byte ptr cs:[@c+3],cl
+          mov    word ptr cs:[@yad+1],bx
+
+          mov    ax,cs:Op
+          mov    cx,64
+@dr:
+          mov    bx,ax
+          mov    di,word ptr cs:oldpos[bx]
+          mov    byte ptr es:[di],0
+
+@yad:     mov    bx,1234                 ; absolute change, Y base of circle
+          add    bx,word ptr ds:[si+2]   ; add y value
+          cmp    bx,199
+          ja     @yli
+          mov    di,word ptr ds:[si]   ; { get x value }
+          add    di,dx
+          cmp    di,319
+          ja     @yli
+          add    bx,bx
+          add    di,word ptr cs:rows[bx]
+@c:       mov    byte ptr es:[di],15
+
+@yli:     mov    bx,ax
+          mov    word ptr cs:oldpos[bx],di
+          add    ax,2
+
+          add    si,4
+          loop   @dr
+          mov    cs:Op,ax
+          pop    ds
+          ret
+Putrouts  ENDP
+
+end

TUNNELI/SINGEN.PAS

@@ -0,0 +1,14 @@
+var   x     : word;
+      sinit : array[0..4096] of word;
+      cosit : array[0..2048] of word;
+      f     : file;
+begin
+    for x := 0 to 4096 do Sinit[x] := round(sin((x)/128*pi)*((x*3) div 128));
+    for x := 0 to 2048 do Cosit[x] := round(cos((x)/128*pi)*((x*4) div 64));
+
+    assign(f,'sinit.dat');
+    rewrite(f,2);
+    blockwrite(f,sinit,4097);
+    blockwrite(f,cosit,2049);
+    close(f);
+end.

TUNNELI/TUN10.LNK

@@ -0,0 +1,4 @@
+TUN10.OBJ
+TUN10
+NUL
+f:\sbpas\PASLIB.LIB

TUNNELI/TUN10.PAS

@@ -0,0 +1,228 @@
+uses crt;
+
+const veke = 1060;    { frame count to exit }
+
+type
+      bc     = record
+                 x : integer;
+                 y : integer;
+               end;
+
+      rengas = record
+                 x,y   : integer;
+                 c     : byte;
+               end;
+
+var
+      putki  : array[0..102] of rengas;
+      pcalc  : array[0..137,0..63] of bc;
+
+      aa1    : array[0..100] of word;
+      rows   : array[0..200] of word;
+      aa2    : array[0..200] of word;
+
+      sinit  : array[0..4096] of word;
+      cosit  : array[0..2048] of word;
+      sade   : array[0..102] of word;
+      frame  : word;
+      bor    : byte;
+      frames : word;
+
+{$L tunneli.obj}
+procedure tun;external;
+{$L sinit.obj}
+procedure sini;far;external;
+
+procedure setrgb(c,r,g,b:byte);
+begin
+     port[$3c8] := c;
+     port[$3c9] := r;
+     port[$3c9] := g;
+     port[$3c9] := b;
+end;
+
+procedure waitr;
+begin
+        setrgb(0,0,0,0);
+        asm
+	mov	bx,1
+	int	0fch
+        mov     frames,ax
+        end;
+        if mem[$40:$17] and 16 = 16 then setrgb(0,0,0,15);
+end;
+
+function dis_exit:boolean;
+var   a : byte;
+begin
+        asm
+	mov	bx,2
+	int	0fch
+        mov     a,al
+        end;
+        if a = 0 then dis_exit := false else dis_exit := true;
+end;
+
+
+var  oldpos : array[0..7500] of word;
+     op     : word;
+     ry     : word;
+
+var  x,y,z : integer;
+     x1,y1 : word;
+     a   : word;
+     f   : file;
+
+     sx,sy : word;
+     _bx,by : word;
+     br    : byte;
+     bbc   : byte;
+     pcp   : word;
+     pc    : byte;
+     mx,my : integer;
+     addi,yvalue : word;
+     ch          : char;
+     oo          : word;
+     flip        : byte;
+     quit        : boolean;
+     sync        : word;
+
+label poies;
+begin
+
+    x := 0;y := 0;z := 0;x1 := 0;y1 := 0;a := 0;sx := 0;sy := 0;
+
+    quit := false;
+
+{    fillchar(oldpos,sizeof(oldpos),#0);}
+
+    for x := 0 to 100 do aa1[x] := 64000;
+    move(aa1,aa2,sizeof(aa1));
+    for x := 0 to 200 do rows[x] := x*320;
+    move(mem[seg(sini):ofs(sini)],sinit,4097*2);
+    move(mem[seg(sini):ofs(sini)+4097*2],cosit,2048*2);
+    move(mem[seg(tun):ofs(tun)],pcalc,sizeof(pcalc));
+
+{
+    for x := 0 to 4096 do Sinit[x] := round(sin((x)/128*pi)*((x*3) div 16));
+    for x := 0 to 2048 do Cosit[x] := round(cos((x)/256*pi)*((x*4) div 32));
+}
+    asm
+        mov  ax,$13
+        int  $10
+
+	xor	bx,bx
+	int	0fch
+    end;
+{
+    for x := 0 to 64 do setrgb(64+x,(64-x) *4 div 7,(64-x) * 2 div 3,64-x);
+    for x := 0 to 64 do setrgb(128+x,(64-x) div 3,(64-x) div 2,(64-x) * 2 div 3);
+}
+    for x := 0 to 64 do setrgb(64+x ,(64-x),(64-x),(64-x));
+    for x := 0 to 64 do setrgb(128+x,(64-x) *3 div 4,(64-x) *3 div 4,(64-x) *3 div 4);
+
+    setrgb(68,0,0,0);
+    setrgb(132,0,0,0);
+
+
+    setrgb(255,0,63,0);
+
+    for x := 0 to 100 do
+     begin
+      putki[x].x := 0;
+      putki[x].y := 0;
+      putki[x].c := 0;
+     end;
+
+  sx := 0;
+  sy := 0;
+
+  pc := 60;
+  addi := 40;
+  flip := 0;
+  bor := 0;
+  frame := 0;
+  quit := false;
+
+  waitr;
+  for Z := 0 to 100 do sade[z] := round(16384 div ((Z*7)+95));
+
+  repeat
+    waitr;
+    ry := 0;
+    for x := 80 downto 4 do
+     begin
+     _bx := putki[x].x-putki[5].x;
+      by := putki[x].y-putki[5].y;
+      br := sade[x];
+      bbc := putki[x].c+round(x / 1.3);
+      pcp := ofs(pcalc[br][0]);
+
+      if bbc >= 64 then
+       asm
+        mov    ax,$a000
+        mov    es,ax
+        mov    si,PCP
+        mov    dx,_BX
+        mov    al,bbc
+        mov    byte ptr cs:[@c+3],al
+
+        mov    cx,64
+        mov    ax,RY
+
+        push   bp
+        mov    bp,BY
+@a:     mov    bx,ax
+        mov    di,word ptr ds:oldpos[bx]
+        mov    byte ptr es:[di],0
+
+        mov    di,word ptr ds:[si]
+        add    di,dx
+        cmp    di,319
+        ja     @yli
+        mov    bx,bp
+        add    bx,word ptr ds:[si+2]
+        add    bx,bx
+        add    di,word ptr ds:rows[bx]
+@c:     mov    byte ptr es:[di],15
+@yli:
+        mov    bx,ax
+        mov    word ptr ds:oldpos[bx],di
+        add    si,4
+        add    ax,2
+        dec    cx
+        jnz    @a
+        pop    bp
+        mov    RY,ax
+       end;
+     end;
+
+     for sync := 1 to frames do
+     begin
+     putki[100].x := cosit[sy and 2047]-sinit[sy*3 and 4095]-cosit[sx and 2047];
+     putki[100].y := sinit[sx*2 and 4095]-cosit[sx and 2047]+sinit[y and 4095];
+     move(putki[1],putki[0],ofs(putki[100])-ofs(putki[0]));
+     inc(sy);
+     inc(sx);
+{
+     asm
+     mov   ax,0
+     mov   bx,6
+     int   0fch
+     cmp   ax,-4
+     jnz   @a
+     mov   quit,1
+@a:
+     end;
+}
+
+     if (sy and 15) > 7 then putki[99].c := 128 else putki[99].c := 64;
+     if frame >= veke-102 then putki[99].c := 0;
+     if frame = veke then quit := true else inc(frame);
+{     inc(frame);}
+     if dis_exit then quit := true;
+     if quit then goto poies;
+     end;
+poies:
+  until quit;
+end.

TUNNELI/TUN9.LNK

@@ -0,0 +1,4 @@
+TUN9.OBJ
+TUN9
+NUL
+f:\sbpas\PASLIB.LIB

TUNNELI/TUN9.PAS

@@ -0,0 +1,246 @@
+uses crt;
+
+const veke = 980;    { frame count to exit }
+
+type
+      bc     = record
+                 x : integer;
+                 y : integer;
+               end;
+
+      rengas = record
+                 x,y   : integer;
+                 r     : byte;
+                 c     : byte;
+               end;
+
+var
+      putki  : array[0..102] of rengas;
+      pcalc  : array[0..137,0..63] of bc;
+
+      aa1    : array[0..200] of word;
+      rows   : array[0..200] of word;
+      aa2    : array[0..200] of word;
+
+      sinit  : array[0..4098] of word;
+      cosit  : array[0..2050] of word;
+      frame  : word;
+      bor    : byte;
+      frames : word;
+
+{$L tunneli.obj}
+procedure tun;external;
+{$L sinit.obj}
+procedure sini;far;external;
+
+procedure setrgb(c,r,g,b:byte);
+begin
+     port[$3c8] := c;
+     port[$3c9] := r;
+     port[$3c9] := g;
+     port[$3c9] := b;
+end;
+
+procedure waitr;
+begin
+        setrgb(0,0,0,0);
+        asm
+	mov	bx,1
+	int	0fch
+        mov     frames,ax
+        end;
+        if mem[$40:$17] and 16 = 16 then setrgb(0,0,0,15);
+end;
+
+function dis_exit:boolean;
+var   a : byte;
+begin
+        asm
+	mov	bx,2
+	int	0fch
+        mov     a,al
+        end;
+        if a = 0 then dis_exit := false;
+end;
+
+
+var  oldpos : array[0..7500] of word;
+     op     : word;
+     ry     : word;
+
+var  x,y,z : integer;
+     x1,y1 : word;
+     a   : word;
+     f   : file;
+
+     sx,sy : word;
+     _bx,by : word;
+     br    : byte;
+     bbc   : byte;
+     pcp   : word;
+     pc    : byte;
+     mx,my : integer;
+     addi,yvalue : word;
+     ch          : char;
+     oo          : word;
+     flip        : byte;
+     quit        : boolean;
+     sync        : word;
+
+label poies;
+begin
+
+    x := 0;y := 0;z := 0;x1 := 0;y1 := 0;a := 0;sx := 0;sy := 0;
+
+    quit := false;
+
+{    fillchar(oldpos,sizeof(oldpos),#0);}
+
+    for x := 0 to 200 do aa1[x] := 64000;
+    move(aa1,aa2,sizeof(aa1));
+    for x := 0 to 200 do rows[x] := x*320;
+    move(mem[seg(sini):ofs(sini)],sinit,4097*2);
+    move(mem[seg(sini):ofs(sini)+4097*2],cosit,2048*2);
+    move(mem[seg(tun):ofs(tun)],pcalc,sizeof(pcalc));
+
+{
+    for x := 0 to 4096 do Sinit[x] := round(sin((x)/128*pi)*((x*3) div 16));
+    for x := 0 to 2048 do Cosit[x] := round(cos((x)/256*pi)*((x*4) div 32));
+}
+    asm
+        mov  ax,$13
+        int  $10
+
+	xor	bx,bx
+	int	0fch
+    end;
+
+    for x := 0 to 64 do setrgb(64+x,(64-x) div 2,(64-x) div 2,64-x);
+    for x := 0 to 64 do setrgb(128+x,(64-x) div 4,(64-x) div 3,(64-x) div 2);
+
+    setrgb(68,0,0,0);
+    setrgb(132,0,0,0);
+
+
+    setrgb(255,0,63,0);
+
+    for x := 0 to 100 do
+     begin
+      putki[x].x := 0;
+      putki[x].y := 0;
+      putki[x].r := 0;
+      putki[x].c := 0;
+     end;
+
+  sx := 0;
+  sy := 0;
+
+  pc := 60;
+  addi := 40;
+  flip := 0;
+  bor := 0;
+  frame := 0;
+  quit := false;
+
+  waitr;
+  for Z := 0 to 100 do putki[z].r := round(16384 div ((Z*7)+95));
+
+  repeat
+    waitr;
+
+
+    ry := 0;
+    for x := 80 downto 4 do
+     begin
+     _bx := putki[x].x-putki[5].x;
+      by := putki[x].y-putki[5].y;
+      br := putki[x].r;
+      bbc := putki[x].c+round(x / 1.3);
+      pcp := ofs(pcalc[br][0]);
+
+      if bbc >= 64 then
+       asm
+        mov    ax,$a000
+        mov    es,ax
+        mov    si,PCP
+        mov    dx,_BX
+        mov    al,bbc
+        mov    byte ptr cs:[@c+3],al
+
+        mov    cx,64
+        mov    ax,RY
+
+        push   bp
+        mov    bp,BY
+@a:     mov    bx,ax
+        mov    di,word ptr ds:oldpos[bx]
+        mov    byte ptr es:[di],0
+
+        mov    di,word ptr ds:[si]
+        add    di,dx
+        cmp    di,319
+        ja     @yli
+        mov    bx,bp
+        add    bx,word ptr ds:[si+2]
+        add    bx,bx
+        add    di,word ptr ds:rows[bx]
+@c:     mov    byte ptr es:[di],15
+@yli:
+        mov    bx,ax
+        mov    word ptr ds:oldpos[bx],di
+        add    si,4
+        add    ax,2
+        dec    cx
+        jnz    @a
+        pop    bp
+        mov    RY,ax
+       end;
+     end;
+
+     for sync := 1 to frames do
+     begin
+     putki[100].x := cosit[sy and 2047]-sinit[sy*3 and 4095]-cosit[sx and 2047];
+     putki[100].y := sinit[sx*2 and 4095]-cosit[sx and 2047]+sinit[y and 4095];
+{     move(putki[1],putki[0],ofs(putki[100])-ofs(putki[0]));}
+      asm
+
+{
+                 x,y   : integer;
+                 r     : byte;
+                 c     : byte;
+}
+
+      mov  si,offset putki[1]
+      mov  di,offset putki[0]
+      mov  cx,600
+@a:   mov  ax,ds:[si]
+      mov  ds:[di],ax
+      mov  ax,ds:[si+2]
+      mov  ds:[di+2],ax
+      mov  al,ds:[si+4]
+      mov  ds:[si+4],al
+      add  si,6
+      add  di,6
+      dec  cx
+      jnz  @a
+      end;
+     inc(sy);
+     inc(sx);
+     asm
+     mov   ax,0
+     mov   bx,6
+     int   0fch
+     cmp   ax,-4
+     jnz   @a
+     mov   quit,1
+@a:  end;
+     if (sy and 15) > 7 then putki[99].c := 128 else putki[99].c := 64;
+     if frame >= veke-102 then putki[99].c := 0;
+     if frame = veke then quit := true else inc(frame);
+     if dis_exit then quit := true;
+     if quit then goto poies;
+     end;
+poies:
+
+  until quit;
+end.

TUNNELI/TUNN.PAS

@@ -0,0 +1,7 @@
+unit tunn;
+{$L tunneli.obj}
+interface
+procedure tun;far;
+implementation
+procedure tun;external;
+end.

TUNNELI/X.BAT

@@ -0,0 +1 @@
+copy tun10.exe ..\main\data\tunneli.exe