'===========================================================================
' Subject: 3D MAP ALGORITHM                  Date: 07-22-00 (15:33)       
' Author:  Erez Shinan                       Code: QB, QBasic, PDS        
' Origin:  shinnan@zahav.net.il            Packet: GRAPHICS.ABC
'===========================================================================
'Üßßßß ÜßßÜÜ Üßßßß ÛßßßÛ       ÜßßßÜ Û   Û ßÛß ÛÜ  Û ÜßßßÜ ÛÜ  Û
'ÛÜÜÜ  Û   Û ÛÜÜÜ    Üß        ßÜÜ   ÛÜÜÜÛ  Û  ÛßÜ Û ÛÜÜÜÛ ÛßÜ Û
'Û     ÛßßßÜ Û      Üß            ßÜ Û   Û  Û  Û ßÜÛ Û   Û Û ßÜÛ
'ßÜÜÜÜ Û   Û ßÜÜÜÜ ÛÜÜÜÛ       ßÜÜÜß Û   Û ÜÛÜ Û  ßÛ Û   Û Û  ßÛ

' /
'<<<<<<<<-------------------------------------------================<
' \

'ßßÛ Üßß ÛßÜ    Ûßß ÜßÜ Üßß ßÛß Û Û ÜßÜ ÜßÜ Üßß
' Û  Ûß  Û Û ßß ßßÜ Û Û Ûß   Û  ÝÜÞ ÛßÛ ÛÜß Ûß
'ÛÜÜ ßÜÜ ÛÜß    ÜÜÛ ßÜß Û    Û  ÞßÝ Û Û Û Û ßÜÜ


'Made by Erez Shinan 21-07-00 / 22-07-00
'Email: erezshn@hotmail.com

'To run press Shift + F5


'This is a very easy 3D map algorithem.

'You can change and use this program as much as you want,
'but if you use it in one of your programs please mention my name.

'If you know how to "hide" the black points that occur on certain
'rotation angles please email me.

'If you have questions or answers email me to: erezshn@hotmail.com

DEFINT A-Z
SCREEN 13
DIM Enlargement AS SINGLE
RANDOMIZE TIMER
HDiff = 10          'Height differences when smoothing
SmoothAmount = 5    'Smoothing amount
HWater = 5          'Water height: 1 to 15
lx = 1: hx = 100     'Borders of ...
ly = 1: hy = 100     '... the map
Enlargement = 1     'In how much to enlarge the map

DIM P(lx TO hx, ly TO hy) AS INTEGER   'If error accurs here use /AH on command-line
DIM sP(lx TO hx, ly TO hy) AS INTEGER  'or decrease the values of 'hx' & 'hy'.

'Random points
FOR x = lx TO hx
FOR y = ly TO hy
P(x, y) = ((RND * 256))
NEXT y, x

FOR x = lx TO hx
FOR y = ly TO hy
sP(x, y) = P(x, y)
NEXT y, x


'Smooth
FOR c = 1 TO SmoothAmount
PRINT "Smooth:"; c; "/"; SmoothAmount
FOR x = lx TO hx
FOR y = ly TO hy
    cur = sP(x, y)
    IF x = lx OR y = ly THEN p1 = cur ELSE p1 = sP(x - 1, y - 1)
    IF y = ly THEN p2 = cur ELSE p2 = sP(x, y - 1)
    IF y = ly OR x = hx THEN p3 = cur ELSE p3 = sP(x + 1, y - 1)
    IF x = lx THEN p4 = cur ELSE p4 = sP(x - 1, y)
    IF x = hx THEN p6 = cur ELSE p6 = sP(x + 1, y)
    IF x = lx OR y = hy THEN p7 = cur ELSE p7 = sP(x - 1, y + 1)
    IF y = hy THEN p8 = cur ELSE p8 = sP(x, y + 1)
    IF y = hy OR x = hx THEN p9 = cur ELSE p9 = sP(x + 1, y + 1)
    P(x, y) = (cur * HDiff + p1 + p2 + p3 + p4 + p6 + p7 + p8 + p9) \ (8 + HDiff)
NEXT y, x

FOR x = lx TO hx
FOR y = ly TO hy
 sP(x, y) = P(x, y)
 NEXT y, x
NEXT c


blue = 40: green = 0: red = 0
FOR c = 1 TO HWater
PALETTE c, 65536 * (blue + c) + 256 * green + red
NEXT c

FOR c = HWater + 1 TO 15
blue = 0: green = c * 4 + 3: red = 0
PALETTE c, 65536 * blue + 256 * green + red
NEXT c

CLS

FOR x = lx TO hx
FOR y = ly TO hy
LINE (x * Enlargement, y * Enlargement)-((x + Enlargement - 1) * Enlargement, (y + Enlargement - 1) * Enlargement), P(x, y) \ 16, BF
NEXT y, x
DO
INPUT "Rotation"; RotationAngle
Rotation# = RotationAngle * ATN(1) / 45
CLS

DIM h AS SINGLE

RCOS# = COS(Rotation#)
RSIN# = SIN(Rotation#)
ya = (255 * RSIN#) / 4
h = ya

FOR y = ly TO hy
h = h + RCOS#
FOR x = lx TO hx
    y2 = h - (P(x, y) \ 4) * RSIN#
    LINE (x * Enlargement, y2 * Enlargement)-((x + Enlargement * 2 - 1) * Enlargement, (y2 + Enlargement * 2 - 1) * Enlargement), P(x, y) \ 16, BF
NEXT x, y
LOOP