06

Spinning Cubes

Another demo scene staple was simulating 3D objects on 2D hardware, so here are some rotating cubes.

I've struggled to attribute the first one in this collection - the text doesn't feel like my own, although 30 years make this hazy. There are other anomalies detailed below. I highly suspect it isn't mine, but can't figure out the author. Any leads are appreciated. The rest are my own variations.

BOX

This one is unattributed. The compiled binary is thirteen months older than ASMBOX and is built from this source; it holds all eight of the file's string literals, in order, byte for byte. So the cube came first, and BOX.PAS's 1995-09-21 date is a re-save.

Strange Directory: It points at a directory that never existed here. Of seventy-odd files, BOX is the only one that hands InitGraph a non-empty path. Every other program, mine and borrowed alike, passes ''. That path is a fossil of a machine where Turbo Pascal lived at C:\TP\; this archive lived at C:\turbo\. It is inert either way, because RegisterBGIDriver runs two lines above it and InitGraph never goes to disk at all, which is precisely why it survived unnoticed.

The Timestamp: July 1994 is inside a school year before I had a computer in the house. I had taken another Pascal class the prior school year and the one after, but not this one. Whatever machine compiled BOX.EXE at 1:26 in the morning, it was not one I had.

This is the odd one out on every axis: 640×480 through BGI rather than 360×480 through jmodex, fully spelled-out names, comments, a help screen, and six faces instead of twelve edges.

The new machinery is SETPRIORITIES, a home-made depth sort, and the rule IF (order<4) - only the three nearest faces are drawn at all. That is not back-face culling; there are no normals anywhere in the file. It is "a convex cube shows exactly three faces, so draw three." With no fill routine each face gets its two diagonals in its own color, which is as close to shading as BGI would get you for free. Two details worth pointing at. The erase rectangle bar(215,135,425,345) is 320±105, and the cube's furthest corner is 60√3 = 103.9, sized by hand, and tight. And the program ends with FOR x:=1 TO 6 DO Writeln(priority[x]), left in: debug output for the sort, printed to a text screen the moment you quit.

What is certain is everything downstream. ASMBOX's rotation matrix is character-identical to BOX's, down to idiosyncrasies like cos(y)*(-sin(z)), so it was copied, not re-derived. But it took only the trigonometry. SETPRIORITIES, the cleverest thing in the family, appears in exactly two files, BOX and BOX2, and never in anything written from scratch. I likely didn't understand it and kept the parts I did.

ASMBOX

The first of the five 1995 files, and the only one that turns on all three axes at once. Eight points, twelve edges, no sorting, no zoom, no velocity - press X, Y or Z to stop and start an axis. Its rotation matrix came straight out of BOX and its depth sort did not. There is no retrace wait: the loop body draws the cube, reads the keyboard, and then calls clear_vga_screen(0), so the erase lands wherever in the frame it lands, which causes a flicker. Untick the box to fix that; the file itself has no way to do that. Also note the angle wrap: IF x=361 THEN x:=0 is tested before the increment, so the counter runs 1..361 and 361° is drawn as a repeat of 1°. One duplicated frame per revolution, in all six files.

ASMBOX3

The whole program is now fourteen lines with every procedure renamed to a single letter (k, f, g, m, h). Three things are new and all three stick: a proper double-edge retrace wait, an integer zoom z applied as *z/10 inside the rotate loop, and velocity instead of on/off: I/K/J/M nudge the per-frame angle step rather than toggling it, clamped to ±50. The z axis is gone; the matrix is the same one with zangle fixed at 0. Both this file and ASMBOX2 start at rest (nothing moves until you press a key) so the demo opens them at pitch 1, yaw 1 instead, which is two keystrokes from where the original starts you. I/M and K/J adjust from there; W and S zoom.

WINGS

I had started working on some enhancements to ASMBOX and a bug resulted in this weird wing shape. It wasn't intentional, but I liked it enough to save a separate file for it. It seems that I kept working and managed to break it, with the archive version rendering a single point. The demo here sneaks a bug fix in to show the wing shape, but you can check the box to remove the fix. There were a few issues with this code: (1) the main block reads SetPoints;h:=50; but h is a global, so it is still 0 when the points are generated, and all eighteen land on the origin. (2) Drawc was never touched: it still draws the cube's twelve edges over points 1..8, so points 9..18 are computed every frame and never referenced.

ASMBOX2

Chronologically last of the three, but I would guess that I wanted to add more features, and the minified ASMBOX3 would be a pain to work with so I went back to this one to do so. Drawc takes a center (j,k) so R/D/F/C pan the cube, and the zoom is a real rather than an integer. That last change carries a bug: ASMBOX3 initialized z:=10 and divided by 10, so it started at 1.0×. ASMBOX2 kept the /10 and set z:=1, so it starts at 0.1×, a twelve-pixel cube, and you have to press W nine times to get back to where you were. Untick the box to start it at 1.0× instead.

BOX2

