'LOAD4DAY - test only

external   messbox() progress() getrec getday getftr lpath fgi bgi \
           fgp bgp wraptext() psa #days dpath

public     ptstr topmat

global     S_S_Format() TransJobs() linecount Navigate() \
           nextdatecell  thisdatecell thisline nextline InsertDayLine() x \
           newcell y1 y2 y3 y #appts z #bottom #fttrs #lines $sort \
           nextblock botmat

MAIN
single-step off
  screen clear box 1 1 25 80 0 0 no-border
  repaint off
  quiet on
  lpath = "C:\programs\lib\"
  load lpath|"displib.rf3" in-memory
  load lpath|"wraptext.rf3" in-memory
  #appts = 7
  load lpath|"uintlib.rf3" in-memory

  file load dpath|"4days"
' repaint on
'   S_S_Format()

  Navigate()

END MAIN

FUNCTION InsertDayLine()
' draw line across screen
  x = "ßßßßßßßßßßßßßßßßßßßßßßßß"		' ALT(223)
  newcell = "r"|str(topmat+1)|"c1"     'goto pos'n for transp'n of Record Nr
  sheet goto cell newcell
  ssput(x,topmat+1,1)
  edit copy right single-cell copies 9
  y = ""
  ssput(y,topmat+2,1)			' insert date/day in Cell 1
  ssput(y,topmat+2,2)
  y = upper(dayname(y2))
  ssput(y,topmat+2,3)
  y = date2(y2)
  ssput(y,topmat+2,4)
END FUNCTION 'InsertDayLine()


