Landscape program

[Pjot]

Folks,

The basicprogramming website showed a nice small piece of code generating Chinese landscapes.

I just had to come up with a BaCon version

BR
Peter


REM Landscape program ported to BaCon
INCLUDE "hug.bac", INIT, WINDOW, CANVAS, ATTACH, SQUARE, LINE, OUT, TIMEOUT, KEY, RESETKEY, DISPLAY

REM Color definition
DEF FN col$(v) = "#" & HEX$(v) & HEX$(v) & HEX$(v)

REM Size of the canvas
CONST Width = 800
CONST Height = 600

REM The landscape
SUB Draw_Landscape

LOCAL colour, start, mountains, offset, x, y, factor

SQUARE("#DCC8DC", 0, 0, Width, Height, TRUE)

colour = 180
start = 100

FOR mountains = 1 TO 6

offset = 0
y = start

REPEAT
factor = (RANDOM(9)-4)/2
FOR x = offset TO offset+RANDOM(40)
y = y + factor
LINE(col$(colour), x, y, x, Height)
NEXT
offset = x
UNTIL offset >= Width

DECR colour, 23
INCR start, 20+RANDOM(80)
NEXT

OUT("Press space for a new landscape...", "#FFFFFF", col$(colour+23), 10, 500)

END SUB

REM Check for <space> or <escape>
FUNCTION Key_Press

IF KEY() = 32 THEN
Draw_Landscape
ELIF KEY() = 65307 THEN
END
ENDIF

RESETKEY

RETURN TRUE

END FUNCTION

REM Define the canvas
INIT
win = WINDOW("Landscape", Width, Height)
cvs = CANVAS(Width, Height)
ATTACH(win, cvs, 0, 0)

Draw_Landscape

TIMEOUT(10, Key_Press)

DISPLAY


Attachments:

[vovchik]

Dear Peter,

Thanks. Very nice and simple - and it generates realistic and attractive images.

With kind regards,
vovchik

[vovchik]

Dear all,

This is the same program Peter posted, just with additional mouse-handling....

With kind regards,
vovchik

' Chinese landscape program ported to BaCon

' ***********************
' INCLUDES
' ***********************

INCLUDE "hug.bac", INIT, WINDOW, CANVAS, ATTACH, SQUARE, LINE, OUT, \
TIMEOUT, KEY, RESETKEY, DISPLAY, MOUSE, QUIT

' ***********************
' END INCLUDES
' ***********************


' ***********************
' INITIALIZATION
' ***********************

' Size of the canvas
CONST WIDTH = 800
CONST HEIGHT = 600
' globals
DECLARE win, cvs
INIT

' ***********************
' END INITIALIZATION
' ***********************


' ***********************
' SUBS & FUNCTIONS
' ***********************

' ------------------
' Color definition
DEF FN COL$(v) = "#" & HEX$(v) & HEX$(v) & HEX$(v)
' ------------------

' ------------------
SUB DRAW_LANDSCAPE()
' ------------------
' The landscape
    LOCAL colour, start, mountains, offset, x, y, factor
    SQUARE("#DCC8DC", 0, 0, WIDTH, HEIGHT, TRUE)
    colour = 180
    start = 100
    FOR mountains = 1 TO 6
         offset = 0
         y = start
         REPEAT
              factor = (RANDOM(9) - 4) / 2
              FOR x = offset TO offset + RANDOM(40)
                   y = y + factor
                   LINE(COL$(colour), x, y, x, HEIGHT)
              NEXT
              offset = x
         UNTIL offset >= WIDTH
         DECR colour, 23
         INCR start, 20 + RANDOM(80)
    NEXT
    OUT("Press SPACE or left click for a new landscape... " & \
"Press ESC or right click to exit.", "#FFFFFF", \
COL$(colour + 23), 130, HEIGHT - 20)
END SUB

' ------------------
FUNCTION USER_ACTION()
' ------------------
' Check for <space> or <escape>, or left/right mouse click
CONST SPACE = 32
CONST ESC = 65307
CONST LEFT_BUTTON = 1
CONST RIGHT_BUTTON = 3
    IF KEY() = SPACE OR MOUSE(2) = LEFT_BUTTON THEN
         DRAW_LANDSCAPE()
    ELIF KEY() = ESC OR MOUSE(2) = RIGHT_BUTTON THEN
         QUIT
    END IF
    RESETKEY
    RETURN TRUE
END FUNCTION

' ------------------
SUB MK_GUI()
' ------------------
' Define the canvas
win = WINDOW("Chinese Landscape", WIDTH, HEIGHT)
cvs = CANVAS(WIDTH, HEIGHT)
ATTACH(win, cvs, 0, 0)
DRAW_LANDSCAPE()
END SUB

' ***********************
' END SUBS & FUNCTIONS
' ***********************


' ***********************
' MAIN
' ***********************

MK_GUI()
TIMEOUT(10, USER_ACTION)
DISPLAY

' ***********************
' END MAIN
' ***********************