BUG 11/BUGCD1998_02.ISO/aplic/turbocad/tcw.z/fern23.bas

BASIC Source File | 1997-05-05 | 9KB | 408 lines

'******************************************************************
'*                                                                *
'*                      TurboCAD for Windows                      *
'*                   Copyright (c) 1993 - 1996                    *
'*             International Microcomputer Software, Inc.         *
'*                            (IMSI)                              *
'*                      All rights reserved.                      *
'*                                                                *
'******************************************************************
'
' Filename: FERN23.BAS
'
' Author:    Pat Garner
'
' Date:        1/13/97
'
'
' Scriptname:    Fractal Fern Generator
'
' Version:        2.3
'
' Description:    Adaptation of the Fern Fractal Generator
'                 that uses functions from the TurboCAD
'                 scripting API to construct a new graphic
'                 object
'
'
' New to version 2.3:    Add property loops from ATS script
'                         series to be used immediately to
'                         test the TCWGraphicPropertyGet/Set
'                         API functions scripting functions.
'
'                        The long term goal would be to hook
'                         the functions into a property
'                         page/wizard dialog to give the
'                         user more depth of control on how
'                         the graphic is created.
'
'                        To take this a step further, the script
'                         could check to see if a selected graphic
'                         is a fern graphic.  If so, the script
'                         could bring up it's 'property page'
'                         dialog and allow the user to modify it's
'                         attributes ala smart shape action.
'
'                                                -pg 2/7/97
'
'
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''SCRIPT VARIABLES'''''''''''''''''''''''''''''''''''''''''''''''''
'
' - Script Constants
'
Global Const MAX_POINTS = 100000        ' * Total number of points to be created
Global Const MY_TRUE = 1                ' * For use with TCWPenDown
Global Const MY_FALSE = 0                ' * For use with TCWPenDown
Global Const GK_GRAPHIC = &H0B            ' * TurboCAD graphic type
Global Const NULL = 0                    ' * Null value equivalent
Global Const LOGFILE = "C:\FERN.LOG"    ' * Name of log file
Global Const METHOD = 0                    ' * Method used to generate the fern graphic
'
'
' - Error Reporting Constants
'
Global Const DEBUG = 0
Global Const SILENT = 1                        ' * Write err message info to error file
Global Const MSG_BOX = 2                    ' * Diplay err message info in a message box
Global Const ALL = 3                        ' * Use error both methods
Global Const NONE = 0                        ' * Don't do any error reporting
Global Const ERR_FILE = "C:\FERN.ERR"       ' * Error file name
Global Const SCRIPT_FILE = "FERN.BAS"        ' * Script file name
Global Const ERR_SL = 10                    ' * Length of "ERR_SET = " for DoErrSetValue
Global Const ERR_SET = 1                    ' * Error file does not exit if 0
Global Const ERR_METHOD = NONE                ' * Set ERR_METHOD behavior
Global Const ERR_TRUE = 1                    ' * For ERR_STOP ending script execution
Global Const ERR_FALSE = 0                    ' * For ERR_STOP not ending script exection
Global Const ERR_STOP = ERR_TRUE            ' * Set ERR_STOP behavior
'
'
' - Arrays to hold the x/y values generated
'    by the fern fractal algorthm.
'
dim Xarray(MAX_POINTS) as double
dim Yarray(MAX_POINTS) as double
dim numPoints As Long
'
'
' - Script effects variables
'
dim smear_eff    as integer
dim smear_val    as double
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''SUBROUTINE: MAIN'''''''''''''''''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' * Return Value: None
' *
' * Description:
' *
' *        Main is the conductor of the program
' *         and like a music conductor, tells
' *         the other parts of the program when
' *         it's time to do their thing.
' *
' *
Sub main ()

    InitializeScript
    DoFernUI

    LoadVertexCoordinateArray
    GenerateFernGraphic

End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''SUBROUTINE: InitializeScript'''''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' * Return Value: None
' *
' * Description:
' *
' *        Script Setup Stuff
' *
' *
Sub InitializeScript ()

    smear_eff = 0
    smear_val = 0

    TCWClearError    ' * Clear any error out of the error buffer.

    ' * ADD YOUR CODE HERE *

