'   SPLOT v1.9 - progress status
'              
' TO DO:
'   [ ] grids -> upgrade to v2.0 !
'   [ ] more rational config
'   [x] linear regression!
'       [x] error on A
'       [ ] error trimming and rounding!
'
'
' DONE:
'   [x] error bars (beta)!
'       [x] poisson
'       [x] fixed value
'       [x] other column (check)
'
DECLARE SUB findextr (z$, n, m1, m2, m)
DECLARE SUB findcol (z$)
DECLARE SUB findcommand (z$)
DECLARE SUB config ()
DECLARE SUB initcolours ()
DECLARE SUB showc ()
DECLARE SUB showhelp ()
DECLARE SUB text ()
DIM SHARED sx, dx, up, dn, nc, ng, min, max, filestart, ee
DIM SHARED a, f$
DIM SHARED colour(0 TO 15), continue, newc(0 TO 15)
DIM SHARED showtext, zoom, marginex, marginey
DIM SHARED istogram
ce = 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ON ERROR GOTO nc1           'no colors or valid color file'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
OPEN "splot.cfg" FOR INPUT AS #1
IF NOT ce THEN
  FOR i = 0 TO 15
    INPUT #1, colour(i)
    IF ce = -1 THEN EXIT FOR
  NEXT
END IF
CLOSE

showtext = 0
zoom = 0
nc = 0
a$ = COMMAND$: findcommand a$
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
fe = 0
ON ERROR GOTO fe1                   'if file doesn't exist'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LOCATE , 1: PRINT SPACE$(80); : LOCATE , 1

ask = 0
DO: fe = 0
  IF f$ = "" THEN INPUT "File: ", f$: ask = -1: IF f$ = "" THEN END
  IF f$ = "?" THEN showhelp: END
  OPEN f$ FOR INPUT AS #1: CLOSE
LOOP UNTIL NOT fe

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ON ERROR GOTO ge1                           'general error'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

IF nc = 0 THEN
  findcol f$
  IF nc > 101 THEN
  '
  ' fixes "linux bug"
    INPUT "Numero di colonne: ", nc$: nc = VAL(nc$): IF nc = 0 THEN nc = 2
  ELSE
    IF ask THEN
      LOCATE CSRLIN - 1, 9 + LEN(f$): PRINT "*  Numero di colonne:"; nc
    ELSE
      PRINT "Numero di colonne:"; nc
    END IF
  END IF
END IF

IF nc = 1 THEN       ''''''''
  PRINT "Istogram mode."
  ng = 1                     ' istogram added!
    ELSE              ''''''''

INPUT "Numero grafici: ", ng$: ng = VAL(ng$): IF ng = 0 THEN ng = nc - 1 '1 !!!
 
END IF     ' istogram added!

  REDIM SHARED b$(ng), b(ng), y(ng), ym(ng), s(nc)
    FOR i = 1 TO nc: s(i) = 1: NEXT i



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ON ERROR GOTO ee1                              'extr error'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

istogram = 0        '''''''
IF nc = 1 THEN
  istogram = -1       ' istogram added!
  b(1) = 1
  sx = 1
  dx = 0
  CLOSE : OPEN f$ FOR INPUT AS #1
  DO
    LINE INPUT #1, yorick$
    dx = dx + 1
  LOOP UNTIL EOF(1)
ELSE                '''''''

INPUT "Colonna asse x: ", a$: a = VAL(a$): IF a = 0 THEN a = 1

IF a$ = "0" THEN
  istogram = -1
  a = 0                      ' istogram added!
  PRINT "Istogram mode."     ' now even with more columns!
END IF
      
