The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 Return to Index  

www.goldensoftware.com/public/scripts/surfer9/colorlines.bas

November 17 2011 at 10:26 PM
Anonymous  (no login)

'============================================================================
' COLORLINES.BAS
'
' This script creates a LVL file with line colors ranging from
' red-yellow-green-cyan-blue.
'
' Contour fills are not filled by default. For Solid contour fill, change
' None to Solid in s1$.
' Original SURF_LVL.BAS by Jud Ahern, University of Oklahoma, written in
' QBASIC. Port to SURFER 6 Scripter BASIC by TB, Golden Software, Inc.
'
' SKP 9/99 Surfer 7
'============================================================================

Sub Main

Dim contour(1000)

header$ = "'Level Flags LColor LStyle LWidth FFGColor FBGColor FPattern FMode"
q$ = Chr$(34) ' a double quote
sp$ = Space$(1) ' a space
s1$ = "0 " + q$
s3$ = q$ + sp$ + q$ + "Solid" + q$ +" 0 " + q$ + "White" + q$ + sp$ + q$ + "White" + q$ + sp$ + q$ + "None" + q$ + " 2"
form$ = s1$ + s2$ + s3$

lvlfile$=InputBox$( "Name of level file to create - must be .lvl")
cmin=Val(InputBox$( "Minimum contour value: "))
cmax=Val(InputBox$( "Maximum contour value: "))
interval=Val(InputBox$( "Contour interval: "))
Open lvlfile$ For Output As #1

nlvls = (cmax - cmin) / interval - 1 ' was + 1, not -1
For i = 1 To nlvls
contour(i) = cmin + i * interval ' was (i - 1) *, not i *
Next
end2 = Int(nlvls / 2)
end1 = Int(end2 / 2)
end3 = end2 + Int((nlvls - end2) / 2)

Print #1, "LVL2"
Print #1, header$

For i = 1 To end1
r = 0
b = 255
g = Int((255 / (end1 - 1)) * (i - 1))
red$ = LTrim$(Str$(r))
green$ = LTrim$(Str$(g))
blue$ = LTrim$(Str$(b))
Debug.Print contour(i);" ";red$;" "; green$;" "; blue$
Print #1, contour(i);" ";s1$+"R"+red$+" G"+green$+" B"+blue$+s3$
Next

For i = end1 + 1 To end2
r = 0
g = 255
b = 255 - Int(255 / (end2 - end1) * (i - end1))
red$ = LTrim$(Str$(r))
green$ = LTrim$(Str$(g))
blue$ = LTrim$(Str$(b))
Debug.Print contour(i);" ";red$;" "; green$;" "; blue$
Print #1, contour(i);" ";s1$+"R"+red$+" G"+green$+" B"+blue$+s3$
Next

For i = end2 + 1 To end3
b = 0
g = 255
r = Int(255 / (end3 - end2) * (i - end2))
red$ = LTrim$(Str$(r))
green$ = LTrim$(Str$(g))
blue$ = LTrim$(Str$(b))
Debug.Print contour(i);" ";red$;" "; green$;" "; blue$
Print #1, contour(i);" ";s1$+"R"+red$+" G"+green$+" B"+blue$+s3$
Next

For i = end3 + 1 To nlvls
r = 255
b = 0
g = 255 - Int(255 / (nlvls - end3) * (i - end3))
red$ = LTrim$(Str$(r))
green$ = LTrim$(Str$(g))
blue$ = LTrim$(Str$(b))
Debug.Print contour(i);" ";red$;" "; green$;" "; blue$
Print #1, contour(i);" ";s1$+"R"+red$+" G"+green$+" B"+blue$+s3$
Next

Close #1
'LVL2

' 52200 0 "R0 G60 B255" "Solid" 0 "White" "White" "Invisible" 2

End Sub


 
 Respond to this message   
Response TitleAuthor and Date
no working (View Thread)Anonymous on Dec 2

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums