Errata for Eduweb pages
Just BASIC compatibility
Some programs may fail because of the restricted command set of JB. This is the case for one of the PI programs, 'pi c.bas'. Version that will run on JB is here.
' PI c Best algorithm I know to calculate multi-precision PI
'
' Uses the ATN( a +b) expansion
' Result is in clipboard at end ready to paste where you wish
' Based on an Apple (the original!) program from 'Kilobaud' mag
' Assembles long, high precision numbers from 5-digit fragments.
blocklength = 5
H = 10^blocklength
numberofdp =1500
B =numberofdp /blocklength +2
term =1.66 *numberofdp
DIM product( B)
DIM term( B)
DIM quotient( B)
term( B -1) =H /2
product( B -1) =H /2
nomainwin
UpperLeftX = 20
UpperLeftY = 20
WindowWidth = 800
WindowHeight = 540
button #w, "Quit?", [quit], LR, 50, 30
texteditor #w.t, 20, 20, 760, 400
open "PI Calculator output window" for window as #w
print #w.t, "!font courier_new 11 bold"
print #w, "trapclose [quit]"
FOR N =1 TO term
scan
X =2 *N -1
carry =0
FOR I =1 TO B
term( I) =term( I) *X +carry
carry =int( term( I) / H)
term( I) =term( I) -carry *H
NEXT I
carry =0
FOR I =1 TO B
term( I) =term( I) *X +carry
carry =int( term( I) / H)
term( I) =term( I) -carry *H
NEXT I
X =8 *N
carry =0
FOR I =B TO 1 STEP -1
Z =term( I) +carry
quotient =INT( Z /X)
term( I) =quotient
carry =H *( Z -quotient *X)
NEXT I
X =2 *N +1
carry =0
FOR I =B TO 1 STEP -1
Z =term( I) +carry
quotient =INT( Z /X)
term( I) =quotient
carry =H *( Z -quotient *X)
NEXT I
carry =0
FOR I =1 TO B
product( I) =product( I) +term( I) +carry
carry =0
IF product( I) >=H THEN
product( I) =product( I) -H
carry =1
ELSE
carry =0
END IF
NEXT I
carry =0
for jf =1 to B
quotient( jf) =product( jf)
next jf
FOR I =1 TO B
quotient( I) =quotient( I) *6 +carry
carry =int( quotient( I) / H)
quotient( I) =quotient( I) -carry *H
NEXT I
op$ =str$( quotient( B))+ "." +chr$(10)
cr =0
FOR I =B -1 TO 1 STEP -1
cr =cr+1
op$ =op$ +RIGHT$( STR$( quotient( I) +10 *H), blocklength)
if cr>=16 then
cr =0
op$ =op$ +chr$(10)
end if
NEXT I
#w.t, "!cls";
#w.t op$
NEXT N
[quit]
notice "Calculation may have been interrupted!" + chr$(13) + "Result in clipboard may be incomplete!"
[quit2]
#w.t, "!selectall";
#w.t, "!copy";
close #w
end
DiscoLitez- sequens
The tkn and executable for the DiscoLitez was compiled in earlier LB.
Souce code follows. If you have LB 4 you can recreate the token and executable. The original downloads hold the two bmp files, but their exe and tkn files will fail on LB4.
'------------------------------------------------------------------
'Disco5g1.bas johnf john.fisher@tauntonschool.co.uk 27 11 2002
'Used to create sequences of coloured lights via parallel port
'The screen mimics the mains-powered bulbs allowing off-line testing
'Try it for discos, party lights, Halloween, Guy Fawkes- or to impress!
'PS Makes a great traffic light simulator too. Two sets for crossing roads.
'In UK we have a different sequence to that in the US! (NO filter-on-red)
'Que aproveche! Muchas gracias, Carl, por Liberty BASIC. Sobresaliente!
'Assumes this port is on &H378 (the usual address) or &H3BC or &H278
'By using data commands it is very easy to plan a sequence
'-------------------------------------------------------------------
nomainwin
WindowWidth = 560
WindowHeight = 340
UpperLeftX = 32
UpperLeftY = 32
options$( 0) = "&H278"
options$( 1) = "&H378"
options$( 2) = "&H3BC"
port$ = "&H3BC"
finished = 0
pace = 2
dim state$( 10)
for i =1 to 8
state$( i) ="darkblue"
next i
UDS.SETBUDDYINT = hexdec( "2")
UDS.ARROWKEYS = hexdec( "20")
UDS.ALIGNRIGHT = hexdec( "4")
loadbmp "mouse", "mouse.bmp"
loadbmp "pointer", "pointer.bmp"
calldll #comctl32, "InitCommonControls", re as void
combobox #w.c, options$(), [selectionMade], 470, 25, 70, 80
graphicbox #w.box1, 20, 20, 440, 80
graphicbox #w.box2, 480, 230, 40, 40
textbox #w.t, 020, 120, 440, 40
textbox #w.t2, 020, 170, 440, 30
textbox #w.t3, 020, 210, 440, 24
textbox #w.t4, 470, 80, 70, 30
textbox #w.t5, 470, 50, 70, 24
'texteditor #w.t6, 550, 10, 120, 500' ASCII output display
textbox #w.t6b, 466, 170, 60, 30' spinner
textbox #w.t7, 020, 250, 440, 30
button #w.b7, "Mouse", [point] , UL, 470, 212, 54, 20
button #w.b8, "Quit", [out_of_here] , UL, 470, 280, 64, 24
open "Parallel Port driver Disco 5g1" for window_nf as #w
hwndParent = hwnd( #w)
hText6b = hwnd( #w.t6b)
CallDLL #user32, "GetWindowLongA", hwndParent As long, _GWL_HINSTANCE As long, hInstance As long
dwStyle= _WS_CHILD or _WS_VISIBLE or _WS_BORDER or UDS.SETBUDDYINT or UDS.ALIGNRIGHT or UDS.ARROWKEYS
calldll #comctl32,"CreateUpDownControl",dwStyle as ulong,0 as long,0 as long,0 as long,0 as long,_
hwndParent as long,1 as long,hInstance as long,hText6b as long,_
10 as long,1 as long,4 as long,hSpinner as long
#w "trapclose [out_of_here]"
#w.t "!font arial_bold 18"
#w.t " Parallel port pattern driver"
#w.t2 "!font arial 8"
#w.t2 " Sequence and timing set in data statements. Edit rate via spinner control."
#w.t3 "!font arial 8"
#w.t3 " 'Mouse' gives left-mouse-button control via square's top/bottom. End by clicking rh cyan."
#w.t4 "!font arial 10"
#w.t5 "!font arial 7"
'#w.t6 "!font courier_new 10"
#w.t6b "!font courier_new 14"
#w.t7 "!font arial 8"
#w.t7 " If lights attached to the printer port aren't controlled, try a diff. port address"
#w.c "!font arial 8"
#w.box1 "goto 400 10"
#w.box1 "down"
#w.box1 "fill black"
#w.t5 "Port address"
#w.t4 port$
#w.c, "select "; port$
#w.box1 "when leftButtonDown [point]"
#w.box1 "down ; backcolor cyan"
#w.box1 "goto 420 0"
#w.box1 "boxfilled 440 80"
#w.box2 "drawbmp mouse 0 0"
[begin]
while finished <>1
scan
#w.c "select "; port$
read op$, duration
'#w.t6 op$
#w.t6b "!contents? txt$"
pace =val( txt$)
if op$ ="end" then
finished =1
end if
if op$ ="repeat" then
restore
'#w.t6 "!cls"
print #w.box1, "discard"
end if
op =binStringToDecimal( op$)
out hexdec( port$), op
now =time$( "milliseconds")
while time$( "milliseconds") -now =420 then
#w.box2 "drawbmp mouse 0 0"
#w.b7, "Point"
done =1
end if
if done =1 then [begin]
#w.box2 "drawbmp pointer 0 0"
#w.b7, "Mouse"
for digit =0 to 7
if x> (20 +digit*50) and x < (60 +digit*50) then
if y >35 then
op$ =left$( op$, digit) +"-" +right$( op$, 7-digit)
else
op$ =left$( op$, digit) +"*" +right$( op$, 7-digit)
end if
end if
next digit
op =binStringToDecimal( op$)
out hexdec( port$), op
goto [point]
' ---------------------------------------------------------------
[out_of_here]
close #w
out hexdec( port$), 0
unloadbmp "pointer"
unloadbmp "mouse"
end
' ---------------------------------------------------------------
function binStringToDecimal( in$)
j=0
for i =8 to 1 step -1
if mid$( in$, i, 1) <>"-" then
j =j +2^(8 -i)
#w.box1 "backcolor 255 "; str$(255 *i/8); " "; str$( 255 -255 *i/8)
#w.box1 "goto "; str$( -30 +50 *i); " 10"
#w.box1 "boxfilled "; str$( -30 +40 +50 *i); " 60"
else
#w.box1 "backcolor darkblue"
#w.box1 "goto "; str$( -30 +50 *i); " 10"
#w.box1 "boxfilled "; str$( -30 +40 +50 *i); " 60"
end if
next i
binStringToDecimal =j
end function
' ---------------------------------------------------------------
data "--------", 1000
' running light
data "-------*", 0400
data "------*-", 0400
data "-----*--", 0400
data "----*---", 0400
data "---*----", 0400
data "--*-----", 0400
data "-*------", 0400
data "*-------", 0400
data "--------", 1000
' alternate
data "*-*-*-*-", 0400
data "-*-*-*-*", 0400
data "*-*-*-*-", 0400
data "-*-*-*-*", 0400
data "*-*-*-*-", 0400
data "-*-*-*-*", 0400
data "*-*-*-*-", 0400
data "-*-*-*-*", 0400
data "--------", 1000
' different alternator
data "----****", 0400
data "****----", 0400
data "-----***", 0400
data "***-----", 0400
data "------**", 0400
data "**------", 0400
data "------**", 0400
data "*-------", 0400
data "-------*", 0400
data "**------", 0400
data "------**", 0400
data "***-----", 0400
data "-----***", 0400
data "****----", 0400
data "----****", 0400
data "--------", 1000
' build & decay
data "*-------", 0200
data "**------", 0200
data "***-----", 0200
data "****----", 0200
data "*****---", 0200
data "******--", 0200
data "*******-", 0200
data "********", 0200
data "-*******", 0200
data "--******", 0200
data "---*****", 0200
data "----****", 0200
data "-----***", 0200
data "------**", 0200
data "-------*", 0200
data "--------", 0200
data "--------", 1000
' knightrider
data "*-------", 0200
data "-*------", 0200
data "--*-----", 0200
data "---*----", 0200
data "----*---", 0200
data "-----*--", 0200
data "------*-", 0200
data "-------*", 0200
data "------*-", 0200
data "-----*--", 0200
data "----*---", 0200
data "---*----", 0200
data "--*-----", 0200
data "-*------", 0200
data "*-------", 0200
data "-*------", 0200
data "--*-----", 0200
data "---*----", 0200
data "----*---", 0200
data "-----*--", 0200
data "------*-", 0200
data "-------*", 0200
data "------*-", 0200
data "-----*--", 0200
data "----*---", 0200
data "---*----", 0200
data "--*-----", 0200
data "-*------", 0200
data "*-------", 0200
data "--------", 1000
' fork
data "*------*", 0300
data "-*----*-", 0300
data "--*--*--", 0300
data "---**---", 0300
data "--*--*--", 0300
data "-*----*-", 0300
data "*------*", 0300
data "-*----*-", 0300
data "--*--*--", 0300
data "---**---", 0300
data "--*--*--", 0300
data "-*----*-", 0300
data "*------*", 0300
data "-*----*-", 0100
data "--*--*--", 0100
data "---**---", 0100
data "--*--*--", 0100
data "-*----*-", 0100
data "*------*", 0100
data "-*----*-", 0100
data "--*--*--", 0100
data "---**---", 0100
data "--*--*--", 0100
data "-*----*-", 0100
data "*------*", 0100
data "--------", 1000
data "*------*", 0300
data "-*----*-", 0100
data "--*--*--", 0100
data "---**---", 0100
data "*------*", 0100
data "-*----*-", 0100
data "--*--*--", 0100
data "---**---", 0100
data "*------*", 0300
data "-*----*-", 0100
data "--*--*--", 0100
data "---**---", 0100
data "*------*", 0100
data "-*----*-", 0100
data "--*--*--", 0100
data "---**---", 0100
data "--------", 1000
data "*--*-*--", 0300
data "-*----*-", 0100
data "*-*--*--", 0100
data "-*-**--*", 0100
data "**--*--*", 0100
data "-*--*-*-", 0100
data "-***-*-*", 0100
data "-*-**-*-", 0100
data "*-*--***", 0300
data "-**-**-*", 0100
data "--**-*--", 0100
data "-*-**-*-", 0100
data "*--*-***", 0100
data "-*-*-*-*", 0100
data "-**-**-*", 0100
data "*-**-**-", 0100
data "--------", 1000
data "repeat", 0
'data "end", 0
tenochtitlanuk ------- JohnF ------ April 2010 ------ mr.john.f@gmail.com