last = a
REDIM SHARED uncert(ng), wl(ng), lr(ng), Sumxy(ng), Sumy(ng) 'linear regression
REDIM SHARED errc(ng)
DIM SHARED Sumx2, Sumx

  FOR n = 1 TO ng
    poisson = 0: fixed = 0: errc = 0
    PRINT n; : INPUT "Colonna asse y: ", b$(n)
    ''''''''''''''''''''''''''''''''''''''''''
    ' very delicate intervention: tags!!!!!!
    ' add after col no., (or just tag)
    ' allowed tags:
    ' P: poissonian error bars
    ' F: fixed error bars (prompts for value)
    ' E: separate error bars (prompts for column)
    ' L: with lines
    ' R: linear regression!!!
    ''''''''''''''''''''''''''''''''''''''''''
    DO WHILE LEN(b$(n)) > 0
   
    tag$ = UCASE$(RIGHT$(b$(n), 1))
    temp$ = LEFT$(b$(n), LEN(b$(n)) - 1)

    SELECT CASE tag$
      CASE "P"
        poisson = -1
      CASE "F"
        fixed = -1
      CASE "E"
        errc = -1
        'poisson = -1 'temporarily until fixed
      CASE "L"
        wl(n) = -1
      CASE "R"
        lr(n) = -1
        ''''''''''''''
        ' must get N !
        NOPE = 0
        CLOSE : OPEN f$ FOR INPUT AS #1
        DO
          LINE INPUT #1, yorick$
          NOPE = NOPE + 1
        LOOP UNTIL EOF(1)
        CLOSE
      CASE ELSE
        temp$ = b$(n)
        EXIT DO
    END SELECT
    b$(n) = temp$

    LOOP

    ' remove until here to get the previous version
    '''''''''''''''''''''''''''''''''''''''''''''''

    b(n) = VAL(b$(n)): IF b(n) = 0 THEN b(n) = last + 1
    IF b(n) > nc THEN b(n) = nc
    IF b(n) < 0 THEN b(n) = -b(n): s(b(n)) = -1
    last = b(n)

    ''''''''' error bars ''''''''
    IF fixed THEN INPUT "Valore barre d'errore: ", uncert(n)
    IF poisson THEN uncert(n) = -1
    IF errc THEN INPUT "Colonna ampiezza errore: ", errc(n)
    '''''''''''''''''''''''''''''
  NEXT n

'INPUT "Vuoi immettere manualmente gli estremi x [Y/N] (N): ", ex$: IF UCASE$(ex$) = "Y" THEN ex = -1
'IF ex THEN

  findextr f$, a, 0, 0, 0
  sx = min
  dx = max

END IF  '''''' istogram added !


IF zoom THEN
INPUT "Estremi asse x (2 valori): ", sx$, dx$
  IF sx$ <> "" THEN sx = VAL(sx$)
  IF dx$ <> "" THEN dx = VAL(dx$)
END IF

IF sx = dx THEN sx = sx - 1: dx = dx + 1: PRINT "Empty range for x values, adjusting to"; sx; dx

  FOR j = 1 TO ng
    findextr f$, b(j), sx, dx, a
    IF j = 1 THEN
      mmin = min
      mmax = max
    ELSE
      IF min < mmin THEN mmin = min
      IF max > mmax THEN mmax = max
    END IF
  NEXT
  dn = mmin
  up = mmax

'INPUT "Vuoi immettere manualmente gli estremi y [Y/N] (N): ", ey$: IF UCASE$(ey$) = "Y" THEN ey = -1
'IF ey THEN
IF zoom THEN
  INPUT "Estremi asse y (2 valori): ", dn$, up$
    IF up$ <> "" THEN up = VAL(up$)
    IF dn$ <> "" THEN dn = VAL(dn$)
END IF

IF dn = up THEN dn = dn - 1: up = up + 1: PRINT "Empty range for y values: adjusting to"; dn; up

IF showtext THEN
marginex = ABS(dx - sx) / 6
marginey = ABS(up - dn) / 6

ELSE
marginex = ABS(dx - sx) / 8
marginey = ABS(up - dn) / 8
END IF

sx = sx - marginex
dx = dx + marginex


up = up + marginey
dn = dn - marginey


IF showtext THEN text

'wl = 0
'INPUT "With lines [Y/N] (N): ", wl$: IF UCASE$(wl$) = "Y" THEN wl = -1

SCREEN 12
'WINDOW (sx, dn)-(dx, up)
WINDOW (sx, dn)-(dx, up)

PAINT ((sx + dx) / 2, (up + dn) / 2), colour(0)

pixel = ABS(dx - sx) / 640
ypixel = ABS(up - dn) / 480
r = 4 * pixel


LINE (sx, 0)-(dx, 0), colour(15)
LINE (0, dn)-(0, up), colour(15)

''''''''''''''''''''''''''''''''' identifies graphs!
FOR i = 1 TO ng
LINE (dx - 10 * pixel, up - 10 * i * ypixel)-(dx - 50 * pixel, up - 10 * i * ypixel), colour(i)
NEXT
'''''''''''''''''''''''''''''''''

LOCATE 1, 1: PRINT "X:"; sx + marginex; dx - marginex
LOCATE 2, 1: PRINT "Y:"; dn + marginey; up - marginey

OPEN f$ FOR INPUT AS #1

FOR i = 1 TO filestart - 1: LINE INPUT #1, a$: NEXT

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ON ERROR GOTO pe1                              'prog error'
ee = 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

count = 0
DO
count = count + 1
  'read data
  FOR n = 1 TO nc
    INPUT #1, c
    
                         ''''''''''''''''''''''''''''''''''''''
                         ' linear regression part!
    IF n = a THEN x = c: Sumx = Sumx + x: Sumx2 = Sumx2 + x ^ 2
                         ''''''''''''''''''''''''''''''''''''''

    IF count = 1 THEN erst = x
    last = x

    IF istogram THEN x = count - 1 ''''' istogram added!
                         '     ^^^ revised 5.11.2002 (starting with 0, not with 1!)
    FOR i = 1 TO ng
      IF n = b(i) THEN y(i) = c * s(n)
      IF n = errc(i) THEN uncert(i) = c '* s(n)
    NEXT i
  NEXT n

  'plot data
  ee = 0
  FOR i = 1 TO ng
    IF NOT ee THEN
    
      PSET (x, y(i)), colour(i)
      IF wl(i) THEN
        IF count > 1 THEN LINE (x, y(i))-(xm, ym(i)), colour(i)
      ELSE
        CIRCLE (x, y(i)), r, colour(i)
      END IF
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' uncertainties
        uncert = uncert(i)
        'uncert(i) = y(errc(i))
    
        IF uncert(i) < 0 AND y(i) > 0 THEN uncert = SQR(y(i)) 'ELSE uncert = uncert(i)
        'IF errc(i) > 0 THEN uncert = y(errc(i))
        IF uncert > 0 THEN
          LINE (x, y(i) - uncert)-(x, y(i) + uncert), colour(i)  ', 15
          LINE (x - 2 * pixel, y(i) - uncert)-(x + 2 * pixel, y(i) - uncert), colour(i) ', 15
          LINE (x - 2 * pixel, y(i) + uncert)-(x + 2 * pixel, y(i) + uncert), colour(i) ', 15
        END IF
        ' linear regression
        IF lr(i) THEN Sumy(i) = Sumy(i) + y(i): Sumxy(i) = Sumxy(i) + x * y(i)
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''

      'END IF
      ym(i) = y(i)
    END IF
  NEXT
  xm = x