This is the year-old BOX being opened and worked on. The same program in Mode X: BGI and its Line3d/setcolor go, jmodex and a one-line helper L(a,b,c,d,e) come in, the six SetPoints faces collapse from 72 commented assignments to one dense procedure named a, and the color Case becomes 1:c:=4; 2:c:=1; 3:c:=7;… SETPRIORITIES and RotateCube and SetRotation survive with only the variable names shortened: s for side, ci for CubeImage. The loop drops the dirty-rect bar for a whole-screen clear, drops the Delay, and starts with all three axes turning. The Writeln debug line is gone too. This is the minification habit caught mid-stroke: the interesting half of the file is preserved exactly and everything around it is compressed.

BOX.PAS

1995-09-21 23:47 · 7,069 bytes · First compiled 1994-07-24 (BOX.EXE). Verbose, commented, BGI at 640×480, six sorted faces.

USES crt, graph, bgidriv;
VAR
  Cube: ARRAY[1..6,1..3,1..4] OF integer;
  CubeImage: ARRAY[1..6,1..3,1..4] OF integer;
  rotation: ARRAY[1..3,1..3] OF real;
  Priority: ARRAY[1..6] OF BYTE;
  DrawOrder: ARRAY[1..6] OF Byte;
  driver, mode: integer;
  x, y, z, d: integer;
  ch: char;
  incx, incy, incz: boolean;


PROCEDURE SETPRIORITIES;
VAR Z:ARRAY[1..6] OF REAL;
    SIDE: INTEGER;
    SIDE2: INTEGER;
    order, x, y, a: integer;
    count: ARRAY[1..6] OF byte;
BEGIN
  FOR SIDE:=1 TO 6 DO
      Z[SIDE]:=(CUBEIMAGE[SIDE,3,1]+CUBEIMAGE[SIDE,3,2]+CUBEIMAGE[SIDE,3,3]
                +CUBEIMAGE[SIDE,3,4]) / 4;
  FOR SIDE:=1 TO 6 DO PRIORITY[SIDE]:=1;
  FOR SIDE2:=1 TO 6 DO
    FOR SIDE:=1 TO 6 DO
        IF Z[SIDE2]>Z[SIDE] THEN INC(PRIORITY[side2]);
REPEAT
 FOR x:=1 TO 6 DO count[x]:=0;
   FOR x:=1 TO 6 DO
    FOR side:=1 TO 6 DO
     IF Priority[side]=x THEN Inc(count[x]);
 a:=0;
 REPEAT Inc(a) UNTIL (a=6) OR (count[a]=0);
 IF (count[a]=0) THEN
   BEGIN
     x:=0;
     REPEAT Inc(x) UNTIL (count[x]>1);
     y:=0;
     REPEAT Inc(y) UNTIL Priority[y]=x;
     Priority[y]:=a;
   END;
UNTIL (count[a]=1) AND (a=6);
  FOR side:=1 TO 6 DO DrawOrder[Priority[side]]:=side;
END;



PROCEDURE RotateCube;
VAR row, column, side: byte;
BEGIN
  FOR side:=1 TO 6 DO
   FOR row:=1 TO 3 DO
    FOR column:=1 TO 4 DO
     CubeImage[side,row,column]:=Trunc((rotation[row,1]*Cube[side,1,column])
                                      +(rotation[row,2]*Cube[side,2,column])
                                      +(rotation[row,3]*Cube[side,3,column]));
END; {PROCEDURE RotateCube}





PROCEDURE SetRotation (xangle, yangle, zangle: integer);
VAR x, y, z: real;
BEGIN
  x:=xangle*(pi/180);
  y:=yangle*(pi/180);
  z:=zangle*(pi/180);
  rotation[1,1]:=cos(y)*cos(z);
  rotation[1,2]:=cos(y)*(-sin(z));
  rotation[1,3]:=(-sin(y));
  rotation[2,1]:=cos(x)*sin(z)+sin(x)*sin(y)*cos(z);
  rotation[2,2]:=cos(x)*cos(z)+sin(x)*sin(y)*(-sin(z));
  rotation[2,3]:=sin(x)*cos(y);
  rotation[3,1]:=sin(z)*(-sin(x))+cos(x)*sin(y)*cos(z);
  rotation[3,2]:=(-sin(x))*cos(z)+cos(x)*sin(y)*(-sin(z));
  rotation[3,3]:=cos(x)*cos(y);
END;




PROCEDURE Line3d (x1, y1, z1, x2, y2, z2: integer);
BEGIN
  y1:=479-y1;
  y2:=479-y2;
  Line (x1, y1,
        x2, y2);
END;




