'===========================================================================
' Subject: 3D FILLED POLYGON                 Date: 09-05-97 (19:51)       
' Author:  Sami Kyostila                     Code: QB, QBasic, PDS        
' Origin:  hiteck@mail.freenet.hut.fi      Packet: GRAPHICS.ABC
'===========================================================================
'----------------------------------------------------------------------------
'           3D Filled Polygon by Sami Ky”stil„ 1997 - [v1.1]
'----------------------------------------------------------------------------
'
' Here it is! My first real polygon engine! The sorting and culling
' algorithms aren't the fastest/best ones around, since I had to make
' up my own routines, because every other 3D-program I've seen had only
' 3 or 4 point polygons (This program can have polygons with virtually
' unlimited amount of points). This program doesn't apply any official
' shading methods, only my own shading models (looks kewl, though ;),
' but most importantly, it runs fast. It uses a virtual buffer to hold the
' VGA screen for flicker-free animation, but that takes up lots of memory,
' so if you run out of memory, then adjust the MaxPoints(per polygon)/
' MaxPolygons values below.
'
' Features:
'    - Polygons can consist of any number of points
'    - Full 3-axis rotation
'    - Filled and shaded polygons
'    - 5 different shading modes:
'      + Wireframe
'      + Flat
'      + Shaded 1
'      + Shaded 2
'      + Transparent
'    - Backface culling and polygon Z-sorting
'    - Double/Single sided polygons
'    - Disable/Enable culling during runtime
'    - Flicker-free animation
'    - VGA 320x200x256 graphics
'    - Point number display
'    - Panning
'    - Zooming
'
'---------------------------------------------[Made in FiNLAND]--------------


DEFLNG A-Z              'For speed
DECLARE FUNCTION PPoint% (x&, y&)
DECLARE SUB TheEnd ()
DECLARE SUB StartUp ()
DECLARE SUB Separator (Col&, Char$)
DECLARE SUB SetPal (i&, r&, g&, b&)
DECLARE SUB DrawLine (x&, y&, X2&, Y2&, Col&)
DECLARE SUB PPSet (x&, y&, Col&)
DECLARE SUB RotatePoint (x&, y&, Z&, rX&, Ry&, Rz&, Nx&, Ny&, Nz&)
DECLARE SUB t3d2d (x&, y&, Z&, Sx&, Sy&)
                                  
TYPE Filltype           'Buffer to hold polygon data
  X1 AS LONG
  X2 AS LONG
END TYPE

TYPE Pointtype
  x3 AS LONG       'Original X
  y3 AS LONG       'Original Y
  z3 AS LONG       'Original Z
  x AS LONG        'Screen X
  y AS LONG        'Screen Y
  Nx AS LONG       'New X
  Ny AS LONG       'New Y
  Nz AS LONG       'New Z
END TYPE

TYPE Polygontype
  Points AS LONG      'Number of points
  AvgZ AS LONG        'Average Z coord.
  Col AS LONG         'Color
  Culled AS LONG      'Culled/Not Culled
  Dbl AS LONG         'Single/Double sided
  ZNormal AS LONG     'For shading and culling
END TYPE


'----------------------------------------------------------------------------
'                           Constants
'----------------------------------------------------------------------------
CONST True = 0
CONST False = NOT True
CONST Pi = 22 / 7
CONST MaxPoints = 25              'Max number of points/polygon, adjust if
                                  'low on memory
CONST MaxPolygons = 30            'Max number of polygons


DIM SHARED Polygons, Points
READ Points                    'Read max points
READ Polygons                  'Read max polygons
DIM SHARED Zoom AS INTEGER     'Zoom factor
DIM SHARED Sine(360)           'SIN table
DIM SHARED Cosine(360)         'COS table
DIM SHARED Fill(199) AS Filltype    'Polygon data buffer
DIM SHARED Upper AS INTEGER  '  Highest scanline
DIM SHARED Lower AS INTEGER    'Lowest scanline
DIM SHARED Vx, Vy, Vz          'Rotation
DIM SHARED ShadingModel        'Shading model
DIM SHARED Culling AS INTEGER  'Culling On/Off
DIM SHARED MaxZoom AS INTEGER  'Max Zoom level
DIM SHARED Pnt(100) AS Pointtype     'Point array
DIM SHARED Sec(100)  AS Polygontype  'Polygon array
DIM SHARED SecPnt(MaxPolygons, MaxPoints)       'Polygon point array
DIM SHARED Pointer(Polygons)   'Pointer for sorting
DIM SHARED AvgZ(Points)        'Z Array
DIM SHARED SrX, SrY            'Screen center
DIM SHARED Mx, My              'Panning
DIM SHARED PDisp               'Number display (True/False)
DIM SHARED Xr, Yr, Zr          'Rotation

