Re: Structured Programming: QB IS STRUCTURED!!!
- Posted by Chris Burch <chriscrylex at aol.com> Jan 17, 2006
- 620 views
Copy, paste and run
-- Extremely Simple Text-mode Dialogs -- ----------------------------------------
modified to be dual platform CM Burch (29/12/04)
include graphics.e color names include dll.e include wildcard.e include misc.e include get.e
without warning
constant COLORS = 1, FGND = 1, BKGND = 2, box structure COORDS = 2, ROW = 1, COL = 2, SIZE = 3, HEIGHT = 1, WIDTH = 2, MINH = 4, MINW = 8, STYLE = 4, SHADOW = 5, HINT = 6, HINTCOLORS = 7, BUFFER = 8
global integer SGL, DBL, DHL, DVL, NONE, up, dn, left, right, ENTER, ESC, SP, pgup, pgdn, home, endd, insert, bksp, del, tab, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, F12
global sequence Lines, Divider, Shadow global integer TL, HL, TR, VL, BL, BR global sequence ENV ENV = "Windows"
tab = '\t' TL = 1 HL = 2 TR = 3 VL = 4 BL = 5 BR = 6
if platform() = LINUX then SGL = 1 DBL = 2 DHL = 3 DVL = 4 NONE = 5 border styles
these have been changed from the 'graphic' character set Lines = {{'+','-','+','|','+','+'}, single line borders {'+','-','+','|','+','+'}, double line borders {'+','-','+','|','+','+'}, double horizontal {'+','-','+','|','+','+'}, double vertical {' ',' ',' ',' ',' ',' '} } none
Divider = {{'+','-','+'}, single style divider line {'+','-','+'}, {'+','-','+'}, double horizontal {'+','-','+'}, {' ',' ',' '}}
Shadow = {' ',' ',' '} 3 different shadow backgrounds
ENV = getenv("TERM") if match(upper(ENV), "XTERM") = -10 then set to -10 to ignore it for now
Divider = {{195,196,180}, single style divider line {204,205,185}, {198,205,181}, double horizontal {199,196,182}, {' ',' ',' '}}
Shadow = {176,177,178} 3 different shadow backgrounds end if
else SGL = 1 DBL = 2 DHL = 3 DVL = 4 NONE = 5 border styles
have to work out codes for lines
Divider = {{195,196,180}, single style divider line {204,205,185}, {198,205,181}, double horizontal {199,196,182}, {' ',' ',' '}}
Shadow = {176,177,178} 3 different shadow backgrounds
end if
global atom SCREEN_BKGND SCREEN_BKGND = BLACK
global atom LIST_KEY
global sequence DefaultBox DefaultBox = {{BRIGHT_WHITE,BLUE}, default colors {1,1}, coordinates top left corner {5,10}, box size SGL, single line border 1, light shadow "Press any key...", hint text {GREEN,BLACK}, hint colors {}} buffer for save screen
to accomodate usage in xterm or konsole that hasn't been set to 25 lines
vid_conf = video_config() SCREEN_LINES = vid_conf[VC_LINES] SCREEN_COLS = vid_conf[VC_COLUMNS]
global procedure printat(sequence coords, sequence text)
position(coords[1],coords[2]) puts(1,text) end procedure
global procedure printcolor(sequence coords, sequence colors, sequence text)
text_color(colors[1]) bk_color(colors[2]) printat(coords,text) end procedure
global function limit (atom n, sequence limits)
if n < limits[1] then n = limits[1] elsif n > limits[2] then n = limits[2] end if return n end function
global function pad (sequence s, atom width)
while length(s) < width do s = s & ' ' end while return s end function
global function delete (sequence s, atom loc, atom len)
return s[1..loc-1] & s[loc+len..length(s)] end function
global function Fdialogs_rts(sequence str)
x = length(str) if x = 0 then return "" end if
while str[x] = 32 or str[x] = '\n' or str[x] = 0 or str[x] = '\t' do x = x-1 if x <= 1 then exit end if end while
if x < 1 then x = 1 end if str = str[1..x]
if length(str) = 1 and (str[1] = 32 or str[1] = ENTER) then str = "" end if
return str end function
procedure MoveCursor(sequence coords)
position(coords[ROW],coords[COL]) end procedure
function SaveBkgnd(object box)
cursor(NO_CURSOR) box[COORDS] = get_position()
MoveCursor(box[COORDS])
see the global defs at the top for characters for boxes.
global function PlainBox(sequence box)
almost the same as display box, but no title area
sequence topline, botline, midline, divline, rshad, bshad, char atom row, col, x, y box = SaveBkgnd(box) row = box[COORDS][ROW] col = box[COORDS][COL] x = box[SIZE][WIDTH] y = box[SIZE][HEIGHT] text_color(box[COLORS][FGND]) bk_color(box[COLORS][BKGND]) cursor(NO_CURSOR)
grab the area to be shadowed:
select the border style to use: char = Lines[box[STYLE]]
draw the borders: printat({row,col}, topline) for i = 1 to y do printat({row+i,col}, midline) end for
MoveCursor(box[COORDS]) restore cursor to start cursor(UNDERLINE_CURSOR) return box
end function
global function DisplayBox(sequence box)
sequence topline, botline, midline, divline, rshad, bshad, char atom row, col, x, y box = SaveBkgnd(box) row = box[COORDS][ROW] col = box[COORDS][COL] x = box[SIZE][WIDTH] y = box[SIZE][HEIGHT] text_color(box[COLORS][FGND]) bk_color(box[COLORS][BKGND]) cursor(NO_CURSOR)
grab the area to be shadowed:
select the border style to use: char = Lines[box[STYLE]]
build the borders: topline = char[TL] & repeat(char[HL],x) & char[TR] botline = char[BL] & repeat(char[HL],x) & char[BR] midline = char[VL] & repeat(' ',x) & char[VL] char = Divider[box[STYLE]] divline = char[1] & repeat(char[2],x) & char[3]
draw the shadows:
MoveCursor(box[COORDS]) restore cursor to start cursor(UNDERLINE_CURSOR) return box end function
global procedure SetColors(atom fgnd, atom bkgnd)
DefaultBox[COLORS] = {fgnd,bkgnd} end procedure
global procedure SetSize(atom rows, atom cols)
DefaultBox[SIZE] = {rows,cols} end procedure
global procedure SetStyle(atom style)
DefaultBox[STYLE] = style end procedure
global procedure SetHint(sequence hint)
DefaultBox[HINT] = hint end procedure
global procedure DisplayHint(sequence hint)
printcolor({SCREEN_LINES,2},DefaultBox[HINTCOLORS],repeat(' ',78)) printcolor({SCREEN_LINES,3},DefaultBox[HINTCOLORS],hint) end procedure
procedure DisplayList(sequence coords, sequence colors, sequence list, atom default)
for i = 1 to length(list) do if i = default then printcolor(coords+{i,0},{colors[2],colors[1]},list[i]) else printcolor(coords+{i,0},colors,list[i]) end if end for end procedure
global function GenericBox (sequence title, sequence msg)
object msgbox msgbox = DefaultBox
object box box = GenericBox(title,msg) end procedure
global procedure Notify (sequence title, sequence msg)
object box box = GenericBox(title,msg) DisplayHint( "Press any key...") while get_key() = -1 do
object box, hilite atom key, selection integer offset
offset = 0 if length(title) > 0 then offset = 2 else offset = 0 end if
box = GenericBox(title,items) DisplayHint( "Select with up/dn arrows - press enter - esc to cancel" ) key = -1 selection = default cursor(NO_CURSOR)
DisplayList(box[COORDS]+{offset,1},box[COLORS],items,selection) while key != ENTER do key = upper(get_key()) if key >= 'A' and key <= 'Z' then for i = selection to length(items) do if items[i][1] = key then selection = i exit end if end for end if
if key = up then selection = limit(selection - 1,{1,length(items)}) elsif key = dn then selection = limit(selection + 1,{1,length(items)}) elsif key = pgup then selection = 1 elsif key = pgdn then selection = length(items) elsif key = left then key = 27 elsif key = right then key = 13 elsif key = ESC then selection = -1 exit end if if key != -1 then DisplayList(box[COORDS]+{offset,1},box[COLORS],items,selection) end if end while RestoreBkgnd(box) cursor(UNDERLINE_CURSOR) return selection end function
global function CheckBox(sequence title, sequence items)
object box, selecteditems atom key, selection for i = 1 to length(items) do items[i] = "[ ] "&items[i] end for box = GenericBox(title,items) DisplayHint("Select with up/dn arrows, toggle with spacebar, enter when finished") key = -1 selection = 1 MoveCursor(box[COORDS]+{selection+2,2}) while key != 13 do key = get_key() if key != -1 then MoveCursor(box[COORDS]+{selection+2,2}) end if if key = SP then if items[selection][2] = 'X' then items[selection][2] = ' ' else items[selection][2] = 'X' end if printcolor(box[COORDS]+{selection+2,1},box[COLORS],items[selection]) MoveCursor(box[COORDS]+{selection+2,2}) elsif key = up then selection = limit(selection - 1,{1,length(items)}) MoveCursor(box[COORDS]+{selection+2,2}) elsif key = dn then selection = limit(selection + 1,{1,length(items)}) MoveCursor(box[COORDS]+{selection+2,2}) elsif key = ENTER then exit end if end while selecteditems = {} for i = 1 to length(items) do if items[i][2] = 'X' then selecteditems = append(selecteditems,items[i][5..length(items[i])]) end if end for return selecteditems end function
global function RadioBox(sequence title, sequence items)
object box, selecteditems atom key, selection for i = 1 to length(items) do items[i] = "( ) "&items[i] end for box = GenericBox(title,items) DisplayHint("Select with up/dn arrows, toggle with spacebar, enter when finished") key = -1 selection = 1 MoveCursor(box[COORDS]+{selection+2,2}) while key != 13 do key = get_key() if key = SP then if items[selection][2] = 'X' then items[selection][2] = ' ' else items[selection][2] = 'X' printcolor(box[COORDS]+{selection+2,1},box[COLORS],items[selection]) end if for i = 1 to length(items) do if i != selection then items[i][2] = ' '
global function RadioBox_def(sequence title, sequence items, integer def)
object box, selecteditems atom key, selection
if def > length(items) then def = 1 end if
for i = 1 to length(items) do if def != i then items[i] = "( ) "&items[i] else items[i] = "(X) "&items[i] end if end for box = GenericBox(title,items) DisplayHint("Select with up/dn arrows, toggle with spacebar, enter when finished") key = -1 selection = 1 MoveCursor(box[COORDS]+{selection+2,2}) while key != 13 do key = get_key() if key = SP then if items[selection][2] = 'X' then items[selection][2] = ' ' else items[selection][2] = 'X' printcolor(box[COORDS]+{selection+2,1},box[COLORS],items[selection]) end if for i = 1 to length(items) do if i != selection then items[i][2] = ' ' reset all buttons printcolor(box[COORDS]+{i+2,1},box[COLORS],items[i]) end if end for printat(box[COORDS]+{selection+2,1},items[selection]) MoveCursor(box[COORDS]+{selection+2,2}) elsif key = up then selection = limit(selection - 1,{1,length(items)}) MoveCursor(box[COORDS]+{selection+2,2}) elsif key = dn then selection = limit(selection + 1,{1,length(items)}) MoveCursor(box[COORDS]+{selection+2,2}) elsif key = ENTER or key = ESC then exit end if end while selecteditems = {} for i = 1 to length(items) do if items[i][2] = 'X' then selecteditems = append(selecteditems,items[i][5..length(items[i])]) end if end for return selecteditems end function
global function ListBox(sequence title, sequence items, atom start)
object box atom key, current, fini, max, itemcount box = GenericBox(title,"") key = -1 current = 1 itemcount = length(items) max = box[SIZE][1] - 3 for i = 1 to itemcount do items[i] = pad(items[i],box[SIZE][2]) end for fini = itemcount fini = limit(fini,{1,itemcount}) fini = limit(fini,{fini,max}) cursor(NO_CURSOR) DisplayList(box[COORDS]+{2,1},box[COLORS],items[start..fini],start) while key != 27 do key = get_key() if key = ESC then exit elsif key = ENTER then exit elsif key = up then current = limit(current - 1,{1,itemcount}) if current < start then start = limit(start - 1,{1,itemcount}) fini = start + max - 1 end if DisplayList(box[COORDS]+{2,1},box[COLORS],items[start..fini],current-start+1)
elsif key = dn then current = limit(current + 1,{1,itemcount}) if current > fini then fini = limit(fini + 1,{1,itemcount}) start = fini - max + 1 end if DisplayList(box[COORDS]+{2,1},box[COLORS],items[start..fini],current-start+1) end if end while cursor(UNDERLINE_CURSOR) return items[current] end function
object box atom key, current, fini, max, itemcount,start, list_start_pos
if length(title) > 0 then list_start_pos = 2 else list_start_pos = 0 end if
itemcount = length(items) max = box[SIZE][1] - (1 + list_start_pos) sets max size of list for i = 1 to itemcount do items[i] = pad(items[i],box[SIZE][2]) end for fini = itemcount fini = limit(fini,{1,itemcount}) fini = limit(fini,{fini,max}) cursor(NO_CURSOR)
simulate key down until get to selected item if selected <= itemcount then while current != selected do current = limit(current + 1,{1,itemcount}) cur_sel = current if current > fini then fini = limit(fini + 1,{1,itemcount}) start = fini - max + 1 end if end while end if
DisplayList(box[COORDS]+{2,1},box[COLORS],items[start..fini],start) DisplayList(box[COORDS]+{list_start_pos,1},box[COLORS],items[start..fini],current-start+1) while key != 27 do LIST_KEY = 0 key = get_key() if key = ESC then cur_sel = -1 exit elsif key = ENTER or key = left or key = right then LIST_KEY = key exit elsif key = up then current = limit(current - 1,{1,itemcount}) cur_sel = current if current < start then start = limit(start - 1,{1,itemcount}) fini = start + max - 1 end if DisplayList(box[COORDS]+{list_start_pos,1},box[COLORS],items[start..fini],current-start+1)
elsif key = dn then current = limit(current + 1,{1,itemcount}) cur_sel = current if current > fini then fini = limit(fini + 1,{1,itemcount}) start = fini - max + 1 end if DisplayList(box[COORDS]+{list_start_pos,1},box[COLORS],items[start..fini],current-start+1)
elsif key > 31 and key <129 then LIST_KEY = key exit end if end while cursor(UNDERLINE_CURSOR)
return cur_sel end function
global function Input (sequence title, sequence prompt, sequence default)
sequence result, pcoords, icoords, box atom key,i,imax, imode, max box = GenericBox(title,prompt) pcoords = get_position() icoords = pcoords max = length(default) printcolor(icoords,{box[COLORS][2],box[COLORS][1]},default)
if imode then i = limit(i+1,{1,max}) result[i] = key else result = result[1..i] & key & result[i+1..length(result)] result = result[1..max] i = limit(i+1,{1,max}) end if end if printcolor(icoords,{box[COLORS][2],box[COLORS][1]},result) position(icoords[1],icoords[2]+i) end if end while RestoreBkgnd(box) return result end function
global procedure Progress(sequence title, sequence msg, atom percent)
object box, pbar box = GenericBox(title,{msg}) pbar = repeat(' ',box[SIZE][COL] - 4) MoveCursor(box[COORDS]+{5,2}) puts(1,pbar) pbar = repeat('#',length(pbar) * percent * .01) MoveCursor(box[COORDS]+{5,2}) puts(1,pbar) end procedure
global procedure Delay(atom sec)
object start, fini start = time() fini = start + sec while time() < fini do end while end procedure
global integer WORD_WRAP WORD_WRAP = 0
function wrap_fields(sequence field_buffers, integer current_field, object overflow)
sequence lfb, temp_word integer posn_in_field
lfb = repeat({}, length(field_buffers) ) posn_in_field = 0
record the length of each of the field_buffers for i = 1 to length(field_buffers) do lfb[i] = length(field_buffers[i]) end for
work forwards from current_field to end for i = current_field to length(field_buffers) do
overflow = Fdialogs_rts(overflow) if length(overflow) = 0 then exit else if i < length(field_buffers) then field_buffers[i+1] = overflow & " " & field_buffers[i+1] append(overflow, field_buffers[i+1]) overflow = field_buffers[i+1][ lfb[i+1]+1 ..$ ] field_buffers[i+1] = field_buffers[i+1][1..lfb[i+1]] end if overflow = Fdialogs_rts(overflow) if length(overflow) = 0 then exit end if
end if
end for
return field_buffers end function
global function Form(sequence title, sequence fields)
pcoords = get_position()
str = {} overflow = 0 have_wrapped = 0
calculate number of lines (1 line = 1 label + 1 field) field_count = length(fields) lines = field_count/3
set box size if length(title) > 0 then size_x = lines+3 offset = 3 else size_x = lines+1 offset = 1 end if
fill in any defaults for i = 1 to lines do if length(fields[((i-1)*3)+2]) > 0 then for k = 1 to length(fields[((i-1)*3)+2]) do if k > length(field_buffers[i]) then exit end if field_buffers[i][k] = fields[((i-1)*3)+2][k] end for end if end for
create box box = GenericBox(title, {})
for i = 1 to lines do printcolor(box[COORDS]+{offset+i-1, 1}, {box[COLORS][1], box[COLORS][2]},labels[i]) printcolor(box[COORDS]+{offset+i-1, 1+start_field}, {WHITE, BLACK}, field_buffers[i]) end for
input loop key = 0 current_field = 1 curs_posn = 1 imode = 1 if WORD_WRAP = 1 then printcolor(box[COORDS]+{offset+lines, 1}, {WHITE, BLACK}, "ovr") end ifwhile key != ESC do key = get_key() if key > 0 then
if key = right then curs_posn += 1 if curs_posn > length(field_buffers[current_field]) then curs_posn -= 1 end if elsif key = left then curs_posn -= 1 if curs_posn < 1 then curs_posn = 1 end if elsif key = up then current_field -= 1 if current_field < 1 then current_field = 1 end if if curs_posn > length(field_buffers[current_field]) then curs_posn = 1 end if elsif key = dn then current_field += 1 if current_field > lines then current_field = lines end if if curs_posn > length(field_buffers[current_field]) then curs_posn = 1 end if elsif key = insert then imode = not(imode) if imode = 1 then cursor(BLOCK_CURSOR) else cursor(UNDERLINE_CURSOR) end if if imode then printcolor(box[COORDS]+{offset+lines, 1}, {WHITE, BLACK}, "ovr") else printcolor(box[COORDS]+{offset+lines, 1}, {WHITE, BLACK}, "ins") end if elsif key = ENTER then current_field += 1 if current_field > lines then exit end if curs_posn = 1 elsif key = home then current_field = 1 curs_posn = 1 elsif key = bksp then if curs_posn = 1 then field_buffers[current_field] = field_buffers[current_field][2..$] & ' ' else field_buffers[current_field] = field_buffers[current_field][1..curs_posn-2] & field_buffers[current_field][curs_posn..$] & ' ' end if curs_posn -= 1 if curs_posn < 1 then curs_posn = 1 end if elsif key > 31 and key <129 then if WORD_WRAP = 0 then if imode then ovr field_buffers[current_field][curs_posn] = key else ins if curs_posn = 1 then field_buffers[current_field] = key & field_buffers[current_field][1..$-1] else field_buffers[current_field] = field_buffers[current_field][1..curs_posn-1] & key & field_buffers[current_field][curs_posn..$-1] end if end if curs_posn += 1 if curs_posn > length(field_buffers[current_field]) then curs_posn -= 1 end if else word wrap is turned on
next line current_field += 1 if current_field > lines then exit end if
cursor for i = 1 to length(field_buffers[current_field]) do if field_buffers[current_field][i] = ' ' then curs_posn = i exit end if end for
end if
redisplay entire form if have word wrapped if have_wrapped then for i = 1 to lines do printcolor(box[COORDS]+{offset+i-1, 1+start_field}, {WHITE, BLACK}, field_buffers[i]) end for have_wrapped = 0 end if
else length of str is < than length field_buffer
print current field printcolor(box[COORDS]+{offset+current_field-1, 1+start_field}, {WHITE, BLACK}, field_buffers[current_field]) position(box[COORDS][1] + offset+current_field-1, box[COORDS][2] + curs_posn+start_field)
end if end while
clear the box SetSize(size_x, size_y) position(pcoords[1],pcoords[2]) SetColors(SCREEN_BKGND, SCREEN_BKGND) cur_style = DefaultBox[STYLE] DefaultBox[STYLE] = 5 box = GenericBox({}, {}) DefaultBox[STYLE] = cur_stylereturn field_buffers end function
global function Form_old(sequence title, sequence fields)
sequence result, box, field_coords, pcoords, input_field integer j, lines, field_count, size_x, size_y, start_field integer max_field_length, current_field, curs_posn, offset atom key, cur_style, field_change, imode key =0 field_change = 0
result = {} pcoords = get_position()
calculate number of lines (1 line = 1 label + 1 field) field_count = length(fields) lines = field_count/3
set box size if length(title) > 0 then size_x = lines+3 offset = 3 else size_x = lines+1 offset = 1 end if
create labels & fields for i = 1 to field_count by 3 do printcolor(box[COORDS]+{offset+i/3, 1}, {box[COLORS][1], box[COLORS][2]},fields[i]) input_field = repeat(' ', fields[i+2]) printcolor(box[COORDS]+{offset+i/3, 1+start_field}, {WHITE, BLACK}, input_field) printat(box[COORDS]+{offset+i/3, 1+start_field}, fields[i+1])
position cursor in 1st entry field, and start entry loop current_field = 1 remember, sets of 3! curs_posn = 1 imode = 1 start on overwrite MoveCursor(box[COORDS]+{offset+current_field/3, 1+start_field})
while length(input_field) < 3 do input_field = input_field & ' ' end while
while key != ESC do key = get_key() if key > 0 then do nothing if no key pressed - faster key scanning, and cursor flashing
if key = dn or key = ENTER then field_change = 1 write out buffer fields[current_field+1] = input_field current_field = current_field+3 if current_field > field_count then current_field = current_field-3 if key = ENTER then exit end if end if input_field = fields[current_field+1] if length(input_field) < 3 then input_field = input_field & " " end if
elsif key = up then field_change = 1 write out buffer fields[current_field+1] = input_field current_field = current_field-3 if current_field < 0 then current_field = current_field+3 end if input_field = fields[current_field+1] if length(input_field) < 3 then input_field = input_field & " " end if
elsif key = home then current_field = 1 field_change = 1
elsif key = right then curs_posn = curs_posn + 1 if curs_posn > fields[current_field+2] then curs_posn = curs_posn - 1 end if
elsif key = left then curs_posn = curs_posn - 1 if curs_posn = 0 then curs_posn = 1 end if
elsif key = bksp then if curs_posn > 1 then and curs_posn <= length(input_field) then if length(input_field) < curs_posn then while length(input_field) < curs_posn do input_field = input_field & ' ' end while end if curs_posn = curs_posn -1 input_field = input_field[1..curs_posn-1] & input_field[curs_posn+1..length(input_field)] & ' ' end if
elsif key = insert then imode = not(imode) if imode = 1 then cursor(BLOCK_CURSOR) else cursor(UNDERLINE_CURSOR) end if
elsif key > 31 and key <129 then if imode then if curs_posn > length(input_field) then curs_posn = length(input_field)+1 input_field = input_field & key elsif curs_posn > length(input_field) and WORD_WRAP = 1 then move to the next field, taking the last word into the next field else input_field[curs_posn] = key end if curs_posn = curs_posn +1 else input_field = input_field[1..curs_posn-1] & key & input_field[curs_posn .. length(input_field)] curs_posn = curs_posn +1 if length(input_field) > fields[current_field+2] then input_field = input_field[1..fields[current_field+2]] end if
end if if curs_posn > fields[current_field+2] then curs_posn = curs_posn - 1 end if end if
if field_change = 1 then field_change = 0 MoveCursor(box[COORDS]+{offset+current_field/3, 1+start_field}) curs_posn = 1
end if
refresh the current field printcolor(box[COORDS]+{offset+current_field/3, 1+start_field}, {WHITE, BLACK}, input_field)
end while
write out last field fields[current_field+1] = input_field
for i =2 to field_count by 3 do result = append(result, fields[i] ) end for
return result
end function
global constant MF_TEXT = 1, MF_CHECK = 2, MF_LABEL = 3, MF_DROPLIST = 4, MF_BUTTON = 5
global procedure draw_MF(sequence title, sequence form_colors, integer form_row, integer form_col, sequence fields)
result = {} blank = {}
create box SetColors(form_colors[1], form_colors[2]) position(form_row, form_col) box = GenericBox(title, {})
for i = 1 to length(fields) do
labels if fields[i][1] = MF_LABEL then text entries if fields[i][1] = MF_TEXT then blank = repeat(' ', fields[i][4]) if length(fields[i][5]) > fields[i][4] then fields[i][5] = fields[i][5][1..fields[i][4]] end if printcolor({form_row + fields[i][2], form_col + fields[i][3]}, {BRIGHT_WHITE, BLACK}, blank) printcolor({form_row + fields[i][2], form_col + fields[i][3]}, {BRIGHT_WHITE, BLACK}, fields[i][5]) end if
check boxes if fields[i][1] = MF_CHECK then position(form_row + fields[i][2], form_col + fields[i][3]) printcolor({form_row + fields[i][2], form_col + fields[i][3]}, form_colors, "[ ] " & fields[i][5]) if fields[i][4] = 1 then position(form_row + fields[i][2], form_col + fields[i][3] + 1) puts(1, "X") end if end if
button if fields[i][1] = MF_BUTTON then
end for
end procedure
global function mf_text(sequence field, sequence form_colors, integer form_row, integer form_col)
sequence return_val, buffer, blank integer max_length, curs_posn atom c
return_val = {{}, 0} field[5] = Fdialogs_rts(field[5]) max_length = field[4] blank = repeat(' ', max_length) buffer = blank curs_posn = length(field[5]) + 1
if curs_posn > max_length then curs_posn = max_length end if if curs_posn = 0 then curs_posn = 1 end if
transfer field text to buffer if length(field[5]) > 0 then for i = 1 to max_length do if i > length(buffer) or i > length(field[5]) then exit end if buffer[i] = field[5][i]
while 1 do c = get_key() if c > 0 then if c = ENTER then return_val[2] = ENTER return_val[1] = buffer exit elsif c = ESC then return_val[2] = ESC return_val[1] = buffer exit elsif c = dn then return_val[2] = dn return_val[1] = buffer exit elsif c = up then return_val[2] = up return_val[1] = buffer exit elsif c = bksp then if curs_posn <= length(buffer) then buffer[curs_posn] = ' ' end if curs_posn -= 1 if curs_posn < 1 then curs_posn = 1 end if buffer[curs_posn] = ' ' printcolor({form_row + field[2], form_col + field[3]}, {BRIGHT_WHITE, BLACK}, buffer) position(form_row + field[2], form_col + field[3] + curs_posn -1 ) elsif c = right then curs_posn += 1 if curs_posn > length(buffer) then curs_posn -= 1 end if position(form_row + field[2], form_col + field[3] + curs_posn -1 ) elsif c = left then curs_posn -= 1 if curs_posn < 1 then curs_posn = 1 end if position(form_row + field[2], form_col + field[3] + curs_posn -1 ) elsif (c >= 'a' and c <= 'z') or (c >= 'A' and c <= 'Z') or (c
field[5] = Fdialogs_rts(buffer) return_val[1] = field
return return_val end function
global function mf_check(sequence field, sequence form_colors, integer form_row, integer form_col)
sequence return_val atom c
return_val = {{}, 0}
set cursor position position(form_row + field[2], form_col + field[3] + 1)
while 1 do c = get_key() if c > 0 then if c = dn or c = right then return_val[2] = dn exit elsif c = up or c = left then return_val[2] = up exit elsif c = ' ' or c = ENTER then field[4] = (field[4] - 1) * -1 if field[4] = 1 then printcolor({form_row + field[2], form_col + field[3] + 1}, form_colors, "X") else printcolor({form_row + field[2], form_col + field[3] + 1}, form_colors, " ") end if position(form_row + field[2], form_col + field[3] + 1) elsif c = ESC then return_val[2] = c exit end if end if end while
return_val[1] = field
return return_val end function
global function mf_droplist(sequence field, sequence form_colors, integer form_row, integer form_col)
sequence return_val, blank atom c integer orig
blank = {} return_val = {{}, 0} set cursor position position(form_row + field[2], form_col + field[3])
while 1 do c = get_key() if c > 0 then if c = ESC then return_val[2] = ESC exit elsif c = up then return_val[2] = up exit elsif c = dn then return_val[2] = dn exit elsif c = ' ' or c = ENTER then position(form_row + field[2], form_col + field[3]) SetSize(field[5], field[4]) SetColors(BLACK, WHITE) orig = field[7] field[7] = ListBoxIndex("", field[6], field[7]) if field[7] = -1 then field[7] = orig end if exit end if end if end while
return_val[1] = field
return return_val end function
function mf_button(sequence field, sequence form_colors, integer form_row, integer form_col)
sequence return_val, blank atom c integer orig
blank = {} return_val = {{}, 0} set cursor position position(form_row + field[2], form_col + field[3])
the input cycle
if c = ESC then return_val[2] = ESC exit elsif c = up or c = left then return_val[2] = up exit elsif c = dn or c = right then return_val[2] = dn exit elsif c = ENTER then return_val[2] = ENTER oh, what the hell, flash the button again! printcolor( {form_row + field[2], form_col + field[3] }, {WHITE, RED}, blank ) Delay(0.1) printcolor( {form_row + field[2], form_col + field[3] }, {form_colors[2], form_colors[1] }, blank ) exit elsif c > -1