PROCEDURE SetPoints;
BEGIN
  Cube[1,1,1]:=-60; Cube[1,2,1]:=-60; Cube[1,3,1]:=-60;   {front face}
  Cube[1,1,2]:=60; Cube[1,2,2]:=-60; Cube[1,3,2]:=-60;
  Cube[1,1,3]:=60; Cube[1,2,3]:=60; Cube[1,3,3]:=-60;
  Cube[1,1,4]:=-60; Cube[1,2,4]:=60; Cube[1,3,4]:=-60;

  Cube[2,1,1]:=-60; Cube[2,2,1]:=-60; Cube[2,3,1]:=60;   {back face}
  Cube[2,1,2]:=60; Cube[2,2,2]:=-60; Cube[2,3,2]:=60;
  Cube[2,1,3]:=60; Cube[2,2,3]:=60; Cube[2,3,3]:=60;
  Cube[2,1,4]:=-60; Cube[2,2,4]:=60; Cube[2,3,4]:=60;

  Cube[3,1,1]:=60; Cube[3,2,1]:=-60; Cube[3,3,1]:=-60;   {right face}
  Cube[3,1,2]:=60; Cube[3,2,2]:=60; Cube[3,3,2]:=-60;
  Cube[3,1,3]:=60; Cube[3,2,3]:=60; Cube[3,3,3]:=60;
  Cube[3,1,4]:=60; Cube[3,2,4]:=-60; Cube[3,3,4]:=60;

  Cube[4,1,1]:=-60; Cube[4,2,1]:=-60; Cube[4,3,1]:=-60;   {left face}
  Cube[4,1,2]:=-60; Cube[4,2,2]:=60; Cube[4,3,2]:=-60;
  Cube[4,1,3]:=-60; Cube[4,2,3]:=60; Cube[4,3,3]:=60;
  Cube[4,1,4]:=-60; Cube[4,2,4]:=-60; Cube[4,3,4]:=60;

  Cube[5,1,1]:=-60; Cube[5,2,1]:=60; Cube[5,3,1]:=-60;   {top face}
  Cube[5,1,2]:=60; Cube[5,2,2]:=60; Cube[5,3,2]:=-60;
  Cube[5,1,3]:=60; Cube[5,2,3]:=60; Cube[5,3,3]:=60;
  Cube[5,1,4]:=-60; Cube[5,2,4]:=60; Cube[5,3,4]:=60;

  Cube[6,1,1]:=-60; Cube[6,2,1]:=-60; Cube[6,3,1]:=-60;   {bottom face}
  Cube[6,1,2]:=60; Cube[6,2,2]:=-60; Cube[6,3,2]:=-60;
  Cube[6,1,3]:=60; Cube[6,2,3]:=-60; Cube[6,3,3]:=60;
  Cube[6,1,4]:=-60; Cube[6,2,4]:=-60; Cube[6,3,4]:=60;
END;



PROCEDURE DrawCube(x, y, z: integer; color:byte);
VAR side, order: byte;
    centerx, centery: integer;
BEGIN
  FOR order:=6 DOWNTO 1 DO
    BEGIN
      setcolor(color);
      side:=DrawOrder[order];
      IF (order<4) THEN
      BEGIN
      Line3d( CubeImage[side,1,1]+x, CubeImage[side,2,1]+y, CubeImage[side,3,1]+z,
              CubeImage[side,1,2]+x, CubeImage[side,2,2]+y, CubeImage[side,3,2]+z);
      Line3d( CubeImage[side,1,2]+x, CubeImage[side,2,2]+y, CubeImage[side,3,2]+z,
              CubeImage[side,1,3]+x, CubeImage[side,2,3]+y, CubeImage[side,3,3]+z);
      Line3d( CubeImage[side,1,3]+x, CubeImage[side,2,3]+y, CubeImage[side,3,3]+z,
              CubeImage[side,1,4]+x, CubeImage[side,2,4]+y, CubeImage[side,3,4]+z);
      Line3d( CubeImage[side,1,4]+x, CubeImage[side,2,4]+y, CubeImage[side,3,4]+z,
              CubeImage[side,1,1]+x, CubeImage[side,2,1]+y, CubeImage[side,3,1]+z);
      END;
      IF (order<4) THEN
      BEGIN
        centerx:=Round ((CubeImage[side,1,1]+CubeImage[side,1,3]) / 2);
        centery:=Round ((CubeImage[side,2,1]+CubeImage[side,2,3]) / 2);
        IF color<>black then
        Case Side OF
         1: Setcolor(red);
         2: setcolor(blue);
         3: setcolor(lightgray);
         4: setcolor(yellow);
         5: setcolor(green);
         6: setcolor(magenta);
        END;
        Line3d(cubeimage[side,1,1]+x,cubeimage[side,2,1]+y,cubeimage[side,3,1],
               cubeimage[side,1,3]+x,cubeimage[side,2,3]+y,cubeimage[side,3,3]);
        Line3d(cubeimage[side,1,2]+x,cubeimage[side,2,2]+y,cubeimage[side,3,2],
               cubeimage[side,1,4]+x,cubeimage[side,2,4]+y,cubeimage[side,3,4]);
      END;
    END;
END;