SCREEN 0: CLS
COLOR 15, 4
LOCATE 1, 1
PRINT STRING$(80, " ")
LOCATE 1, 1
PRINT "             3D Filled Polygon Engine by Sami Ky”stil„ 1997"
COLOR 7, 0
StartUp

DO
'----------------------------------------------------------------------------
'                          Rotate all points
'----------------------------------------------------------------------------
  FOR i& = 1 TO Points
    RotatePoint Pnt(i&).x3, Pnt(i&).y3, Pnt(i&).z3, Xr, Yr, Zr, x3, y3, z3
    AvgZ(i&) = z3
    t3d2d x3, y3, z3, Sx, Sy
    Pnt(i&).Nx = x3
    Pnt(i&).Ny = y3
    Pnt(i&).Nz = z3
    Pnt(i&).x = Sx
    Pnt(i&).y = Sy
  NEXT


 
 
'----------------------------------------------------------------------------
'        Calculate average Z values and cull non-visible polygons
'----------------------------------------------------------------------------

  FOR i& = 1 TO Polygons
    Sec(i&).AvgZ = 0
    NormalZ = 0

    FOR i2& = 0 TO Sec(i&).Points - 2
      Sec(i&).AvgZ = Sec(i&).AvgZ + AvgZ(SecPnt(i&, i2&))
      NormalZ = NormalZ + (Pnt(SecPnt(i&, i2&)).Nz) * 10
    NEXT

    Sec(i&).AvgZ = (Sec(i&).AvgZ \ Sec(i&).Points) * 20
    NormalZ = NormalZ \ Sec(i&).Points

    IF NormalZ < NormalZ \ 10 THEN
      IF Culling = True AND Sec(i&).Dbl = 0 THEN
        Sec(i&).Culled = True
      ELSEIF Culling = True AND Sec(i&).Dbl = 1 THEN
        Sec(i&).Culled = False
        NormalZ = -NormalZ
      ELSE
        IF NormalZ < 0 THEN NormalZ = -NormalZ
      END IF
    ELSE
      Sec(i&).Culled = False
    END IF
    Sec(i&).ZNormal = (NormalZ) \ 10

    IF Culling = False THEN Sec(i&).Culled = False
  NEXT
 
 
'----------------------------------------------------------------------------
'                Sort polygons by their average Z values
'----------------------------------------------------------------------------
  Closest = 32000
  Furthest = -32000
  FOR s& = 1 TO Polygons                 'Find out closest/furthest polygon
    IF Sec(s&).AvgZ < Closest THEN Closest = Sec(s&).AvgZ
    IF Sec(s&).AvgZ > Furthest THEN Furthest = Sec(s&).AvgZ
  NEXT

  Sort = 1
  FOR s2 = Closest TO Furthest STEP 2   'Loop from closest to furthest
                                   '^
                                   'Adjust this value to get more
                                   'precise sorting/less speed (def:2)
    FOR s& = 1 TO Polygons
      IF Sec(s&).AvgZ = s2 THEN    'Found a match?
        Pointer(Sort) = s&         'Store it
        Sort = Sort + 1            'Update counter
      END IF
    NEXT
  NEXT


  Upper = 100                      'Reset High/Low scanline values
  Lower = 100


'----------------------------------------------------------------------------
'           Create a buffer to serve as page in VGA 320x200x256 mode
'----------------------------------------------------------------------------
  DIM SHARED Buffer(0 TO 32001) AS INTEGER
  Buffer(0) = 2552
  Buffer(1) = 199


