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 workingAnonymous on Dec 2
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

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