BEGIN {main program}
  ClrScr;
  if RegisterBGIDriver(@EGAVGADriverProc) < 0 then halt(1);
  driver:=VGA; mode:=VGAhi; Initgraph (driver,mode,'C:\TP\BGI');
  OutTextXY(10,10,'This is a rotating cube.  Cool, isn''t it?');
  OutTextXY(10,30,'Press the < or > keys to increase/decrease animation rate.');
  OuttextXY(10,50,'Press X, Y, or Z to start/stop rotation on the respective axis.');
  OutTextXY(10,70,'Press <Escape> to quit.');
  OutTextXY(10,430,'Remember all you demo programmers: this is written PURELY in Turbo Pascal');
  OutTextXY(10,450,'so of course it runs slow and is not flood-filled.  Maybe after I learn some');
  OutTextXY(10,470,'assembley...');
  SetPoints;
  x:=0; y:=0; z:=0; d:=0; ch:=' ';
  incx:=false; incy:=false; incz:=true;
  REPEAT
    IF x=361 THEN x:=0; IF INCX=true THEN Inc(x);
    IF y=361 THEN y:=0; IF INCY=true THEN Inc(y);
    IF z=361 THEN z:=0; IF INCZ=true THEN Inc(z);
    SetRotation(x,y,z);
    RotateCube;
    SetPriorities;
    setfillstyle(0,0);
    bar(215,135,425,345);
    DrawCube (320, 240, 0, white);
    Delay(d);
    IF Keypressed THEN
      BEGIN
        ch:=readkey;
        IF ch='.' THEN Inc(d);
        IF (ch=',') AND (d>0) THEN dec(d);
        IF (UpCase(ch)='X') THEN INCX:=NOT(INCX);
        IF (UpCase(ch)='Y') THEN INCY:=NOT(INCY);
        IF (UpCase(ch)='Z') THEN INCZ:=NOT(INCZ);
      END;
  UNTIL Ord(ch)=27;
  CloseGraph;
  TextMode(co80);
  ClrScr;
  FOR x:=1 TO 6 DO Writeln(priority[x]);
END. {main program}
ASMBOX.PAS

1995-08-19 23:05 · 2,233 bytes · Thirteen months later: eight points, twelve edges, Mode X. Same matrix.

USES crt,JMODEX;VAR C,i:ARRAY[1..8,1..3]OF integer;r:ARRAY[1..3,1..3]OF real;
x,y,z,q:integer;ch:char;p,d:array[1..8]of byte;incx,incy,incz:boolean;

PROCEDURE k;VAR a,b:byte;BEGIN FOR b:=1TO 8DO FOR a:=1TO 3DO i[b,a]:=
Trunc((r[a,1]*c[b,1])+(r[a,2]*c[b,2])+(r[a,3]*c[b,3]));END;

PROCEDURE Setr(m,n,o:integer);VAR x,y,z:real;BEGIN x:=m*(pi/180);
y:=n*(pi/180);z:=o*(pi/180);r[1,1]:=cos(y)*cos(z);r[1,2]:=cos(y)*(-sin(z));
r[1,3]:=(-sin(y));r[2,1]:=cos(x)*sin(z)+sin(x)*sin(y)*cos(z);
r[2,2]:=cos(x)*cos(z)+sin(x)*sin(y)*(-sin(z));r[2,3]:=sin(x)*cos(y);
r[3,1]:=sin(z)*(-sin(x))+cos(x)*sin(y)*cos(z);
r[3,2]:=(-sin(x))*cos(z)+cos(x)*sin(y)*(-sin(z));r[3,3]:=cos(x)*cos(y);END;

PROCEDURE SetPoints;const v:array[1..24]of integer=(-60,-60,-60,60,-60,-60,60,
60,-60,-60,60,-60,-60,-60,60,60,-60,60,60,60,60,-60,60,60);var a,b,d:integer;
begin d:=1;for a:=1to 8do for b:=1to 3do begin c[a,b]:=v[d];inc(d);end;END;

PROCEDURE Drawc;BEGIN
draw_line(i[1,1]+180,239-i[1,2],i[2,1]+180,239-i[2,2],15);
draw_line(i[1,1]+180,239-i[1,2],i[4,1]+180,239-i[4,2],15);
draw_line(i[1,1]+180,239-i[1,2],i[5,1]+180,239-i[5,2],15);
draw_line(i[3,1]+180,239-i[3,2],i[2,1]+180,239-i[2,2],15);
draw_line(i[3,1]+180,239-i[3,2],i[7,1]+180,239-i[7,2],15);
draw_line(i[3,1]+180,239-i[3,2],i[4,1]+180,239-i[4,2],15);
draw_line(i[6,1]+180,239-i[6,2],i[2,1]+180,239-i[2,2],15);
draw_line(i[6,1]+180,239-i[6,2],i[5,1]+180,239-i[5,2],15);
draw_line(i[6,1]+180,239-i[6,2],i[7,1]+180,239-i[7,2],15);
draw_line(i[8,1]+180,239-i[8,2],i[4,1]+180,239-i[4,2],15);
draw_line(i[8,1]+180,239-i[8,2],i[5,1]+180,239-i[5,2],15);
draw_line(i[8,1]+180,239-i[8,2],i[7,1]+180,239-i[7,2],15);END;