LOOP UNTIL EOF(1)
CLOSE


''''''''''''''''''''''
REDIM SHARED a(ng), b(ng) 'useless; it can be done with just one variable
no = 0
erst = erst - 70 * pixel
'last = last + 70 * pixel
FOR i = 1 TO ng
IF lr(i) THEN
no = no + 1
a(i) = (Sumx2 * Sumy(i) - Sumx * Sumxy(i))
b(i) = NOPE * Sumxy(i) - Sumx * Sumy(i)
d = NOPE * Sumx2 - Sumx ^ 2
a(i) = a(i) / d
b(i) = b(i) / d

EA = SQR(uncert(i) ^ 2 * Sumx2 / d)

LINE (erst, a(i) + b(i) * erst)-(last, a(i) + b(i) * last), 15
COLOR colour(i)
temp$ = "A =" + STR$(a(i)) + " ñ" + STR$(EA)
LOCATE 5 + no, 79 - LEN(temp$): PRINT temp$
                                             

END IF
NEXT

''''''''''''''''''''''

SLEEP

END


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' error managing part (stupid qbasic, can't put in SUBs!) '
'                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

fe1:
IF CSRLIN > 1 THEN LOCATE CSRLIN - 1, 1 ELSE LOCATE , 1
PRINT f$; "  Warning: FILE NOT FOUND"; : PRINT SPACE$(80 - POS(0))
f$ = "": fe = -1
RESUME NEXT

ge1:
PRINT : PRINT "Fatal error, quitting.": END
RESUME NEXT

ee1:
ee = -1
RESUME NEXT

pe1:
ee = -1
RESUME NEXT

nc1:
initcolours
ce = -1
RESUME NEXT

SUB config
continue = 0
showc
INPUT "Vuoi modificare? [Y/N] (Y): ", a$: IF a$ = "" THEN a$ = "Y"
IF UCASE$(a$) = "N" THEN END
PRINT
INPUT "Nuovo colore di sfondo:", a$: a = VAL(a$):
IF a$ <> "" THEN
  IF a >= 0 AND a <= 15 THEN newc(0) = a
ELSE
  newc(0) = colour(0)
END IF

FOR i = 1 TO 15
  PRINT "Nuovo colore"; i; ": ";
  INPUT "", a$
  a = VAL(a$)
  IF a$ <> "" THEN
    IF a >= 0 AND a <= 15 THEN newc(i) = a
  ELSE
    newc(i) = colour(i)
  END IF

  'automatically swap values (but allows repetitions!)
  FOR c = i + 1 TO 15
    IF colour(c) = newc(i) THEN colour(c) = colour(i)
  NEXT