'----------------------------------------------------------------------------
'                        Calculate polygons
'----------------------------------------------------------------------------
  FOR ii& = 1 TO Polygons
    i& = Pointer(ii&)                     'Get sorted pointer
    IF Sec(i&).Culled = False THEN        'Visible?
    FOR i2& = 0 TO Sec(i&).Points - 2
      Col = (Sec(i&).Col - 40 + (Sec(i&).AvgZ \ 16)) * 1024
      IF Col < (Sec(i&).Col - 60) * 1024 THEN Col = (Sec(i&).Col - 60) * 1024
      IF i2& < Sec(i&).Points - 1 THEN
        DrawLine Pnt(SecPnt(i&, i2&)).x + SrX, Pnt(SecPnt(i&, i2&)).y + SrY, Pnt(SecPnt(i&, i2& + 1)).x + SrX, Pnt(SecPnt(i&, i2& + 1)).y + SrY, Col \ 1024
      ELSE
        DrawLine Pnt(SecPnt(i&, 0)).x + SrX, Pnt(SecPnt(i&, 0)).y + SrY, Pnt(SecPnt(i&, i2& + 1)).x + SrX, Pnt(SecPnt(i&, i2& + 1)).y + SrY, Col \ 1024
      END IF
    NEXT
    
'----------------------------------------------------------------------------
'                     Draw polygons into screen buffer
'----------------------------------------------------------------------------
    IF Upper <= 0 THEN Upper = 1
    DEF SEG = VARSEG(Buffer(2))

    FOR i2 = Upper TO Lower

      'Calculate shade
      Range = (((Fill(i2).X2) - (Fill(i2).X1)) \ 2)
      IF Range = 0 THEN ColStep = 0 ELSE ColStep = ((30 / Range) * Sec(i&).ZNormal / 6) * 1024
      ColMax = (Sec(i&).Col - 1) * 1024
      Col = (Sec(i&).Col - 50 + (Sec(i&).AvgZ \ 16)) * 1024
      IF Col < (Sec(i&).Col - 60) * 1024 THEN Col = (Sec(i&).Col - 60) * 1024

      'Draw scanline into buffer
      SELECT CASE ShadingModel
      CASE IS = 5                'Transparent
        FOR Fl& = (Fill(i2).X1) TO Fill(i2).X2
          TCol = ((PPoint(Fl&, i2) MOD 63) + (Sec(i&).Col) - 50) * 1024
          IF TCol > ColMax THEN TCol = ColMax
          PPSet Fl&, i2, TCol \ 1024
        NEXT
      CASE IS = 4                'Shaded 2
        FOR Fl& = (Fill(i2).X1) TO Fill(i2).X2
          PPSet Fl&, i2, Col \ 1024
          Col = Col + ColStep \ 2
          IF Col > ColMax THEN Col = ColMax
        NEXT
      CASE IS = 3                'Shaded
        FOR Fl& = (Fill(i2).X1) TO ((Fill(i2).X2) - (Fill(i2).X1)) \ 2 + (Fill(i2).X1)
          PPSet Fl&, i2, Col \ 1024
          PPSet Fill(i2).X1 + Fill(i2).X2 - Fl&, i2, Col \ 1024
          Col = Col + ColStep
          IF Col > ColMax THEN Col = ColMax
        NEXT
      CASE IS = 2                'Flat
        FOR Fl& = (Fill(i2).X1) TO ((Fill(i2).X2) - (Fill(i2).X1)) \ 2 + (Fill(i2).X1)
          PPSet Fl&, i2, Col \ 1024
          PPSet Fill(i2).X1 + Fill(i2).X2 - Fl&, i2, Col \ 1024
        NEXT
      END SELECT


      'Empty the keyboard buffer
      a$ = INKEY$
      Fill(i2).X1 = 321
      Fill(i2).X2 = -1
      Fill(i2 - 1).X1 = 321
      Fill(i2 - 1).X2 = -1
    NEXT
    END IF
  NEXT

'----------------------------------------------------------------------------
'                       Dump buffer to screen
'----------------------------------------------------------------------------
  PUT (0, 0), Buffer, PSET


  'Print Point numbers
  IF PDisp = True THEN
    FOR i = 1 TO MaxPoints - 1
      Ty = (Pnt(i).y + SrY) \ 8 + 1
      Tx = (Pnt(i).x + SrX) \ 8 + 1
      IF Ty > 23 THEN Ty = 23
      IF Ty < 1 THEN Ty = 1
      IF Tx < 1 THEN Tx = 1
      IF Tx > 40 THEN Tx = 40
      LOCATE Ty, Tx
      PRINT LTRIM$(RTRIM$(STR$((i))))
    NEXT
  END IF