FUNCTION TransJobs()
local    i botmat nextblock cc cr
  for i = 1 to linecount
    topmat = i+2
    botmat = topmat + 6
    nextblock ="r"|str(topmat)|":"|str(botmat)|"c4"
    sheet matrix transpose nextblock   ' transpose Job Nr's

    newcell = "r"|str(topmat)|"c11"     'goto pos'n for transp'n of Record Nr
    sheet goto cell newcell
    nextblock ="r"|str(topmat)|":"|str(botmat)|"c11"
    sheet matrix transpose nextblock   ' transpose record Nr's

    newcell = "r"|str(topmat)|"c18"     'goto pos'n for transp'n of All_info
    sheet goto cell newcell
    nextblock ="r"|str(topmat)|":"|str(botmat)|"c18"
    sheet matrix transpose nextblock   ' transpose All_info

    newcell = "r"|str(topmat)|"c4"     'go back to prev. pos'n
    sheet goto cell newcell
    cursor down

    y1 = days(indirect(makecell(topmat+1,1)))
    y2 = days(indirect(makecell(topmat+7,1)))

    #bottom = (#fttrs+2)*#days
    if i = #bottom
      newcell = "r"|str(#bottom)|"c1"   ' 3 = appt line + 2 x daylines
      sheet goto cell newcell
      cursor down
      edit delete rows 10
      cursor up
      linecount = row
      exit for
    end if

    if y2 > y1
      edit delete rows 4
      InsertDayLine()
      cursor down
      cursor down
      i = i + 2
      linecount = linecount + 4  	' increase bottom row for lines not
					' deleted
    elseif y2 = y1
      edit delete rows 6
    end if
  end for
END FUNCTION ' TransJobs()


FUNCTION S_S_Format()                      ' set up format of s/s
  at r1c1
  edit insert columns 1
  sheet goto lower-edge                ' find Nr of rows in s/s
  #lines = row
  at r2c1
  enter formula "days(r2c2)"
  edit copy down single-cell copies #lines-2
  recalc
  nextblock = "r2:"|str(#lines)|"c1:19"
  edit sort nextblock ascending using column "1 4"
  edit delete columns 1

  window border
  window numbers row
  window numbers column

  sheet goto cell r1c1                 ' goto to first line & remove titles
  edit delete rows 1
  y = days(indirect(makecell(1,1)))
  edit insert rows 2
  y1 = upper(dayname(y))
  ssput(y1,2,3)
  y2 = date2(y)
  ssput(y2,2,4)
  sheet goto lower-edge                ' find Nr of rows in s/s and divide
  linecount = (row-2)/#appts           ' by Nr of Appts in day
  #fttrs = linecount/#days
  layout cell-size width 9 columns 1
  sheet goto cell r2c2                 ' goto to 2nd column & set & 5
  layout cell-size width 5 columns 1
  sheet goto cell r2c3                 ' goto to 3rd column & set & 16
  layout cell-size width 16 columns 1
  sheet goto cell r2c4                 ' goto to 4th column & centre Job_Nrs
  layout cell-size width 9 columns 7
  layout justify center columns 7
  TransJobs()
  at r1c1
  layout cell-size width 0 columns 2
END FUNCTION


FUNCTION Navigate()
local x j k l nextcell sortblock y y1 y2
  sheet lock all
  sheet goto cell r1c1
  window titles fix columns 3
  window titles fix rows 1
  window paint cells locked-cells background 0 foreground 15
  sheet goto upper-edge
  cursor down
  repaint on
  repaint

  while TRUE
    y2 = format("{Enter} for information or {R} to reserve appt","M80")
    y3 = format("{Esc} to quit","M80")
    screen clear box 1 1 1 80 15 9 no-border
    screen print 23 1 fgp bgp y2
    screen print 24 1 fgp bgp y3
    screen clear box 25 1 25 80 15 9 no-border

    x = inchar

    if x = {Up}
      if row = 3     ' stop cursor at row 3
        beep
        continue while
      end if
      cursor up

    elseif x = {Down}
      if row = linecount     ' stop cursor at last row
        beep
        continue while
      end if
      cursor down

    elseif x = {Right}
      if column = 10     ' check that cursor does not go to col 11
        beep
        continue while
      end if
      cursor right

    elseif x = {Left}
      if column = 4     ' check that cursor does not go to col 3
        beep
        continue while
      end if
      cursor left

    elseif x = {PgDn}
      j = row                     ' find present pos'n
      j = j + 20                  '
      if j > linecount
        sheet goto lower-edge
      else
        for y = 1 to 20
          cursor down
        end for
      end if
    elseif x = {PgUp}
      j = row                     ' find present pos'n
      j = j - 20                  ' go up 20 rows
      if j < 3                    ' ensure it does not goes above row 1
        sheet goto upper-edge
        cursor down
      else
        nextcell = "r"|str(j)|"c4"
        sheet goto cell nextcell
      end if

    elseif x = {^End}
      sheet goto lower-edge

    elseif x = {^Home}
      sheet goto upper-edge
      cursor down

    elseif x = {Enter}
      j = row                     ' find present pos'n
      k = column
      if indirect(makecell(j,k)) = "None"
        continue while
      elseif indirect(makecell(j,k)) = "SUNDAY"
        continue while
      elseif indirect(makecell(j,k)) = "BNKHOL"
        continue while
      elseif indirect(makecell(j,k)) = "ABSENT"
        continue while
      end if
      k = k + 14                  ' offset 14 cols to right for All_info
      z = indirect(makecell(j,k))
      if wraptext(10,22,15,58,fgp,10,z,"M",1,1,0) = 0
        wait 4
        screen shortrestore psa
      end if

    elseif x = {R} or x = {r}     ' select Appointment and return to dbase
      j = row                     ' find present pos'n
      k = column
      z = indirect(makecell(j,k))
      if z !! "None"
        continue while
      end if
      k = k + 7                   ' offset 7 cols to right for record nr

      getday = indirect(makecell(j,1))
      getftr = indirect(makecell(j,3))
      z = k - 10
      getrec = z
      x = messbox(" Reserve appt nr"&str(z)&"for"&getftr&"on"&getday|"? (y/n)",1,1,1)
      if ptstr == "y"
        quit database project-file "retappt2.rf3"
      else
        continue while
      end if
    elseif x = {Esc}
      messbox(" Finished? (y/n) ",1,1,1)
      if ptstr == "y"
        quit database project-file "retappt1.rf3"
      else
        continue while
      end if
      exit while
    end if
  end while
END FUNCTION

