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_drive_gads
< prev
next >
Wrap
Text File
|
1989-08-21
|
3KB
|
135 lines
\ Drive Gadgets for HeadClean
\
\ Author: Phil Burk
\ Copyright 1987,8,9 Phil Burk
\
\ This program is a freely redistributable shareware program.
ANEW TASK-HC_DRIVE_GADS
\ Use an arrow to point to the chosen disk drive.--------------
\ This is an Intuition Image structure.
Image ARROW-IMAGE
\ Define bitmap for arrow
create ARROW-BITS
BINARY \ Enter bits in binary, base 2
\ 0123456789ABCDEF
here
0011111111100000 w,
0001111111000000 w,
0000111110000000 w,
0000111110000000 w,
0000111110000000 w,
0000111110000000 w,
1000111110001000 w,
1111111111111000 w,
0111111111110000 w,
0011111111100000 w,
0001111111000000 w,
0000111110000000 w,
0000011100000000 w,
0000001000000000 w,
here swap - 2/ constant ARROW_HEIGHT ( calculate how many rows )
DECIMAL
variable ARROW-BITS-PTR
: ARROW.INIT ( -- , setup IntuiImage )
\ Try to copy image to CHIP RAM for use by Graphics Chips
memf_chip arrow_height 2* allocblock ?dup
IF dup arrow-bits-ptr !
arrow-bits-ptr @ >abs arrow-image ..! ig_imagedata
arrow-bits swap arrow_height 2* cmove
ELSE \ Just use garbage data cuz couldn't alloc RAM for copy
8 arrow-image ..! ig_imagedata
THEN
\
13 arrow-image ..! ig_width
arrow_height arrow-image ..! ig_height
1 arrow-image ..! ig_depth
\
\ Draw using color 1
1 arrow-image ..! ig_PlanePick
NULL arrow-image ..! ig_NextImage
;
: ARROW.TERM ( -- , deallocate image in CHIP RAM )
arrow-bits-ptr @ ?dup
IF freeblock arrow-bits-ptr off
THEN
;
: DRAW.ARROW ( x y -- , draw arrow to show which drive is active )
>r >r
gr-currport @ ( rastport already absolute for speed )
arrow-image >abs ( use absolute address )
r> r>
callvoid Intuition_lib DrawImage
;
: HC.POINT.DRIVE ( drive# color -- , make arrow point to drive )
arrow-image ..! ig_PlanePick
hc_gadget_inc * hc_gadget_x +
10 + hc_show_y draw.arrow
;
: XY+ ( x y xinc yinc -- x' y' )
rot + >r
+ r>
;
: HC.MARK.DRIVE ( drive# -- , mark with a check to show cleaned )
hc_gadget_inc * hc_gadget_x + 10 +
hc_gadget_y hc_gadget_h + 9 + ( starting x,y )
2dup gr.move 3 gr.color!
3 5 xy+ 2dup gr.draw
6 -10 xy+ gr.draw
1 gr.color!
;
: HC.GADGETS.OFF ( -- , turn off arrow above other drives )
4 0
DO i 0 hc.point.drive
LOOP
;
: HC.SHOW.DRIVE ( -- , show which drive is current )
hc.gadgets.off
clean-drive @ 1 hc.point.drive
;
: HC.DRIVE ( drive -- )
clean-drive !
gr-curwindow @
IF hc.show.drive
THEN
;
\ ----------------------------------------------
: HC.DRIVE.0 ( -- , select this drive )
0 hc.drive
;
: HC.DRIVE.1 ( -- , select this drive )
1 hc.drive
;
: HC.DRIVE.2 ( -- , select this drive )
2 hc.drive
;
: HC.DRIVE.3 ( -- , select this drive )
3 hc.drive
;
\ Initialize drive gadgets.
: DRIVE.BUTTONS.INIT ( init buttons for drive 0,1,2,3 )
\ Put values on stack to be eaten in DO LOOP
' hc.drive.3 0" DF3:"
' hc.drive.2 0" DF2:"
' hc.drive.1 0" DF1:"
' hc.drive.0 0" DF0:"
4 0
DO hc_gadget_x hc_gadget_inc i * + ( xpos )
hc_gadget_y hc_w_h gt.gad.make
LOOP
;