home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Harvey Norman Games
/
HN.iso
/
BOARD
/
LIFE2P0.ZIP
/
EXT_PROC.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-05-30
|
10KB
|
471 lines
DECLARE SUB Procedure12 ()
DECLARE SUB Procedure11 ()
DECLARE SUB Procedure8 ()
DECLARE SUB Procedure7 ()
DECLARE SUB Procedure6 ()
DECLARE SUB Procedure5 ()
DECLARE SUB Procedure4 ()
DECLARE SUB Procedure3 ()
DECLARE SUB Procedure2 ()
DECLARE SUB Procedure1 ()
DECLARE SUB Procedure9 ()
DECLARE SUB Procedure10 ()
DEFINT A-Z
'
'
'This demonstrates how to get your own programs to interact with LIFE.
'
'This program can be run with QBasic or compiled with QB.
'
'Basically, all an external procedure needs to do is.. .
' 1/ Clear the screen. It should still be in mode 13
' 2/ Read in and act on information from life in RETURN.DTA
' 3/ Draw something on screen. (COLOR 1)
' 4/ Set values in Control structure and save to CONTROL.DTA
' 5/ END. Which returns control to life with a new screen of data or
' a command to stop processing.
'
'The screen drawn is returned to life in the video memory.
'
'If there are any other things you would like in these structures
'please let me know.
'
'
'
'For best results, use SMARTDRV with as large a buffer as possible and the
' /N switch or a RAM disk.
'
'
'Files with the extension .DTA are tempory files and may be deleted when no
'longer required. I suggest you stay with this convention.
'
'Life reads from CONTROL.DAT, if it exists and sends info to this program
'in RETURN.DTA.
'
'
'This program IS the documentation for the LIFE External procedure.
'
'
'
'This structure controls the life program
TYPE Frame
ExitAfter AS LONG 'LIFE returns to this program after
'ExitAfter generations.
MaxNoChange AS LONG 'LIFE returns if population doesn't change for this
'number of generations.
Wrap AS INTEGER '-1 turns wrap mode on, 0 turns wrap mode off.
Rules AS STRING * 4
StopExecution AS INTEGER 'if set to -1 will cause life to display menu
Delay AS INTEGER 'Delay time, same as delay in control menu.
StartDelay AS INTEGER 'time to delay start of processing.
reserved AS STRING * 1004 'pad to 1024 bytes. All 0.
END TYPE
DIM SHARED Control AS Frame
'This is returned from LIFE
TYPE rd
Version AS INTEGER 'Version number of LIFE.
Population AS LONG 'Number of cells on screen, current population.
generation AS LONG 'Number of generations completed.
LastStableGeneration AS LONG 'Generation where last stable population
'occured.
GenerationsPerSecond AS STRING * 10 'Just what it says
Wrap AS INTEGER 'Wrap mode -1 = on, 0 = OFF
Rules AS STRING * 4 'The rules. See below.
Delay AS INTEGER 'Delay value 0 - 255, 0 = fastest.
reserved AS STRING * 992 'padding to make 1024 bytes long
END TYPE
DIM SHARED ReturnData AS rd
StartUp& = TIMER 'make it different each time.
'Check for existance is if Version number is 0, could use EOF()
n$ = "RETURN.DTA"
OPEN n$ FOR BINARY AS #1
GET #1, , ReturnData
CLOSE #1
IF ReturnData.Version = 0 THEN GOTO FirstTime
'File didn't exist so is the first this program has been called.
'extract rules for no reason but to show how to.
LeastToLive = ASC(MID$(ReturnData.Rules, 1, 1))
LowestBirth = ASC(MID$(ReturnData.Rules, 2, 1))
HighestBirth = ASC(MID$(ReturnData.Rules, 3, 1))
MostToLive = ASC(MID$(ReturnData.Rules, 4, 1))
Max = 8000' only interested in things that last longer than this.
'Test if meets criteria of >=8000 Generations.
'If it does, BEEP and signal stop in Control structure.
IF (ReturnData.LastStableGeneration > Max) OR (ReturnData.generation >= Max) THEN
'first fix so it only stops first time thru.
n$ = "RETURN.DTA"
ReturnData.generation = 0
ReturnData.LastStableGeneration = 0
OPEN n$ FOR BINARY AS #1
PUT #1, , ReturnData
CLOSE #1
PLAY "a c b f f g" 'HEY YOU ...
Control.StopExecution = -1 'Tell LIFE to stop processing.
GOTO ImmediateExit:
END IF
'un-comment to keep a log, a simple example
'n$ = "log.dta"
'OPEN n$ FOR APPEND AS #1
' PRINT #1, "StartUp "; StartUp&; "Gen "; ReturnData.LastStableGeneration, "Pop "; ReturnData.Population, " Size "; s
'CLOSE #1
FirstTime:
SCREEN 13 'Must be SCREEN 13. BASIC won't clear screen
'if it was already in mode 13.
COLOR 1 'Must be color 1 to work properly, try some
'others if you like.
CLS
'Put something onto the screen.
RANDOMIZE StartUp&
LoopHere:
v = INT(12 * RND) + 1
'v = 12 'Debug control to force selection of same one.
SELECT CASE v
CASE 1
Procedure1
CASE 2
Procedure2
CASE 3
Procedure3
CASE 4
Procedure4
CASE 5
Procedure5
CASE 6
Procedure6
CASE 7
Procedure7
CASE 8
Procedure8
CASE 9
Procedure9
CASE 10
Procedure10
CASE 11
Procedure11
CASE 12
Procedure12
CASE ELSE
BEEP 'Should never happen, here for debugging.
BEEP
END SELECT
'Set-up and save control info.
Control.StopExecution = 0 'Don't stop
ImmediateExit:
Control.ExitAfter = Max + 10
'Set to exit after X generations. Slightly larger than max generations.
'Life will stop processing after Max+10 generations.
Control.MaxNoChange = 500 'number of no population change generations.
'LIFE will stop processing the current screen after this number of
'generations without a population change.
Control.Wrap = -1 ' Wrap mode is ON
Control.Rules = CHR$(2) + CHR$(3) + CHR$(3) + CHR$(3) 'standard rules.2333
Control.Delay = 0'No delay
Control.StartDelay = 0 'delay between display and start of processing in
'1/18 seconds.
n$ = "CONTROL.DTA" ' Change directory to suit, must retain the
' same filename, CONTROL.DTA.
'Save control info.
OPEN n$ FOR BINARY AS #1
PUT #1, , Control
CLOSE
'That's all, LIFE will restore what needs to be so just end.
SYSTEM
SUB Procedure1
sx = RND * 64 + 1
sy = RND * 64 + 1
DO
Density! = RND
LOOP UNTIL Density! < .66
FOR x = 0 TO sx - 1
FOR y = 0 TO sy - 1
IF RND > Density! THEN
PSET (x + 160 - (sx \ 2), y + 100 - (sy \ 2)), 1
END IF
NEXT
NEXT
END SUB
SUB Procedure10
s = RND * 150
o = 0
IF RND > .5 THEN o = 1
l = RND * 199
LINE (160 - s + o, 0)-(160 - s + o, l), 1
LINE (160 + s, 0)-(160 + s, l), 1
END SUB
SUB Procedure11
l = RND * 99
LINE (160, 100)-(160 - l, 100 - l), 1
LINE (160, 100)-(160 + l, 100 - l), 1
LINE (160, 100)-(160 - l, 100 + l), 1
LINE (160, 100)-(160 + l, 100 + l), 1
IF RND > .5 THEN
l = RND * 100
LINE (160 - l, 100 - l)-(160 + l, 100 + l), 1, B
END IF
END SUB
SUB Procedure12
l = RND * 99
'Up and left
LINE (160 - 1, 100 - 1)-(160 - l - 1, 100 - l - 1), 1
'Up and right
LINE (160, 100 - 1)-(160 + l, 100 - l - 1), 1
'Down and left
LINE (160 - 1, 100)-(160 - l - 1, 100 + l), 1
'Down and right
LINE (160, 100)-(160 + l, 100 + l), 1
IF RND > .5 THEN
l = RND * 100
LINE (160 - l - 1, 100 - l - 1)-(160 + l, 100 + l), 1, B
END IF
END SUB
SUB Procedure2
Size = RND * 100 + 10
Number = RND * 1000 + 50
x = 160
y = 100
IF RND > .5 THEN
inc = 1
ELSE
inc = 0
END IF
FOR t = 1 TO Number
x1 = RND * Size
y1 = RND * Size
PSET (x - x1, y + y1 - inc), 1
PSET (x - x1, y - y1), 1
PSET (x + x1 - inc, y - y1), 1
PSET (x + x1 - inc, y + y1 - inc), 1
NEXT
END SUB
SUB Procedure3
x = 160
y = 100
n = RND * 1000 + 50
z = 5 + RND * 60
o = RND * 16
IF RND > .5 THEN
inc = 1
ELSE
inc = 0
END IF
FOR count = 1 TO n
x1 = RND * z + o
y1 = RND * z + o
PSET (x + x1, y + y1), 1
PSET (x + y1, y - x1), 1
PSET (x - x1 + inc, y - y1 + inc), 1
PSET (x - y1 + inc, y + x1 + inc), 1
NEXT
END SUB
SUB Procedure4
n = INT(RND * 16) + 1
s = INT(RND * 15) + 1
w = INT(RND * 150) + 1
YSize = (n - 1) * s
y = 100 - (YSize \ 2)
x = 160 - (w \ 2)
FOR t = 1 TO n
LINE (x, y)-(x + w, y), 1'must be color 1
y = y + s
NEXT
END SUB
SUB Procedure5
xl = INT(160 * RND) + 1
yl = INT(100 * RND) + 1
x = xl \ 2
LINE (160 - x, 100)-(160 + x, 100), 1
y = yl \ 2
LINE (160, 100 - y)-(160, 100 + y), 1
END SUB
SUB Procedure6
x = INT(80 * RND) + 1
y = INT(50 * RND) + 1
inc = RND > .5
LINE (160 - x, 100 - y)-(160 + x, 100 - y), 1
LINE (160 - x, 100 + y + inc)-(160 + x, 100 + y + inc), 1
LINE (160 - x, 100 - y)-(160 - x, 100 + y + inc), 1
END SUB
SUB Procedure7
x = INT(80 * RND) + 1
y = INT(50 * RND) + 1
inc = RND > .5
inc2 = RND > .5
LINE (160 - x, 100 - y)-(160 + inc2 + x, 100 - y), 1
LINE (160 - x, 100 + y + inc)-(160 + inc2 + x, 100 + y + inc), 1
LINE (160 - x, 100 - y)-(160 - x, 100 + y + inc), 1
LINE (160 + inc2 + x, 100 - y)-(160 + inc2 + x, 100 + y + inc), 1
END SUB
SUB Procedure8
FOR t = 1 TO RND * 15 + 2
x = INT(80 * RND) + 1
y = INT(50 * RND) + 1
LINE (160 - x, 100 - y)-(160 + x, 100 - y), 1
LINE (160 - x, 100 + y)-(160 + x, 100 + y), 1
LINE (160 - x, 100 - y)-(160 - x, 100 + y), 1
LINE (160 + x, 100 - y)-(160 + x, 100 + y), 1
NEXT
END SUB
SUB Procedure9
x = INT(80 * RND) + 1
y = INT(50 * RND) + 1
inc = RND > .5
inc2 = RND > .5
xl = 160 - x
xr = 160 + inc + x
LINE (xl, 100)-(xr, 100), 1
yt = -INT(50 * RND) + 1
yb = INT(50 * RND) + 1
LINE (xl, 100 + yt)-(xl, 100 + yb), 1
LINE (xr, 100 + yt)-(xr, 100 + yb), 1
END SUB