for a=0 to qtoct-1
        fich(a)=asc(input$(#f,1))
    next
 

 
[loadbmp]
        filedialog "Choose an image","*.bmp",file$
        if file$<>"" then
            loadbmp "pic",file$
            open file$ for input as #bmp
            'get the file into a string
            bmp$ = Input$(#bmp,lof(#bmp))
            'analyse the file header
            bmpw=value(mid$(bmp$,19,4)) 'width
            bmph=value(mid$(bmp$,23,4)) 'height
            b=value(mid$(bmp$,29,2))    'bits per pixel, ie color depth
            o=value(mid$(bmp$,11,4))    'picture data offset, where the color data starts
            close #bmp
        end if
        'work out start of picture data and how to move through file
        o=o+1
        'work out how many bytes to step through the string 8=1 24=3 32=4
        st=b/8
        'work out padding each raster line must be a 4byte multiple
        mult=b/8*bmpw/4
        padding = 4*(1-(mult-int(mult))) mod 4
 
        for y=bmph-1 to 0 step -1
            for x=0 to bmpw-1
                'run through bmp
                if b=8 then
                    'color stored in pallet index at start of file
                    'pallet starts at 54 in steps of four ABGR A=alpha
                    pi=asc(mid$(bmp$,o,1))*4+54
                else
                    'color stored as BGR Liberty needs RGB
                end if
            o=o+st
            next
        o=o+padding
        next
    wait
function value(x$)
    select case len(x$)
        case 1
        value = asc(x$)
        case 2
        value=asc(mid$(x$,1,1))
        value=value+(asc(mid$(x$,2,1))*256)
        case 3
        value=asc(mid$(x$,1,1))
        value=value+(asc(mid$(x$,2,1))*256)
        value=value+(asc(mid$(x$,3,1))*65536)
        case 4
        value=asc(mid$(x$,1,1))
        value=value+(asc(mid$(x$,2,1))*256)
        value=value+(asc(mid$(x$,3,1))*65536)
        value=value+(asc(mid$(x$,4,1))*16777216)
    end select
end function
 

 
'Writing 256 color BMP (that is, paletted)
'by tsh73, October 2007
'of several sources
'nomainwin
'/* bmp write stuff
global BMP.width, BMP.height
'ALL ARRAYS USED FROM 0
dim BMPpalette$(256)   'colors as text, like "255 100 23" - useful from JB
dim BMPdata(0,0)       'to be REDIM'med
'*/ bmp write stuff

dim info$(10, 10)
 
'test data
BMP.width = 100 'different if divided/not divided by 4
BMP.height = 256
redim BMPdata(BMP.width,BMP.height)
 
'Making some palette    'R G B
t0 = time$("ms")
for i = 0 to 255
    'gray one
    BMPpalette$(i) = i;" ";i;" ";i
next
t1 = time$("ms")
print "Palette, ms ", t1-t0
 
'making some data
for x = 0 to BMP.width-1
    for y = 0 to BMP.height-1
        BMPdata(x,y) = y mod 256 'fix Nov 28 2020 for bigger heights
    next
next
t2 = time$("ms")
print "Array, ms ", t2-t1
 
OutFile$ = "test1.bmp"
'make sure file not extst
if fileExists(DefaultDir$, OutFile$) then
    kill OutFile$
end if
 
t2 = time$("ms")
'call functions
call writeFromArray OutFile$
t3 = time$("ms")
print "writeFromArray, ms ", t3-t2
 
print "Over!"
end
 
'------------------------------------------------------'
'Functions:
function createHeader$()
    'create string with header
    createHeader$ = ""
end function
 
function pal2binPal$()
    'BMPpalette$() -> palette$ string
    pal2binPal$ = ""
    for i = 0 to 256
     pal2binPal$ = pal2binPal$ _
        + chr$(val(word$(BMPpalette$(i),3))) _
        + chr$(val(word$(BMPpalette$(i),2))) _
        + chr$(val(word$(BMPpalette$(i),1))) _
        + chr$(0)
    next
end function
 
function data2Raw$()
    'BMPdata() -> raw$ string
    data2Raw$ = ""
end function
 
sub writeFromArray fname$
    BMPheader$ = createHeader$()
    palette$ = pal2binPal$()
    'write stuff
    'filler pads to dividable by 4 bytes
    fillLen = iif(BMP.width mod 4, 4 - BMP.width mod 4, 0)
    filler$=left$(chr$(0)+chr$(0)+chr$(0), fillLen)
    open fname$ for binary as #BMPout
        print #BMPout, BMPheader$
        print #BMPout, palette$ 
        for y = BMP.height-1 to 0 step -1
            'create line
            aLine$=""
            for x = 0 to BMP.width-1
                aLine$=aLine$+chr$(BMPdata(x,y))
            next
            'add filler
            aLine$=aLine$+filler$
            'write line
            print #BMPout, aLine$
        next
    close #BMPout
end sub
 
sub writeFromRaw fname$
end sub
 
'------------------------------------------------------'

    UpperLeftX = 1
    UpperLeftY = 1
    'for bitmap width be better dividable by 4
    WindowWidth = 320
    WindowHeight = 200
'    WindowWidth = 640
'    WindowHeight = 480
'    WindowWidth = 512
'    WindowHeight = 512

'increase window size so we get our requested size
print "Adjusting window for borders..."
'   call adjustWindowSize WindowWidth, WindowHeight
   print WindowWidth, WindowHeight
 
   open "plasma" for graphics_nsb_nf as #gr
'   open "plasma" for graphics_nsb_fs as #gr
   #gr, "trapclose quit"
   #gr, "home ; down ; posxy x y"
   width = 2*x : height = 2*y
   print  width, height
 
d = 2 'rect size    'but 3 is too rought it seems - ??
Maxx =  int(width/d)
Max.y = int(height/d)      'array size - from screen size
Max.color = 255  'number of colors to use
rough = 2       'how "rough" you want the plasma to be. It can be jsut too plain for small values - so we'll get no much oscillation...
min.size = 2    'pixel size, kind of?
'min.size = 10   'nice enough - but much faster (I think about full screen...)
'Time taken: 43906 for full screen and min.size = 10. Good enough...
dim screenBuf(Maxx, Max.y)
 
    startTime = time$("ms")
print "Making smooth palette..."
   call Makepalette
 
'   for i= 0 to 512
'    print i,  PAL$(i)
'   next

    #gr, "size ";min.size-1
 
    'set initial (seed) points
    screenBuf(0, 0) = (RND(1) * Max.color) + 1
    screenBuf(0, Max.y) = (RND(1) * Max.color) + 1
    screenBuf(Maxx, 0) = (RND(1) * Max.color) + 1
    screenBuf(Maxx, Max.y) = (RND(1) * Max.color) + 1
 
print "Filling underlying plasma array..."
    call Splitbox 0, 0, Maxx, Max.y
 
print "Time taken 1 : ";time$("ms") - startTime
startTime = time$("ms")
 
    oldCol$ = ""
    print "Drawing plasma from array..."
            for xx = 0 to Maxx-1
            x = xx*d
            for yy = 0 to Max.y-1
                y = yy*d
                scan
                Colr = screenBuf(xx, yy)
                col$ = PAL$(Colr)
                if  oldCol$ <> col$ then #gr, "color ";col$;";backcolor ";col$ 
                if d>1 then
                    #gr, "place ";x;" ";y;";boxfilled ";x+d;" ";y+d
                else
                    #gr, "set ";x;" ";y
                end if
                'print "color ";col$;";backcolor ";col$;";place ";x;" ";y;";boxfilled ";x+d;" ";y+d
                #gr, "discard"
            next
        next
 
print "Time taken 2 : ";time$("ms") - startTime
'Time taken: 57750 with drawing on
'Time taken: 29906 with drawing off (just creating array)
'I wonder if draw by array will be any faster, then???
'as an idea - to ret reasonable time drawing fullscreen, try to set minsize to more then 1 pixel??

startTime = time$("ms")
'easiest way to get right BMP header is to actually save BMP and look header (just change BPP and some other things after)
     #gr, "getbmp drawing 0 0 ";width;" "; height
     bmpsave "drawing", "just4header.bmp"
     unloadbmp("drawing")
'and I think if I wrote BMP upside down noone will notice - because it's just well, uncomprehensible anyway
    'get header
    open "just4header.bmp" for binary as #1
        size = lof(#1)
        header$ = input$(#1, 53)  'or 54???
    close #1
'     kill "just4header.bmp"
    'modify header
    'numbers stored hi lo
    '2  4 fileSize                                    = imagebytes + offset
    '10 4 offset                                      1078
    '28 2 BitsPerPixel (bpp)                          8
    '30 4 CompressMethod                              0
    '34 4 imagebytes                                  width*height
    '46 4 ColorsUsed                                  256
    '50 4 ImportantColors                             256
    'all goes +1 because bytes numbered from zero by loc()
    call putNumber header$, 2+1, 4, width*height + 1078
    call putNumber header$, 10+1, 4, 1078
    call putNumber header$, 28+1, 2, 8
    call putNumber header$, 30+1, 4, 0
    call putNumber header$, 34+1, 4, width*height
    call putNumber header$, 46+1, 4, 256
    call putNumber header$, 50+1, 4, 256
 
    'get image data
    'loop
        'open "frame.bmp" for binary
        open "frame.bmp" for binary as #1
        'write modif. header
        print  #1, header$
        'write palette
        for i = 0 to 255
            print  #1, PAL2BMP$(i)
        next
        'write image data
        'print  #1, space$(width*height)
        FOR y =  Max.y-1 TO 0 step -1
            aLine$ = ""
            FOR x = 0 TO Maxx-1
                for k = 1 to d
                    aLine$ =  aLine$ + chr$(screenBuf(x,y))
                next
            next
            for k = 1 to d
                print #1, aLine$ 
            next
        next
        close #1
print "Time taken 3 : ";time$("ms") - startTime
 
    'loop
    do while 1
        startTime = time$("ms")
        open "frame.bmp" for binary as #1
        seek #1, 54 'palette data
        for i = 0 to 255
            print  #1, PAL2BMP$(i+k)
        next
        close #1
        loadbmp "copyimage", "frame.bmp"
        #gr, "drawbmp copyimage 0 0"
        unloadbmp("copyimage")
        #gr, "discard"
        scan
        k = (k+1) mod Max.color
        tt = time$("ms") - startTime
        if  tt = 0 then  tt = 1
        fps = 1000/tt
        'print "Time taken: ";tt ;" fps: "; fps
       loop
    '//loop
   wait
 
'------------------------------------------------------
   SUB Makepalette
'     PAL$(0) = "0 0 0"
      FOR c = 1 TO 63
        c2 = c*4
'         cn = 63 - c
'         PAL(c).R = 63
'         PAL(c).G = c
'         PAL(c).B = 0
         PAL$(c) = "255 ";c2;" 0"
      NEXT
      FOR c = 0 TO 63
        c2 = c*4
         cn = 63 - c
        cn2 = cn*4
         ci = c + 64
'         PAL(ci).R = cn
'         PAL(ci).G = cn
'         PAL(ci).B = c
         PAL$(ci) = cn2;" ";cn2;" ";c2
      NEXT
      FOR c = 0 TO 63
        c2 = c*4
         cn = 63 - c
        cn2 = cn*4
         ci = c + 128
'         PAL(ci).R = 0
'         PAL(ci).G = c
'         PAL(ci).B = 63
         PAL$(ci) = "0 ";c2;" 255"
      NEXT
      FOR c = 0 TO 63
        c2 = c*4
         cn = 63 - c
        cn2 = cn*4
         ci = c + 192
'         PAL(ci).R = c
'         PAL(ci).G = cn
'         PAL(ci).B = cn
         PAL$(ci) = c2;" ";cn2;" ";cn2
      NEXT
      FOR c = 1 TO Max.color
'         col = PAL(c).R
'         PAL(c + Max.color).R = col
'         col = PAL(c).G
'         PAL(c + Max.color).G = col
'         col = PAL(c).B
'         PAL(c + Max.color).B = col
        PAL$(c + Max.color) =  PAL$(c)
      NEXT
'      FOR X = 1 TO Max.color
'         OUT &H3C8, X
'         OUT &H3C9, PAL(X).R
'         OUT &H3C9, PAL(X).G
'         OUT &H3C9, PAL(X).B
'      NEXT X
'     PAL$(511) = "0 0 0"
'     PAL$(512) = "0 0 0"
'   'for BMP palette is BGRempty
'   'while in PAL$ it's R G B
    for i = 0 to 512
         PAL2BMP$(i) = chr$(val(word$(PAL$(i),3))) _
            + chr$(val(word$(PAL$(i),2))) _
            + chr$(val(word$(PAL$(i),1))) _
            + chr$(0)
        'print i,  PAL2BMP$(i)
    next
 
   END SUB
 
   SUB Newcolor xa, ya, X, Y, xb, yb
      'IF Get13Pixel(X, Y) <> 0 THEN EXIT SUB
      IF screenBuf(X, Y) <> 0 THEN EXIT SUB
      avg = ABS(xa - xb) + ABS(ya - yb)
      'colour = (Get13Pixel(xa, ya) + Get13Pixel(xb, yb)) / 2 + (RND(1) - .5) * avg * rough
      colour = (screenBuf(xa, ya) + screenBuf(xb, yb)) / 2 + (RND(1) - .5) * avg * rough
      IF colour < 1 THEN colour = 1
      IF colour > Max.color THEN colour = Max.color
      'call Set13Pixel X, Y, colour
      screenBuf(X, Y) = colour
   END SUB
 
   SUB Splitbox X1, Y1, X2, Y2
      IF (X2 - X1 < min.size) AND (Y2 - Y1 < min.size) THEN EXIT SUB
      scan
      X = int((X1 + X2) / 2)
      Y = int((Y1 + Y2) / 2)
       call Newcolor X1, Y1, X, Y1, X2, Y1
       call Newcolor X2, Y1, X2, Y, X2, Y2
       call Newcolor X1, Y2, X, Y2, X2, Y2
       call Newcolor X1, Y1, X1, Y, X1, Y2
      IF screenBuf(X, Y) = 0 THEN
         'colour = (Get13Pixel(X1, Y1) + Get13Pixel(X2, Y1) + Get13Pixel(X2, Y2) + Get13Pixel(X1, Y2)) / 4
         colour = (screenBuf(X1, Y1) + screenBuf(X2, Y1) + screenBuf(X2, Y2) + screenBuf(X1, Y2)) / 4
         IF colour < 1 THEN colour = 1
         IF colour > Max.color THEN colour = Max.color
          'call Set13Pixel X, Y, colour
          screenBuf(X, Y) = colour
      END IF
       call Splitbox X1, Y1, X, Y
       call Splitbox X, Y1, X2, Y
       call Splitbox X, Y, X2, Y2
       call Splitbox X1, Y, X, Y2
   END SUB
 
'===========================================
sub quit handle$
   timer 0
   close #handle$
   end
END SUB
 
'------------------------------------------
   sub putNumber byref aStr$, aPos, aLen, value
    tmp$=""
    for i = 1 to aLen
        'tmp$=chr$(value mod 256)+tmp$   'numbers stored hi lo
        tmp$=tmp$+chr$(value mod 256)   'numbers stored lo hi
        value = int(value/256)
    next
    aStr$ = left$(aStr$, aPos-1)+tmp$+mid$(aStr$, aPos+aLen)
   end sub
'------------------------------------------
function iif(test, valYes, valNo)
    iif =  valNo
    if test then iif =  valYes
end function
'---------------------------------------
function fileExists(path$, filename$)
  'dimension the array info$( at the beginning of your program
  files path$, filename$, info$()
  fileExists = val(info$(0, 0))  'non zero is true
end function