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


  << Previous Topic | Next Topic >>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   
AuthorReply
Anonymous
(no login)

no working

December 2 2011, 4:38 AM 

mean can we delete slowely this applemind which inkompetent with his bas
becouse see value that not a bas otherway would work
yes three letters like who or bas
and be sure that only can write bas
perhaps was this www pages no able to understand whats a bas

 
 Respond to this message   
Current Topic - www.goldensoftware.com/public/scripts/surfer9/colorlines.bas
  << Previous Topic | Next Topic >>Return to Index  
 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