\ Clean a drive by trying to format several cylinders
\ on a fibre cleaning disk
\ The last cylinder used will be kept in a file called
\   HEADCLEAN.LOG

\ Author: Phil Burk
\ Copyright 1987,8,9 Phil Burk
\
\ This program is a freely redistributable shareware program.

\ Files from HeadClean Directory
include? td.format disk_support
include? tdt.init disk_tools
include? gt.process.events gadget_tools
include? $hc.msg hc_base
include? drive.buttons.init hc_drive_gads

ANEW TASK-HeadClean

\ ----------------------------------------------------
\ Graphical User Interface Portion of code.

\ Support for GO gadget.
: HC.ALL.USED ( -- )
    " This disk is used up. You may want to buy a new one."
    $HC.MSG
    0 clean-start !
;

: CHECK.START ( -- , correct start cylinder if bad )
    clean-start @ NUMCYLS 1- clean_#cyl - >
    IF hc.all.used
    THEN
;

: HC.GO  ( -- , clean disk
    check.start
    <headclean>
    check.start
;

\ ------------------------------------------------
\ Support for HELP gadget.
variable HC-CURY

: HC.LINE  ( text -- , new line of graphics )
    10 hc-cury @ gr.move
    gr.text
    hc_line_height hc-cury +!
;

variable HC-WINDOW

: HC.HELP.TEXT1 ( -- , display first help screen )
    1 gr.color!
    hc_banner_y1 hc-cury !  ( set y pos )
    " HeadClean V2.0 is designed to work with any fibre" hc.line    
    " cleaning disk.  Read directions for your cleaning" hc.line
    " disk first.  Then apply cleaning liquid and place" hc.line
    " disk in drive to be cleaned. Then select drive" hc.line
    " with mouse and select 'GO!'. Every cleaning will" hc.line
    " use 4 cylinders of the disk. The next cylinder" hc.line
    " to use will be written to the file HeadClean.LOG." hc.line
    " When every cylinder has been used you may want" hc.line
    " to buy a new cleaning disk, or keep using it over" hc.line
    " and over.  Clean your heads after every 40 hours" hc.line
    " of use, or if you start getting Read/Write errors." hc.line
    "  " hc.line
    " Click in CloseBox to continue" hc.line
;

: HC.HELP.TEXT2 ( -- )
    gr.clear
    1 gr.color!
    hc_banner_y1 hc-cury !
    " HeadClean was written using JForth Professional 2.0," hc.line
    " a powerful and fast interactive programming language." hc.line
    " For more information, write or phone:" hc.line
    3 gr.color!
    "  " hc.line
    "     Delta Research" hc.line
    "     P.O. Box 1051" hc.line
    "     San Rafael, CA, 94915" hc.line
    "     (415) 485-6867" hc.line
    "  " hc.line
    1 gr.color!
    " HeadClean V2.0 is shareware.  If you find this" hc.line
    " program useful please send a check for $10.00" hc.line
    " payable to Phil Burk at the above address." hc.line
    " HeadClean V2.0 may be freely restributed." hc.line
;

newWindow HC-NewWindow

: HC.HELP ( -- , Draw explanatory help in separate window )
    hc-newwindow newwindow.setup
    hc_window_w hc-NewWindow ..! nw_width
    160 hc-NewWindow ..! nw_height
\ Set new title.
    0" HeadClean Help"
        >abs  hc-NewWindow ..! nw_title
\
    hc-NewWindow gr.opencurw
    IF  hc.help.text1
        BEGIN ?closebox
        UNTIL
        hc.help.text2
        BEGIN ?closebox
        UNTIL
        gr.closecurw
\
        hc-window @ ?dup
        IF gr.set.curwindow
        THEN
    ELSE " Insufficient memory for HELP window!" $hc.msg
    THEN
;

\ Main Graphics support --------------------------------
: HC.DRAW.BANNER ( -- )
    1 gr.color!
    hc_banner_y1 hc-cury !
    " Written by Phil Burk using JForth Professional 2.0"
    hc.line
    " from Delta Research, Box 1051, San Rafael, CA, 94915"
    hc.line
    " Select which drive to clean, then hit 'GO!'."
    hc.line
;

: HC.REDRAW  ( -- , redraw graphics )
    gr.clear
    1 gr.color!
    hc.draw.banner
    hc.report.left
    hc.show.drive
    gt.refresh
;

: HC.GADS.INIT ( -- , initialize gadgets for demo )
\  define border of gadgets.
    boolg-xys >abs boolg-border ..! bd_xy
    hc_w_h boolg-border border.setup
\
\ Declare text, CFA, and size for each gadget.
    0 first-gadget !
    ' hc.go      0" Go!"
    hc_gadget_x hc_gadget_inc 5 * + hc_gadget_y hc_w_h  gt.gad.make
    ' hc.help    0" Help"
    hc_gadget_x hc_gadget_inc 6 * + hc_gadget_y hc_w_h  gt.gad.make
\
    drive.buttons.init
\
\ Set defaults for newwindow
    hc-NewWindow newwindow.setup
    hc_window_w hc-NewWindow ..! nw_width
    hc_window_h hc-NewWindow ..! nw_height
\
\ Link gadget list to window.
    first-gadget @ >abs hc-NewWindow ..! nw_firstgadget
\
\ Set new title.
    0" -< HeadClean V2.0 -- Shareware >-"
        >abs  hc-NewWindow ..! nw_title
\
\ Set flags for gadget events.
    CLOSEWINDOW  GADGETDOWN | GADGETUP |
    hc-NewWindow ..! nw_idcmpflags
;

: HC.LOOP  ( -- , process mouse events until done )
    BEGIN
        gr-curwindow @ ev.wait
        gr-curwindow @ ev.getclass dup
        IF gt.process.event ( -- done? )
        THEN
    UNTIL
;

\ Read and write starting cylinder to a log file --------------
: HC_FILENAME ( -- $name )
    " RAM:HeadClean.log"
;

: HC.READ.START ( -- , read start from log file or set to -1 )
    hc_filename $fopen ?dup
    IF  dup clean-start 4 fread 4 -  ( unformatted 4 byte read )
        IF " Could not find HeadClean.log file. Start at 0"
           $HC.MSG
           0 clean-start !
        THEN
        fclose
    ELSE  " Could not find HeadClean.log file. Start at 0"
           $HC.MSG
           0 clean-start !
    THEN
;

: HC.WRITE.START ( -- , write start to log file or set to -1 )
    new hc_filename $fopen ?dup
    IF  dup clean-start 4 fwrite drop  ( unformatted 4 byte read )
        fclose
    THEN
;

\ Main control words ----------------------------
\ I strongly recommend structuring your programs
\ with a separate INIT and TERM word
\ and a simple Main word that does both.
\ This greatly simplifies testing bacause
\ you can INIT completely then test interactively
\ withou running the program.
    
: HC.INIT  ( -- ok? , initialize EVERYTHING )
    gr.init
    hc.gads.init
    hc-NewWindow gr.opencurw dup
    IF  gr-curwindow @ hc-window !
        hc.read.start
        check.start
        arrow.init
        0 hc.drive
	hc.redraw
    THEN
;

: HC.TERM ( -- , clean up SAFELY )
    arrow.term
    gr.closecurw
    hc-window off
    hc.write.start
    gt.free.all
;

: HEADCLEAN ( -- , main entry point )
    hc.init
    IF  hc.loop
    THEN
    hc.term
;

\ Automatically clean up if FORGET used.
if.forgotten HC.TERM

cr ." Enter:   HEADCLEAN     to clean drive heads." cr