'----------------------------------------------------------------------------
'                    Handle keypresses
'----------------------------------------------------------------------------

  DEF SEG = 0: k = INP(&H60)
  WHILE LEN(INKEY$): WEND     'Empty keyboard buffer
  SELECT CASE k
    CASE &H3B               'F1
      ShadingModel = 1
    CASE &H3C               'F2
      ShadingModel = 2
    CASE &H3D               'F3
      ShadingModel = 3
    CASE &H3E               'F4
      ShadingModel = 4
    CASE &H3F               'F5
      Culling = True
    CASE &H40               'F6
      Culling = False
    CASE &H41               'F7
      PDisp = True
    CASE &H42               'F8
      PDisp = False
    CASE &H43               'F9
      ShadingModel = 5
      Culling = False
    CASE &H52               '0
      Zoom = 100
      Xr = 400
      Yr = 315
      Zr = 0
      Mx = 0
      My = 0
    CASE &H4C               '5
      Vx = 0
      Vy = 0
      Vz = 0
    CASE &H1E               'A
      Zoom = Zoom - 10
      IF Zoom < MaxZoom THEN Zoom = MaxZoom
    CASE &H50               '2
      Vx = Vx + 1
    CASE &H48               '8
      Vx = Vx - 1
    CASE &H4B               '4
      Vy = Vy + 1
    CASE &H4D               '6
      Vy = Vy - 1
    CASE &H4A               '+
      Vz = Vz + 1
    CASE &H4E               '-
      Vz = Vz - 1
    CASE &H2C               'Z
      Zoom = Zoom + 10
    CASE &H17               'I
      My = My + 5
    CASE &H25               'K
      My = My - 5
    CASE &H24               'J
      Mx = Mx + 5
    CASE &H26               'L
      Mx = Mx - 5
    CASE 1                  'ESC
      EXIT DO
    END SELECT

'----------------------------------------------------------------------------
'                 Update rotation velocities
'----------------------------------------------------------------------------
  Xr = Xr + Vx
  Yr = Yr + Vy
  Zr = Zr + Vz

  IF Xr < 0 THEN Xr = 360 + Xr
  IF Yr < 0 THEN Yr = 360 + Yr
  IF Zr < 0 THEN Zr = 360 + Zr
  ERASE Buffer
LOOP


TheEnd


'----------------------------------------------------------------------------
'                        Object data
'----------------------------------------------------------------------------
' I've included a hexagonal shape for the demo, but it may be too much
' for some machines, so there is also a simpler cube shape at the end of
' the data lines. To use it, REM the data lines of the hex-thingy.


'Number of points
DATA 16

'Number of polygons
DATA 10



'       X    Y     Z
'
DATA  -15, -25,   15
DATA   15, -25,   15
DATA   30, -10,   15
DATA   30,   5,   15
DATA   15,  20,   15
DATA  -15,  20,   15
DATA  -30,   5,   15
DATA  -30, -10,   15

DATA  -15, -25,  -15
DATA   15, -25,  -15
DATA   30, -10,  -15
DATA   30,   5,  -15
DATA   15,  20,  -15
DATA  -15,  20,  -15
DATA  -30,   5,  -15
DATA  -30, -10,  -15

'----------------------------------------------------------------------------
'Polygon data format:
'----------------------------------------------------------------------------
' First number - Specifies if the polygon is double sided (1:yes, 0:no)
'                A double sided polygon is never culled, ie It is visible
'                from all directions
' Second number - Number of points in polygon
' Next n numbers - Index numbers of the points that form the polygon
'                  Make sure that the polygon is fully closed, otherwise
'                  it won't be filled correctly:
'                    For example         (a filled square):
'                           5, 1, 2, 3, 4, 1
'                           ^              ^
'                           |              |
'                    5 points              return to first point to complete
'                      NOT 4!              the polygon.
'
'
' Last number - Color of polygon
'               1 - White
'               2 - Red
'               3 - Green
'               4 - Blue
'----------------------------------------------------------------------------


'   Pts.                          Col.
'      |                             |
' Dbl. |                             |
'    | |                             |
DATA 0,9,1,2,3,4,5,6,7,8,1,          2
DATA 0,9,9,10,11,12,13,14,15,16,9,   3
DATA 0,5,1,2,10,9,1,                 1
DATA 0,5,2,3,11,10,2,                2
DATA 0,5,3,4,12,11,3,                3
DATA 0,5,4,5,13,12,4,                4
DATA 0,5,5,6,14,13,5,                1
DATA 0,5,6,7,15,14,6,                2
DATA 0,5,7,8,16,15,7,                3
DATA 0,5,8,1,9,16,8,                 4


