'===========================================================================
' Subject: ROUTINE TO DRAW HEXAGONS           Date: 10-20-97 (10:34)       
'  Author: William A. Deer                    Code: QB, QBasic, PDS        
'  Origin: ag312350@student.uq.edu.au       Packet: EGAVGA.ABC
'===========================================================================
DECLARE SUB Hexagon (X%, Y%, R%, C%)
'
' HEXAGON.BAS
' The Heart of this program is a small subrountine which draws a hexagon
' with Point (x,y) in the middle. The hexagon has radius R pixels, and is
' colour C.

' The rest of this short program tiles the hexagons on the screen, and then
' fills them in a random order with specific colours.

' This program should help anyone who needs a simple way of drawing a hexagon
' on the screen. It should work in other screen modes, but I haven't tried it.

' Hope you enjoy.
' William c/o ag312350@student.uq.oz.au


CONST Sine60 = .866025403785#
CONST TRUE = 0, FALSE = NOT TRUE
CONST XMax = 640, YMax = 480

SCREEN 12 ' 640* 480  16/256K Colours
GOSUB ColourImplementation

DIM Hex(8000, 3) AS INTEGER
DIM Colour AS INTEGER
DIM Radius AS INTEGER
DIM HexCount AS INTEGER
DIM HexCol AS INTEGER
DIM HexRow AS INTEGER
DIM X, Y AS INTEGER
DIM S, T AS INTEGER

        Colour = 3
        Radius = 10
        Flag = TRUE
        HexCount = 0

FOR Y = Radius TO YMax - Radius STEP Radius * Sine60
  HexRow = HexRow + 1
  HexCol = 0
  IF Flag = TRUE THEN XX = 0: Flag = FALSE:  ELSE XX = Radius * 1.5: Flag = TRUE
  FOR X = Radius TO XMax - Radius STEP 3 * Radius
    HexCol = HexCol + 1
    HexCount = HexCount + 1
    CALL Hexagon(X - XX, Y, Radius, Colour)
    Hex(HexCount, 1) = X - XX
    Hex(HexCount, 2) = Y
    Hex(HexCount, 3) = Colour
    
  NEXT X
NEXT Y
PRINT "total Number of Hexagons = "; HexCount
PRINT "Number of Columns = "; HexCol
PRINT "Number of Rows = "; HexRow

SLEEP
CLS
FOR a = 1 TO HexCount
        Colour = (INT(RND * 4)) + 2
        CALL Hexagon(Hex(a, 1), Hex(a, 2), Radius, Colour)
        PAINT (Hex(a, 1), Hex(a, 2)), Colour, Colour
NEXT a
SLEEP 1
END

ColourImplementation:
' COLOUR INTERPRETATION
MaxCol = 7
DIM Colours(MaxCol, 3)
 FOR a = 1 TO MaxCol
  FOR B = 1 TO 3
   READ C: Colours(a, B) = C
  NEXT B
 NEXT a
 DATA 100,187,103
 DATA 215,163,85
 DATA 230,126,70
 DATA 158,56,22
 DATA 3,35,12
 DATA 28,154,1
 DATA 124,66,31

DIM Pal(MaxCol) AS DOUBLE
FOR a = 1 TO MaxCol
 R = INT(Colours(a, 1) / 4): IF R > 63 THEN R = 63
 G = INT(Colours(a, 2) / 4): IF G > 63 THEN G = 63
 B = INT(Colours(a, 3) / 4): IF B > 63 THEN B = 63
 PALETTE a, ((65536 * B) + (256 * G) + R)

NEXT a
RETURN

SUB Hexagon (X%, Y%, R%, C%)
' This subrountine creates a really accurate hexagon,

DIM Dx, Dy AS INTEGER

Dx = .5 * R%
Dy = Sine60 * R%
' Sine60 is a constant of Sin60 = 0.866025403785#

COLOR C%
PSET (X% + R%, Y%)
LINE -STEP(-Dx, -Dy)
LINE -STEP(-R%, 0)
LINE -STEP(-Dx, Dy)
LINE -STEP(Dx, Dy)
LINE -STEP(R%, 0)
LINE -STEP(Dx, -Dy)

END SUB