General Information
Author: Carsten Strotmann
Language: ACTION!
Compiler/Interpreter: ACTION!
Published: 1991-2008
Tool to configure Percom Block Drives. This Tool can be used to test Disk integrity and to format all kind of different Disk Formats available for Atari Disk Drives.
Download: PERCOM Service/PERCOM.ATR
Needs ACTION! Runtime package to compile a standalone Version. Disk with Source and compiled Version attached.
I wrote this Tool to configure the HDI 3 1/2" Disk drive designed by Erhard Pütz (aka FloppyDoc)
2008-01-13 disabled break key, custom error procedure, updated copyright
Key | Description | |
---|---|---|
1 - 4 | Read Percom Block from D1: - D4: and update display | |
T | change number of Tracks per Disc | |
S | change number of Sectors per Track | |
A | change modulation (FM or MFM) | |
R | change stepping rate | |
D | toggle doublesided <-> singlesides | |
B | change Bytes per Sectors (normally 128 or 256) | |
V | change Drive active Flag / HD flag | |
CTRL+F | Format selected Disk in configured Format (CAUTION!!!) | |
CTRL+T | Read and Test all Sectors in configured Format, printing Status for each Sector | |
CTRL+S | configure Drive for Atari Single Density, single sided (SS/SD) | |
CTRL+M | configure Drive for Atari Medium Density, single sided (SS/MD), 1050 Format | |
CTRL+D | configure Drive for Atari Double Density, single sided (SS/DD) | |
CTRL+H | configure Drive for Atari High Density, single sided (SS/HD) | |
CTRL+Z | configure Drive for Atari Single Density, double sided (DS/SD) | |
CTRL+Y | configure Drive for Atari Medium Density, double sided (DS/MD), 1050 Format | |
CTRL+X | configure Drive for Atari Double Density, double sided (DS/DD) | |
CTRL+V | configure Drive for Atari High Density, double sided (DS/HD) |
The data "
;********************************
;** **
;** Phoenix SoftCrew ACTION! **
;** **
;** Carsten Strotmann **
;** carsten@strotmann.de **
;** **
;** http://www.strotmann.de **
;** **
;********************************
; Programname:Percom Haendler
; Programmer:CAS
; Filename:PERCOM.ACT
; first Version:18.08.91
; last Change:13.01.08
; Usage:Manage Floppy Percom Block
;
;
INCLUDE "D:>WORK>SYSTEM.ACT"
MODULE
BYTE drivenum,err,p_read
CARD maxsec,bytes
BYTE ARRAY percom($C),buff($1000),txt(40),
sdss(12)=[40 2 0 18 0 0 0 $80 0 0 0 0],
sdds(12)=[40 2 0 18 1 0 0 $80 0 0 0 0],
mdss(12)=[40 2 0 26 0 4 0 $80 0 0 0 0],
mdds(12)=[40 2 0 26 1 4 0 $80 0 0 0 0],
ddss(12)=[40 2 0 18 0 4 1 0 0 0 0 0],
ddds(12)=[40 2 0 18 1 4 1 0 0 0 0 0],
hdss(12)=[80 2 0 36 0 4 1 0 0 0 0 0],
hdds(12)=[80 2 0 36 1 4 1 0 0 0 0 0]
INCLUDE "D:>WORK>PERCOM1.INC"
PROC PercError(BYTE err)
ErrMess (err)
RETURN
PROC Read_Percom ()
err=Sio (drivenum,$52,$40,7,buff,128,1)
err=Sio (drivenum,$4E,$40,7,percom,12,0)
ErrMess (err)
maxsec=percom(0)*(percom(2)*$100+percom(3))
maxsec==*(percom(4)+1)
bytes =percom(6)*$100+percom(7)
p_read=err
RETURN
PROC Write_Percom ()
err=Sio (drivenum,$4F,$80,7,percom,12,0)
ErrMess (err)
RETURN
PROC Format ()
Write (20,10," Formatting ")
err=Sio (drivenum,$21,$40,$40,buff,bytes,1)
ErrMess (err)
Write (20,10," ")
RETURN
PROC Test()
BYTE ARRAY t(8)
BYTE ch=$2FC,consol=$D01F
CARD u,b,s
Write (18,11,"Test Sector :")
u=0
SCopy (t,"000000")
DO
u==+1
IF u<4 THEN
b=$80
ELSE
b=bytes
FI
err=Sio (drivenum,$52,$40,$7,buff,b,u)
t(6) == +1
FOR s = 2 TO 6
DO
IF t(s) > '9 THEN
t(s) = '0
t(s-1) == +1
FI
OD
Write (32,11,t)
IF err # 1 THEN
ErrMess (err)
FI
UNTIL u=maxsec OR ch=28 or consol=6
OD
Pause (200)
ch=$FF
Write (18,11," ")
RETURN
PROC Mask ()
BYTE lmarg=82
CARD savmsc=$58
lmarg=0
SetBlock (savmsc+120,240,0)
Position (0,0)
Print (" PhoeniX SoftCrew Percom Service 1.1 ")
Position (1,2)
Print ("Drive # ")
Position (1,3)
Print ("Sectors :")
Position (20,3)
Print ("KBytes :")
Position (1,5)
Print ("Tracks :")
Position (18,5)
Print ("Steprate :")
Position (1,6)
Print ("Sectors :")
Position (18,6)
Print ("Doubleside :")
Position (1,7)
Print ("Modulat.:")
Position (18,7)
Print ("Bytes p. Sector :")
Position (1,8)
Print ("Drive active :")
Position (1,10)
Print ("^Format ")
Position (1,11)
Print ("^Test Disc ")
Position (1,13)
Print ("^Single Density 1S")
Position (23,13)
Print ("^Z Sgl. Dens. 2S")
Position (1,14)
Print ("^Medium Density 1S")
Position (23,14)
Print ("^Y Med. Dens. 2S")
Position (1,15)
Print ("^Double Density 1S")
Position (23,15)
Print ("^X Dbl. Dens. 2S")
Position (1,16)
Print ("^High Density 1S")
Position (23,16)
Print ("^V Hgh. Dens. 2S")
Write (0,23," (c) 1991-06 PhoeniX SoftCrew ")
RETURN
PROC Fill_Mask ()
CARD c
Mask ()
Position (13,2)
PrintB (drivenum)
Position (13,3)
PrintC (maxsec)
Position (30,3)
c=$400/bytes
PrintC (maxsec/c)
Position (11,5)
PrintB (percom(0))
Position (35,5)
PrintB (percom(1))
Position (11,6)
c=percom(2)*$100+percom(3)
PrintC (c)
Position (35,6)
IF percom(4)=1 THEN
Print ("Yes ")
ELSE
Print ("No ")
FI
Position (11,7)
IF percom(5)=0 THEN
Print ("FM ")
FI
IF percom(5)=4 THEN
Print ("MFM")
FI
Position (35,7)
c=percom(6)*$100+percom(7)
PrintC (c)
Position (18,8)
IF percom(8)=$FF THEN
Print ("Normal")
FI
IF percom(8)=$40 THEN
Print ("HD ")
FI
RETURN
PROC Refresh ()
Write_Percom ()
Read_Percom ()
Fill_Mask ()
RETURN
PROC Test_Form ()
BYTE skstat=$D20F
IF (skstat & 8) = 0 THEN
Format ()
FI
RETURN
PROC Percom_Service ()
BYTE key
BYTE ARRAY value (3)
CARD temperr
BreakOff()
temperr = Error
Error = PercError
drivenum = 1
p_read=$FF
MoveBlock (percom,sdss,12)
Put (125)
C_Off ()
Mask ()
DO
key=Inkey ()
IF key<'5 AND key>'0 THEN
drivenum=key-48
Read_Percom ()
Refresh ()
FI
IF key='T OR key='t THEN
StrB (percom(0),value)
Position (11,5)
GetIn (value,2)
percom(0)=ValB(value)
Refresh ()
FI
IF key='R OR key='r THEN
StrB (percom(1),value)
Position (35,5)
GetIn (value,2)
percom(1)=ValB(value)
Refresh ()
FI
IF key='S OR key='s THEN
StrC (percom(2)*$100+percom(3),value)
Position (11,6)
GetIn (value,5)
percom(2)=ValC(value)/$100
percom(3)=ValB(value)
Refresh ()
FI
IF key='D or key='d THEN
percom(4)==XOR 1
Refresh ()
FI
IF key='A or key='a THEN
percom(5)==XOR 4
Refresh ()
FI
IF key='B OR key='b THEN
StrC (percom(6)*$100+percom(7),value)
Position (35,7)
GetIn (value,4)
percom(6)=ValC(value)/$100
percom(7)=ValB(value)
Refresh ()
FI
IF key='V or Key='v THEN
IF percom(8)=$FF THEN
percom(8)=$40
ELSE
percom(8)=$FF
FI
Refresh ()
FI
IF key>='! AND key<='$ THEN
drivenum=key-32
Refresh ()
FI
IF key='0x14 THEN
Read_Percom ()
Fill_Mask ()
Test ()
FI
IF key='0x13 THEN
MoveBlock (percom,sdss,12)
Refresh ()
Test_Form ()
FI
IF key='0x1A THEN
MoveBlock (percom,sdds,12)
Refresh ()
Test_Form ()
FI
IF key='
THEN
MoveBlock (percom,mdss,12)
Refresh ()
Test_Form ()
FI
IF key='0x19 THEN
MoveBlock (percom,mdds,12)
Refresh ()
Test_Form ()
FI
IF key='0x4 THEN
MoveBlock (percom,ddss,12)
Refresh ()
Test_Form ()
FI
IF key='0x18 THEN
MoveBlock (percom,ddds,12)
Refresh ()
Test_Form ()
FI
IF key='0x8 THEN
MoveBlock (percom,hdss,12)
Refresh ()
Test_Form ()
FI
IF key='0x16 THEN
MoveBlock (percom,hdds,12)
Refresh ()
Test_Form ()
FI
IF key='0x6 THEN
Format ()
FI
UNTIL key='q OR key='Q or key=27
OD
C_On ()
Error = temperr
BreakOn()
RETURN
" is not legal for a JDOM character content: 0x0014 is not a legal XML character.
; Includedatei fuer PERCOM.ACT ;--- PROC siov=$E459 () BYTE FUNC Sio (BYTE num,comnd,stats,tim,CARD buf,byt,sec) BYTE ddevic=$300, dunit=$301, dcomnd=$302, dstats=$303, dtimlo=$306 CARD dbuf=$304, dbyt=$308, daux=$30A ddevic=$31 dunit=num dcomnd=comnd dstats=stats dtimlo=tim dbuf=buf dbyt=byt daux=sec siov () ; ansprung der sioroutine RETURN (dstats) ;--- PROC C_On () BYTE crsin=752 crsin=0 RETURN PROC C_Off () BYTE crsin=752 crsin=1 RETURN BYTE FUNC Inkey () BYTE atascii Close (2) Open (2,"K:",4,0) atascii=GetD(2) Close(2) RETURN (atascii) PROC Pause (CARD times) BYTE wsync=$14,q CARD u FOR u=1 TO times DO FOR q=1 TO 200 DO wsync=q OD OD RETURN PROC Beep (BYTE times) BYTE u FOR u= 1 TO times DO PutD (0,253) Pause (10) OD RETURN PROC Getin (BYTE ARRAY text,BYTE len) BYTE ascii,pos,u,inv,ch=764 C_On () ch=$FF pos=text(0)+1 inv=0 IF text(0)#0 THEN Print (text) FI DO ascii=Inkey () IF ascii=129 THEN inv==!$80 FI IF ascii=$1E AND pos>1 THEN pos==-1 PutD (0,$1E) FI IF ascii=$7E AND pos>1 THEN pos==-1 PutD (0,$7E) FI IF ascii=$1F AND pos#len+1 THEN pos==+1 PutD (0,$1F) FI IF ascii>26 AND ascii<32 THEN ascii=128 FI IF pos#len+1 AND ascii<$7E THEN ascii==+inv PutD (0,ascii) text(pos)=ascii pos==+1 FI text(0)=pos-1 UNTIL ascii=$9B OD C_Off () Put (31) RETURN PROC Write (BYTE x,y,BYTE ARRAY string) BYTE u,chr CARD savmsc=$58 BYTE POINTER adr adr=savmsc+y*40+x FOR u=1 TO string(0) DO chr=string(u) IF chr>=0 AND chr<32 THEN chr==+64 ELSEIF chr>31 AND chr<95 THEN chr==-32 ELSEIF chr>127 AND chr<160 THEN chr==+64 ELSEiF chr>159 AND chr<224 THEN chr==-32 FI adr^=chr adr==+1 OD RETURN ;----------------------------------- PROC ErrMess (BYTE err) Write (10,20,"Status - ") StrB(err,txt) Write (20,20," ") Write (20,20,txt) IF err>$7F THEN Write (25,20," ERROR ") ELSE Write (25,20,"OK ") FI RETURN PROC BreakOff() BYTE POKMSK = $10 BYTE IRQEN = $D20E POKMSK ==& $7F IRQEN ==& $7F RETURN PROC BreakOn() BYTE POKMSK = $10 BYTE IRQEN = $D20E POKMSK ==% $80 IRQEN ==% $80 RETURN