'----------------------------------------------------------------------------
'              Alternate object for slower machines
'----------------------------------------------------------------------------
' To use, REM the above data lines

'Number of points
DATA 8

'Number of polygons
DATA 6


'Point data

'       X    Y     Z
'
DATA   15,  15,   15
DATA   15, -15,   15
DATA  -15, -15,   15
DATA  -15,  15,   15
DATA   15,  15,  -15
DATA   15, -15,  -15
DATA  -15, -15,  -15
DATA  -15,  15,  -15


'Polygon data

'   Pts.              Col.
'      |                 |
' Dbl. |                 |
'    | |                 |
DATA 0,5,5,8,4,1,5,      2
DATA 0,5,6,7,3,2,6,      3
DATA 0,5,1,2,3,4,1,      4
DATA 0,5,1,5,6,2,1,      1
DATA 0,5,3,7,8,4,3,      2
DATA 0,5,5,6,7,8,5,      3

SUB DrawLine (x, y, X2, Y2, Col)
'----------------------------------------------------------------------------
'             Calculate the points of a polygon into the buffer
'----------------------------------------------------------------------------


IF x < 0 THEN x = 0
IF x > 319 THEN x = 319
IF X2 < 0 THEN X2 = 0
IF X2 > 319 THEN X2 = 319

IF y < 0 THEN y = 0
IF y > 199 THEN y = 199
IF Y2 < 0 THEN Y2 = 0
IF Y2 > 199 THEN Y2 = 199

IF y < Upper THEN Upper = y
IF y > Lower THEN Lower = y


'Calculate deltas and scale by 1024

Steps = SQR((X2 - x) ^ 2 + ((Y2 - y) ^ 2))
IF Steps > 0 THEN
  XStep& = ((X2 - x) / Steps) * 1024
  YStep& = ((Y2 - y) / Steps) * 1024
END IF

Tempxx& = x
Tempyy& = y

xxx& = Tempxx& * 1024
yyy& = Tempyy& * 1024

DEF SEG = VARSEG(Buffer(2))

IF ShadingModel = 1 THEN
  FOR i& = 1 TO Steps
    IF xxx& \ 1024 < Fill(yyy& \ 1024).X1 THEN
      Fill(yyy& \ 1024).X1 = xxx& \ 1024
    END IF
    
    IF xxx& \ 1024 > Fill(yyy& \ 1024).X2 THEN
      Fill(yyy& \ 1024).X2 = xxx& \ 1024
    END IF
     
    PPSet xxx& \ 1024, yyy& \ 1024, Col&

    xxx& = xxx& + XStep&
    yyy& = yyy& + YStep&
  NEXT
ELSE
  FOR i& = 1 TO Steps
    IF xxx& \ 1024 < Fill(yyy& \ 1024).X1 THEN
      Fill(yyy& \ 1024).X1 = xxx& \ 1024
    END IF

    IF xxx& \ 1024 > Fill(yyy& \ 1024).X2 THEN
      Fill(yyy& \ 1024).X2 = xxx& \ 1024
    END IF

    IF ShadingModel = 1 THEN
      PPSet xxx& \ 1024, yyy& \ 1024, Col&
    END IF

    xxx& = xxx& + XStep&
    yyy& = yyy& + YStep&
  NEXT
END IF


END SUB

DEFINT A-Z
FUNCTION PPoint (x&, y&)
'----------------------------------------------------------------------------
'               Returns a pixel from the screen buffer
'----------------------------------------------------------------------------

IF x& > 319 THEN EXIT FUNCTION
IF x& < 0 THEN EXIT FUNCTION

Offset& = VARPTR(Buffer(2))
PPoint = PEEK(Offset& + (y& * 319&) + x&)

END FUNCTION

SUB PPSet (x&, y&, Col&)
'----------------------------------------------------------------------------
'               Writes a pixel to the screen buffer
'----------------------------------------------------------------------------

IF x& > 319 THEN EXIT SUB
IF x& < 0 THEN EXIT SUB

Offset& = VARPTR(Buffer(2))
POKE Offset& + (y& * 319&) + x&, Col&

END SUB

DEFLNG A-Z
SUB RotatePoint (x, y, Z, rX, Ry, Rz, Nx, Ny, Nz)
'----------------------------------------------------------------------------
'                    Rotate a point in 3D space
'----------------------------------------------------------------------------