BEGIN if set_vga_modex(7,360,480,1)=0 then halt(0);clear_vga_screen(0);
SetPoints;x:=0;y:=0;z:=0;ch:=' ';incx:=false;incy:=true;incz:=true;
setr(x,y,z);k;REPEAT IF x=361 THEN x:=0;IF INCX=true THEN
Inc(x);IF y=361 THEN y:=0;IF INCY=true THEN Inc(y);IF z=361 THEN z:=0;
IF INCZ=true THEN Inc(z);drawc;Setr(x,y,z);k;
IF Keypressed THEN BEGIN ch:=readkey;IF(UpCase(ch)='X')THEN INCX:=NOT(INCX);
IF(UpCase(ch)='Y')THEN INCY:=NOT(INCY);IF(UpCase(ch)='Z')THEN INCZ:=NOT(INCZ)
END;clear_vga_screen(0);UNTIL Ord(ch)=27;asm mov ah,0;mov al,3;int 16;end;END.
ASMBOX3.PAS

1995-08-21 00:35 · 1,756 bytes · Fourteen lines. Retrace wait, zoom, velocity.

USES crt,JMODEX;VAR C,i:ARRAY[1..8,1..3]OF integer;r:ARRAY[1..3,1..3]OF real;x,y,z,q,a,b:integer;j:char;PROCEDURE k;VAR b:byte;
BEGIN FOR b:=1TO 8DO begin i[b,1]:=Trunc(((r[1,1]*c[b,1])+(r[1,2]*c[b,2])+(r[1,3]*c[b,3]))*z/10)+180;i[b,2]:=239-Trunc(((r[2,1]
*c[b,1])+(r[2,2]*c[b,2])+(r[2,3]*c[b,3]))*z/10);END;end;PROCEDURE f(m,n:integer);VAR x,y:real;BEGIN x:=m*(pi/180);y:=n*(pi/180)
;r[1,1]:=cos(y);r[1,2]:=0;r[1,3]:=-sin(y);r[2,1]:=sin(x)*sin(y);r[2,2]:=cos(x);r[2,3]:=sin(x)*cos(y);r[3,1]:=cos(x)*sin(y);r[3,
2]:=-sin(x);r[3,3]:=cos(x)*cos(y);END;PROCEDURE g;const v:array[1..24]of integer=(-60,-60,-60,60,-60,-60,60,60,-60,-60,60,-60,
-60,-60,60,60,-60,60,60,60,60,-60,60,60);var a,b,d:integer;begin d:=1;for a:=1to 8do for b:=1to 3do begin c[a,b]:=v[d];inc(d);
end;END;Procedure m(a,b,c,d:integer);begin draw_line(a,b,c,d,15);end;PROCEDURE h;BEGIN m(i[1,1],i[1,2],i[2,1],i[2,2]);m(i[1,1],
i[1,2],i[4,1],i[4,2]);m(i[1,1],i[1,2],i[5,1],i[5,2]);m(i[3,1],i[3,2],i[2,1],i[2,2]);m(i[3,1],i[3,2],i[7,1],i[7,2]);m(i[3,1],i[3
,2],i[4,1],i[4,2]);m(i[6,1],i[6,2],i[2,1],i[2,2]);m(i[6,1],i[6,2],i[5,1],i[5,2]);m(i[6,1],i[6,2],i[7,1],i[7,2]);m(i[8,1],i[8,2]
,i[4,1],i[4,2]);m(i[8,1],i[8,2],i[5,1],i[5,2]);m(i[8,1],i[8,2],i[7,1],i[7,2]);END;BEGIN if set_vga_modex(7,360,480,1)=0then
halt(0);g;x:=0;y:=0;z:=10;j:=' ';a:=0;b:=0;f(x,y);k;REPEAT IF x=361THEN x:=0;Inc(x,a);IF y=361THEN y:=0;Inc(y,b);if a>50then a
:=50;if a<-50then a:=-50;if b>50then b:=50;if b<-50then b:=-50;if z>20then z:=20;if z<1then z:=1;repeat until(port[$3da]and 8)
<>0;h;f(x,y);k;IF Keypressed THEN BEGIN j:=readkey;case upcase(j)of'I':a:=a+1;'K':b:=b+1;'J':b:=b-1;'M':a:=a-1;'W':z:=z+1;'S':z
:=z-1;end;END;clear_vga_screen(0);UNTIL Ord(j)=27;asm mov ah,0;mov al,3;int 16;end;END.
WINGS.PAS

1995-08-21 00:50 · 1,968 bytes · Fifteen minutes after ASMBOX3.

