BBC BASIC
« NOTE BOOK program (modified March 8 2018) »

Welcome Guest. Please Login or Register.
Mar 31st, 2018, 10:45pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
We apologize Conforums does not have any export functions to migrate data.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

Thank you Conforums members.
Cross-platform BBC BASIC (Windows, Linux x86, Mac OS-X, Android, iOS, Raspberry Pi)
BBC BASIC Resources
BBC BASIC Help Documentation
BBC BASIC for Windows Home Page
BBC BASIC Programmers' Reference
BBC BASIC Beginners' Tutorial
BBC BASIC for SDL 2.0 Home Page
BBC BASIC Discussion Group

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: NOTE BOOK program (modified March 8 2018)  (Read 82 times)
michael
Full Member
ImageImageImage


member is offline

Avatar




PM


Posts: 157
xx NOTE BOOK program (modified March 8 2018)
« Thread started 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$ 
« Last Edit: Mar 9th, 2018, 02:22am by michael » User IP Logged

I like reinventing the wheel, but for now I will work on tools for D3D
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls