public profile := array(96) public defprof := array(96) public next7days := array(7) public next7profs := array(7) public timarray public tops public bots public version := "1.6" public dbname := "profile" public thisprof // New in this version(1.3): Improved screen layout. // Retains today's profile name until edit // Optional loop counter (LEFT-SHIFT to activate) // Bar to indicate progress through current slot // V 1.4: Block letters for current time, so it's legible on the Tosh // V 1.5: tone indicates whether switching on or off. Midnight bug fixed. // V 1.6: tones doubled for clarity. 7 day program. Tab through edit. // larger, faster ticker set cursor off set scoreboard off fill_arrays() paintscreen() use (dbname) afill(profile, 0) setup_week() load_profname(cdow(date())) timeloop() QUIT ////////////////////////////////////////////////////////////////////////// function timeloop() local done := .F. local last_slot := 1 local last_seconds := 1 local lcount := 0 local current_slot, this_seconds, x local this_qsecs := 1 local last_qsecs := 1 current_slot := int((seconds()/900) + 1) change_state(0, current_slot) do while .not.done x := inkey() do case case x == asc("e") .or. x == asc("E") editprofile(current_slot) @ scr_todaych-3, 12 say space(16) change_state(0, current_slot) case x == asc("s") .or. x == asc("S") saveprofile() case x == asc("p") .or. x == asc("P") do7dayprogram() case x == asc("l") .or. x == asc("L") loadprofile() for i := 1 to 96 show_setting(profile, i, .T.) next @ scr_todaych-3, 12 say thisprof change_state(0, current_slot) case x == 27 // ESC done := quitcheck() case x == 28 // F1 help_timeloop() endcase this_seconds := int(seconds()) this_qsecs := int(4*seconds()) current_slot := int((this_seconds/900) + 1) if current_slot <> last_slot if current_slot == 1 load_profname(next7profs[1]) advance_7days() endif change_state(last_slot, current_slot) endif if this_seconds <> last_seconds // @ scr_tnowlin, scr_tnowcol say time() ticker(this_seconds, this_qsecs) showtime() if isbit(kbdstat(), 2) @ 23, 2 say lcount else @ 23, 2 say space(10) endif lcount := 0 else lcount++ endif last_seconds := this_seconds last_qsecs := this_qsecs last_slot := current_slot enddo return NIL function paintscreen() public scr_timoffset := 25 public scr_todaych := 13 public scr_todayhw := 14 public scr_todaytim := 15 public scr_seltime := 17 public scr_chstatel := 19 public scr_hwstatel := 20 public scr_statecol := 53 public scr_tnowlin := 19 public scr_tnowcol := 9 public scr_messlin := 23 public scr_slotlin := 17 public scr_slotbar := 27 cls @ 0, 0 say "旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커" @ 1, 0 say "� Boiler v �" @ 2, 0 say "� �" @ 3, 0 say "� �" @ 4, 0 say "� �" @ 5, 0 say "� �" @ 6, 0 say "� �" @ 7, 0 say "� �" @ 8, 0 say "� �" @ 9, 0 say "� �" @ 10, 0 say "� Today: 1 1 1 1 1 1 �" @ 11, 0 say "� 0 1 2 3 4 5 6 7 8 9 0 1 2 1 2 3 4 5 6 7 8 9 0 1 2 �" @ 12, 0 say "� 憫컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨컨� �" @ 13, 0 say "� CH � � �" @ 14, 0 say "� HW � � �" @ 15, 0 say "� 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� �" @ 16, 0 say "� _____________________ �" @ 17, 0 say "� Slot: 같같같같같같같같같같같같같같같같같같같같같같� �" @ 18, 0 say "� �" @ 19, 0 say "� Time: � � Cent Heating: �" @ 20, 0 say "� � � Boiler: �" @ 21, 0 say "� �" @ 22, 0 say "쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴캑" @ 23, 0 say "� �" @ 24, 0 say "읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸" @ 1, 11 say version return NIL function editprofile(selected_time) local done := .F. local n if pcount() < 1 selected_time := 1 // just gone midnight endif @ scr_todaych , 3 say "幡�" @ scr_todaych+1, 3 say "幡 " @ scr_todaych+2, 3 say "賽�" show_selected_time(selected_time) do while .not.done n=inkey(0) message() do case case n == asc("1") profile[selected_time] := 1 show_setting(profile, selected_time, .T.) selected_time := advance_seltime(selected_time) case n == asc("3") profile[selected_time] := 3 show_setting(profile, selected_time, .T.) selected_time := advance_seltime(selected_time) case n == asc("0") profile[selected_time] := 0 show_setting(profile, selected_time, .T.) selected_time := advance_seltime(selected_time) case n == asc(" ") profile[selected_time] := 0 show_setting(profile, selected_time, .T.) selected_time := advance_seltime(selected_time) case n == 19 // left arrow clear_selected_time(selected_time) if selected_time == 1 selected_time := 96 else selected_time-- endif show_selected_time(selected_time) case n == 4 // right arrow selected_time := advance_seltime(selected_time) case n == 9 // Tab clear_selected_time(selected_time) selected_time := (4*int((selected_time+4)/4))+1 if selected_time > 96 selected_time := selected_time - 96 endif show_selected_time(selected_time) case n == 271 // shift-Tab clear_selected_time(selected_time) if selected_time < 4 selected_time := selected_time + 96 endif selected_time := (4*int((selected_time-4)/4))+1 show_selected_time(selected_time) case n == 13 done := .T. otherwise message("Bad key") endcase enddo clear_selected_time(selected_time) @ scr_todaych , 3 say " " @ scr_todaych+1, 3 say " " @ scr_todaych+2, 3 say " " return NIL function message(messtext) if pcount() == 0 messtext := "" endif messtext := padr(messtext,70) @ scr_messlin, 5 say messtext return NIL function show_selected_time(seltime) memvar timarray local chrpos @ scr_slotlin, scr_tnowcol say timarray[seltime] chrpos := int(seltime/2) if chrpos == seltime/2 @ scr_todaytim, scr_timoffset+chrpos say "�" else @ scr_todaytim, scr_timoffset+chrpos say "�" endif return NIL function clear_selected_time(seltime) local chrpos chrpos := int(seltime/2) @ scr_todaytim, scr_timoffset+chrpos say "�" return NIL function show_setting(settings, seltime, today) // TODAY == .T. of we're showing today's time, .F. for program. local chrpos, set1, set2, lin1, lin2 memvar tops, bots chrpos := int(seltime/2) if today lin1 := scr_todaych lin2 := scr_todayhw else lin1 := scr_progch lin2 := scr_proghw endif do case case seltime == 1 set1 := 0 set2 := settings[seltime] case seltime == 96 set1 := settings[seltime] set2 := 0 otherwise if chrpos == seltime/2 set1 := settings[seltime] set2 := settings[seltime + 1] else set1 := settings[seltime - 1] set2 := settings[seltime] endif endcase @ lin1, scr_timoffset+chrpos say tops[1+set1][1+set2] @ lin2, scr_timoffset+chrpos say bots[1+set1][1+set2] return NIL function change_state(prevtime,seltime) local ch, hw clear_selected_time(prevtime) show_selected_time(seltime) if prevtime == 0 .or. profile[seltime] <> profile[prevtime] do case case profile[seltime] == 0 ch := .F. hw := .F. case profile[seltime] == 1 ch := .F. hw := .T. case profile[seltime] == 3 ch := .T. hw := .T. endcase turn_ch(ch) turn_hw(hw) endif return NIL function turn_ch(state) if state @ scr_chstatel,scr_statecol say " 栢栢 ON 栢栢 " else @ scr_chstatel,scr_statecol say "쳐컴� OFF 컴캑" endif com_dtr(1,state) return NIL function turn_hw(state) if state @ scr_hwstatel,scr_statecol say " 栢栢 ON 栢栢 " tone(261,1) tone(523,1) else @ scr_hwstatel,scr_statecol say "쳐컴� OFF 컴캑" tone(523,1) tone(261,1) endif com_rts(1,state) return NIL function fill_arrays() memvar tops, bots, timarray defprof := afill(defprof, 0) tops := { ; {" ", " ", "X", "�"},; {" ", " ", "X", "�"},; {"X", "X", "X", "X"},; {"�", "�", "X", "�"} ; } bots := { ; {" ", "�", "X", "�"},; {"�", "�", "X", "�"},; {"X", "X", "X", "X"},; {"�", "�", "X", "�"} ; } timarray := { ; "00:00 - 00:15" , ; "00:15 - 00:30" , ; "00:30 - 00:45" , ; "00:45 - 01:00" , ; "01:00 - 01:15" , ; "01:15 - 01:30" , ; "01:30 - 01:45" , ; "01:45 - 02:00" , ; "02:00 - 02:15" , ; "02:15 - 02:30" , ; "02:30 - 02:45" , ; "02:45 - 03:00" , ; "03:00 - 03:15" , ; "03:15 - 03:30" , ; "03:30 - 03:45" , ; "03:45 - 04:00" , ; "04:00 - 04:15" , ; "04:15 - 04:30" , ; "04:30 - 04:45" , ; "04:45 - 05:00" , ; "05:00 - 05:15" , ; "05:15 - 05:30" , ; "05:30 - 05:45" , ; "05:45 - 06:00" , ; "06:00 - 06:15" , ; "06:15 - 06:30" , ; "06:30 - 06:45" , ; "06:45 - 07:00" , ; "07:00 - 07:15" , ; "07:15 - 07:30" , ; "07:30 - 07:45" , ; "07:45 - 08:00" , ; "08:00 - 08:15" , ; "08:15 - 08:30" , ; "08:30 - 08:45" , ; "08:45 - 09:00" , ; "09:00 - 09:15" , ; "09:15 - 09:30" , ; "09:30 - 09:45" , ; "09:45 - 10:00" , ; "10:00 - 10:15" , ; "10:15 - 10:30" , ; "10:30 - 10:45" , ; "10:45 - 11:00" , ; "11:00 - 11:15" , ; "11:15 - 11:30" , ; "11:30 - 11:45" , ; "11:45 - 12:00" , ; "12:00 - 12:15" , ; "12:15 - 12:30" , ; "12:30 - 12:45" , ; "12:45 - 13:00" , ; "13:00 - 13:15" , ; "13:15 - 13:30" , ; "13:30 - 13:45" , ; "13:45 - 14:00" , ; "14:00 - 14:15" , ; "14:15 - 14:30" , ; "14:30 - 14:45" , ; "14:45 - 15:00" , ; "15:00 - 15:15" , ; "15:15 - 15:30" , ; "15:30 - 15:45" , ; "15:45 - 16:00" , ; "16:00 - 16:15" , ; "16:15 - 16:30" , ; "16:30 - 16:45" , ; "16:45 - 17:00" , ; "17:00 - 17:15" , ; "17:15 - 17:30" , ; "17:30 - 17:45" , ; "17:45 - 18:00" , ; "18:00 - 18:15" , ; "18:15 - 18:30" , ; "18:30 - 18:45" , ; "18:45 - 19:00" , ; "19:00 - 19:15" , ; "19:15 - 19:30" , ; "19:30 - 19:45" , ; "19:45 - 20:00" , ; "20:00 - 20:15" , ; "20:15 - 20:30" , ; "20:30 - 20:45" , ; "20:45 - 21:00" , ; "21:00 - 21:15" , ; "21:15 - 21:30" , ; "21:30 - 21:45" , ; "21:45 - 22:00" , ; "22:00 - 22:15" , ; "22:15 - 22:30" , ; "22:30 - 22:45" , ; "22:45 - 23:00" , ; "23:00 - 23:15" , ; "23:15 - 23:30" , ; "23:30 - 23:45" , ; "23:45 - 24:00" ; } return NIL function quitcheck() local x, retval message("Sorry, but I really must check. Do you really want to quit? Y/N") x := inkey(0) if x == asc("y") retval := .T. else retval := .F. endif message() return RETVAL function advance_seltime(selected_time) clear_selected_time(selected_time) if selected_time == 96 selected_time := 1 else selected_time++ endif show_selected_time(selected_time) return SELECTED_TIME function ticker(secs, qsecs) local thruslot local remainder := (qsecs%4) @ 3, 60 say "幡賽賽賞" @ 4, 60 say "� �" @ 5, 60 say "� �" @ 6, 60 say "白複複蔔" millisec(50) @ 3, 60 say " 複複複 " @ 4, 60 say " � � " @ 5, 60 say " � � " @ 6, 60 say " 賽賽賽 " millisec(50) @ 3, 60 say " " @ 4, 60 say " 幡賞 " @ 5, 60 say " 白蔔 " @ 6, 60 say " " millisec(50) @ 3, 60 say " " @ 4, 60 say " 複 " @ 5, 60 say " 賽 " @ 6, 60 say " " millisec(50) @ 4, 60 say " " @ 5, 60 say " " thruslot := secs%900 thruslot := int(thruslot/20) if thruslot == 0 @ scr_slotlin, scr_slotbar say replicate("�", 45) else @ scr_slotlin, scr_slotbar say replicate("�", thruslot) endif return NIL function getrecno(header) local oldscreen, brcol, brobj, done, x go top oldscreen := savescreen(2, 29, 22, 51) brcol := tbcolumnnew("", {||profname} ) brcol:heading := header brcol:headsep := "�" brobj := tbrowsedb(3, 30, 21, 50) @ 2,29 to 22,51 double brobj:addcolumn(brcol) done := .F. do while .not.done do while .not.brobj:stable brobj:stabilize() enddo x := inkey(0) do case case x == 5 // uparrow brobj:up() case x == 24 // down arrow brobj:down() case x == 1 // home brobj:gotop() case x == 6 // end brobj:gobottom() case x == 18 // page up brobj:pageup() case x == 3 // page down brobj:pagedown() case x == 13 //Enter done := .T. endcase enddo restscreen(2, 29, 22, 51, oldscreen) return NIL function saveprofile() local thisname getrecno("Save") thisname := profname set cursor on message("Name of profile:") @ scr_messlin, 40 get thisname read set cursor off message() replace profname with thisname for i := 1 to 96 fieldput(i, profile[i]) next if recno() == lastrec() append blank replace profname with "NEW PROFILE" endif return NIL function loadprofile() getrecno("Load") for i := 1 to 96 profile[i] := fieldget(i) next thisprof := profname return NIL function help_timeloop() oldscreen := savescreen(5, 10, 19, 70) @ 5,10 clear to 19,70 @ 5,10 to 19,70 double @ 6, 12 say " HELP" @ 8, 12 say " E - Edit today's profile" @ 9, 12 say " L - Load a profile from disk" @ 10, 12 say " S - Save today's profile to disk" @ 11, 12 say " R - Reset today's profile to current default" @ 13, 12 say " Press a key to return to program..." inkey(0) restscreen( 5, 10, 19, 70, oldscreen) return NIL function showtime() static number := { {"幡�","� �","賽�"} ,; {" � "," � "," � "} ,; {"賽�","幡�","賽�"} ,; {"賽�"," 賞","賽�"} ,; {"� ","白�"," �"} ,; {"幡�","賽�","賽�"} ,; {"幡�","幡�","賽�"} ,; {"幡�"," �"," �"} ,; {"幡�","幡�","賽�"} ,; {"幡�","賽�","賽�"} } local now := time() local h1 := 1 + val(substr(now, 1, 1)) local h2 := 1 + val(substr(now, 2, 1)) local m1 := 1 + val(substr(now, 4, 1)) local m2 := 1 + val(substr(now, 5, 1)) local s1 := 1 + val(substr(now, 7, 1)) local s2 := 1 + val(substr(now, 8, 1)) for i := 1 to 3 @ 18+i, 9 say number[h1][i] @ 18+i,13 say number[h2][i] @ 18+i,19 say number[m1][i] @ 18+i,23 say number[m2][i] @ 18+i,29 say number[s1][i] @ 18+i,33 say number[s2][i] next return NIL function setup_week() local i for i := 1 to 7 next7days[i] := left(cdow(date()+i), 3) +" " next7days[i] += str(day(date()+i),2) +" " next7days[i] += left(cmonth(date()+i), 3) +" " next7profs[i] := padr(cdow(date()+i), 20) @ 1+i, 25 say next7days[i] @ 1+i, 38 say next7profs[i] next return NIL function load_profname(nametoload) local done := .F. local profrec := 1 go top do while .not.done if alltrim(upper(profname)) == alltrim(upper(nametoload)) done := .T. profrec := recno() endif skip if eof() done := .T. endif enddo go profrec for i := 1 to 96 profile[i] := fieldget(i) show_setting(profile, i, .T.) next thisprof := profname @ scr_todaych-3, 12 say thisprof return NIL function advance_7days() local i for i := 1 to 7 if i == 7 next7days[i] := left(cdow(date()+i), 3) +" " next7days[i] += str(day(date()+i),2) +" " next7days[i] += left(cmonth(date()+i), 3) +" " next7profs[i] := padr(cdow(date()+i), 20) else next7days[i] := next7days[i+1] next7profs[i] := next7profs[i+1] endif @ 1+i, 25 say next7days[i] @ 1+i, 38 say next7profs[i] next return NIL function do7dayprogram() local selecday := achoice(2,25, 8, 36, next7days) getrecno(next7days[selecday]) next7profs[selecday] := profname @ 1+selecday, 38 say next7profs[selecday] return NIL