NEXT
PRINT "Premi un tasto per vedere le modifiche": SLEEP

FOR i = 0 TO 15
  temp = colour(i)
  colour(i) = newc(i)
  newc(i) = temp
NEXT

showc
INPUT "Conservo le modifiche? [Y/N] (Y): ", a$: IF a$ = "" THEN a$ = "Y"
IF UCASE$(a$) = "Y" THEN
  CLOSE
  OPEN "splot.cfg" FOR OUTPUT AS #1
  FOR i = 0 TO 15
    PRINT #1, colour(i)
  NEXT
  CLOSE
  END
ELSE
  FOR i = 0 TO 15
    colour(i) = newc(i)
  NEXT
END IF
INPUT "Vuoi continuare a modificare? [Y/N] (Y): ", a$: IF a$ = "" THEN a$ = "Y"
IF UCASE$(a$) = "N" THEN END
continue = -1
END SUB

SUB findcol (z$)
'CLOSE : OPEN z$ FOR INPUT AS #1
'nc = 0
'count = 0
'DO: count = count + 1: LINE INPUT #1, a$: LOOP WHILE a$ = ""
'filestart = count - 2
'
'DO
'mc = nc
'nc = 1
'
'  DO
'    a$ = LTRIM$(RTRIM$(a$))
'    l = LEN(a$)
'    p = INSTR(a$, CHR$(32))
'    IF p = 0 OR a$ = "" THEN EXIT DO
'    nc = nc + 1
'    'a$ = RIGHT$(a$, l - p + 1)
'    a$ = MID$(a$, p)
'  LOOP
'
'IF EOF(1) THEN EXIT DO

'LINE INPUT #1, a$: filestart = filestart + 1

'LOOP UNTIL mc = nc

CLOSE : OPEN z$ FOR INPUT AS #1
nc = 1
count = 0
DO: count = count + 1: LINE INPUT #1, a$: LOOP WHILE a$ = ""
filestart = count

DO
a$ = LTRIM$(RTRIM$(a$))
l = LEN(a$)
p = INSTR(a$, CHR$(32))
IF p = 0 OR a$ = "" THEN EXIT DO
nc = nc + 1
a$ = RIGHT$(a$, l - p + 1)
LOOP


END SUB

SUB findcommand (z$)
DO
z$ = LTRIM$(RTRIM$(z$))
IF z$ = "" THEN EXIT DO
l = LEN(z$)
p = INSTR(z$, CHR$(32))
IF p > 1 THEN token$ = MID$(z$, 1, p - 1)
IF p = 0 THEN token$ = MID$(z$, 1)
SELECT CASE UCASE$(token$)
  CASE ""
    EXIT DO
  CASE "-?", "?", "--?", "-HELP", "--HELP", "HELP", "/?"
    showhelp
    END
    'PRINT "Help screen: coming soon.": END
  CASE "CONFIG"
    DO: config: LOOP UNTIL continue = 0
    END
  CASE "TEXT", "T", "/TEXT", "/T", "-TEXT", "-T"
    showtext = -1
  CASE "ZOOM", "Z", "/ZOOM", "/Z", "-ZOOM", "-Z"
    zoom = -1
  CASE ELSE
    t = VAL(token$)
    SELECT CASE t
      CASE IS > 0
        nc = t
      CASE IS = 0
        f$ = token$
    END SELECT
END SELECT
IF p < l AND p <> 0 THEN z$ = MID$(z$, p) ELSE EXIT DO
LOOP

END SUB

SUB findextr (z$, n, m1, m2, m)
CLOSE : OPEN z$ FOR INPUT AS #1
ee = 0

FOR i = 1 TO filestart - 1: LINE INPUT #1, a$: NEXT

count = 0: p = -1
DO
  count = count + 1
  FOR i = 1 TO nc
 
    INPUT #1, c
    c = c * s(i)

    IF i = n THEN value = c
    IF i = m THEN
      IF c >= m1 AND c <= m2 THEN p = -1 ELSE p = 0
    END IF

  NEXT

  IF p AND NOT ee THEN
    IF count = 1 THEN
      min = value: max = value
    ELSE
    IF value < min THEN min = value
      IF value > max THEN max = value
 
    END IF
  END IF

LOOP UNTIL EOF(1)

CLOSE

END SUB

SUB initcolours
colour(0) = 0
FOR i = 1 TO 15
  colour(i) = 9 + i
  IF colour(i) > 15 THEN colour(i) = colour(i) MOD 15