Sine1& = Sine(rX MOD 360)
Sine2& = Sine(Ry MOD 360)
SINe3& = Sine(Rz MOD 360)

Cosine1& = Cosine(rX MOD 360)
Cosine2& = Cosine(Ry MOD 360)
COSine3& = Cosine(Rz MOD 360)
 


TEMPX& = (x * Cosine2& - Z * Sine2&) \ 1024
TEMPZ& = (x * Sine2& + Z * Cosine2&) \ 1024

Z2 = (TEMPZ& * Cosine1& - y * Sine1&) \ 1024
TEMPY& = (TEMPZ& * Sine1& + y * Cosine1&) \ 1024

X2 = (TEMPX& * COSine3& + TEMPY& * SINe3&) \ 1024
Y2 = (TEMPY& * COSine3& - TEMPX& * SINe3&) \ 1024



Nx = X2
Ny = Y2
Nz = Z2

END SUB

SUB Separator (Col, Char$)
'----------------------------------------------------------------------------
'                           Prints a separator line
'----------------------------------------------------------------------------


SELECT CASE Col
CASE IS = 1
  Col1 = 1
  Col2 = 9
  Col3 = 3
  Col4 = 11
  Col5 = 15
CASE IS = 2
  Col1 = 2
  Col2 = 10
  Col3 = 14
  Col4 = 15
  Col5 = 15
CASE IS = 3
  Col1 = 8
  Col2 = 7
  Col3 = 15
  Col4 = 15
  Col5 = 15
END SELECT



COLOR Col1
PRINT STRING$(5, Char$);
COLOR Col2
PRINT STRING$(5, Char$);
COLOR Col3
PRINT STRING$(5, Char$);
COLOR Col4
PRINT STRING$(5, Char$);
COLOR Col5
PRINT STRING$(40, Char$);
COLOR Col4
PRINT STRING$(5, Char$);
COLOR Col3
PRINT STRING$(5, Char$);
COLOR Col2
PRINT STRING$(5, Char$);
COLOR Col1
PRINT STRING$(5, Char$)

END SUB

DEFSNG A-Z
SUB SetPal (i&, r&, g&, b&)
'----------------------------------------------------------------------------
'                        Sets a palette value
'----------------------------------------------------------------------------

OUT &H3C8, i&
OUT &H3C9, r&
OUT &H3C9, g&
OUT &H3C9, b&


END SUB

DEFLNG A-Z
SUB StartUp
'----------------------------------------------------------------------------
'               Read objects and print StartUp message
'----------------------------------------------------------------------------

PRINT " þ Calculating Sine/Cosine table..."


'----------------------------------------------------------------------------
'                 Precalculate tables for speed
'----------------------------------------------------------------------------
FOR i = 0 TO 360
  Sine(i) = SIN(i * Pi / 180) * 1024
  Cosine(i) = COS(i * Pi / 180) * 1024
NEXT


SrX = 320 \ 2     'Screen center
SrY = 200 \ 2


Zoom = 100        'Initial values
Xr = 400
Yr = 315
Zr = 0
Mx = 0
My = 0
PDisp = False
ShadingModel = 3
Culling = True
PRINT " þ Reading"; Points; "points..."


'----------------------------------------------------------------------------
'                   Read object data (See end of program)
'----------------------------------------------------------------------------
MaxZoom = 0
MinZoom = 0
FOR i = 1 TO Points                                   'Read points
  READ Pnt(i).x3, Pnt(i).y3, Pnt(i).z3
  t3d2d Pnt(i).x3, Pnt(i).y3, Pnt(i).z3, Sx&, Sy&
  IF Pnt(i).x3 > MaxZoom THEN MaxZoom = Pnt(i).x3
  IF Pnt(i).y3 > MaxZoom THEN MaxZoom = Pnt(i).y3
  IF Pnt(i).z3 > MaxZoom THEN MaxZoom = Pnt(i).z3

  IF Pnt(i).x3 < MinZoom THEN MinZoom = Pnt(i).x3
  IF Pnt(i).y3 < MinZoom THEN MinZoom = Pnt(i).y3
  IF Pnt(i).z3 < MinZoom THEN MinZoom = Pnt(i).z3

  Pnt(i).x = Sx&
  Pnt(i).y = Sy&
NEXT

IF MaxZoom < 0 THEN MaxZoom = -MaxZoom
IF MinZoom < 0 THEN MinZoom = -MinZoom
IF MinZoom > MaxZoom THEN MaxZoom = MinZoom
MaxZoom = MaxZoom * 1.3

