' ported by TassyJim from a post on PureBasic forum  by Jeff88
 ' his comments follow
 '
 ';Many years ago when I used Quickbasic, I came across a program to calc pi.  Of course this has no practical
 ';purpose, but just to fight winter boredom I modified the program (see comments included below) to run
 ';under Purebasic,  now can use 10 digits per word instead of 4. Also added a bit of assembly to avoid calculating
 ';the remainder, this only makes a slight difference since most of time is taken by dividing.
 ';Using threads sped up by a factor of 3.  Note calc atan(1/5) takes about twice as long as atan(1/239).
 ';Programmed by Jeff Wyatt, Highlands Ranch, Colorado (1/2019).
 '
 ';On my Athelon II X4 635  the program can calculate 100,000 digits in about 8 secs with debugging off.
 '
 ';   >>>>>>>>>>>>>>>>>>>>>>>COMPILE With THREAD SAFE BOX CHECKED<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 '
 ';Based upon Machin's (1706) formula: pi/4=arctan(1)=4*arctan(1/5)-arctan(1/239), he did 100 digits by hand
 ';which would take about 8 usec with this program.  Time is prop. to digits^2 so need to use another method
 ';for very large number of digits. Good way to test your computer's integer arithmatic.
 ';See https://www.angio.net/pi/ for further info and searchable listing of pi.
 ';I used it to check that my program worked correctly for the first 2,000,000 digits.
 '
 ';Previous comments from authors 20 years ago
 '
 ';Program To calculate pi, version 4.8
 ';A major rewrite of version 4.2, this uses only two arrays instead of
 ';three, and includes a host of speedups based on a similar C program.
 ';A sampler: all the carries are reserved until the end, the divide and
 ';add routines are combined, two terms are added at a time, and the number
 ';of function calls is minimized. It's a big change for a small gain, since
 ';the compiled version requires 28.6 seconds for 5000 digits on my 486 66 MHz
 ';computer, a 10 gain over version 4.2; like before, it's capable of about
 ';150,000 digits of pi.
 ';
 ';This program has come a long way from version 1.0; thanks are due to
 ';Larry Shultis, Randall Williams, Bob Farrington and Adrian Umpleby.
 ';One final note for speed freaks: this program will run about 6 times faster
 ';if written in C using an optimizing compiler. Likewise, if you can figure
 ';out a way to do integer division and use both the quotient and remainder,
 ';this program can easily be sped up by 25.      -jasonp@isr.umd.edu
 OPTION EXPLICIT
 DIM INTEGER words, big, Digits, DigitsperWord, x, i, quotient
 DIM INTEGER ctime, stime
 
 DigitsperWord=10
 big=1
 FOR i=1 TO DigitsperWord  '1 followed by 10 zeros, note if you use 14 digits/word
   big=big*10              'arctan(1/5) will overflow about digit 64,760
 NEXT                      'when 1.4*digits*big~denom*big >9e18
 
 INPUT "how many digits? ",Digits
 words = Digits / DigitsperWord+2
 DIM INTEGER sum(words + 2),sum1(words+2),sum2(words+2)
 stime = TIMER
 print "Started at "+time$
 '---------------  -4*atan(1/239)
 x = atan239()
 '------------   16*atan(1/5)
 PRINT STR$(TIMER - stime)+"mS so far"
 x = atan51()
 PRINT STR$(TIMER - stime)+"mS so far"
 x = atan52()
 PRINT STR$(TIMER - stime)+"mS so far"
 sum1(2)=sum1(2)-big/5
 FOR x=2 TO words
   sum(x)=sum(x)+sum1(x)+sum2(x)
 NEXT
 
 FOR x = words TO 2 STEP -1                        'finish up
   IF sum(x) < 0   THEN                                'release borrows
     quotient = sum(x) \ big
     sum(x) = sum(x) - (quotient - 1) * big
     sum(x - 1) = sum(x - 1) + quotient - 1
   ENDIF
   IF sum(x) >= big  THEN                              'and carries
     quotient = sum(x) \ big
     sum(x) = sum(x) - quotient * big
     sum(x - 1) = sum(x - 1) + quotient
   ENDIF
 NEXT
 ctime = TIMER - stime
 x = PrintOut()
 
END
 