USES crt,JMODEX;VAR C,i:ARRAY[1..18,1..3]OF integer;r:ARRAY[1..3,1..3]OF real;
x,y,q,z,h:integer;ch:char;incx,incy:shortint;

PROCEDURE k;VAR a,b:byte;BEGIN FOR b:=1TO 18DO FOR a:=1TO 3DO i[b,a]:=
Trunc(((r[a,1]*c[b,1])+(r[a,2]*c[b,2])+(r[a,3]*c[b,3]))*z/10);END;

PROCEDURE Setr(m,n:integer);VAR x,y:real;BEGIN x:=m*(pi/180);y:=n*(pi/180);
r[1,1]:=cos(y);r[1,2]:=0;r[1,3]:=-sin(y);r[2,1]:=sin(x)*sin(y);r[2,2]:=cos(x);
r[2,3]:=sin(x)*cos(y);r[3,1]:=cos(x)*sin(y);r[3,2]:=-sin(x);
r[3,3]:=cos(x)*cos(y);END;

PROCEDURE SetPoints;var a,b:integer;begin for a:=1to 18do begin
c[a,1]:=trunc(h*sin(a*pi/9));c[a,2]:=trunc(h*cos(a*pi/9));end;
for a:=1to 18do c[a,3]:=0;end;

PROCEDURE Drawc;BEGIN
draw_line(i[1,1]+180,239-i[1,2],i[2,1]+180,239-i[2,2],15);
draw_line(i[1,1]+180,239-i[1,2],i[4,1]+180,239-i[4,2],15);
draw_line(i[1,1]+180,239-i[1,2],i[5,1]+180,239-i[5,2],15);
draw_line(i[3,1]+180,239-i[3,2],i[2,1]+180,239-i[2,2],15);
draw_line(i[3,1]+180,239-i[3,2],i[7,1]+180,239-i[7,2],15);
draw_line(i[3,1]+180,239-i[3,2],i[4,1]+180,239-i[4,2],15);
draw_line(i[6,1]+180,239-i[6,2],i[2,1]+180,239-i[2,2],15);
draw_line(i[6,1]+180,239-i[6,2],i[5,1]+180,239-i[5,2],15);
draw_line(i[6,1]+180,239-i[6,2],i[7,1]+180,239-i[7,2],15);
draw_line(i[8,1]+180,239-i[8,2],i[4,1]+180,239-i[4,2],15);
draw_line(i[8,1]+180,239-i[8,2],i[5,1]+180,239-i[5,2],15);
draw_line(i[8,1]+180,239-i[8,2],i[7,1]+180,239-i[7,2],15);END;

BEGIN if set_vga_modex(7,360,480,1)=0 then halt(0);clear_vga_screen(0);
SetPoints;h:=50;x:=0;y:=0;z:=10;ch:=' ';incx:=0;incy:=0;setr(x,y);k;REPEAT IF x=361
THEN x:=0;Inc(x,incx);IF y=361 THEN y:=0;Inc(y,incy);if z>20 then z:=20;
if z<1 then z:=1;repeat until(port[$3da]and 8)<>0;drawc;Setr(x,y);k;
IF Keypressed THEN BEGIN ch:=readkey;case upcase(ch) of 'I':INCX:=INCX+1;
'K':INCY:=INCY+1;'J':INCY:=INCY-1;'M':INCX:=INCX-1;'W':z:=z+1;'S':z:=z-1;
end;
END;clear_vga_screen(0);UNTIL Ord(ch)=27;asm mov ah,0;mov al,3;int 16;end;END.
ASMBOX2.PAS

1995-09-02 11:14 · 2,042 bytes · ASMBOX3 un-minified, plus panning and the zoom bug.

USES crt,JMODEX;VAR C,i:ARRAY[1..8,1..3]OF integer;r:ARRAY[1..3,1..3]OF real;
j,k,x,y,q:integer;ch:char;p,d:array[1..8]of byte;incx,incy:shortint;z:real;

PROCEDURE m;VAR a,b:byte;BEGIN FOR b:=1TO 8DO FOR a:=1TO 3DO i[b,a]:=
Trunc(((r[a,1]*c[b,1])+(r[a,2]*c[b,2])+(r[a,3]*c[b,3]))*z/10);END;

PROCEDURE Setr(m,n:integer);VAR x,y:real;BEGIN x:=m*(pi/180);y:=n*(pi/180);
r[1,1]:=cos(y);r[1,2]:=0;r[1,3]:=(-sin(y));r[2,1]:=sin(x)*sin(y);
r[2,2]:=cos(x);r[2,3]:=sin(x)*cos(y);r[3,1]:=cos(x)*sin(y);r[3,2]:=(-sin(x));
r[3,3]:=cos(x)*cos(y);END;

PROCEDURE SetPoints;const v:array[1..24]of integer=(-60,-60,-60,60,-60,-60,60,
60,-60,-60,60,-60,-60,-60,60,60,-60,60,60,60,60,-60,60,60);var a,b,d:integer;
begin d:=1;for a:=1to 8do for b:=1to 3do begin c[a,b]:=v[d];inc(d);end;END;

