home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Fred Fish Collection 1.5
/
ffcollection-1-5-1992-11.iso
/
ff_disks
/
200-299
/
ff239.lzh
/
JGoodies
/
HeadClean
/
hc_base
< prev
next >
Wrap
Text File
|
1989-08-21
|
3KB
|
113 lines
\ Layout for HeadClean plus actual Cleaning words
\
\ Author: Phil Burk
\ Copyright 1987,8,9 Phil Burk
\
\ This program is a freely redistributable shareware program.
ANEW TASK-HC_BASE
80 constant NUMCYLS
\ Specify layout of window by defining constants
20 constant HC_BANNER_Y1
10 constant HC_LINE_HEIGHT
50 constant HC_SHOW_Y
10 constant HC_GADGET_X
hc_show_y 18 + constant HC_GADGET_Y
40 constant HC_GADGET_W
13 constant HC_GADGET_H
50 constant HC_GADGET_INC
110 constant HC_MSG_Y
440 constant HC_WINDOW_W
120 constant HC_WINDOW_H
: HC_W_H hc_gadget_w hc_gadget_h ;
\ Output messages graphically in special area. ----------
: HC.BLANK ( -- , clear message area )
2 gr.color!
10 hc_msg_y gr.move
5 hc_msg_y 12 - hc_window_w 10 - hc_msg_y 4 + gr.rect
;
: HC.TYPE ( addr count -- , output some text )
gr-curwindow @
IF 1 gr.color!
JAM1 gr.mode! \ don't clear background
gr.type
ELSE \ just type it out if no window
type cr
THEN
;
: $HC.MSG ( $string -- , clear area & display message )
gr-curwindow @
IF hc.blank
THEN
count hc.type
;
\ --------------------------------------------------------
\ This portion of the Code is concerned with actually
\ cleaning the disk.
variable CLEAN-DRIVE ( which drive to clean 0,1,2,3 )
variable CLEAN-START ( which cylinder to start on )
4 constant CLEAN_#CYL ( # of cylinders to format each pass )
6 constant CLEAN_#PASSES
: DELAY() ( #ticks -- , wait )
1 max callvoid dos_lib delay
;
\ Format a band of cylinders several times.
: CLEAN ( start #cyl many -- ok? )
tdt.unformatted? not
IF " Warning - not a fibre cleaning disk in drive!!" $hc.msg
drop 2drop false
ELSE 0
DO " Cylinders: " $hc.msg
2dup 0
DO dup i + n>text hc.type " ," count hc.type
LOOP drop
" Pass: " count hc.type i n>text hc.type
\
2dup tdt.format.cyl.many
LOOP 2drop true
THEN
;
: HC.REPORT.LEFT ( -- , report how many cylinders are left )
" Cleaning disk has " $hc.msg
numcyls clean-start @ - clean_#cyl / ( number of cleanings )
n>text hc.type
" cleanings left." count hc.type
;
: HC.SETTLE ( #ticks -- , give disk time to settle )
10 / dup 0
DO " Validating: " $hc.msg
dup i - n>text hc.type
10 delay()
LOOP drop
;
: <HEADCLEAN> ( -- ok? , clean based on variables )
200 hc.settle
clean-drive @ tdt.init
IF clean-start @
clean_#cyl
clean_#passes
clean
IF clean_#cyl clean-start +!
hc.report.left true
ELSE false
THEN
tdt.term
ELSE " Error accessing that drive!" $hc.msg false
THEN
;