home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
www
/
f1
/
archives
/
tpc.lha
/
TPCruncher.AMOS
/
TPCruncher.amosSourceCode
Wrap
AMOS Source Code
|
1992-09-02
|
8KB
|
265 lines
Rem TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
Rem T TECHNOPHOBIA T
Rem T CRUNCHER T
Rem T MADE T
Rem T BY T
Rem T JOHN DILLON AND STEPHEN ORR T
Rem TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
Screen Open 0,640,256,8,Hires
Flash Off : Curs Off : Cls 1 : Paper 1 : Ink 1,1
Palette $0,$6F,$77,$EEE,$F00,$DD,$AA,$FF3
Limit Mouse 128,42 To 639+128,255+42
Gr Writing 0
Get Rom Fonts
HLIGHT=3
MID=6
SHADE=2
SHINE=5
OLINE=0
Global HLIGHT,MID,SHADE,SHINE,OLINE
BUTTONS=5
_TEXT$=""
Dim BUT(BUTTONS,4)
Dim BUT$(BUTTONS)
Global BUT(),BUT$(),_TEXT$
Reserve Zone BUTTONS
_MAIN
End
Procedure _MAIN
_BOX[16,8,624,248]
_BOX[32,16,608,40]
_BUTTON[32,216,608,240,"EXIT PROGRAM",1]
_BOX[32,48,608,208]
_BUTTON[48,152,592,176,"CRUNCH",2]
_BUTTON[48,176,592,200,"DECRUNCH",3]
_DRAWTEXT[0,30,640,"TECHNOPHOBIA CRUNCHER ACCESSORY",1,1,"C"]
_DRAWTEXT[0,64,640,"This cruncher is basically an interface to",1,1,"C"]
_DRAWTEXT[0,72,640,"the DMS program. It was created by John",1,1,"C"]
_DRAWTEXT[0,80,640,"Dillon and Stephen Orr.",1,1,"C"]
_DRAWTEXT[0,96,640,"Click on CRUNCH to crunch a disk, or",1,1,"C"]
_DRAWTEXT[0,104,640,"DECRUNCH to decrunch one. Simple really!",1,1,"C"]
Do
If Mouse Key=1 and Mouse Zone>0
_BUTTONCLICK[Mouse Zone]
If Mouse Zone=1
Fade 4
Wait 50
Screen Close 0
End
End If
If Mouse Zone=2
_CRUNCH
End If
If Mouse Zone=3
_DECRUNCH
End If
End If
Loop
End Proc
Procedure _DECRUNCH
_BOX[32,48,608,208]
_BUTTON[32,216,608,240,"EXIT DECRUNCH SCREEN",1]
_BOX[32,16,608,40]
_DRAWTEXT[0,30,640,"TECHNOPHOBIA CRUNCH ACCESSORY - DECRUNCH SCREEN",1,1,"C"]
_BUTTON[48,176,592,200,"SELECT FILE",2]
_DRAWTEXT[0,64,640,"When you click on SELECT FILE below, a file",1,1,"C"]
_DRAWTEXT[0,72,640,"requester will appear. Select the DMS file you",1,1,"C"]
_DRAWTEXT[0,80,640,"wish to decrunch, then just follow the prompts",1,1,"C"]
_DRAWTEXT[0,88,640,"that will appear once the information has been",1,1,"C"]
_DRAWTEXT[0,96,640,"copied to the RAM disk.",1,1,"C"]
Do
MZ=Mouse Zone
If Mouse Key=1
If MZ>0
_BUTTONCLICK[MZ]
If MZ=1
_MAIN
End If
If MZ=2
F$=Fsel$("*.DMS","","Please select a DMS file","or click on Cancel to exit")
Exec "NewShell"
Exec "Copy SYS:C/Copy RAM:"
Exec "Copy SYS:C/DMS RAM:"
Exec "Copy "+F$+" RAM:DMSFile.DMS"
_DRAWTEXT[0,112,640,"Please put a blank disk into DF0: (the internal drive)",1,1,"C"]
_DRAWTEXT[0,120,640,"and click on DECRUNCH FILE below.",1,1,"C"]
_BUTTON[48,176,592,200,"DECRUNCH FILE",2]
Do
MZ=Mouse Zone
If Mouse Key=1
If MZ=1
_MAIN
End If
If MZ=2
_BUTTONCLICK[MZ]
_DRAWTEXT[0,136,640,"Decrunching... please wait, this may take some time.",1,1,"C"]
Exec "RAM:DMS Write RAM:DMSFile.DMS to DF0:"
Exec "EndCLI"
Kill "RAM:DMSFile.DMS"
Kill "RAM:DMS"
Kill "RAM:Copy"
_DRAWTEXT[0,152,640,"Decrunching Completed.",1,1,"C"]
_DRAWTEXT[0,160,640,"Now returning to main menu.",1,1,"C"]
_MAIN
End If
End If
Loop
End If
End If
End If
Loop
End Proc
Procedure _CRUNCH
_BOX[32,48,608,208]
_BUTTON[32,216,608,240,"EXIT CRUNCH SCREEN",1]
_BOX[32,16,608,40]
_DRAWTEXT[0,30,640,"TECHNOPHOBIA CRUNCH ACCESSORY - CRUNCH SCREEN",1,1,"C"]
_BUTTON[48,176,592,200,"BEGIN CRUNCHING",2]
_DRAWTEXT[0,64,640,"Please put the disk that you want to crunch into DF0:,",1,1,"C"]
_DRAWTEXT[0,72,640,"then click on the BEGIN CRUNCHING button below this",1,1,"C"]
_DRAWTEXT[0,80,640,"text.",1,1,"C"]
Do
MZ=Mouse Zone
If Mouse Key=1
If MZ>0
_BUTTONCLICK[MZ]
If MZ=1
_MAIN
End If
If MZ=2
Exec "NewShell"
Exec "Copy SYS:C/Copy RAM:"
Exec "Copy SYS:C/DMS RAM:"
_DRAWTEXT[0,96,640,"Crunching started. Please wait... this'll take a while!",1,1,"C"]
Exec "RAM:DMS READ RAM:DMSFile.DMS FROM DF0:"
_DRAWTEXT[0,112,640,"Crunching completed. Now it's time to select a location",1,1,"C"]
_DRAWTEXT[0,120,640,"for your crunched file.",1,1,"C"]
F$=Fsel$("","","Please select a location for your DMS file","to be copied to")
Exec "RAM:Copy RAM:DMSFile.DMS "+F$
Exec "EndCLI"
Kill "RAM:DMS"
Kill "RAM:Copy"
Kill "RAM:DMSFile.DMS"
_DRAWTEXT[0,136,640,"All done, returning to main menu.",1,1,"C"]
_MAIN
End If
End If
End If
Loop
End Proc
Procedure _BUTTON[X1,Y1,X2,Y2,_TEXT$,_ZONE]
Rem *** Draw The Button
Ink OLINE
Bar X1,Y1 To X2,Y2
Ink MID
Bar X1+2,Y1+1 To X2-2,Y2-1
Ink SHADE
Polyline X1+2,Y2-1 To X2-2,Y2-1 To X2-2,Y1+1
Draw X2-3,Y1+1 To X2-3,Y2-1
Ink SHINE
Polyline X2-3,Y1+1 To X1+2,Y1+1 To X1+2,Y2-1
Draw X1+3,Y1+1 To X1+3,Y2-2
Ink HLIGHT
Draw X1+4,Y1+2 To X1+5,Y1+2
Rem *** Work Out Position Of Text And Draw It
Y=Y1+((Y2-Y1)/2)+3
_DRAWTEXT[X1,Y,X2-X1,_TEXT$,1,HLIGHT,"C"]
Rem *** Set The Zone And Put Values Into Array For Later Use
Set Zone _ZONE,X1,Y1 To X2,Y2
BUT(_ZONE,1)=X1
BUT(_ZONE,2)=Y1
BUT(_ZONE,3)=X2
BUT(_ZONE,4)=Y2
BUT$(_ZONE)=_TEXT$
End Proc
Procedure _BUTTONCLICK[MZ]
Rem *** Set Up Information For Button Drawing
X1=BUT(MZ,1) : Y1=BUT(MZ,2)
X2=BUT(MZ,3) : Y2=BUT(MZ,4)
_TEXT$=BUT$(MZ)
Rem *** Actually Draw The Button
Ink SHADE
Bar X1+2,Y1+1 To X2-2,Y2-1
Ink MID
Polyline X1+2,Y2-1 To X2-2,Y2-1 To X2-2,Y1+1
Draw X2-3,Y1+1 To X2-3,Y2-1
Ink OLINE
Polyline X2-3,Y1+1 To X1+2,Y1+1 To X1+2,Y2-1
Draw X1+3,Y1+1 To X1+3,Y2-2
Rem *** Work Out The Position Of The Text And Draw It
Y=Y1+((Y2-Y1)/2)+4
_DRAWTEXT[X1,Y,X2-X1,_TEXT$,1,HLIGHT,"C"]
Rem *** Short Delay Before Redrawing
Repeat : Until Mouse Key=0
Rem *** Redraw Button In Normal Mode
Ink OLINE
Bar X1,Y1 To X2,Y2
Ink MID
Bar X1+2,Y1+1 To X2-2,Y2-1
Ink SHADE
Polyline X1+2,Y2-1 To X2-2,Y2-1 To X2-2,Y1+1
Draw X2-3,Y1+1 To X2-3,Y2-1
Ink SHINE
Polyline X2-3,Y1+1 To X1+2,Y1+1 To X1+2,Y2-1
Draw X1+3,Y1+1 To X1+3,Y2-2
Ink HLIGHT
Draw X1+4,Y1+2 To X1+5,Y1+2
Rem *** Draw The Text In It's Original Position
_DRAWTEXT[X1,Y-1,X2-X1,_TEXT$,1,HLIGHT,"C"]
End Proc
Procedure _BOX[X1,Y1,X2,Y2]
Ink OLINE : Bar X1,Y1 To X2,Y2
Ink MID : Bar X1+2,Y1+1 To X2-2,Y2-1
Ink SHADE
Polyline X1+2,Y2-1 To X2-2,Y2-1 To X2-2,Y1+1
Draw X2-3,Y1+1 To X2-3,Y2-1
Ink SHINE
Polyline X2-3,Y1+1 To X1+2,Y1+1 To X1+2,Y2-1
Draw X1+3,Y1+1 To X1+3,Y2-2
Ink HLIGHT
Draw X1+4,Y1+2 To X1+5,Y1+2
End Proc
Procedure _DRAWTEXT[X,Y,WIDTH,_TEXT$,FONT,CLR,TYPE$]
Gr Writing 0
Ink 3
Set Font FONT
CENTRD=(X+(WIDTH/2))-(Text Length(_TEXT$))/2
RIGHT=(X+WIDTH)-Text Length(_TEXT$)
If Upper$(TYPE$)="C"
Text CENTRD,Y,_TEXT$
End If
If Upper$(TYPE$)="L"
Text X,Y,_TEXT$
End If
If Upper$(TYPE$)="R"
Text RIGHT,Y,_TEXT$
End If
End Proc