NEXT
END SUB

SUB showc
SCREEN 12: CLS
PAINT (10, 10), colour(0)
PRINT "Colore di sfondo:"; colour(0)
PRINT "Sequenza colori:";
FOR i = 1 TO 15
  COLOR colour(i)
  PRINT colour(i);
NEXT
PRINT
COLOR 15
END SUB

SUB showhelp
COLOR 15: PRINT "SPLOT v1.9"; : COLOR 7: PRINT " -- latest at ";
COLOR 11: PRINT "http://web.tiscali.it/nick_stavrogin/software": COLOR 7
PRINT "USE: SPLOT [file] [n. di colonne] [zoom] [help] [config]"
PRINT
PRINT "Tutti i parametri sono opzionali. Crea il grafico a partire da un"
PRINT "file di dati incolonnati. Cerca di rilevare automaticamente il"
PRINT "numero di colonne ed eventualmente chiede di inserirlo manualmente."
PRINT "Il parametro CONFIG permette di scegliere i colori da utilizzare"
PRINT "nel grafico. ZOOM permette di visualizzare parte del grafico."
PRINT
PRINT "<Continua>"
SLEEP
PRINT
PRINT "E' possibile specificare dei tag quando si immettono i numeri delle"
PRINT "colonne da visualizzare."
PRINT "Es.:"
PRINT " 1 Colonna asse y: [-][numero colonna][r][l][f|p|e]"
PRINT "  -  cambia di segno i valori (solo se seguito dal numero colonna)"
PRINT " [ ] se non specificato, il n colonna aumenta di volta in volta di 1"
PRINT "  r  calcola la regressione lineare e mostra il valore dell'intercetta"
PRINT "  l  unisce i punti del grafico con delle linee"
PRINT "  f  sovrappone ai punti un intervallo di errore fisso (richiesto poi)"
PRINT "  p  assegna ai punti un errore di tipo poissoniano (radice del valore)"
PRINT "  e  chiede quale colonna riporta i valori di errore punto per punto"
PRINT
END SUB

SUB text
CLS
'text mode graphics
ntiles = 75
widthx = (dx - sx) / ntiles
ntilesy = 20
widthy = (up - dn) / ntilesy
marginx = (80 - ntiles) / 2
marginy = (25 - ntilesy) / 2
zerox = -sx / widthx
zeroy = -dn / widthy
isx = 0: isy = 0
IF zerox >= marginx AND zerox <= 80 - marginx THEN isx = -1
IF isx THEN
  FOR i = marginy TO 25 - marginy STEP .5
    'lOCATE 25 - marginy - i, marginx + zerox: PRINT "|"
    LOCATE i, marginx + zerox: PRINT "|"
    
  NEXT
    LOCATE marginy, marginx + zerox: PRINT "^"
  
END IF
IF zeroy >= marginy AND zeroy <= 25 - marginy THEN isy = -1
IF isy THEN
  FOR i = marginx TO 80 - marginx STEP .5
    'LOCATE 25 - marginy - zeroy, marginx + i: PRINT "-"
    LOCATE 25 - marginy - zeroy, i: PRINT "-"
  NEXT
    LOCATE 25 - marginy - zeroy, 80 - marginx: PRINT ">"
END IF
IF isx AND isy THEN LOCATE 25 - marginy - zeroy, marginx + zerox: PRINT "+"
LOCATE 1, 1: PRINT "X:"; sx + marginex; dx - marginex
LOCATE 2, 1: PRINT "Y:"; dn + marginey; up - marginey
OPEN f$ FOR INPUT AS #1
FOR i = 1 TO filestart - 1: LINE INPUT #1, a$: NEXT
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ON ERROR GOTO pe1                              'prog error'
ee = 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
count = 0
DO
count = count + 1
  'read data
  FOR n = 1 TO nc
    INPUT #1, c
  
    IF n = a THEN x = c
   
    IF istogram THEN x = count - 1 ''''' istogram added!
                         '     ^^^ revised 5.11.2002 (starting with 0, not with 1!)
    FOR i = 1 TO ng
      IF n = b(i) THEN y(i) = c * s(n)
    NEXT i
  NEXT n

  'plot data
  FOR i = 1 TO ng
    IF NOT ee THEN
      cx = (x - sx) / widthx
      cy = (y(i) - dn) / widthy

      'LOCATE 3, 1: PRINT cx; cy
      COLOR colour(i) '2 + i
      LOCATE 25 - (marginy + cy), marginx + cx: PRINT "x"
     

    END IF
  NEXT
  xm = x

LOOP UNTIL EOF(1)



END

END SUB