End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''SUBROUTINE: LoadVertexCoordinateArray''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' * Return Value: None
' *
' * Description:
' *
' *        This subroutine uses a fern fractal algorithm
' *         to generate a set of x/y coordinates based on
' *         a randomly generated seed value and the previous
' *         iterations x/y output.  Each iterations
' *         results are loaded into an array which is
' *         then used to generate the fractal graphic itself.
' *
' *
Sub LoadVertexCoordinateArray ()

    dim counter as long
    dim a        as double
    dim b        as double
    dim c        as double
    dim d        as double
    dim e        as double
    dim f        as double
    dim r        as double
    dim x        as double
    dim y        as double

    for counter = 0 To (numPoints-1)

        r = rnd

        if r <= .01 then
            a = 0
            b = 0
            c = 0
            d = .16
            e = 0
            f = 0

        elseif r > .01 and r <= .86 then
            a = .85
            b = .04
            c = -.04
            d = .85
            e = 0
            f = 1.6

        elseif r > .86 and r <= .93 then
            a = .2
            b = -.26
            c = .23
            d = .22
            e = 0
            f = 1.6

        else
            a = -.15
            b = .28
            c = .26
            d = .24
            e = 0
            f = .44

        end if

        x = (a * x) + (b * y) + e
        y = (c * x) + (d * y) + f

        Xarray(counter) = x
        Yarray(counter) = y

    next

End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''SUBROUTINE: GenerateFernGraphic''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' * Return Value: None
' *
' * Description:
' *
' *        This subroutine creates the fern
' *         graphic.
' *
' *
Sub GenerateFernGraphic ()

    dim gfgCounter    as long
    dim hGraphic    as long
    dim hDrawing    as long
    dim offset        as double

    if smear_eff = 1 then

        offset = smear_val

    else

        offset = .01

    end if

    hDrawing = TCWDrawingActive
    hGraphic = TCWGraphicCreate (GK_GRAPHIC, "")

    for gfgCounter=0 to (numPoints-1)

        VertexCreateMethod hGraphic, Xarray(gfgCounter), Yarray(gfgCounter), offset

    next

    TCWGraphicAppend NULL, hGraphic
    TCWGraphicDraw hGraphic, 0

    TCWUndoRecordStart hDrawing, "fern"

        TCWUndoRecordAddGraphic hDrawing, hGraphic

    TCWUndoRecordEnd hDrawing

End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''SUBROUTINE: VertexCreateMethod'''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' * Return Value: None
' *
' * Description:
' *
' *        This subroutine creates a fern
' *         graphic using TCWVertexAppend
' *
' *
' *
Sub VertexCreateMethod (ByVal hGraphic As Long, ByVal x As Double, ByVal y As Double, ByVal os As Double)

    dim hVertex1    as long
    dim hVertex2    as long

    hVertex1 = TCWVertexCreate(x#, y#, 0#)
    hVertex2 = TCWVertexCreate(x#+os#, y#+os#, 0#)

    TCWPenDown hVertex1, MY_FALSE
    TCWPenDown hVertex2, MY_TRUE

    TCWGraphicVertexAdd hGraphic, hVertex1
    TCWGraphicVertexAdd hGraphic, hVertex2

End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





''SUBROUTINE: DoFernUI'''''''''''''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' * Return Value: None
' *
' * Description:
' *
' *        This is the fern fractal script's user interface.
' *         It's actually a dialog box definition that serves
' *         as a "template" for later creating a variable of
' *         of this type and them using the enable function
' *        'Dialog' to display it and return values.  The
' *         dialog definition is done in a manner very similar
' *         to creating user defined variables with the type
' *         function in basic or the struct function in C.
' *         By utilizing several of the UI objects available
' *         you can actually create quite a useful interface
' *         for setting script values and options as well as
' *         guiding the user through script setup with a
' *         "wizard" like interface.
' *
Sub DoFernUI ()

    Begin Dialog FernUI 60, 60, 240, 184, "Fern Fractal Generator"

        Text 30,    30,        200,    200,    "This script demonstrates the use of TurboCAD scripting to interact with the user with a 'wizard' style interface and then generate a new graphic type generated by the script drive certain properties of the graphic."
        Text 30,    140,    140,    20,        "How many Points would you like?"

        TextBox 150, 140, 40, 16, .numPointText

        OKbutton     80, 170, 40, 12
        CancelButton 120, 170, 40, 12

    End Dialog


    Dim FrnDlg As FernUI
    FrnDlg.numPointText = "500"
    button = Dialog(FrnDlg)


    if button = 0 then

        END

    else

        numPoints = FrnDlg.numPointText

        if numPoints > 100000 then

            MsgBox "Too many points!  Please enter a value smaller than 100000."
            DoFernUI

        elseif numPoints < 1 then

            MsgBox "Not enough points!  Please enter a value larger than 0."
            DoFernUI

        end if

    end if

End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''