PROCEDURE Drawc(j,k:integer);BEGIN
draw_line(i[1,1]+j,k-i[1,2],i[2,1]+j,k-i[2,2],15);
draw_line(i[1,1]+j,k-i[1,2],i[4,1]+j,k-i[4,2],15);
draw_line(i[1,1]+j,k-i[1,2],i[5,1]+j,k-i[5,2],15);
draw_line(i[3,1]+j,k-i[3,2],i[2,1]+j,k-i[2,2],15);
draw_line(i[3,1]+j,k-i[3,2],i[7,1]+j,k-i[7,2],15);
draw_line(i[3,1]+j,k-i[3,2],i[4,1]+j,k-i[4,2],15);
draw_line(i[6,1]+j,k-i[6,2],i[2,1]+j,k-i[2,2],15);
draw_line(i[6,1]+j,k-i[6,2],i[5,1]+j,k-i[5,2],15);
draw_line(i[6,1]+j,k-i[6,2],i[7,1]+j,k-i[7,2],15);
draw_line(i[8,1]+j,k-i[8,2],i[4,1]+j,k-i[4,2],15);
draw_line(i[8,1]+j,k-i[8,2],i[5,1]+j,k-i[5,2],15);
draw_line(i[8,1]+j,k-i[8,2],i[7,1]+j,k-i[7,2],15);END;

BEGIN if set_vga_modex(7,360,480,1)=0 then halt(0);clear_vga_screen(0);
SetPoints;j:=180;k:=239;x:=0;y:=0;z:=1;ch:=' ';incx:=0;incy:=0;setr(x,y);m;REPEAT IF x=361
THEN x:=0;Inc(x,incx);IF y=361 THEN y:=0;Inc(y,incy);if z>20 then z:=20;
if z<1 then z:=1;repeat until(port[$3da]and 8)<>0;drawc(j,k);Setr(x,y);m;
IF Keypressed THEN BEGIN ch:=readkey;case upcase(ch) of 'I':inc(INCX);
'K':inc(INCY);'J':INCY:=INCY-1;'M':INCX:=INCX-1;'W':z:=z+1;'S':z:=z-1;
'R':k:=k-5;'D':j:=j-5;'F':j:=j+5;'C':k:=k+5;end;
END;clear_vga_screen(0);UNTIL Ord(ch)=27;asm mov ah,0;mov al,3;int 16;end;END.
BOX2.PAS

1995-09-22 00:27 · 3,929 bytes · BOX caught halfway through the minification pass.

uses crt,jmodex;var c,ci:array[1..6,1..3,1..4]of integer;
  rotation: ARRAY[1..3,1..3] OF real;
  Priority,DrawOrder: ARRAY[1..6] OF Byte;
  x, y, z,  k: integer;
  ch: char;
  incx, incy, incz: boolean;


PROCEDURE SETPRIORITIES;
VAR Z:ARRAY[1..6] OF REAL;
    s: INTEGER;
    s2: INTEGER;
    order, x, y, a: integer;
    count: ARRAY[1..6] OF byte;
BEGIN
  FOR s:=1TO 6DO begin Z[s]:=(ci[s,3,1]+ci[s,3,2]+ci[s,3,3]+ci[s,3,4])/4;
PRIORITY[s]:=1;end;
  FOR S2:=1TO 6DO FOR S:=1TO 6DO IF Z[S2]>Z[S] THEN INC(PRIORITY[s2]);
REPEAT
 FOR x:=1 TO 6 DO count[x]:=0;
   FOR x:=1 TO 6 DO
    FOR s:=1 TO 6 DO
     IF Priority[s]=x THEN Inc(count[x]);
 a:=0;
 REPEAT Inc(a) UNTIL (a=6) OR (count[a]=0);
 IF (count[a]=0) THEN
   BEGIN
     x:=0;
     REPEAT Inc(x) UNTIL (count[x]>1);
     y:=0;
     REPEAT Inc(y) UNTIL Priority[y]=x;
     Priority[y]:=a;
   END;
UNTIL (count[a]=1) AND (a=6);
  FOR s:=1 TO 6 DO DrawOrder[Priority[s]]:=s;
END;



PROCEDURE RotateCube;
VAR row, column, s: byte;
BEGIN
  FOR s:=1 TO 6 DO
   FOR row:=1 TO 3 DO
    FOR column:=1 TO 4 DO
     ci[s,row,column]:=Trunc((rotation[row,1]*c[s,1,column])
                                      +(rotation[row,2]*c[s,2,column])
                                      +(rotation[row,3]*c[s,3,column]));
END;

