This is a big examlpe.We want an object to handle input. We can define menus, buttons, drop down lists, numeric (integer/double), text in one line, text using editor for multiple lines.
We can export data in two ways. Using serialize$ as a string only with data, or using json$ for headers and data. We can use both function to restore data. Using json$ we can input some data, using header and value. There is away to render outpout from object in parts, and using offset on paper (here we have a demo in screen), changing background/foreground colors.
We can define functions to validate data (embeded using lambda functions), and we can use callback functions for adding logic
In the example we use two objects, one for menu, and one for data. E1, E2, FIN are events objects, and we place in fields, by copy (these are the CallBacks)
In field "Name" we want no spaces in then name and 4 chars at least. So we place a lambda function, as generated by ValidateValue() function.
Objects InpValue and InpValue2, draw data and record all commands. So in the last place we have the loop. We can use mouse inside input fields, but we have to move to fields using keyboard. F10 (Field number 121) move quick to menu. Field is console variable for returning the last key from exit from an input field.
For InpValue {
.mywidth=6
.PrintButton "File","File [F10]",,,8,1,,E2
.UseLastAsList ("Menu1","Menu2","Menu3","Exit")
.PrintButtonNext "Edit","Edit",,6,8,1,,E2
.UseLastAsList ("Help","Update","--------","About")
}
For InpValue2 {
.mywidth=10
.PrintLabel "Element",,15,1
.PrintLabel "Type", 4
.PrintUp "Combo", 10, 14
.UseLastAsList ("ListBox","Combo", "TextBox", "EditBox"), E1
.PrintLabel "Name", 4
.PrintUp "Combo1", 10, 14,,ValidateValue(-3, "A")
.PrintLabel "Text Field",4
Document AA$={aaaaaaaaaaaaa
bbbbbbbbbbbbb
cccccccccc
}
.PrintText 3, 30, AA$, 10,14
middlepoint=.maxitem
Cursor 0, Row+4
.PrintLabel "Attributes",,15,1
.PrintLabel "Title", 4
.PrintUp "Form1", 10, 14
.PrintLabel "Top", 4
.PrintUpInteger 0, 10, 14
.PrintNext "Left",24
.PrintUpInteger 0, 30, 14
.PrintLabel "Width",4
.PrintUpInteger 4000, 10, 14, ,ValidateValue(3000, 12000)
.PrintNext "Height",4+20
.PrintUpInteger 6000, 10+20, 14
.PrintLabel "Double",4
.PrintUp pi, 10, 14
.PrintNext "Double1",24
.PrintUp 2*pi, 30, 14
.PrintNext "Double2",44
.PrintUp 4*pi, 50, 14
.PrintButton "Exit","For Exit Come Here", 8, 10, 15, 1,,FIN
Print "Press Esc Key"
THERE:
Cls, Row
\\ .RenderView
}
\\Exit
maxInputitem=InpValue2.maxInputItem
do {
do {
InpValue.ScanRange
} until Field<>121
IF exitthis Then Exit
InpValue2.ScanRange 1, maxInputitem, maxInputitem-1, True
} until exitthis Or Field=1000
Form 60,44 Escape Off Flush Flush Garbage mybg=5 Cls mybg,0 : Pen 11 Bold 1 Report "Console Input Parameters Easy" Bold 0 Cursor 0,0 : Print Under Cls , 1 \\ ValidateValue(number, letter$) \\ return a lambda function with closures And signature lambda(letter$), returning boolean \\ ValidateValue( number, number) \\ return a lambda function with closures And signature lambda(number), returning boolean
Function ValidateValue { IF match("NN") Then { Read X1, Y1 =lambda X1, Y1 (n) ->{ =X1<=n And n<=Y1 ' Or n<Y1 } } Else { Read what, x1$ =lambda x1$, what (n$) ->{ IF what=0 Then { =n$ ~ x1$ } Else.If what>0 Then { =n$ >= x1$ And len(n$)>what } Else = n$ >= x1$ And len(n$)>-what And n$=filter$(n$, " ") } } } \\ InpValueClass make a group \\ We can display labels, values, recording positions \\ Using ScanRange we can use arrows To move from a range of input values, in Loop \\ using Esc we get out from Loop \\ we can give two more parameters \\ the "Exit" value And a flag, IF True Then Exit IF value changed \\ mygroup=InpValueClass(#FF5522) '' need a color for background \\ \\ .Record=True needed for recording \\ .PrintLabel \\ .PrintNext \\ .PrintUp \\ .UseLastAsList \\ when we record we make ranges of input/print values And we can use \\ .RenderView To print labels/values \\ .ScanRange \\ Class InpValueClass { Private: NoKey, LastKey$, UseInteger, drawbg, overridecolors, mybg, overfr, overbg Inventory Bag, EditItems Public: Record=True, item Property mywidth { Value, Set { IF value>width Then value=width IF value<3 Then value=3 } } = 10 Property myheight { Value, Set { IF value>height-1 Then value=height-1 IF value<1 Then value=1 } }=1 Group MaxInputItem { Value { Link Parent EditItems To Ed =Len(Ed) } } Group MaxItem { Value { Link Parent Bag To Bag =Len(Bag) } } Group ItemValue { Value (akey$) { Link Parent Bag To Bag =Bag(akey$+".value") } Set (akey$) { Read mGroup Link Parent Bag To Bag IF exist(Bag, akey$+".value") Then { Return Bag, akey$+".value":=mGroup } } } Class Info { iskey, isbutton, menuitem, isnumeric Event CallBack { Read &What } ValidValue=Lambda->True myvalue$ stackA=stack X, Y, mycolor, boldface W=10, H=1 \\ only for button mybg Class: Module Info { Read .isnumeric, .iskey, .MyValue$ Read .X, .Y, .W, .H, .mycolor, .boldface, .ValidValue } } Module PrintNext { Cursor 0, Row-1 .PrintLabel } Module PrintLabel { ticket=False IF IsNum Then { ticket=1-.UseInteger Read N IF ticket=2 Then { what$=Trim$(Str$(N,"0")) } Else what$=Trim$(Str$(N)) } Else Read what$ Let colour=pen, spaces=0, boldface=0 Read ? spaces, colour, boldface bold Abs(boldface<>0) Pen colour { Print @(spaces), IF .Record Then RecordMe() IF ticket Then what$=Format$("{0}",N) IF .drawbg Then .drawbg<=False : Print @(Pos,Row,Pos+.mywidth, Row+.myheight, .mybg); IF .myheight>1 Then { Legend ! what$, .mywidth, .myheight } Else { Legend ! what$, .mywidth, 1 } Print } bold 0 Sub RecordMe() Local mylambda=lambda->True IF Not empty Then Read myLambda IF Not .NoKey Then { Append .Bag, what$:=.Info(False, true, what$, Pos, Row, .mywidth, .myheight, colour, Abs(boldface<>0), mylambda) .lastkey$<=what$+".value" \\ using = And Not <= we get Error in next call \\ becaue = make a Local variable, but .lastkey$ is a group variable. } Else { Try ok { Append .EditItems, len(.Bag) Append .Bag, .lastkey$:=.Info(ticket, False, what$, Pos, Row, .mywidth, .myheight, colour, Abs(boldface<>0), mylambda) } \\ using of Flush Error To clean Error message first IF Error Or Not ok Then Flush Error : Error "You can't record two values in same key" } End Sub } Module PrintButtonNext { Cursor 0, Row-1 .PrintButton } Module PrintButton { Read .LastKey$, caption$ Oldmybg=.mybg Read ? .mybg Push caption$ .LastKey$<=.LastKey$+".value" .NoKey~ .drawbg~ .PrintLabel .NoKey~ \\ Bag(key) Or Bag(num!) num from 0 To len(Bag)-1 Read ? event_copy there=Len(.Bag)-1 For .Bag(there!), this { .isbutton<=True .callback<=event_copy .mybg<=..mybg } swap Oldmybg, .mybg } Module PrintText (Lines, TextWidth) { Cursor 0, Row-1 .NoKey~ Let oldw=.mywidth, oldH=.myHeight .mywidth<=TextWidth .myheight<=Lines .PrintLabel swap .mywidth, oldw swap .myHeight, oldH .NoKey~ } Module UseLastAsList (ArrayA) { Read ? event_copy IF Instr(.lastkey$,".value") Else Exit For .Bag(.Lastkey$) { Stack New { Data !ArrayA .CallBack<=event_copy \\ this [] pass current stack To .StackA, and leave a new empty stack \\ [] is "[" and "]" (these chars can be used in variables names too) .StackA<=[] } } } Module InpList { a=Each(.EditItems) While a { \\ ! use position (form 0) And no key To walk in .bag() for .bag(eval(a)!) { Print .MyValue$, Len(.stackA)>0, .isbutton, .iskey } } } Group Json$ { Value (x) { ' quote$(string$(MyValue$ as json)) bag$="" nl$={ } if x<=0 then nl$="" : x=0 space$=string$(" ",x) Link Parent bag To bag a=Each(bag) While a { M= bag(a^!) For M { IF Not .iskey and Not .isbutton Then { if bag$<>"" then bag$=bag$+", "+nl$ bag$=bag$+space$+quote$(Replace$(".value","",Eval$(bag, a^-1)))+" : "+quote$(string$(.MyValue$ as json)) } } } ="{"+nl$+bag$+nl$+"}" } Set { Read bag$ c$="""" \\ this is one char 34 nl$={ } end$="" Link Parent bag To bag safety=len(bag$) Stack New { if left$(trim$(bag$),1)="{" then { bag$=Trim$(RightPart$(bag$,"{")) end$="]" } else.if left$(trim$(bag$),1)="[" then { bag$=Trim$(RightPart$(bag$,"{")) end$="}" } do { While Left$(bag$,2)=nl$ {bag$=Trim$(Mid$(bag$, 3))} bag$=Trim$(RightPart$(bag$, c$)) mkey$=LeftPart$(bag$, c$)+".value" bag$=Trim$(RightPart$(bag$, c$)) if mkey$="" then exit While Left$(bag$,2)=nl$ {bag$=Trim$(Mid$(bag$, 3))} bag$=Trim$(RightPart$(bag$,":")) While Left$(bag$,2)=nl$ {bag$=Trim$(Mid$(bag$, 3))} bag$=Trim$(RightPart$(bag$, c$)) mval$=LeftPart$(bag$, c$) bag$=Trim$(RightPart$(bag$, c$)) Group M if exist(bag, mkey$) Then { M=eval(bag) M.myvalue$<=format$(mval$) Return bag, mkey$:=M } If left$(bag$, 1)="," then bag$=Trim$(Mid$(bag$, 2)) : Restart if end$<>"" then if left$(bag$,1)=end$ then exit if safety=len(bag$) then Error "Json parse problem" safety=len(bag$) } Until bag$="" } } } Group Serialize$ { value { bag$="" Link Parent bag To bag a=Each(bag) While a { M= bag(a^!) For M { IF Not .iskey and Not .isbutton Then { IF .isnumeric Then { bag$=bag$+" "+.MyValue$ } else bag$=bag$+stack$(.MyValue$) } } } =bag$ } Set { Read bag$ Stack New { Stack bag$ \\ fill stack with special format string for stack Link Parent bag To bag a=Each(bag) Try ok { While a { M= bag(a^!) For M { IF Not .iskey And Not .isbutton Then { IF .isnumeric=1 Then { Read N .MyValue$=Trim$(Str$(N)) } Else.If .isnumeric=2 Then { Read N% .MyValue$=Trim$(Str$(N%)) } Else Read .MyValue$ } } } } If Error Or Not ok Then Flush Error : Error "Serialize Input Not Compatible" } } } Module PrintUp { Cursor 0, Row-1 .NoKey~ .PrintLabel .NoKey~ } Module PrintUpInteger { Read N Push Val(Str$(N,"0")) Cursor 0, Row-1 .NoKey~ .UseInteger~ .PrintLabel .UseInteger~ .NoKey~ } Module RenderThis { Read M Read ? offsetX, offsetY IF .overridecolors Then { mybg= .overbg } else { mybg=.mybg } local inuse, final$ For M { IF this.overridecolors and .isbutton Then exit offsetX+=.X offsetY+=.Y Cursor offsetX, offsetY IF .isbutton Then mybg=.mybg \\ from M.mybg Print @(offsetX, offsetY, offsetX+.W, offsetY+.H, mybg); IF this.overridecolors Then {inuse=this.overfr} else inuse=.mycolor Pen inuse { Bold .boldface if .isnumeric then { final$=format$( "{0}", Val(.MyValue$) ) } else final$=.MyValue$ IF .H>1 Then { Legend ! final$, .W, .H } Else Legend ! final$, .W, 1 Bold 0 } } } Module RenderView { local fromA=1, toB=-1, offsetX, offsetY Read ? FromA, toB, offsetX, offsetY, .overridecolors IF .overridecolors Then Read .overfr, .overbg N=Each(.Bag, FromA, toB) While N { .RenderThis .Bag(N^!),offsetX, offsetY } Print .overridecolors<=false } Module ScanRange { Local FromA=1, ToB=.maxitem, vert, curx, cury, mKey$ IF ToB=0 Then Exit Read ? FromA, ToB Read ? ExitC, forever Local changed .item<=FromA Field New 1 ' reset To 1 the Field internal variable. mybg=.mybg { GetAValue(.item, &changed) IF changed Then vert=False IF Field=99 Or Field=121 Then .item<=0 : Exit IF Field=1000 Then Exit IF .item=ExitC And (changed Or Not forever) Then Field New 1000 : Exit IF vert Then { vert=False IF .item>=ToB And Field=1 Then Exit IF .item<=FromA And Field=-1 Then Exit IF Field=1 Then { a=Each(.EditItems, .item+1, ToB) } Else a=Each(.EditItems, .item, FromA) last=.item Try { While a { IF Field=1 Then { for .bag(eval(a)!) { IF .x>=curx And .y>cury Then last<=a^ :Break } } Else { for .bag(eval(a)!) { IF .x>=curx And .y<cury Then { field new 0 : last<=a^+1 IF .x>curx else Break } } } } } .item<=last } IF Field=1 Then .item++ IF Field=-1 Then .item-- IF .item<FromA Then .item<=ToB IF .item>ToB Then .item<=FromA CONTHERE: Loop } Sub CheckOk() Refresh ok=-2 { ok=inkey(100) \\ delay 100ms IF no key pressed (return -1 IF no key pressed in 100ms) IF ok=-1 Then Loop ' any block can performe once using loop statement } Select Case ok Case 121 ' F10 oldfield=121 Case 262162 oldfield=99 Case 38 { oldfield=-1 : vert=True } Case 40 ' two Or more statements need a block after Case { oldfield=1 : vert=True} Case 39 ' left oldfield=1 Case 37 ' right oldfield=-1 Case 27, -2 { While keypress(27) {} : oldfield=99 } End Select End Sub Sub GetAValue(where, &changed) Local N,N$, posnow=Pos, rownow=Row, StackB, k$, oldfield=Field, ok IF Not Abs(oldfield)=1 Then oldfield=1 Try ok { where=val(eval$(.EditItems, where-1)) } IF Error Or Not ok Then Exit Sub Try { mKey$=Eval$(.Bag, where) } IF mKey$="" Then Exit Sub IF Instr(mKey$,".value") Else Exit Sub temp=.Bag(mKey$) For temp { Let curx=.x, cury=.y IF Len(.stackA)>0 Then { Print @(.X,.Y, .X+.W, .Y+.H, 7), IF Not .isbutton Then Mark 1,1, 8: Print " "; Pen .myColor { Bold .boldface IF .H>1 Then { Legend ! .MyValue$, .W, .H } Else Legend ! .MyValue$, .W, 1 Bold 0 } CheckOk() IF ok=13 Or ok=9 Or ok=32 Then { ShowMenu() } } Else.If .isnumeric Then { Print @(.X,.Y, .X+.W, .Y+.H, 7); Pen .mycolor { Bold .boldface Legend ! Format$("{0}",val(.MyValue$)), .W, 1 Bold 0 } CheckOk() IF ok>=96 And ok<=105 Then ok=ok-48 IF ok=13 Or ok=9 Or Chr$(ok) ~ "[0-9]" Then { N=Val(.MyValue$) Pen .mycolor { IF Chr$(ok) ~ "[0-9]" Then { IF N=0 Then {N=Val(Chr$(ok))} Else N=Val(.MyValue$+Chr$(ok)) } Print @(.X,.Y,.X+.W, .Y+.H, 7); IF .isnumeric=2 Then { N%=N Input ! N%, .W N=N% } Else Input ! N, .W } IF .ValidValue(N) Then { changed=Not .MyValue$=Trim$(Str$(N)) .MyValue$<=Trim$(Str$(N)) } } } Else { Print @(.X,.Y,.X+.W, .Y+.H, 7); IF .isbutton Then { Pen .mycolor { Bold .boldface IF .H>1 Then { Legend ! .MyValue$, .W, .H } Else Legend ! .MyValue$, .W, 1 Bold 0 } CheckOk() Field New oldfield IF ok=13 Then Call Event .callback, &This, Replace$(".value","", mKey$) : changed=True oldfield=Field } Else { N$=.MyValue$ Pen .mycolor { Bold .boldface IF .h>1 Then { Legend ! .MyValue$, .W, .H CheckOk() IF ok=13 Or ok=9 Or ok=32 Then Input ! N$, .w, .h,"Editor" } Else { Legend ! .MyValue$, .W, 1 CheckOk() IF ok=13 Or ok=9 Or ok=32 Then Print @(.X,.Y,.X+.W, .Y+.H, 7); : Input ! N$, .w } Bold 0 } IF .ValidValue(N$) Then { changed=Not .MyValue$=N$ .MyValue$<=N$ } } } IF .isbutton Then { Print @(.X,.Y, .X+.W, .Y+.H, .mybg); } Else Print @(.X,.Y, .X+.W, .Y+.H, mybg); Pen .mycolor { Bold .boldface IF .H>1 Then { Legend ! .MyValue$, .W, .H } Else { IF .isnumeric Then { Legend ! Format$("{0}",val(.MyValue$)), .W, 1 } Else Legend ! .MyValue$, .W, 1 } Bold 0 } } Field New oldfield Cursor posnow, rownow Return .Bag, mKey$:=temp End Sub Sub ShowMenu() oldfield=1 Print @(.X,.Y+1), IF Not .isbutton Then Print @(.X,.Y), :Mark 1,1, 15 : Print " "; menu fill 7,7, .mycolor menu frame off menu \\ erase menu StackB=Each(.stackA) While StackB { Menu + stackitem$(StackB) } try ok { menu show .MyValue$ } IF Error Or Not ok Then Error flush : Menu ! \\ show menu Menu fill 1 \\ reset fill colors menu frame \\ reset frame IF menu>0 Then { IF Not .isbutton Then { changed=Not .MyValue$=menu$(menu) .MyValue$<=menu$(menu) } Else .menuitem<=menu Field New oldfield Call Event .callback, &This, Replace$(".value","", mKey$) oldfield=Field IF Abs(oldfield)=1 Then oldfield=0 } Else oldfield=0 End Sub } Class: module InpValueClass (.mybg) { Read ? .mywidth, .myheight } }
LocalVar$="New Title - Module scope variable" exitthis=False Function FromEvent { Read New &What, mykey$ Local K K=Ask(what.myvalue$, LocalVar$) } Function FromEvent2 { Read New &What, mkey$ Local K
IF what.menuitem>0 Then { IF instr(Menu$(what.menuitem),"---")>0 Then Break K=Ask(what.myvalue$+" "+Menu$(what.menuitem), "No2") IF what.menuitem=2 Then { M=InpValue2.ItemValue("Exit") M.myvalue$="Press me "+Time$(Now) InpValue2.ItemValue("Exit")=M InpValue2.RenderThis M } } Else { K=Ask(what.myvalue$, "No2") } IF mKey$="File" And what.menuitem=4 Then Field New 99 : exitthis=True : Exit Cls, -14 InpValue2.InpList } Function FromEvent3 { \\ this is a module's variable ' exitthis=True ' Field New 99 \\ We can use 1000 as default Exit Field New 1000 } Event E1 { Read &A, B$} E2=E1 ' copy of E1 To E2 FIN=E2 ' copy of E2 To FIN \\ Using Lazy$(&FromEvent()) And Not FromEvent() we pass code from module \\ when run take the module name space, so all modules variables/modules/functions are visible \\ except subrutines. Event E1 New Lazy$(&FromEvent()) Event E2 New Lazy$(&FromEvent2()) Event FIN New Lazy$(&FromEvent3()) \\ Now we have InpValue=InpValueClass(mybg) InpValue2=InpValueClass(mybg) middlepoint=0 For InpValue { .mywidth=6 .PrintButton "File","File [F10]",,,8,1,,E2 .UseLastAsList ("Menu1","Menu2","Menu3","Exit") .PrintButtonNext "Edit","Edit",,6,8,1,,E2 .UseLastAsList ("Help","Update","--------","About") } For InpValue2 { .mywidth=10 .PrintLabel "Element",,15,1 .PrintLabel "Type", 4 .PrintUp "Combo", 10, 14 .UseLastAsList ("ListBox","Combo", "TextBox", "EditBox"), E1 .PrintLabel "Name", 4 .PrintUp "Combo1", 10, 14,,ValidateValue(-3, "A") .PrintLabel "Text Field",4 Document AA$={aaaaaaaaaaaaa bbbbbbbbbbbbb cccccccccc } .PrintText 3, 30, AA$, 10,14 middlepoint=.maxitem Cursor 0, Row+4 .PrintLabel "Attributes",,15,1 .PrintLabel "Title", 4 .PrintUp "Form1", 10, 14 .PrintLabel "Top", 4 .PrintUpInteger 0, 10, 14 .PrintNext "Left",24 .PrintUpInteger 0, 30, 14 .PrintLabel "Width",4 .PrintUpInteger 4000, 10, 14, ,ValidateValue(3000, 12000) .PrintNext "Height",4+20 .PrintUpInteger 6000, 10+20, 14 .PrintLabel "Double",4 .PrintUp pi, 10, 14 .PrintNext "Double1",24 .PrintUp 2*pi, 30, 14 .PrintNext "Double2",44 .PrintUp 4*pi, 50, 14 .PrintButton "Exit","For Exit Come Here", 8, 10, 15, 1,,FIN Print "Press Esc Key" THERE: Cls, Row \\ .RenderView } \\Exit maxInputitem=InpValue2.maxInputItem do { do { InpValue.ScanRange } until Field<>121 IF exitthis Then Exit InpValue2.ScanRange 1, maxInputitem, maxInputitem-1, True } until exitthis Or Field=1000
\\ Part 2 Cls 15, 1 Pen 0 Report "Print to Paper <Demo on Screen>" \\ export without buttons, black color on white paper InpValue2.RenderView 1,7, 5, 5, true, 0, 15 \\ -1 is the maxitem in bag Cursor 0,15 Report "We can move a group by offset X and Y" \\ using -1 for end mark \\ 5 chars right, 10 char lines down InpValue2.RenderView 8, -1, 5, 10, true, 0, 15
Print InpValue2.maxitem A$=InpValue2.Serialize$ Print A$ InpValue2.Serialize$=A$ A$=key$ cls mybg,1 Pen 15 Report "RenderView" InpValue2.RenderView Report "Json 2 chars indent" Pen 14 Report InpValue2.Json$(2) A$=InpValue2.Json$(0) Pen 15 { Report "Json 0 chars indent" } Report A$ Pen 15 { Report "Len json$ vs Serialize$" } Print Len(A$), Len(InpValue2.Serialize$) '' 216, 123 InpValue2.Json$=A$ Pen 15 { Report {InpValue2.Json$={"Left" : "1000", "Top" : "500"}} }
InpValue2.Json$={"Left" : "1000", "Top" : "500"} Report InpValue2.Json$(0)
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου
You can feel free to write any suggestion, or idea on the subject.