|
|
Post by Admin on Mar 31, 2018 4:26:58 GMT
REM This program has some extra tools in case future mods are desired(rect and abutton added)
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
DEFPROCrect(x%,y%,w%,h%)
LOCAL sx%,sy%
sx%=x%:sy%=y%
IF x%>w% THEN x%=w%:w%=sx%
IF y%>h% THEN y%=h%:h%=sy%
LINE x%,y%,w%,y%
LINE w%,y%,w%,h%
LINE w%,h%,x%,h%
LINE x%,h%,x%,y%
ENDPROC
REM FNabutton added October 22 2017
DEFFNabutton(x,y,size%,c$,com$)
MOUSE mx,my,mb
LOCAL ret$
PROCcolor("f","5")
PROCrect(x,y,x+size%,y+size%)
IF com$="fill" THEN
PROCpaint(x+5,y+5,c$)
ENDIF
IF mx>x AND mx<x+size% AND my>y AND my<y+size% THEN
PROCcolor("f","15"):PROCrect(x,y,x+size%,y+size%)
IF mb=4 THEN ret$=com$
ENDIF
=ret$
DEFPROCnfile
A=OPENOUT("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("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("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$
|
|
