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"
IM****T "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,@[EMAIL PROTECTED]
)
chooser$=INLINE$("stdin")
resdex#=bsymdex#(0,chooser$,outerdepth#,@[EMAIL PROTECTED]
)
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 cl*****"
PRINT "have to be restored before Windows can be"
PRINT "Reinstated."
END IF
IF resdex# == 1 THEN
PRINT "Demoli****ng 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 cl***** 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
|
