# 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")

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.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\$
'#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"
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
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