Support Forum / Форум поддержки

Code: Select all

' "Scrabble words"
' by Henko, version 1 , march 24, 2014
' with this app you can store words with "difficult" caracters like x,y,q
' etc. the words are kept in a list on alphabetic order, filters may be
' applied to search for specific words.
' Words may be added by typing them in the input field and push the "add"
' button. Deletion of a word is done by selecting the word in the list
' and then hitting the "del" button. Deletion only functions if none of
' the filter buttons is active. Filter buttons are toggle switches.
' Filters use the AND mechanism: only words are shown which contain
' all of the letters from the active filters.
' 2 additional letter filters can easily be added by filling them in in
' the DATA statement somewhere in the middle of the code.
' The words are kept in a file which is updated immediately after each
' modification, so there is no need for a save button or save warning.
'
dim ftok$(8)
maxw=1000
dim w$(maxw),wsel$(maxw),filter(8)
init_app
loop:

sel=list_selected("ind")
if sel>-1 then
  ksel=sel
  field "inp" set text wsel$(sel) ! list "ind" set selection -1
  end if

if ksel>-1 and fstat=0 and nw>0 and button_pressed("del") then
  changed=1
  if nw=1 or ksel=nw then
    w$(nw)="" ! nw-=1
    else
    for i=ksel to nw-1 ! w$(i)=w$(i+1) ! next i
    w$(nw)="" ! nw-=1
    end if
  build_list ! field "inp" set text ""
  end if

fstat=0 ! bl=0
for i=1 to ntok
  n$="tok" & i
  if button_pressed(n$) then
    filter(i)=1-filter(i) ! bl=1
    if filter(i) then
      button n$ set title capstr$(ftok$(i)) & " on"
      else
      button n$ set title ftok$(i)
      end if
    end if
  fstat += filter(i)
  next i
if bl then build_list

z$=field_text$("inp")
if button_pressed ("add") and nw<maxw and z$>"" then
  changed=1
  for i=1 to nw ! if z$>w$(i) then continue
    ksel=i ! goto lab1
    next i
  ksel=nw+1
lab1:
  if ksel<=nw then
    for k=nw to ksel step-1 ! w$(k+1)=w$(k) ! next k
    end if
  w$(ksel)=z$ ! nw+=1 ! build_list ! field "inp" set text ""
  end if
if changed then ! savewords ! changed=0 ! end if

goto loop
end

def init_app
option base 1 ! changed=0
.sw=320 ! .sh=436
graphics ! graphics clear .8,.8,.8
fill color .8,.8,.8
draw font size 16
for i=1 to 8 ! read .ftok$(i) ! next i
DATA "c","q","u","w","x","y","",""
do ! .ntok+=1 ! until .ntok=9 or .ftok$(.ntok)="" ! .ntok-=1
w_open ("Scrabble words",10,10,.sw-10,.sh-10)
field "inp" text "" at 15,42 size 183,40
button "add" title "<- Add" at 204,46 size 100,32
draw color .8,0,0 ! draw text "filters" at 224,88
for i=1 to 8 
  button "tok" & i title .ftok$(i) at 230,80+33*i size 52,24
  next i
button "del" title "Delete" at 204,388 size 100,32
loadwords ! build_list
end def


def loadwords()
if file_exists("worddata") then
  file "worddata" input .nw
  for i=1 to .nw ! file "worddata" input .w$(i) ! next i
  end if
end def

def savewords()
if file_exists("worddata") then file "worddata" delete
file "worddata" print .nw
for i=1 to .nw ! file "worddata" print .w$(i) ! next i
end def

def build_list
if .nw then
  nk=0
  for i=1 to .nw
    wrd$=.w$(i)
    if .fstat=0 then goto b_lab1
    for j=1 to .ntok
      if not .filter(j) then continue j
      if instr(wrd$,.ftok$(j))=-1 then continue i
      next j
    b_lab1: nk+=1 ! .wsel$(nk)=wrd$
    next i
  end if
if nk then
  dim lind$(nk)
  for i=1 to nk ! lind$(i)=.wsel$(i) ! next i
  else
  dim lind$(1) ! lind$(1)=""
  end if
list "ind" text lind$ at 16,90 size 183,330
draw color 0,0,1 ! draw size 2 ! draw rect 15,89 to 200,421
draw color 0,0,0 
end def

def w_open (title$,xtop,ytop,xbot,ybot)
r=10 ! draw color 0,0,0 ! draw size 4
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
if title$<>"" then
  l=(xbot-xtop-10*len(title$))/2
  draw line xtop,ytop+24 to xbot,ytop+24
  draw color 0,0,1
  draw text title$ at xtop+l,ytop+4
  draw color 0,0,0
end if
end def