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

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



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 80 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