FUNCTION atan239()                    'arctan(x) = x-x^3/3+x^5/5-x^7 ....
 LOCAL INTEGER mainder, mainder1, mainder2, dividend, denom, temp, firstword, x
 LOCAL INTEGER term(words +2), lastword
 mainder=4
 FOR x = 2 TO words
   dividend = mainder * big              'crunch out 1st term
   term(x) = dividend \ 239
   mainder = dividend - term(x) * 239
   sum2(x) = sum2(x) - term(x)             'subtract as we want -atan(1/239)
 NEXT x
 
 denom=3:firstword=2
 DO                                   'do two more terms, add first, subtract second
   mainder1=0
   mainder2=0
   FOR x = firstword TO words
     temp = term(x)
     dividend = mainder1 * big + temp
     temp = dividend \ 57121
     mainder1 = dividend - temp * 57121
     term(x) = temp
     dividend = mainder2 * big + temp
     temp = dividend \ denom
     mainder2 = dividend - temp * denom
     sum2(x) = sum2(x) + temp
   NEXT
   
   IF term(firstword) = 0 THEN
     firstword = firstword + 1
   ENDIF
   denom = denom + 2
   mainder1 = 0: mainder2 = 0
   
   FOR x = firstword TO words
     temp = term(x)
     dividend = mainder1 * big + temp
     temp = dividend \ 57121
     mainder1 = dividend - temp * 57121
     term(x) = temp
     
     dividend = mainder2 * big + temp
     temp = dividend \ denom
     mainder2 = dividend - temp * denom
     sum2(x) = sum2(x) - temp
   NEXT x
   
   IF term(firstword) = 0 THEN
     firstword = firstword + 1
   ENDIF
   denom = denom + 2
 LOOP UNTIL firstword >=words
END FUNCTION
 '-------------------------------------------------------------------
FUNCTION atan51()                      ' atan(1/5)  one half of calc terms 1/5, 1/9, 1/13 ......
 LOCAL INTEGER mainder, mainder1, mainder2, dividend, denom, temp, firstword, x
 LOCAL INTEGER term(words +2), lastword
 denom = 5: firstword = 1: lastword =3
 sum(1) = 3: term(1) = 3: sum(2) = big/5: term(2) = sum(2)
 DO
   
   mainder1=0
   mainder2=0
   FOR x = firstword TO lastword + 1
     temp = term(x)
     dividend = mainder1 * big + temp
     temp = dividend \ 625                 ' 625 = 5^4
     mainder1 = dividend - temp * 625
     term(x) = temp
     
     dividend = mainder2 * big + temp
     temp = dividend \ denom
     mainder2 = dividend - temp * denom
     sum(x) = sum(x) + temp
   NEXT
   
   FOR x = lastword + 2 TO words
     dividend = mainder2 * big
     temp = dividend \ denom
     mainder2 = dividend - temp * denom
     sum(x) = sum(x) + temp
   NEXT
   IF term(lastword + 1) > 0 AND lastword < words THEN
     lastword = lastword + 1
   ENDIF
   IF term(firstword) = 0 THEN
     firstword = firstword + 1
   ENDIF
   
   denom = denom + 4
 LOOP UNTIL firstword >= words
 
END FUNCTION
 