PROCEDURE SetRotation (xangle, yangle, zangle: integer);
VAR x, y, z: real;
BEGIN
  x:=xangle*(pi/180);
  y:=yangle*(pi/180);
  z:=zangle*(pi/180);
  rotation[1,1]:=cos(y)*cos(z);
  rotation[1,2]:=cos(y)*(-sin(z));
  rotation[1,3]:=(-sin(y));
  rotation[2,1]:=cos(x)*sin(z)+sin(x)*sin(y)*cos(z);
  rotation[2,2]:=cos(x)*cos(z)+sin(x)*sin(y)*(-sin(z));
  rotation[2,3]:=sin(x)*cos(y);
  rotation[3,1]:=sin(z)*(-sin(x))+cos(x)*sin(y)*cos(z);
  rotation[3,2]:=(-sin(x))*cos(z)+cos(x)*sin(y)*(-sin(z));
  rotation[3,3]:=cos(x)*cos(y);
END;

PROCEDURE L(a,b,c,d,e:integer);BEGIN draw_line(a+180,239-b,c+180,239-d,e);END;

PROCEDURE a;BEGIN c[1,1,1]:=-60;c[1,2,1]:=-60;c[1,3,1]:=-60;c[1,1,2]:=60;c[1,2
,2]:=-60;c[1,3,2]:=-60;c[1,1,3]:=60;c[1,2,3]:=60;c[1,3,3]:=-60;c[1,1,4]:=-60;c
[1,2,4]:=60;c[1,3,4]:=-60;c[2,1,1]:=-60;c[2,2,1]:=-60;c[2,3,1]:=60;c[2,1,2]:=
60;c[2,2,2]:=-60;c[2,3,2]:=60;c[2,1,3]:=60;c[2,2,3]:=60;c[2,3,3]:=60;c[2,1,4]
:=-60;c[2,2,4]:=60;c[2,3,4]:=60;c[3,1,1]:=60;c[3,2,1]:=-60;c[3,3,1]:=-60;c[3,1
,2]:=60;c[3,2,2]:=60;c[3,3,2]:=-60;c[3,1,3]:=60;c[3,2,3]:=60;c[3,3,3]:=60;c[3,
1,4]:=60;c[3,2,4]:=-60;c[3,3,4]:=60;c[4,1,1]:=-60;c[4,2,1]:=-60;c[4,3,1]:=-60;
c[4,1,2]:=-60;c[4,2,2]:=60;c[4,3,2]:=-60;c[4,1,3]:=-60;c[4,2,3]:=60;c[4,3,3]:=
60;c[4,1,4]:=-60;c[4,2,4]:=-60;c[4,3,4]:=60;c[5,1,1]:=-60;c[5,2,1]:=60;c[5,3,1
]:=-60;c[5,1,2]:=60;c[5,2,2]:=60;c[5,3,2]:=-60;c[5,1,3]:=60;c[5,2,3]:=60;c[5,3
,3]:=60;c[5,1,4]:=-60;c[5,2,4]:=60;c[5,3,4]:=60;c[6,1,1]:=-60;c[6,2,1]:=-60;c[
6,3,1]:=-60;c[6,1,2]:=60;c[6,2,2]:=-60;c[6,3,2]:=-60;c[6,1,3]:=60;c[6,2,3]:=
-60;c[6,3,3]:=60;c[6,1,4]:=-60;c[6,2,4]:=-60;c[6,3,4]:=60;END;

PROCEDURE DrawCube;VAR s,c:byte;BEGIN FOR k:=3 DOWNTO 1 DO BEGIN s:=DrawOrder
[k];l(ci[s,1,1],ci[s,2,1],ci[s,1,2],ci[s,2,2],15);l(ci[s,1,2],ci[s,2,2],ci[s,1
,3],ci[s,2,3],15);l(ci[s,1,3],ci[s,2,3],ci[s,1,4],ci[s,2,4],15);l(ci[s,1,4],ci
[s,2,4],ci[s,1,1],ci[s,2,1],15);Case s of 1:c:=4;2:c:=1;3:c:=7;4:c:=14;5:c:=2;
6:c:=5;END;l(ci[s,1,1],ci[s,2,1],ci[s,1,3],ci[s,2,3],c);l(ci[s,1,2],ci[s,2,2],
ci[s,1,4],ci[s,2,4],c);END;END;

BEGIN if set_vga_modex(7,360,480,1)=0 then halt(0);clear_vga_screen(0);
a;x:=0;y:=0;z:=0;ch:=' ';incx:=true;incy:=true;incz:=true;REPEAT
IF x=361 THEN x:=0;IF INCX THEN Inc(x);IF y=361 THEN y:=0;IF INCY THEN Inc(y);
IF z=361 THEN z:=0;IF INCZ THEN Inc(z);SetRotation(x,y,z);RotateCube;
SetPriorities;clear_vga_screen(0);DrawCube;
IF Keypressed THEN BEGIN ch:=readkey;case upcase(ch)of'X':INCX:=NOT(INCX);
'Y':INCY:=NOT(INCY);'Z':INCZ:=NOT(INCZ);end;END;UNTIL Ord(ch)=27;
asm mov ah,0;mov al,3;int 16;end;END.