\ 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 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