FUNCTION atan52()             ' atan(1/5)  other half of calc terms 1/3, 1/7, 1/11 ....
 LOCAL INTEGER mainder, mainder1, mainder2, dividend, denom, temp, firstword, x
 LOCAL INTEGER term(words +2), lastword
 denom = 3: firstword = 1: lastword =3
 sum1(1) = 3: term(1) = 3: sum1(2) = big/5: term(2) = sum1(2)
 print "starting atan52()" 'DEBUG
 mainder1=0
 mainder2=0
 FOR x = firstword TO lastword + 1   'term 1/3
   temp = term(x)
   dividend = mainder1 * big + temp
   temp = dividend \ 25
   mainder1 = dividend - temp * 25
   term(x) = temp
   
   dividend = mainder2 * big + temp
   temp = dividend \ denom
   mainder2 = dividend - temp * denom
   sum1(x) = sum1(x) - temp
 NEXT
 print "atan52() step 2" 'DEBUG
 FOR x = lastword + 2 TO words
   dividend = mainder2 * big
   temp = dividend \ denom
   mainder2 = dividend - temp * denom
   sum1(x) = sum1(x) - temp
 NEXT
 IF term(lastword + 1) > 0 AND lastword < words THEN
   lastword = lastword + 1
 ENDIF
 IF term(firstword) = 0 THEN
   firstword = firstword + 1
 ENDIF
 denom = denom + 4
 print "atan52() step 3" 'DEBUG
 DO                                'do the rest
 if firstword mod 100 = 0 then print firstword 'DEBUG
   mainder1 = 0: mainder2 = 0
   FOR x = firstword TO lastword + 1
     temp = term(x)
     dividend = mainder1 * big + temp
     temp = dividend \ 625
     mainder1 = dividend - temp * 625
     term(x) = temp
     
     dividend = mainder2 * big + temp     'eventually this will overflow >9e18
     temp = dividend \ denom
     mainder2 = dividend - temp * denom
     sum1(x) = sum1(x) - temp
   NEXT x
   
   FOR x = lastword + 2 TO words
     dividend = mainder2 * big
     temp = dividend \ denom
     mainder2 = dividend - temp * denom
     sum1(x) = sum1(x) -temp
   NEXT x
   
   IF term(lastword + 1) > 0 AND lastword < words THEN
     lastword = lastword + 1
   ENDIF
   IF term(firstword) = 0 THEN
     firstword = firstword + 1
   ENDIF
   denom = denom + 4
 LOOP UNTIL firstword >= words
END FUNCTION
 
FUNCTION PrintOut()
 LOCAL p$, i AS INTEGER, j AS INTEGER, ptime AS INTEGER
 PRINT ""
 p$="pi = 3."
 i=2
 DO
   FOR j=i TO i+4
     IF j>words THEN
       p$=p$+SPACE$(11)
     ELSE
       p$=p$+STR$(sum(j),10,0,"0")+" "
     ENDIF
   NEXT
   p$=p$+STR$(10*i+30,7)
   PRINT p$
   p$="       "
   i=i+5
 LOOP UNTIL i>=words
 ptime = TIMER - stime - ctime
 PRINT ""
 
 PRINT " Total computation time:   "+STR$(ctime)+" mS"
 PRINT " Time to format and print: "+STR$(ptime)+" mS at "+time$
