info
Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
Linux Xbasic programming example
0 views
Skip to first unread message
ericmatteson...@hotmail.com
May 17, 2007, 12:51:37 AM5/17/07
to
Linux Xbasic for Linux has recently been discovered and
it is a very flexible and powerful version of BASIC
Use xb instead of xbasic at bash command prompt
Use .fl gamexb07.x to load this basic program
after downloading and saving in dot command window
' delete all lines above this line
' This is the FIRST LINE of this BASIC PROGRAM
PROGRAM "gamexb07"
' This gamexb07.x xbasic game program is written
' by Eric Matteson. Permission is granted to copy
' this gamexb07.x source code and to publish it
' on the Internet and to use it at least for
' non profit use.
VERSION "2.0"
IMPORT "xst"
DECLARE FUNCTION KAPOWSKI07()
DECLARE FUNCTION numfroml#(n2p#,nmfwid#,n2b#,simode$,nmfline$)
DECLARE FUNCTION sfromnu$(sfnwid#,sfnbase#,vemode$,sfnuin#)
DECLARE FUNCTION prgroup#(prrmany#,prrset#,zlarry$[])
DECLARE FUNCTION bsymdex#(g4r#,singlev$,bydepth#,wayner$[])
DECLARE FUNCTION lben#(wseaver$)
DECLARE FUNCTION onedigit#(ogdsub#,ogdline$)
DECLARE FUNCTION dprecise#(dprein#,dprebase#,dprelimit#)
FUNCTION KAPOWSKI07()
DIM ttgreg#[11]
DIM larry$[32]
larry$[0]="05startgame"
larry$[1]="demolish demolish and close CE 101 permanently"
r5t$="postpone postpone reopening CE 101 until later semester"
larry$[2]=r5t$
larry$[3]="reopen reopen CE 101 computer science lab NOW!"
r5t$="avj avj Make an All Volunteer Jury system in ALL COURTS"
larry$[4]=r5t$
larry$[5]="*/"
outerfirst$=larry$[0]
outerdepth#=numfroml#(1,2,10,"i",outerfirst$)
regwid#=dprecise#(outerdepth#,10,72)-3
testin# = 1.0 / 7.0
testsize$=sfromnu$(regwid#,10,"v",testin#)
testsize$=testsize$+sfromnu$(4,10,"e",testin#)
outersize$=sfromnu$(regwid#,10,"v",outerdepth#)
outersize$=outersize$+sfromnu$(4,10,"e",outerdepth#)
outersize$=outersize$+" "
outersize$=outersize$+testsize$
PRINT outersize$
PRINT "gamexb07.x Pretend that you are in charge."
PRINT "Written by Hollywood Scriptwriter Eric Matteson"
PRINT "CLICK HERE in this xb XBasic run Window then"
PRINT "choose an option by typing the leftmost word"
PRINT "of chosen line and then enter key"
PRINT ". "
gothree# = prgroup#(outerdepth#,0,@larry$[])
chooser$=INLINE$("stdin")
resdex#=bsymdex#(0,chooser$,outerdepth#,@larry$[])
resline$=sfromnu$(regwid#,10,"v",resdex#)
resline$=resline$+sfromnu$(4,10,"e",resdex#)
PRINT resline$
IF resdex# > 0
resdej& = resdex#
repline$=larry$[resdej&]
PRINT "You Chose"
PRINT repline$
END IF
IF resdex# == 4 THEN
PRINT "IF only all volunteer juries are used in every trial"
PRINT "U.S. manned space program is restored."
PRINT "U.S. economy improves so much that four year college"
PRINT "Becomes affordable. Linux and Windows both improve."
PRINT "Draft registration is abolished by existence of"
PRINT "All volunteer jury system!"
END IF
IF resdex# == 3 THEN GOTO izthree
IF resdex# == 2 THEN
PRINT "Computer LAB in CE 101 has to be reopened and"
PRINT "computer science and physics and math classes"
PRINT "have to be restored before Windows can be"
PRINT "Reinstated."
END IF
IF resdex# == 1 THEN
PRINT "Demolishing or remodeling and closing computer"
PRINT "science lab in CE 101 has caused all students to"
PRINT "think that scince the schools are unwilling to "
PRINT "pay for decent programming laboratories then"
PRINT "students should no longer pay for Microsoft"
PRINT "Windows and all students are using only Linux"
PRINT "On their own computers. Closing the good "
PRINT "programming labs at schools has put Microsoft"
PRINT "out of business! Student Vice Principal Screech"
PRINT "Powers has reccomended that all CS902 students"
PRINT "use xb Xbasic for Linux instead of Liberty"
PRINT "Basic for Microsoft Windows!"
END IF
GOTO nonchoice
izthree: gothree#=0
PRINT "In additon to reopening the good computer lab"
PRINT "in CE 101 Community colleges including GlenOak"
PRINT "community college in California have to restore"
PRINT "courses to their Fall 2007 schedules including"
PRINT "calculus physics 37 Computer science 939 C++"
PRINT "Computer science 933 database elective"
PRINT "CS099JS JavaSCript CS938 Visual Basic"
PRINT "CS099SB C++ Dot.NET programming"
PRINT "Preserve advanced MATH and Science and"
PRINT "computer science classes to restore Microsoft Windows."
nonchoice: gothree=0
PRINT "Click on upper right X of Other open window to quit."
RETURN 0
END FUNCTION
'REM gamesp07.bas is written by Eric Matteson
FUNCTION sfromnu$(sfnwid#,sfnbase#,vemode$,sfnuin#)
DIM prigits#[84]
sfromre$ = ""
fixuin# = sfnuin#
ssgn$ = "+"
sfudbase# = 1.0 / sfnbase#
IF sfnuin# < 0.0 THEN
fixuin# = 0.0 - sfnuin#
ssgn$ = "-"
END IF
sfnexp# = 0.0
IF fixuin# >= 1.0 THEN
DO WHILE fixuin# >= 1.0
fixuin# = fixuin# / sfnbase#
sfnexp# = sfnexp# + 1.0
LOOP WHILE fixuin# >= 1.0
END IF
IF fixuin# > 0 THEN
IF fixuin# < sfudbase# THEN
DO WHILE fixuin# < sfudbase#
fixuin# = fixuin# * sfnbase#
sfnexp# = sfnexp# - 1.0
LOOP WHILE fixuin# < sfudbase#
END IF
END IF
expsgn$ = "+"
rfnexp# = sfnexp#
IF sfnexp# < 0 THEN
rfnexp# = 0.0 - sfnexp#
expsgn$ = "-"
END IF
rfntiny#=sfudbase#
sfnctr# = 0 - 1
DO WHILE sfnctr# < sfnwid#
rfntiny# = rfntiny# / sfnbase#
rfnexp# = rfnexp# / sfnbase#
sfnctr#=sfnctr# + 1
LOOP WHILE sfnctr# < sfnwid#
rfntiny# = rfntiny# / sfnbase#
rfntiny# = rfntiny# / sfnbase#
rfnexp# = rfnexp# + sfudbase# + rfntiny#
sfntop# = rfntiny# / sfnbase#
IF vemode$ = "e" THEN
sfntop# = sfntop# + rfnexp#
sfromre$ = "E" + expsgn$
END IF
IF vemode$ = "v" THEN
sfntop# = sfntop# + fixuin#
sfromre$ = ssgn$ + "."
END IF
sfnctr# = 0
DO WHILE sfnctr# < (sfnwid# + 1)
sfnterm# = 0
sfndd# = 0
sfnilop# = 0
sfnallow# = 2
DO WHILE sfnallow# > 1
sfnshrink# = sfnilop# * sfudbase#
sfncmp# = sfntop# - sfnshrink#
IF sfncmp# < 0 THEN sfnallow# = 0
IF sfnallow# > 1 THEN
sfndd# = sfnilop#
sfnilop#=sfnilop# + 1
IF sfnilop# >= sfnbase# THEN sfnallow# = 0
END IF
LOOP WHILE sfnallow# > 1
sfnshrink# = sfndd# * sfudbase#
sfntop# = sfntop# - sfnshrink#
sfntop# = sfntop# * sfnbase#
sfnterm# = sfndd# + 48
IF sfndd# > 9 THEN sfnterm# = sfndd# + 87
ijsfnttr& = sfnctr#
prigits#[ijsfnttr&] = sfnterm#
sfnctr# = sfnctr# + 1
LOOP WHILE sfnctr# < (sfnwid# + 1)
sfnilop# = 0
IF vemode$ = "e" THEN sfnilop# = 1
'REM sfnilop# = 0
sfnctr# = 0
DO WHILE sfnctr# < sfnwid#
sfnshrink# = sfnctr# + sfnilop#
ijsfnttr& = sfnshrink#
sfnterm# = prigits#[ijsfnttr&]
ijsfnttr& = sfnterm#
sfromre$ = sfromre$ + CHR$(ijsfnttr&)
sfnctr# = sfnctr# + 1
LOOP WHILE sfnctr# <sfnwid#
RETURN sfromre$
END FUNCTION
'REM end of function sfromnu$
FUNCTION onedigit#(ogdsub#,ogdline$)
ogdres#=0
ogdchri$ = CHR$(0)
IF ogdsub# < LEN(ogdline$) THEN
waygdsub& = ogdsub#
waygdsub& = waygdsub& + 1
ogdchri$ = MID$(ogdline$,waygdsub&,1)
END IF
ogdres# = ASC(ogdchri$)
cgdres#=187
IF ogdres# >= 48 && ogdres# <= 57 THEN
cgdres# = ogdres# - 48
END IF
IF ogdres# >= 97 && ogdres# <= 102 THEN
cgdres# = ogdres# - 87
END IF
IF ogdres# >= 65 && ogdres <= 70 THEN
cgdres# = ogdres# - 55
END IF
RETURN cgdres#
END FUNCTION
FUNCTION numfroml#(n2p#,nmfwid#,n2b#,simode$,nmfline$)
nmfpoz#=n2p#
nmfbase#=n2b#
nmfisdot# = 0.0
nmfres# = 0.0
nmfudbase# = 1.0/nmfbase#
nmfisneg# = 0
nmfallow#=2
nmfctr#=0
DO WHILE nmfallow# > 1
nmfsub#=nmfctr#+nmfpoz#-1
nmfterm#=onedigit#(nmfsub#,nmfline$)
IF nmfterm# < 16 THEN nmfallow# = 0
IF nmfallow# > 1 THEN
nmfayne& = nmfsub#
nmfayne& = nmfayne& + 1
aafchri$ = MID$(nmfline$,nmfayne&,1)
IF aafchri$ = "-" THEN nmfisneg#=2
IF aafchri$ = "." THEN nmfdot#=2
nmfctr#=nmfctr#+1
IF nmfctr# >= nmfwid# THEN nmfallow#=0
END IF
LOOP WHILE nmfallow# > 1
IF nmfctr# < nmfwid# THEN nmfallow#=4
IF nmfisdot# < 1 THEN
DO WHILE nmfallow# > 3
nmfsub#=nmfctr#+nmfpoz#-1
nmfterm#=onedigit#(nmfsub#,nmfline$)
IF nmfterm# > 15 THEN nmfallow#=0
nmfayne& = nmfsub#
nmfayne& = nmfayne& + 1
IF MID$(nmfline$,nmfayne&,1) = "." THEN
nmfdot#=2
nmfallow#=2
END IF
IF nmfallow# > 3 THEN
nmfres#=nmfres#*nmfbase#
nmfres#=nmfres#+nmfterm#
END IF
IF nmfallow# > 1 THEN
nmfctr#=nmfctr#+1
IF nmfctr# >= nmfwid# THEN nmfallow#=0
END IF
LOOP WHILE nmfallow# > 3
END IF
IF nmfdot# > 1 THEN
nmftrod# = nmfudbase#
DO WHILE nmfallow# > 1
nmfsub#=nmfctr#+nmfpoz#-1
nmfterm#=onedigit#(nmfsub#,nmfline$)
IF nmfterm# > 15 THEN nmfallow=0
IF nmfallow# > 1 THEN
nmfzod#=nmftrod#*nmfterm#
nmfres#=nmfres#+nmfzod#
nmftrod#=nmftrod#*nmfudbase#
nmfctr#=nmfctr#+1
IF nmfctr# >= nmfwid# THEN nmfallow#=0
END IF
LOOP WHILE nmfallow# > 1
END IF
IF nmfisneg# > 1 THEN nmfres# = 0.0 - nmfres#
nmfsub#=nmfctr#+nmfpoz#-1
IF simode$ = "s" THEN mmfres# = nmfsub# + 1
IF simode$ = "i" THEN mmfres# = nmfres#
RETURN mmfres#
END FUNCTION
'REM end of numfroml
FUNCTION lben#(wseaver$)
maxben#=LEN(wseaver$)
lbectr#=0
lbeallow#=2
DO WHILE lbeallow# > 1
walbe& = lbectr#
walbe& = walbe& + 1
lbechri$=MID$(wseaver$,walbe&,1)
lbegreg#=ASC(lbechri$)
IF lbegreg# < 33 THEN lbeallow# = 0
IF lbeallow# > 1 THEN
lbectr#=lbectr#+1
IF lbectr# >= maxben# THEN lbeallow#=0
END IF
LOOP WHILE lbeallow# > 1
RETURN lbectr#
END FUNCTION
'REM end of lben
FUNCTION bsymdex#(g4r#,singlev$,bydepth#,wayner$[])
grouprloc#=g4r#
lew#=lben#(singlev$)
bsyeq#=0-5
IF lew# > 0 THEN
bsyctr#=0
DO WHILE bsyctr# < bydepth#
waynetot# = grouprloc# + bsyctr#
bsyne& = waynetot#
zipglev$ = wayner$[bsyne&]
ler#=lben#(zipglev$)
IF ler# = lew# THEN
bsylop#=0
bsydiff#=0
DO WHILE bsylop# < ler#
bsyne& = bsylop#
bsyne& = bsyne& + 1
bsyl$ = MID$(zipglev$,bsyne&,1)
bsyr$ = MID$(singlev$,bsyne&,1)
IF bsyl$ <> bsyr$ THEN bsydiff#=2
bsylop#=bsylop#+1
LOOP WHILE bsylop# < ler#
IF bsydiff# < 1 THEN bsyeq#=bsyctr#
END IF
bsyctr#=bsyctr#+1
LOOP WHILE bsyctr# < bydepth#
END IF
RETURN bsyeq#
END FUNCTION
'REM end of bsymdex
FUNCTION prgroup#(prrmany#,prrset#,zlarry$[])
prrctr#=1
DO WHILE prrctr# < prrmany#
wayneprs# = prrset# + prrctr#
waynepri& = wayneprs#
prrelem$=zlarry$[waynepri&]
PRINT prrelem$
prrctr#=prrctr#+1
LOOP WHILE prrctr# < prrmany#
RETURN 0
END FUNCTION
FUNCTION dprecise#(dprein#,dprebase#,dprelimit#)
lprecise#=dprein#
tprebase#=dprebase#
dpreactr#=1
dpreaone#=dpreactr#
udpreabase#=dpreaone#/tprebase#
dpreactr#=0
dpreallow#=1
rprecise#=lprecise#
DO WHILE dpreallow# > 0
tprecise#=rprecise#+lprecise#
IF tprecise# = lprecise# THEN dpreallow#=0
IF dpreallow# > 0 THEN
dpreactr#=dpreactr#+1
rprecise#=rprecise#*udpreabase#
IF dpreactr# >= dprelimit# THEN dpreallow#=0
END IF
LOOP WHILE dpreallow# > 0
RETURN dpreactr#
END FUNCTION
END PROGRAM
' This is the LAST LINE of this BASIC PROGRAM
' delete all lines below this line
it is a very flexible and powerful version of BASIC
Use xb instead of xbasic at bash command prompt
Use .fl gamexb07.x to load this basic program
after downloading and saving in dot command window
' delete all lines above this line
' This is the FIRST LINE of this BASIC PROGRAM
PROGRAM "gamexb07"
' This gamexb07.x xbasic game program is written
' by Eric Matteson. Permission is granted to copy
' this gamexb07.x source code and to publish it
' on the Internet and to use it at least for
' non profit use.
VERSION "2.0"
IMPORT "xst"
DECLARE FUNCTION KAPOWSKI07()
DECLARE FUNCTION numfroml#(n2p#,nmfwid#,n2b#,simode$,nmfline$)
DECLARE FUNCTION sfromnu$(sfnwid#,sfnbase#,vemode$,sfnuin#)
DECLARE FUNCTION prgroup#(prrmany#,prrset#,zlarry$[])
DECLARE FUNCTION bsymdex#(g4r#,singlev$,bydepth#,wayner$[])
DECLARE FUNCTION lben#(wseaver$)
DECLARE FUNCTION onedigit#(ogdsub#,ogdline$)
DECLARE FUNCTION dprecise#(dprein#,dprebase#,dprelimit#)
FUNCTION KAPOWSKI07()
DIM ttgreg#[11]
DIM larry$[32]
larry$[0]="05startgame"
larry$[1]="demolish demolish and close CE 101 permanently"
r5t$="postpone postpone reopening CE 101 until later semester"
larry$[2]=r5t$
larry$[3]="reopen reopen CE 101 computer science lab NOW!"
r5t$="avj avj Make an All Volunteer Jury system in ALL COURTS"
larry$[4]=r5t$
larry$[5]="*/"
outerfirst$=larry$[0]
outerdepth#=numfroml#(1,2,10,"i",outerfirst$)
regwid#=dprecise#(outerdepth#,10,72)-3
testin# = 1.0 / 7.0
testsize$=sfromnu$(regwid#,10,"v",testin#)
testsize$=testsize$+sfromnu$(4,10,"e",testin#)
outersize$=sfromnu$(regwid#,10,"v",outerdepth#)
outersize$=outersize$+sfromnu$(4,10,"e",outerdepth#)
outersize$=outersize$+" "
outersize$=outersize$+testsize$
PRINT outersize$
PRINT "gamexb07.x Pretend that you are in charge."
PRINT "Written by Hollywood Scriptwriter Eric Matteson"
PRINT "CLICK HERE in this xb XBasic run Window then"
PRINT "choose an option by typing the leftmost word"
PRINT "of chosen line and then enter key"
PRINT ". "
gothree# = prgroup#(outerdepth#,0,@larry$[])
chooser$=INLINE$("stdin")
resdex#=bsymdex#(0,chooser$,outerdepth#,@larry$[])
resline$=sfromnu$(regwid#,10,"v",resdex#)
resline$=resline$+sfromnu$(4,10,"e",resdex#)
PRINT resline$
IF resdex# > 0
resdej& = resdex#
repline$=larry$[resdej&]
PRINT "You Chose"
PRINT repline$
END IF
IF resdex# == 4 THEN
PRINT "IF only all volunteer juries are used in every trial"
PRINT "U.S. manned space program is restored."
PRINT "U.S. economy improves so much that four year college"
PRINT "Becomes affordable. Linux and Windows both improve."
PRINT "Draft registration is abolished by existence of"
PRINT "All volunteer jury system!"
END IF
IF resdex# == 3 THEN GOTO izthree
IF resdex# == 2 THEN
PRINT "Computer LAB in CE 101 has to be reopened and"
PRINT "computer science and physics and math classes"
PRINT "have to be restored before Windows can be"
PRINT "Reinstated."
END IF
IF resdex# == 1 THEN
PRINT "Demolishing or remodeling and closing computer"
PRINT "science lab in CE 101 has caused all students to"
PRINT "think that scince the schools are unwilling to "
PRINT "pay for decent programming laboratories then"
PRINT "students should no longer pay for Microsoft"
PRINT "Windows and all students are using only Linux"
PRINT "On their own computers. Closing the good "
PRINT "programming labs at schools has put Microsoft"
PRINT "out of business! Student Vice Principal Screech"
PRINT "Powers has reccomended that all CS902 students"
PRINT "use xb Xbasic for Linux instead of Liberty"
PRINT "Basic for Microsoft Windows!"
END IF
GOTO nonchoice
izthree: gothree#=0
PRINT "In additon to reopening the good computer lab"
PRINT "in CE 101 Community colleges including GlenOak"
PRINT "community college in California have to restore"
PRINT "courses to their Fall 2007 schedules including"
PRINT "calculus physics 37 Computer science 939 C++"
PRINT "Computer science 933 database elective"
PRINT "CS099JS JavaSCript CS938 Visual Basic"
PRINT "CS099SB C++ Dot.NET programming"
PRINT "Preserve advanced MATH and Science and"
PRINT "computer science classes to restore Microsoft Windows."
nonchoice: gothree=0
PRINT "Click on upper right X of Other open window to quit."
RETURN 0
END FUNCTION
'REM gamesp07.bas is written by Eric Matteson
FUNCTION sfromnu$(sfnwid#,sfnbase#,vemode$,sfnuin#)
DIM prigits#[84]
sfromre$ = ""
fixuin# = sfnuin#
ssgn$ = "+"
sfudbase# = 1.0 / sfnbase#
IF sfnuin# < 0.0 THEN
fixuin# = 0.0 - sfnuin#
ssgn$ = "-"
END IF
sfnexp# = 0.0
IF fixuin# >= 1.0 THEN
DO WHILE fixuin# >= 1.0
fixuin# = fixuin# / sfnbase#
sfnexp# = sfnexp# + 1.0
LOOP WHILE fixuin# >= 1.0
END IF
IF fixuin# > 0 THEN
IF fixuin# < sfudbase# THEN
DO WHILE fixuin# < sfudbase#
fixuin# = fixuin# * sfnbase#
sfnexp# = sfnexp# - 1.0
LOOP WHILE fixuin# < sfudbase#
END IF
END IF
expsgn$ = "+"
rfnexp# = sfnexp#
IF sfnexp# < 0 THEN
rfnexp# = 0.0 - sfnexp#
expsgn$ = "-"
END IF
rfntiny#=sfudbase#
sfnctr# = 0 - 1
DO WHILE sfnctr# < sfnwid#
rfntiny# = rfntiny# / sfnbase#
rfnexp# = rfnexp# / sfnbase#
sfnctr#=sfnctr# + 1
LOOP WHILE sfnctr# < sfnwid#
rfntiny# = rfntiny# / sfnbase#
rfntiny# = rfntiny# / sfnbase#
rfnexp# = rfnexp# + sfudbase# + rfntiny#
sfntop# = rfntiny# / sfnbase#
IF vemode$ = "e" THEN
sfntop# = sfntop# + rfnexp#
sfromre$ = "E" + expsgn$
END IF
IF vemode$ = "v" THEN
sfntop# = sfntop# + fixuin#
sfromre$ = ssgn$ + "."
END IF
sfnctr# = 0
DO WHILE sfnctr# < (sfnwid# + 1)
sfnterm# = 0
sfndd# = 0
sfnilop# = 0
sfnallow# = 2
DO WHILE sfnallow# > 1
sfnshrink# = sfnilop# * sfudbase#
sfncmp# = sfntop# - sfnshrink#
IF sfncmp# < 0 THEN sfnallow# = 0
IF sfnallow# > 1 THEN
sfndd# = sfnilop#
sfnilop#=sfnilop# + 1
IF sfnilop# >= sfnbase# THEN sfnallow# = 0
END IF
LOOP WHILE sfnallow# > 1
sfnshrink# = sfndd# * sfudbase#
sfntop# = sfntop# - sfnshrink#
sfntop# = sfntop# * sfnbase#
sfnterm# = sfndd# + 48
IF sfndd# > 9 THEN sfnterm# = sfndd# + 87
ijsfnttr& = sfnctr#
prigits#[ijsfnttr&] = sfnterm#
sfnctr# = sfnctr# + 1
LOOP WHILE sfnctr# < (sfnwid# + 1)
sfnilop# = 0
IF vemode$ = "e" THEN sfnilop# = 1
'REM sfnilop# = 0
sfnctr# = 0
DO WHILE sfnctr# < sfnwid#
sfnshrink# = sfnctr# + sfnilop#
ijsfnttr& = sfnshrink#
sfnterm# = prigits#[ijsfnttr&]
ijsfnttr& = sfnterm#
sfromre$ = sfromre$ + CHR$(ijsfnttr&)
sfnctr# = sfnctr# + 1
LOOP WHILE sfnctr# <sfnwid#
RETURN sfromre$
END FUNCTION
'REM end of function sfromnu$
FUNCTION onedigit#(ogdsub#,ogdline$)
ogdres#=0
ogdchri$ = CHR$(0)
IF ogdsub# < LEN(ogdline$) THEN
waygdsub& = ogdsub#
waygdsub& = waygdsub& + 1
ogdchri$ = MID$(ogdline$,waygdsub&,1)
END IF
ogdres# = ASC(ogdchri$)
cgdres#=187
IF ogdres# >= 48 && ogdres# <= 57 THEN
cgdres# = ogdres# - 48
END IF
IF ogdres# >= 97 && ogdres# <= 102 THEN
cgdres# = ogdres# - 87
END IF
IF ogdres# >= 65 && ogdres <= 70 THEN
cgdres# = ogdres# - 55
END IF
RETURN cgdres#
END FUNCTION
FUNCTION numfroml#(n2p#,nmfwid#,n2b#,simode$,nmfline$)
nmfpoz#=n2p#
nmfbase#=n2b#
nmfisdot# = 0.0
nmfres# = 0.0
nmfudbase# = 1.0/nmfbase#
nmfisneg# = 0
nmfallow#=2
nmfctr#=0
DO WHILE nmfallow# > 1
nmfsub#=nmfctr#+nmfpoz#-1
nmfterm#=onedigit#(nmfsub#,nmfline$)
IF nmfterm# < 16 THEN nmfallow# = 0
IF nmfallow# > 1 THEN
nmfayne& = nmfsub#
nmfayne& = nmfayne& + 1
aafchri$ = MID$(nmfline$,nmfayne&,1)
IF aafchri$ = "-" THEN nmfisneg#=2
IF aafchri$ = "." THEN nmfdot#=2
nmfctr#=nmfctr#+1
IF nmfctr# >= nmfwid# THEN nmfallow#=0
END IF
LOOP WHILE nmfallow# > 1
IF nmfctr# < nmfwid# THEN nmfallow#=4
IF nmfisdot# < 1 THEN
DO WHILE nmfallow# > 3
nmfsub#=nmfctr#+nmfpoz#-1
nmfterm#=onedigit#(nmfsub#,nmfline$)
IF nmfterm# > 15 THEN nmfallow#=0
nmfayne& = nmfsub#
nmfayne& = nmfayne& + 1
IF MID$(nmfline$,nmfayne&,1) = "." THEN
nmfdot#=2
nmfallow#=2
END IF
IF nmfallow# > 3 THEN
nmfres#=nmfres#*nmfbase#
nmfres#=nmfres#+nmfterm#
END IF
IF nmfallow# > 1 THEN
nmfctr#=nmfctr#+1
IF nmfctr# >= nmfwid# THEN nmfallow#=0
END IF
LOOP WHILE nmfallow# > 3
END IF
IF nmfdot# > 1 THEN
nmftrod# = nmfudbase#
DO WHILE nmfallow# > 1
nmfsub#=nmfctr#+nmfpoz#-1
nmfterm#=onedigit#(nmfsub#,nmfline$)
IF nmfterm# > 15 THEN nmfallow=0
IF nmfallow# > 1 THEN
nmfzod#=nmftrod#*nmfterm#
nmfres#=nmfres#+nmfzod#
nmftrod#=nmftrod#*nmfudbase#
nmfctr#=nmfctr#+1
IF nmfctr# >= nmfwid# THEN nmfallow#=0
END IF
LOOP WHILE nmfallow# > 1
END IF
IF nmfisneg# > 1 THEN nmfres# = 0.0 - nmfres#
nmfsub#=nmfctr#+nmfpoz#-1
IF simode$ = "s" THEN mmfres# = nmfsub# + 1
IF simode$ = "i" THEN mmfres# = nmfres#
RETURN mmfres#
END FUNCTION
'REM end of numfroml
FUNCTION lben#(wseaver$)
maxben#=LEN(wseaver$)
lbectr#=0
lbeallow#=2
DO WHILE lbeallow# > 1
walbe& = lbectr#
walbe& = walbe& + 1
lbechri$=MID$(wseaver$,walbe&,1)
lbegreg#=ASC(lbechri$)
IF lbegreg# < 33 THEN lbeallow# = 0
IF lbeallow# > 1 THEN
lbectr#=lbectr#+1
IF lbectr# >= maxben# THEN lbeallow#=0
END IF
LOOP WHILE lbeallow# > 1
RETURN lbectr#
END FUNCTION
'REM end of lben
FUNCTION bsymdex#(g4r#,singlev$,bydepth#,wayner$[])
grouprloc#=g4r#
lew#=lben#(singlev$)
bsyeq#=0-5
IF lew# > 0 THEN
bsyctr#=0
DO WHILE bsyctr# < bydepth#
waynetot# = grouprloc# + bsyctr#
bsyne& = waynetot#
zipglev$ = wayner$[bsyne&]
ler#=lben#(zipglev$)
IF ler# = lew# THEN
bsylop#=0
bsydiff#=0
DO WHILE bsylop# < ler#
bsyne& = bsylop#
bsyne& = bsyne& + 1
bsyl$ = MID$(zipglev$,bsyne&,1)
bsyr$ = MID$(singlev$,bsyne&,1)
IF bsyl$ <> bsyr$ THEN bsydiff#=2
bsylop#=bsylop#+1
LOOP WHILE bsylop# < ler#
IF bsydiff# < 1 THEN bsyeq#=bsyctr#
END IF
bsyctr#=bsyctr#+1
LOOP WHILE bsyctr# < bydepth#
END IF
RETURN bsyeq#
END FUNCTION
'REM end of bsymdex
FUNCTION prgroup#(prrmany#,prrset#,zlarry$[])
prrctr#=1
DO WHILE prrctr# < prrmany#
wayneprs# = prrset# + prrctr#
waynepri& = wayneprs#
prrelem$=zlarry$[waynepri&]
PRINT prrelem$
prrctr#=prrctr#+1
LOOP WHILE prrctr# < prrmany#
RETURN 0
END FUNCTION
FUNCTION dprecise#(dprein#,dprebase#,dprelimit#)
lprecise#=dprein#
tprebase#=dprebase#
dpreactr#=1
dpreaone#=dpreactr#
udpreabase#=dpreaone#/tprebase#
dpreactr#=0
dpreallow#=1
rprecise#=lprecise#
DO WHILE dpreallow# > 0
tprecise#=rprecise#+lprecise#
IF tprecise# = lprecise# THEN dpreallow#=0
IF dpreallow# > 0 THEN
dpreactr#=dpreactr#+1
rprecise#=rprecise#*udpreabase#
IF dpreactr# >= dprelimit# THEN dpreallow#=0
END IF
LOOP WHILE dpreallow# > 0
RETURN dpreactr#
END FUNCTION
END PROGRAM
' This is the LAST LINE of this BASIC PROGRAM
' delete all lines below this line
Stephen J. Rush
May 17, 2007, 8:41:29 AM5/17/07
to
On Wed, 16 May 2007 21:51:37 -0700, ericmatteson2003november wrote:
> Linux Xbasic for Linux has recently been discovered and
> it is a very flexible and powerful version of BASIC
I've used Xbasic, but I couldn't get used to the
FunctionNamesThatRambleAcrossTheWholeDamnLine and the C-ish "everything
is a function" philosophy. I prefer FreeBASIC, which still has a
QB-compatibility mode and is still being actively developed.
I just got a look into the past. I stumbled across a copy of Wizard's
Castle, a game that I spent a lot of time hacking on on the TRS-80, so I
thought I'd translate it to FreeBASIC. This version is for the interpreter
that ran on Heathkit's 6800-based system, so it's a _really_ old BASIC. It
doesn't even have ELSE. It does, however let you use T, T$, T() and T$()
as four different variables, and the code is mostly spaghetti. Ouch!
Gordon Rahman
May 17, 2007, 10:17:27 AM5/17/07
to
THIS IS SPAM TOO.
Gordon.,
<ericmatteson...@hotmail.com> schreef in bericht
news:1179377497.2...@k79g2000hse.googlegroups.com...
Steve Foley
May 17, 2007, 1:51:43 PM5/17/07
to
"Gordon Rahman" <gra...@planet.nl> wrote in message
news:464c62e4$0$16948$ba62...@text.nova.planet.nl...
>
> THIS IS SPAM TOO.
>
news:464c62e4$0$16948$ba62...@text.nova.planet.nl...
>
> THIS IS SPAM TOO.
>
That's too bad. I was just getting ready to grab my shovel and see if I
could 'discover'
a new compiler.
ericmatteson...@hotmail.com
May 17, 2007, 2:00:18 PM5/17/07
to
job control language (JCL) such as program name and the first
declared function is assumed to be the main program.
In spite of difficulty, XBasic is flexible and has many variable
types.
THe reason that I use XBASIC is that it works with LINUX so I can
write and run XBASIC programs on the free Linux operating system
without limiting my programs to the alleged Windows Monopoly that
dominates most basics.
Does FreeBASIC run on LINUX yet ??
I wrote an XBasic example program to show how
to do various things in XBASIC
http://groups.google.com/group/alt.lang.basic/msg/1958a548092844bf?dmode=source
Perhaps that example program might make XBASIC easier
to deal with.
Eric Matteson Linux User.
Paul Bartlett
May 17, 2007, 7:22:11 PM5/17/07
to
On Thu, 17 May 2007, Gordon Rahman wrote:
> THIS IS SPAM TOO.
>
> Gordon.,
>
> <ericmatteson...@hotmail.com> schreef in bericht
> news:1179377497.2...@k79g2000hse.googlegroups.com...
>> [...]
If you think it is spam (which I did not), then why did you quote the
entire message? You just made the (non-existent) "problem" worse.
Learn how to complain properly.
--
Paul Bartlett
Gordon Rahman
May 18, 2007, 5:21:07 AM5/18/07
to
Okay,
I wasted my time trying to convert the listing into BASIC.
Where (and how) do I complain about this things?
I do have a fulltime job, married, two kids.
I got frustrated by this C-ish thing.
Sorry for the word SPAM, it was a wast of time.
Gordon
"Paul Bartlett" <bart...@panix.com> schreef in bericht
news:Pine.NEB.4.64.07...@panix2.panix.com...
Stephen J. Rush
May 21, 2007, 6:35:10 PM5/21/07
to
> THe reason that I use XBASIC is that it works with LINUX so I can
> write and run XBASIC programs on the free Linux operating system
> without limiting my programs to the alleged Windows Monopoly that
> dominates most basics.
> Does FreeBASIC run on LINUX yet ??
> write and run XBASIC programs on the free Linux operating system
> without limiting my programs to the alleged Windows Monopoly that
> dominates most basics.
> Does FreeBASIC run on LINUX yet ??
Yes, but there is no built-in IDE. Before I defenestrated, I used the
third-party FBIDE, which made FreeBASIC nearly as nice to develop in as
QuickBasic. In Linux I have Scite configured with some tweaks from the
FreeBASIC Linux forum to provide syntax coloring and compile-from-the-
editor services. I've also heard that Kate supports FreeBASIC, but I use
Gnome.
0 new messages