PRINT " þ Reading"; Polygons; "polygons..."

FOR i = 1 TO Polygons                                  'Read polygons
  READ Sec(i).Dbl
  READ Sec(i).Points
  FOR i2 = 0 TO Sec(i).Points - 1
    READ SecPnt(i, i2)
    IF SecPnt(i, i2) > Points THEN
      PRINT "   - Point"; SecPnt(i, i2); "in polygon"; i; "not found!"
      END
    END IF
  NEXT
  READ Sec(i).Col
  Sec(i).Col = Sec(i).Col * 64
NEXT
            
Sec(i + 1).Points = -1
Separator 1, "Ä"
COLOR 7
PRINT , , "         Keys"
Separator 1, "Ä"


COLOR 3
PRINT " Arrows/Numpad",
COLOR 7
PRINT "- Control Rotation"

COLOR 3
PRINT " J/K/L/I", ,
COLOR 7
PRINT "- Translation (Doesn't quite work yet ;)"

COLOR 3
PRINT " A/Z", ,
COLOR 7
PRINT "- Zoom In/Out"

COLOR 3
PRINT " 5/0", ,
COLOR 7
PRINT "- Stop/Reset rotation"

COLOR 3
PRINT " F1", ,
COLOR 7
PRINT "- Select wireframe mode"

COLOR 3
PRINT " F2", ,
COLOR 7
PRINT "- Select flat mode"

COLOR 3
PRINT " F3", ,
COLOR 7
PRINT "- Select shade mode"

COLOR 3
PRINT " F4", ,
COLOR 7
PRINT "- Select shade mode 2"

COLOR 3
PRINT " F5/F6", ,
COLOR 7
PRINT "- Backface culling On/Off"

COLOR 3
PRINT " F7/F8", ,
COLOR 7
PRINT "- Point number display On/Off"

COLOR 3
PRINT " F9", ,
COLOR 7
PRINT "- Select transparent mode (Sets culling off)"


COLOR 3
PRINT " Esc", ,
COLOR 7
PRINT "- Exit"

Separator 1, "Ä"
Separator 3, "Ä"
COLOR 9
PRINT "        You may use this code freely, as long as I am credited for it."
Separator 3, "Ä"

DO: LOOP UNTIL INKEY$ <> ""


'----------------------------------------------------------------------------
'                              Set palette
'----------------------------------------------------------------------------

SCREEN 13: CLS
FOR i = 0 TO 63
  SetPal i, i, i, i
  SetPal i + 64, i, 0, 0
  SetPal i + 128, 0, i, 0
  SetPal i + 192, 0, 0, i
NEXT i

FOR i2 = 0 TO 199                    'Initialize screen array
  Fill(i2).X1 = 321
  Fill(i2).X2 = -1
NEXT



END SUB

SUB t3d2d (x, y, Z, Sx, Sy)
'----------------------------------------------------------------------------
'         Transforms 3D coordinates into 2D screen coordinates
'----------------------------------------------------------------------------


IF Z - Zoom <> 0 THEN Sy = (y + My) * 60 \ (Z - Zoom)
IF Z - Zoom <> 0 THEN Sx = (x + Mx) * 60 \ (Z - Zoom)

END SUB

SUB TheEnd
'----------------------------------------------------------------------------
'                      Ending message
'----------------------------------------------------------------------------

SCREEN 0: CLS
WIDTH 80, 25
COLOR 15, 4
LOCATE 1, 1
PRINT STRING$(80, " ")
LOCATE 1, 1
PRINT "             3D Filled Polygon Engine by Sami Ky”stil„ 1997"

COLOR 3, 0
PRINT " Final location of points:"
Separator 1, "Ä"
COLOR 11
PRINT " X", " Y", " Z"
Separator 1, "Ä"
COLOR 7
FOR i& = 1 TO Points
  PRINT Pnt(i&).Nx,
  PRINT Pnt(i&).Ny,
  PRINT Pnt(i&).Nz
NEXT
Separator 1, "Ä"
COLOR 14

LOCATE 6, 40: PRINT "String Space:", FRE("")
LOCATE 7, 40: PRINT "Stack Space:", FRE(-1)
LOCATE 8, 40: PRINT "Array Space:", FRE(-1)
LOCATE 9, 40: PRINT "Shading mode:", ShadingModel
COLOR 7

END SUB