BBC BASIC
Programming >> Database and Files >> NOTE BOOK program (modified March 8 2018)
http://bbcbasic.conforums.com/index.cgi?board=database&action=display&num=1520142074
NOTE BOOK program (modified March 8 2018)
Post by michael on Mar 4th, 2018, 04:41am

UPDATE :Works on BBC4W and Raspberry Pi3 and Mac

* modified output/ reading file to use @usr$+"memo.txt"
so it is BBCSDL file system compliant.

A Note book program. Create a new file to start and it makes a nice tiny note app with slide show controls.

REQUEST: could someone test this out on an android? My android devices are too old
Code:
      REM This program has some extra tools in case future mods are desired      PROCgraphics(500,250)      PROCsbox(10,10,1000,900,"100,100,100")      ON CLOSE PROCclose      REPEAT        r$=FNbuttonz(0,0,"clearitall")        IF FNbuttonz(100,400,"NEW FILE")="NEW FILE" THEN PROCnfile:CLG        IF FNbuttonz(100,300,"ADD TO FILE")="ADD TO FILE" THEN PROCapnd:CLG        IF FNbuttonz(100,200,"VIEW MY INFO")="VIEW MY INFO" THEN PROCview:CLG        IF FNbuttonz(100,100,"QUIT")="QUIT" THEN QUIT        WAIT 10      UNTIL FALSE      QUIT      DEFPROCnfile      A=OPENOUT(@usr$+"memo.txt")      REPEAT        CLG        PROCsbox(10,10,1000,900,"200,200,200")        PROCpr(10,500," Title, item 1, item 2, item 3, item 4","200,200,200")        title$=FNtype(20,450)        n1$=FNtype(20,380)        n2$=FNtype(20,310)        n3$=FNtype(20,240)        n4$=FNtype(20,170)        n5$=FNtype(20,100)        PRINT#A,title$,n1$,n2$,n3$,n4$,n5$        PROCcolor("b","150,150,150")        CLG        PROCpr(20,450,"Would you like to make another page? ","180,200,200")        r$=""        REPEAT          r$=FNbuttonz(0,0,"clearitall")          IF FNbuttonz(100,350,"YES")="YES" THEN r$="y"          IF FNbuttonz(100,250,"MENU")="MENU" THEN r$="n"          WAIT 10        UNTIL r$<>""      UNTIL r$<>"y"      CLOSE#A      ENDPROC      DEFPROCapnd      A=OPENUP(@usr$+"memo.txt")      PTR#A = EXT#A      REPEAT        CLG        PROCsbox(10,10,1000,900,"200,200,200")        PROCpr(10,500," Title, item 1, item 2, item 3, item 4","200,200,200")        title$=FNtype(20,450)        n1$=FNtype(20,380)        n2$=FNtype(20,310)        n3$=FNtype(20,240)        n4$=FNtype(20,170)        n5$=FNtype(20,100)        PRINT#A,title$,n1$,n2$,n3$,n4$,n5$        CLG        REPEAT          r$=FNbuttonz(0,0,"clearitall")          IF FNbuttonz(100,400,"ADD PAGE")="ADD PAGE" THEN r$="y"          IF FNbuttonz(100,300,"RETURN TO MAIN MENU")="RETURN TO MAIN MENU" THEN r$="n"          WAIT 10        UNTIL r$<>""      UNTIL r$<>"y"      CLOSE#A      ENDPROC      DEFPROCview      A=OPENIN(@usr$+"memo.txt")      REPEAT        CLG        PROCsbox(10,10,1000,900,"220,220,220")        INPUT#A,title$,n1$,n2$,n3$,n4$,n5$        IF title$="" THEN CLOSE#A:PROCpr(100,300,"EMPTY","249,249,249"):WAIT 200:ENDPROC        PROCcolor("f","000,000,000")        PROCpr(10,500,title$,"200,220,220")        MOVE 20,400:PRINT n1$        MOVE 20,350:PRINT n2$        MOVE 20,300:PRINT n3$        MOVE 20,250:PRINT n4$        MOVE 20,200:PRINT n5$        REPEAT          r$=FNbuttonz(0,0,"clearitall")          IF FNbuttonz(850,100,"NEXT")="NEXT" THEN r$="y"          IF FNbuttonz(30,100,"BACK")="BACK" THEN r$="n"          WAIT 10        UNTIL r$<>""      UNTIL r$<>"y"      CLOSE#A      ENDPROC      DEFPROCclose      QUIT      ENDPROC      DEFFNrgb(x%,y%)      LOCAL rgb%, r&, g&, b&      rgb%=TINT(x%,y%)      r&=rgb%    :REM Use byte variable as mask.      g&=rgb% >>8      b&=rgb% >>16      =FNnumstr(r&)+","+FNnumstr(g&)+","+FNnumstr(b&)      DEF FNtype(x%,y%)      REM first define a efficient array a&() and retstr$- case of empty returned string      LOCAL a&(),retstr$,h%,v%,t&,k$,cp&,bc$,fc$      h%=x%:v%=y%      fc$="000,000,000":bc$="200,200,200":REM text color is black      REM l%,cp% line # and cursor position.l%- future(not used yet)      REM bc$-(text overwrite-background) fc$-foreground text colors-      REM now give a&() a dimension of 100      DIM a&(100)      REPEAT        h%=x%        REPEAT          k$=INKEY$(4)          REM Cursor          PROCcolor("f",fc$):MOVE cp&*16+h%,v%:PRINT"_"          WAIT 10:REM seems pretty smooth          PROCcolor("f",bc$):MOVE cp&*16+h%,v%:PRINT"_"        UNTIL k$<>""        IF k$<>"" THEN          IF ASC(k$)>31 AND ASC(k$)<127 AND cp&<100 THEN            a&(cp&)=ASC(k$):cp&=cp&+1          ENDIF          h%=x%:v%=y%:REM test          MOVE h%,v%:PROCcolor("f",bc$)          REM print every ascii value in a&() array except 0 -cool stuff          PRINT $$^a&(0)          t&=0          h%=x%:v%=y%:REM test          MOVE h%,v%:PROCcolor("f",fc$)          PRINT $$^a&(0)          t&=0        ENDIF        IF ASC(k$)=8 AND cp&>0 THEN          t&=0          h%=x%:v%=y%:REM test          MOVE h%,v%:PROCcolor("f",bc$)          PRINT $$^a&(0)          t&=0          t&=cp&-1          REPEAT            a&(t&)=a&(t&+1)            t&+=1          UNTIL t&=100          t&=0          h%=x%:v%=y%:REM test          MOVE h%,v%:PROCcolor("f",fc$)          PRINT $$^a&(0)          t&=0          cp&-=1        ENDIF      UNTIL ASC(k$)=13      retstr$ = $$^a&(0)      t&=0:PROCresetrgb      =retstr$      DEF PROCgraphics(x,y)      VDU 23,22,x;y;8,15,16,1      OFF      VDU 5      N%=0      N%=20      DIM X(20),Y(20),H(20),V(20)      ENDPROC      DEF PROCsbox(x%,y%,w%,h%,c$)      LOCAL ry%,sx%,sy%      sx%=x%:sy%=y%      IF x%>w% THEN x%=w%:w%=sx%      IF y%>h% THEN y%=h%:h%=sy%      ry%=y%      PROCcolor("f",c$)      REPEAT        LINE x%,y%,w%,y%        y%=y%+1      UNTIL y%=h%      y%=ry%      IF c$<>"0" THEN PROCcolor("f","000,000,000") ELSE PROCcolor("f","white")      LINE x%+2,y%+2,w%-2,y%+2      LINE w%-2,y%+2,w%-2,h%-4      LINE w%-2,h%-4,x%+2,h%-4      LINE x%+2,h%-4,x%+2,y%+2      PROCresetrgb      ENDPROC      DEFPROCresetrgb      COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000      COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200      COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056      COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056      COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248      COLOUR 15,248,248,248      ENDPROC      DEF PROCcolor(fb$,rgb$)      PRIVATE assemble$,br%,bg%,bb%      IF rgb$="0" OR rgb$="black" THEN rgb$="000,000,000"      IF rgb$="1" OR rgb$="red" THEN rgb$="200,000,000"      IF rgb$="2" OR rgb$="green" THEN rgb$="000,200,000"      IF rgb$="3" OR rgb$="yellow" THEN rgb$="200,200,000"      IF rgb$="4" OR rgb$="blue" THEN rgb$="000,000,200"      IF rgb$="5" OR rgb$="magenta" THEN rgb$="200,000,200"      IF rgb$="6" OR rgb$="cyan" THEN rgb$="000,200,200"      IF rgb$="7" OR rgb$="white" THEN rgb$="200,200,200"      IF rgb$="8" OR rgb$="grey" THEN rgb$="056,056,056"      IF rgb$="9" OR rgb$="light red" THEN rgb$="248,056,056"      IF rgb$="10" OR rgb$="light green" THEN rgb$="056,248,056"      IF rgb$="11" OR rgb$="light yellow" THEN rgb$="248,248,056"      IF rgb$="12" OR rgb$="light blue" THEN rgb$="056,056,248"      IF rgb$="13" OR rgb$="light magenta" THEN rgb$="248,056,248"      IF rgb$="14" OR rgb$="light cyan" THEN rgb$="056,248,248"      IF rgb$="15" OR rgb$="light white" THEN rgb$="248,248,248"      assemble$=rgb$      br%=VAL(MID$(assemble$,1,3)):bg%=VAL(MID$(assemble$,5,3)):bb%=VAL(MID$(assemble$,9,3))      IF fb$="f" OR fb$="F" THEN COLOUR 0,br%,bg%,bb% : GCOL 0      IF fb$="b" OR fb$="B" THEN COLOUR 1,br%,bg%,bb% : GCOL 128+1      ENDPROC      DEFFNnumstr(num)      LOCAL cov$,l%      cov$=STR$(num)      l%=LEN(cov$)      IF l%=1 THEN ret$="00"+cov$      IF l%=2 THEN ret$="0"+cov$      IF l%=3 THEN ret$=cov$      =ret$      DEF PROCpr(X,Y,msg$,c$)      LOCAL initialx%,fi%,reduction%,tx,ty      initialx%=LEN(msg$)      PROCcolor("f",c$)      GCOL 0      LET tx= X+initialx%+25      LET ty= Y:reduction%=0      reduction%=initialx%/2      reduction%=reduction%*6      IF initialx%<20 THEN reduction%=reduction%/2      initialx%=initialx%*22-reduction%      FOR fi%=12 TO 48        LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%      NEXT      COLOUR 0,0,0,0      GCOL 0      MOVE tx,ty      PRINT msg$      MOVE 0,0      ENDPROC      DEFFNbuttonz(X,Y,msg$)      LOCAL initialx%,fi%,reduction%,tx,ty,mx%,my%,mb%,ad%,ady%,c$      PRIVATE st$      IF msg$<> "clearitall" THEN        initialx%=LEN(msg$)        LET tx= X+initialx%+25        LET ty= Y:reduction%=0        reduction%=initialx%/2        reduction%=reduction%*6        IF initialx%<20 THEN reduction%=reduction%/2        initialx%=initialx%*22-reduction%        MOUSE mx%,my%,mb%        ad%=initialx%+8:ad%+=X:ady%=Y-28        IF mx% >X AND mx%<ad% AND my%<Y+8 AND my%>ady% THEN          c$="255,255,255"          IF mb%=4 THEN st$=msg$        ELSE c$="200,200,200"        ENDIF        IF FNrgb(X,Y)="000,000,000" THEN c$="200,200,200"        PROCcolor("f",c$)        IF FNrgb(X,Y)<>c$ THEN          FOR fi%=12 TO 48            LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%          NEXT          PROCcolor("f","000,000,000")          MOVE tx,ty          PRINT msg$        ENDIF      ENDIF      IF msg$="clearitall" THEN st$=""      MOVE 0,0      =st$