END FUNCTION

 ' test card for CMM2
 ' TassyJim August 2020
 
 OPTION EXPLICIT
 OPTION DEFAULT NONE
 DIM INTEGER wd, ht, wbox, sh, x, w, n, nn, m, cd, maxMode, keepMode
 DIM FLOAT a, defaultMode
 DIM k$, imgtitle$, fname$, imgRes$
 DIM INTEGER c(8)
 c(0) = RGB(BLACK)
 c(1) = RGB(YELLOW)
 c(2) = RGB(CYAN)
 c(3) = RGB(GREEN)
 c(4) = RGB(MAGENTA)
 c(5) = RGB(RED)
 c(6) = RGB(BLUE)
 c(7) = RGB(WHITE)
 c(8) = RGB(64,64,64)
 
 maxMode = 9
 cd = 8
 a = 1
 defaultMode = MM.INFO(MODE)
 CLS
 
 DO
   IF m = 0 THEN
     MODE 1,8
     CLS
     TEXT 400,100, "Video mode test",cm,5,1
     TEXT 400,180, "Ratio = aspect ratio used in the circle command",cm,1,1
     TEXT 400,220, "Q to quit, P to save page as a BMP",cm,3,1
     TEXT 400,260, "Up Down arrow to change resolution",cm,3,1
     TEXT 400,300, "Left Right arrow to change colour depth",cm,3,1
     TEXT 400,340, "+ - to change circle aspect ratio",cm,3,1
   ELSE
     IF keepmode THEN ' only change resolution if needed
       keepmode = 0
     ELSE
       MODE m,cd
     ENDIF
     wd = MM.HRES : ht = MM.VRES
     nn = INT(wd/80)
     imgtitle$ =" MODE "+STR$(MM.INFO(MODE))+" Ratio "+STR$(a,1,3)+" "
     imgRes$ = " "+STR$(MM.HRES)+" x "+STR$(MM.VRES)+" "
     wbox = wd / 8
     PAGE WRITE 1 ' no flicker during write
     CLS
     ' primary colours
     FOR x = 0 TO 7
       BOX x*wbox,ht/4,wbox,ht/2,0,c(x), c(x)
     NEXT x
     ' full gradient for each primary colour and greyscale
     FOR x = 0 TO wd-1
       sh = 255*x/wd
       
       LINE x,0,x,ht/12,1,RGB(sh,0,0)
       LINE x,ht/12,x,ht/6,1,RGB(0,sh,0)
       LINE x,ht/6,x,ht/4,1,RGB(0,0,sh)
       
       LINE x,ht*9/12,x,ht*10/12,1,RGB(0,sh,sh)
       LINE x,ht*10/12,x,ht*11/12,1,RGB(sh,0,sh)
       LINE x,ht*11/12,x,ht,1,RGB(sh,sh,0)
       
       LINE x,ht/2,x,ht*3/4,1,RGB(sh,sh,sh) ' greyscale
     NEXT x
     ' circle to check aspect ratio
     CIRCLE wd/2,ht/2, ht*15/32,3,a,c(7)
     sh = 0
     x = wd/2 - 55*nn/2
     ' black white bars to check monitor bandwidth
     FOR w = 10 TO 1 STEP -1
       FOR n = 1 TO nn
         sh = 255 - sh
         LINE x,ht*3/8,x,ht*5/8,w,RGB(sh,sh,sh)
         x = x + w
       NEXT n
     NEXT w
     ' white and red border to check that image fits on monitor
     BOX 0,0,wd,ht,3,c(7)
     BOX 1,1,wd-2,ht-2,1,c(5)
     ' title
     IF wd > 600 THEN
       TEXT wd/2,ht/2, imgtitle$,cm,4,1
       TEXT wd/2,ht/2+25, imgRes$,cm,4,1
     ELSE
       TEXT wd/2,ht/2, imgtitle$,cm,1,1
       TEXT wd/2,ht/2+25, imgRes$,cm,1,1
     ENDIF
     ' show the new image
     PAGE COPY 1 TO 0 ,B
   ENDIF
   ' wait for keypress
   DO
     k$ = INKEY$
   LOOP UNTIL k$<>""
   '
   SELECT CASE k$
     CASE "Q","q"
       EXIT DO
     CASE "P","p"
       fname$ = MID$(imgtitle$,2)+".bmp"
       TIMER = 0
       SAVE IMAGE fname$
       PAGE WRITE 0
       TEXT wd/2,ht/2,"Saved as "+fname$+" in "+STR$(TIMER/1000,3,2)+" Sec" ,cm,1,1
       DO
         k$ = INKEY$
       LOOP UNTIL k$<>""
     CASE CHR$(128) ' up arrow
       m = m - 1
       IF m < 1 THEN m = maxMode
     CASE CHR$(129) ' down arrow
       m = m + 1
       IF m > maxMode THEN m = 1
     CASE CHR$(131) ' right arrow res up
       cd = cd + 4
       IF cd > 16 THEN cd = 8
       IF m = 9 AND cd = 12 THEN cd = 16 ' skip 12 bit for mode 9
     CASE CHR$(130) ' left arrow  res down
       cd = cd - 4
       IF cd < 8 THEN cd = 16
       IF m = 9 AND cd = 12 THEN cd = 8 ' skip 12 bit for mode 9
     CASE "+" ' ratio plus
       IF a < 1.4 THEN a = a + 0.01
       keepmode = 1
     CASE "-" ' ratio minus
       IF a > 0.75 THEN a = a - 0.01
       keepmode = 1
     CASE ELSE ' same as down arrow
       m = m + 1
       IF m > maxMode THEN m = 1
   END SELECT
 LOOP
 setmode defaultMode ' restore original mode before ending program
 PAGE WRITE 0
 CLS
 
END
 
SUB setmode dotMode AS FLOAT
 LOCAL INTEGER mm, md
 ' use float returned by mm.info(mode) to set MODE
 mm = INT(dotmode)
 md = (dotmode - mm)*100
 IF md > 20 THEN md = md/10
 MODE mm, md
END SUB
 

10 PRINT CHR$(47+(INT(RND()*2)*45)); : GOTO 10

font 8

do : print CHR$(48+(INT(RND*2))); : pause 25 : loop

DefineFont #8
 03301010
 02000100 08000400 20001000 80004000 00020001 00080004 00200010 00800040
 00400080 00100020 00040008 00010002 40008000 10002000 04000800 01000200
 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000
End DefineFont