'* -------------------------------------------- * '* AmBOS V5.04ß © by Testaware * '* -------------------------------------------- * '* ® 10-06-02 / 01:23:37 by Volker Stepprath * '* -------------------------------------------- * '* AMOS Professional V2.0 by Europress Software * '* -------------------------------------------- * '* Extra Extensions: * '* AMOSPro_Explode.Lib V2.01 * '* AMOSPro_AMCAF.Lib V1.50 beta 4 * '* -------------------------------------------- * Set Buffer 100 Break Off 'Variablen installieren Dim XMEN$(1,14),XCM$(44),XTI$(21) Global XMEN$(),XCM$(),XTI$(),XAV$ Global XN$,XSD,XOM,XE,XSCRN,XAFD,XEXA,XDA,XTB Global X0FA,XPOSA,XANZA#,XLENA#,XBARA#,XBARPOSA# Global X0FB,XPOSB,XANZB#,XLENB#,XBARB#,XBARPOSB# XAV$="V5.04ß" Rs Structure False,256 _DEFAULT : _MAIN 'Grundeinstellungen Procedure _DEFAULT Fix(2) XSCRN=4 XEXA=300 XSD=True X0FA=100 X0FB=116 XTB=8 Reserve As Data X0FA,260 Reserve As Data X0FB,260 Poke$ Start(X0FA)+8,"SYS:" Poke$ Start(X0FB)+8,"SYS:" Cd Set "SYS:" Close Editor Request Off Key Speed 10,2 Default Palette $789,$0,$FFF,$34A _INSTALLAMBOS _INSTALLSCREEN Amos To Front End Proc 'Hauptschleife Procedure _MAIN Do Ink 1,False Erase 7 Erase 8 Every 50 Proc _MEMTIME _MEMTIME Repeat _WAIT A=Param B=Scancode X=X Screen(X Mouse) Y=Y Screen(Y Mouse) If B=80 If XSD : A=X0FB Else A=X0FA : End If B=Length(A)/260-1 For I=1 To B C=Start(A)+I*260+8 D=Peek(C) If D>96 and D<123 Bclr 5,D Poke C,D End If Next _EXASHOW[XSD] Exit Else If B=95 X=496 : Y=False : Exit Else If A=13 X=110 : Y=False : Exit Else If Key Shift and A=27 X=1 : Y=False : Exit Else If A=8 X=607 : Y=False : Exit Else If A=28 Cls False,342,31 To 639,178 Erase X0FB If Length(X0FA) XPOSB=XPOSA XANZB#=XANZA# XLENB#=XLENA# XBARB#=XBARA# XBARPOSB#=XBARPOSA# Bank Clone X0FA To X0FB _EXASHOW[True] _SCROLLBAR[True] End If Else If A=29 Cls False,1,31 To 298,178 Erase X0FA If Length(X0FB) XPOSA=XPOSB XANZA#=XANZB# XLENA#=XLENB# XBARA#=XBARB# XBARPOSA#=XBARPOSB# Bank Clone X0FB To X0FA _EXASHOW[False] _SCROLLBAR[False] End If Else If A>48 and A<57 If A<53 X=544+(A-48)*20 : Y=210 Else X=544+(A-52)*20 : Y=217 End If A=True Else If A>64 and A<91 or A>96 and A<123 If XSD : B=X0FB Else B=X0FA : End If If Length(B) C=Length(B)/260-1 If C>False For I=1 To C _EXANAME[B,I] A$=Param$ If Peek(Varptr(A$))=A I=Min(I-1,C-18) If XSD XPOSB=I Else XPOSA=I End If Exit End If Next _EXASHOW[XSD] _SCROLLBAR[XSD] End If End If End If Until A<3 Every Off XE=False If A>2 Then A=False _CHECKSELECT[A,X,Y] Loop End Proc 'Mausabfrage Procedure _CHECKSELECT[A,X,Y] If Y<13 If A=True _EXIT Else If X>109 and X<144 _G[110,0,143,12,True] Close Lib Close Erase Temp Kill Editor For I=0 To 21 : XTI$(I)="" : Next Flush Wait 20 _INSTALLSCREEN Else If X>495 and X<530 _HELP Else If X>605 _ICONIFY End If End If 'Datenfelder scrollen If X>301 and X<317 and Y>151 and Y<165 _G[301,152,317,164,True] _EXASCRD[False] : Wait 3 While Mouse Key : _EXASCRD[False] : Wend _G[301,152,317,164,False] Else If X>301 and X<319 and Y>165 and Y<179 _G[301,166,317,178,True] _EXASCRU[False] : Wait 3 While Mouse Key : _EXASCRU[False] : Wend _G[301,166,317,178,False] Else If X>322 and X<339 and Y>151 and Y<165 _G[322,152,338,164,True] _EXASCRD[True] : Wait 3 While Mouse Key : _EXASCRD[True] : Wend _G[322,152,338,164,False] Else If X>321 and X<339 and Y>165 and Y<179 _G[322,166,338,178,True] _EXASCRU[True] : Wait 3 While Mouse Key : _EXASCRU[True] : Wend _G[322,166,338,178,False] Else If X>300 and X<318 and Y>29 and Y<151 If XANZA#>18 A#=120.0/XANZA# A=XPOSA While Mouse Key B#=(Max(0,Y Screen(Y Mouse)-30)) B#=B#/A# XPOSA=B# If XPOSA>XANZA#-18 : XPOSA=XANZA#-18 : End If If A<>XPOSA _SCROLLBAR[False] _EXASHOW[False] A=XPOSA End If Wend End If Else If X>321 and X<339 and Y>29 and Y<151 If XANZB#>18 A#=120.0/XANZB# A=XPOSB While Mouse Key B#=(Max(0,Y Screen(Y Mouse)-30)) B#=B#/A# XPOSB=B# If XPOSB>XANZB#-18 : XPOSB=XANZB#-18 : End If If A<>XPOSB _SCROLLBAR[True] _EXASHOW[True] A=XPOSB End If Wend End If Else If X>300 and X<318 and Y>179 and Y<193 _G[301,180,317,192,True] _SCROLLTOPBUTTOM[False,A] _G[301,180,317,192,False] Else If X>321 and X<339 and Y>179 and Y<193 _G[322,180,338,192,True] _SCROLLTOPBUTTOM[1,A] _G[322,180,338,192,False] End If 'Device If Y>14 and Y<28 If X>0 and X<53 _G[False,15,52,27,True] : _GETDEVICES[False] Else If X>366 and X<420 _G[367,15,419,27,True] : _GETDEVICES[True] 'GetDir Else If X>53 and X<105 _G[55,15,107,27,True] : _EXAMINE[False] Else If X>421 and X<475 _G[422,15,474,27,True] : _EXAMINE[True] 'Parent Else If X>109 and X<163 _G[110,15,162,27,True] : _PARENT[False] Else If X>475 and X<527 _G[477,15,529,27,True] : _PARENT[True] Else If X>164 and X<218 _G[165,15,217,27,True] : _MATCH[False] Else If X>532 and X<585 _G[532,15,584,27,True] : _MATCH[True] 'C A S Else If X>219 and X<273 X=(X-220)/18 _G[X*18+220,15,X*18+236,27,True] _ALLCLEAR[False,X] Else If X>586 and X<640 X=(X-587)/18 _G[X*18+587,15,X*18+603,27,True] _ALLCLEAR[True,X] '0 - 9 / <- * -> Else If X>273 and X<299 _G[275,15,298,27,True] If Length(X0FA) : Bank As Work X0FA : End If If A<>1 : A=True : End If : Add X0FA,A,100 To 115 If Length(X0FA) : Bank As Data X0FA : End If _X0FAB[False] : _SCROLLBAR[False] _G[275,15,298,27,False] Else If X>342 and X<365 _G[341,15,364,27,True] If Length(X0FB) : Bank As Work X0FB : End If If A<>1 : A=True : End If : Add X0FB,A,116 To 131 If Length(X0FB) : Bank As Data X0FB : End If _X0FAB[True] : _SCROLLBAR[True] _G[341,15,364,27,False] Else If X>300 and X<339 If A=2 If XAFD=False XAFD=True A$="on" Else XAFD=False A$="off" End If _G[301,15,338,27,XAFD] _R["AmBOS fastdirmode is turned "+A$+"!","",False] Else _SOURCEDEST End If End If End If 'Devices angeben If Y>180 and Y<192 If X>3 and X<297 _EXAENTR[False] Else If X>343 and X<637 _EXAENTR[True] End If End If 'Files selektieren If Y>31 and Y<176 If X>0 and X<299 _SELECT[False,A,Y] Else If X>340 and X<640 _SELECT[True,A,Y] End If End If 'MenÜoptionen If Y>194 and Y<208 or X<558 and Y>209 and Y<223 X=X/80 If Y>194 and Y<208 Y=195 B=X Else If Y>209 and Y<223 Y=210 B=X+8 End If _G[X*80+1,Y,X*80+78,Y+12,True] If XMEN$(1,B)<>"" A$=XMEN$(A-1,B) Cls False,X*80+3,Y+1 To X*80+78,Y+12 Text X*80+40-Text Length(A$)/2,Y+9,A$ End If Inc B If XOM=0 If A=1 On B Proc _COPY,_MOVE,_RENAME,_PROTECT,_COMMENT,_DELETE,_MAKEDIR,_FILEINFO,_READ,_PRINT,_EXECUTE,_COMPARE,_JOIN,_EDITOR,_DISKINFO Else If A=2 On B Proc _COPYTO,_MOVETO,_RENAME,_PROTECT,_COMMENT,_DELETE,_MAKEDIR,_FILEINFO,_HEXDUMP,_PRINT,_CLI,_COMPARE,_SIDEJOIN,_EDITOR,_DISKINFO End If Else If XOM=1 If A=1 On B Proc _ANALYZE,_SORT,_REPLACE,_SEARCH,_REMDSEQ,_READAPF,_ADDSUFX,_ADDICON,_SHOWPIC,_SHOWFONT,_PLAYANIM,_PLAYSAM,_PLAYABK,_PLAYMED,_PLAYMOD Else If A=2 On B Proc _ANALYZE,_SORT,_REPLACE,_SEARCH,_REMASEQ,_SETTAB,_REMSUFX,_SHOWICON,_PRINTPIC,_SHOWFONT,_PLAYANIM,_PLAYSAM,_PLAYABK,_PLAYMED,_PLAYMOD End If Else If XOM=2 If A=1 On B Proc _APACK,_PPACK,_XPACK,_LPACK,_PPBKSAVE,_DECRUNCH,_ENCRYPT,_UNPACK,_PPBEST,_PACKINFO,_CONVASM,_CONVBAS,_CONVASC,_CONVPBK,_REMHUNK Else If A=2 On B Proc _APACK,_PPACK,_XPACK,_LPACK,_PPBKLOAD,_CRUNCHER,_DECRYPT,_BKUNPACK,_PPBEST,_PACKINFO,_CONVASM,_CONVBAS,_CONVASC,_CONVPBK,_REMHUNK End If Else If XOM=3 If A=1 On B Proc _IFFABK,_GETABS,_SHOWASP,_SHOWAIC,_SHOWA3D,_SHOWMEM,_VECTEST,_RESET,_BUFFER,_PUTADR,_CLONE,_SPLIT,_SIZE,_DEVSCAN,_DISKTOOL Else If A=2 On B Proc _ABKIFF,_SPLITABS,_SHOWASP,_SHOWAIC,_SHOWA3D,_SAVEMEM,_VECTEST,_RESET,_BUFFER,_PUTADR,_CLONE,_SPLIT,_SIZE,_DEVSCAN,_DISKTOOL End If Else If XOM=4 If A=1 On B Proc _ASSIGN,_SPEAK,_SETPRT,_GETDAY,_WORKBENCH,_STICKTEST,_VALUE,_ANIMCUT,_AMBOSCOLS,_AMBOSFDIR,_AMBOSMENU,_AMBOSEXAM,_AMBOSDPTH,_AMBOSINFO,_ABOUT Else If A=2 On B Proc _ASSIGN,_SPEAK,_SETPRT,_GETDAY,_WORKBENCH,_STICKTEST,_VALUE,_ANIMCUT,_AMBOSCOLS,_AMBOSFDIR,_AMBOSMENU,_AMBOSEXAM,_AMBOSDPTH,_WORKINFO,_ABOUT End If End If Dec B If XOM>4 _CALLOWN[A,B] Else If XMEN$(1,B)<>"" Clear Mouse Ink 3 A$=XMEN$(0,B) Cls False,X*80+3,Y+1 To X*80+78,Y+12 Text X*80+40-Text Length(A$)/2,Y+9,A$ End If End If _EXASHOW[False] : _EXASHOW[True] End If '1|2|3|4....8 If X>563 and X<636 and Y>209 and Y<223 X=(X-564)/20 : Y=(Y-210)/7 : XOM=X+Y*4 _NEWMENU : _MENU End If _NEWGG[False] : _NEWGG[True] : _OPTIONOFF End Proc 'Menü 1 Procedure _COPY _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc _XSD Repeat _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _COPYING[N$,A$+Param$] If File Type(N$)=-2 B$=A$+Param$ _EXAMULT[False,N$,B$] End If Until XE _XSD : _EXAMINE[XSD] End Proc Procedure _COPYTO _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc _XSD Repeat _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] A=File Type(N$) If A<>-2 _T["Old: "+Param$] _E["New:",Param$] Else XN$=Param$ End If If XN$<>"" _COPYING[N$,A$+XN$] If A=-2 B$=A$+Param$ _EXAMULT[1,N$,B$] End If Else _T[Param$+" not copied!"] End If Until XE _XSD : _EXAMINE[XSD] End Proc Procedure _MOVE _DEVNAME[False] : A$=Param$ _DEVNAME[True] : B$=Param$ If A$=B$ Then _T["Devices must be different!"] : Pop Proc If Peek$(Varptr(A$),40,":")<>Peek$(Varptr(B$),40,":") _T["Impossible to MOVE across devices!"] Pop Proc End If On Error Proc _ERROR _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc _XSD Repeat _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Move.."+Param$] Rename N$ To A$+Param$ Until XE _XSD : _EXAMINE[True] : _EXAMINE[False] End Proc Procedure _MOVETO _DEVNAME[False] : A$=Param$ _DEVNAME[True] : B$=Param$ If A$=B$ Then _T["Devices must be different!"] : Pop Proc If Peek$(Varptr(A$),40,":")<>Peek$(Varptr(B$),40,":") _T["Impossible to MOVE across devices!"] Pop Proc End If On Error Proc _ERROR _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc _XSD Repeat _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Moving..: "+Param$] _E["New name:",Param$] If XN$<>"" Rename N$ To A$+XN$ Else _T[Param$+" not moved!"] End If Until XE _XSD : _EXAMINE[True] : _EXAMINE[False] End Proc Procedure _RENAME On Error Proc _ERROR _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc If XSD=False Then A=X0FA Else A=X0FB Do _GETDFPOS : N=Param _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Old: "+Param$] _E["New:",Param$] If XN$<>"" Rename N$ To A$+XN$ Exit If XE Poke$ Start(A)+N*260+8,XN$+String$(Chr$(0),108-Len(XN$)) End If Loop End Proc Procedure _PROTECT On Error Proc _ERROR If XSD=False Then A=X0FA Else A=X0FB Do _GETDFPOS : N=Param _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _E["Flags to "+Param$+" [HSPARWED]:",A$] A$=Upper$(XN$) N$=N$+Chr$(0) B=False If Instr(A$,"D")=False Then Bset 0,B If Instr(A$,"E")=False Then Bset 1,B If Instr(A$,"W")=False Then Bset 2,B If Instr(A$,"R")=False Then Bset 3,B If Instr(A$,"A") Then Bset 4,B If Instr(A$,"P") Then Bset 5,B If Instr(A$,"S") Then Bset 6,B If Instr(A$,"H") Then Bset 7,B Dreg(1)=Varptr(N$) Dreg(2)=B If Doscall(-186)=False Then Error 94 Exit If XE Loke Start(A)+N*260+116,B Loop End Proc Procedure _COMMENT On Error Proc _ERROR If XSD=False Then A=X0FA Else A=X0FB Do _GETDFPOS : N=Param _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Comment to "+Param$] _E[":",A$] A$=XN$ XN$=XN$+Chr$(0) N$=N$+Chr$(0) Dreg(1)=Varptr(N$) Dreg(2)=Varptr(XN$) If Doscall(-180)=False Then Error 94 Exit If XE Poke$ Start(A)+N*260+144,A$+String$(Chr$(0),116-Len(A$)) Loop End Proc Procedure _DELETE On Error Proc _ERROR _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc Repeat _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] If File Type(N$)=-2 A$=N$ _DIRALL[N$+"/"] Bank Shrink 8 To XDA-Start(8) A=Start(8) B=Finish(8)-2 For I=B To A Step -1 If Peek(I)=False N$=Peek$(I+1,260,Chr$(0)) Gosub A End If Next N$=A$ Gosub A Erase 7 Erase 8 Else Gosub A End If Until XE _EXAMINE[XSD] Pop Proc A: If Key State(69)=False If Right$(N$,1)="/" N$=Left$(N$,Len(N$)-1) End If _T["Delete.."+N$] If X<>True _W[76,336,23,%110,"DELETE","No","All","Yes"] N=Param _OAGW[N] _WAGW[N] If Param=1 X=False Else If Param=2 X=True Else If Param=3 X=1 End If _CAGW[N] End If If X<>False and Exist(N$)=True A=Object Protection(N$) If XE=False If Btst(0,A)+Btst(2,A)=False Kill N$ Else Error 89 End If End If End If Else XE=True End If Return End Proc Procedure _MAKEDIR _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc On Error Proc _ERROR XN$="" Repeat _E["Mkdir:",XN$] Exit If XN$="" or XN$=B$ If Exist(A$+XN$)=False Then Mkdir A$+XN$ B$=XN$ Until XE _EXAMINE[XSD] End Proc Procedure _FILEINFO If XSD=False Then A=X0FA : B=XANZA# Else A=X0FB : B=XANZB# If Length(A)=False or B=False Then Pop Proc _W[40,384,115,%1110,"FILEINFO","Abort","","Next"] C=Param : _OAGW[C] X=Deek(C+2)+14 Y=Deek(C+4)+27 A=Start(A) For I=1 To B Add A,260 If Peek(A+1) Poke A+1,0 Ink 1,False Cls False,X,Y-7 To X+Deek(C+6)-8,Y+Deek(C+8)-40 Text X,Y,"Name : "+Peek$(A+8,39,Chr$(0)) If Peek(A) : A$="File" Else A$="Directory" : End If Text X,Y+9,"Type : "+A$ Text X,Y+18,"Key :"+Str$(Leek(A+112)) Text X,Y+27,"Bytes :"+Str$(Leek(A+124)) Text X,Y+36,"Blocks:"+Str$(Leek(A+128)) A$="dewrapsh" B=Leek(A+116) For N=False To 3 If Btst(N,B) : Mid$(A$,N+1)="-" : End If If Btst(N+4,B)=False : Mid$(A$,N+5)="-" : End If Next Text X,Y+45,"Flags : "+Flip$(A$) _DATE[Leek(A+132)] : Text X,Y+54,"Date : "+Left$(Param$,6)+Right$(Param$,2) _SYSTIME[A+136] : Text X,Y+63,"Time : "+Param$ Text X,Y+72,"Note : "+Peek$(A+144,39,Chr$(0)) _WAGW[C] Exit If Param=1 End If Next _CAGW[C] End Proc Procedure _READ Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Read.."+Param$] _FLOAD[N$,7] : Exit If XE _TPTR[7] _B[36,False,639,12] : Text 39,9,N$ Cls False,False,15 To 640,223 _T[""] A=Start(8) E=Length(8)/4-3 For I=0 To E B=Leek(A+I*4) C=Leek(A+I*4+4) A$=Peek$(B,C-B,Chr$(10)) Text False,21+D*8,A$ Add D,1,False To 26 If D=26 or I=E Rs Set False,False Rs Long False,100.0/Length(7)*(C-Start(7)) Rs Long False,I+1 Rs Long False,E+1 Rs Long False,C-Start(7) Rs Long False,Length(7) Text 6,250,Format$("Done:%ld%% - Lines:%ld/%ld - Bytes:%ld/%-15ld",Rs Start(False)) Gosub A : Exit If Param=27 or Param=True,2 : Exit If Param=32 Cls False,False,15 To 640,223 End If Next Loop Erase 8 _INSTALLSCREEN Pop Proc A: _WAIT D=False If Param=2 or Param=29 or Param=30 I=Max(True,I-52) Else If Param=116 I=True Else If Param=98 I=Max(True,E-26) End If Return End Proc Procedure _HEXDUMP On Error Proc _ERROR Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Read.."+Param$] B=False C=False D=-16 E=False F=False A$="" Bank Load N$ To 7 Exit If XE N=Length(7) _B[36,False,639,12] : Text 39,9,N$ Cls False,False,15 To 640,223 Gosub A Repeat For A=False To 15 B=Peek(Start(7)+C) Inc C Inc D Exit If C>N B$=Hex$(B,2) If B<32 or(B>127 and B<161) Then B=46 A$=A$+Chr$(B) C$=C$+" "+B$-"$" Next Text False,21+E*8,Hex$(D,8)+": "+C$+Space$(52-A*3)+A$ A$="" C$="" Inc E Inc F If E=26 or C=>N Gosub B _WAIT If Param=13 Gosub C E=Val(XN$) E=Max(False,E) If E=False F=False C=False D=-16 End If If E>N/16 E=False F=False C=False D=-16 End If If E>False and E<=N/16 F=E-1 C=E*16 D=C-16 End If Gosub A End If E=False Cls False,False,15 To 640,223 Exit If Param=27 or Param=True,2 End If Until C=>N Loop _INSTALLSCREEN Pop Proc A: _T["File : "+N$] _T["Lines:"] _T["Read :"] B: C=Min(C,N) Text 56,242,Str$(F) Text 56,250,Str$(100.0/N*C)+"% ("+Str$(C)+" of"+Str$(N)+" bytes )" Return C: _T["Max. lines:"+Str$(N/16+1)] _T["Cur. lines:"+Str$(Max(1,F-26))+" to"+Str$(F)] _E["Enter line:",""] Return End Proc Procedure _PRINT _R["Really print?","",True] : If Param=False Then Pop Proc Trap Open Port 1,"PRT:" If Errtrap Then _R["Can`t open printer.device!","",False] : Pop Proc On Error Proc _ERROR Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _FLOAD[N$,7] : Exit If XE _T["Printing "+Param$+" [ESC=Abort]!"] N=False Repeat N$=Peek$(Start(7)+N,,Chr$(10)) Add N,Len(N$)+1 Print #1,N$+Chr$(10); Wait 30 Exit If Key State(69)+XE,2 Until N=>Length(7) Loop Close 1 Wait 200 End Proc Procedure _EXECUTE Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] N$=Chr$(34)+N$+Chr$(34) _E["Params to "+Param$+":",""] If XN$<>"" Then XN$=N$+" "+XN$ Else XN$=N$ _RUN Loop End Proc Procedure _CLI Do _E["CLI:",""] : Exit If XN$="" _RUN Loop End Proc Procedure _COMPARE If Length(X0FA)=False or Length(X0FB)=False Then Pop Proc On Error Proc _ERROR _GETF : A$=Param$ : _XSD _GETF : B$=Param$ : _XSD If A$="" or B$="" _R["Need two files to compare!","",False] Pop Proc End If Swap A$,B$ Bank Load A$ To 7 Bank Load B$ To 8 If XE Then Pop Proc C=Min(Length(7),Length(8))-1 _R["Quick compare?","",True] If Param B=False If Length(7)=Length(8) B=True For A=False To C If Peek(Start(7)+A)<>Peek(Start(8)+A) B=False : Exit End If Next End If If B : C$="same!" Else C$="different!" : End If _T[A$+" and "+B$+" are "+C$] Pop Proc End If A$=Right$(A$,38) : A$=A$+Space$(38-Len(A$)) B$=Right$(B$,38) : B$=B$+Space$(38-Len(B$)) Cls False,False,15 To 640,223 _B[36,False,639,12] : Text 39,9,"COMPARE" Ink 2,1 Text False,20,A$ Text 336,20,B$ Gosub A For A=False To C Step 38 For B=False To 37 Exit If A+B>C A$=Peek$(Start(7)+A+B,1) B$=Peek$(Start(8)+A+B,1) If A$<>B$ Then Ink 2,3 : Inc F Else Ink 1,0 Text B*8,29+N*8,A$ Text 336+B*8,29+N*8,B$ Next Inc N If N=25 or A>C Gosub A _WAIT Exit If A>C or Param=27 or Param=True N=False Cls False,False,23 To 640,223 End If Next If Param>True and Param<>27 Then Gosub A : _WAIT _INSTALLSCREEN Pop Proc A: Ink 1,0 : Text 6,250,"Different bytes:"+Str$(F)+" of"+Str$(A+B) Return End Proc Procedure _JOIN On Error Proc _ERROR If XSD Then A=X0FA : B=XANZA# Else A=X0FB : B=XANZB# If Length(A)=False Then Pop Proc A=Start(A) For I=1 To B Add A,260 If Peek(A)=1 and Peek(A+1)=1 Then Add C,Leek(A+124) Next If C=False Then Pop Proc _E["Outfile:",""] If XN$="" Then Pop Proc _DEVNAME[XSD] A$=Param$+XN$ _XSD Reserve As Work 7,C If XE Then Goto A A=Start(7) Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] B=File Size(N$) If B>False _T["Merge.."+Param$] Bload N$,A Add A,B End If Until XE A: _XSD If XE+Key State(69) _T["Merging of files aborted!"] Else _T["Writing merged files to "+A$+"!"] _FSAVE[A$,7] : _EXAMINE[XSD] End If End Proc Procedure _SIDEJOIN On Error Proc _ERROR Do _GETF : Exit If Param$="" : A$=Param$ _GETF : Exit If Param$="" : B$=Param$ _E["Output to..........:",B$] Exit If XN$="" N$=XN$ _E["Letter per line....:",""] : A=Val(XN$) _E["Spaces between line:",""] : B=Val(XN$) Exit If A=False or B=False _FLOAD[A$,7] : Exit If XE _FLOAD[B$,8] : Exit If XE _T["First file......: "+A$] _T["Second file.....: "+B$] _T["Parallel join to: "+N$] Open Out 1,N$ Exit If XE C=Start(7) D=Start(8) Do A$=Peek$(C,A,Chr$(10)) B$=Peek$(D,A,Chr$(10)) Add C,Len(A$) Add D,Len(B$) If Len(A$)Start(7)+Length(7) or D=>Start(8)+Length(8) Loop Close Loop Close End Proc Procedure _EDITOR On Error Proc _ERROR _GETF If Param$="" _R["No file selected!","Direct memory edit?",True] If Param _E["Edit address:",""] : S7=Val(XN$) _E["Edit length :",""] : L7=Val(XN$) C$=Hex$(S7) B$=File Path$(C$) End If Else B$=Param$ : _CALCNAME[Param$] : C$=Param$+Chr$(0) Bank Load B$ To 7 If XE=False S7=Start(7) : L7=Length(7) End If End If If S7=False or L7=False Then Pop Proc LMAX=L7/80 Gosub E _B[36,False,639,12] : Text 39,9,B$ Ink 1,0 Cls False,False,15 To 640,224 Text 7,219,"Asc: 000 Hex: $00 Line: 00000 Pos: 000000 Search Save As ? Input" Gosub D Gosub B Do _WAIT N=Param : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) If Key State(70) Repeat I=S7+I3+CX+CY*80+1 Copy I,Finish(7) To I-1 Poke Finish(7)-1,0 Ink 1 For I=CY To 23 For I2=False To 79 If I*80+I2+I3127 and C<160) C=46 End If A$=A$+Chr$(C) End If Next Text False,I*8+22,A$ A$="" Next Gosub C Wait Vbl Until Key State(70)=False Else If N>7 If N>27 and N<32 If Key Shift If N=28 CX=78 : Gosub C Else If N=29 CX=1 : Gosub C Else If N=31 and I48 and N<>13 Gosub A Else If N=8 Poke S7+I3+CX+CY*80,32 Ink 1 : Text CX*8,CY*8+22," " Gosub C N=29 Gosub C Else If N=13 CX=False : N=31 : Gosub C End If Else If NTrue If Y>209 and Y<223 If X>174 and X<278 _G[175,210,277,222,True] _E["Linenumber:",""] I4=Abs(Val(XN$)) I4=Min(I4,LMAX) I3=I4*80 Gosub B End If If X<81 XN$="" _G[False,210,80,222,True] Do _E["Asc:",XN$] Exit If XN$="" N=Val(XN$) Gosub A Loop End If If X>87 and X<167 XN$="$" _G[88,210,166,222,True] Do _E["Hex:",XN$] Exit If XN$="" N=Val(XN$) Gosub A Loop End If If X>285 and X<391 _G[286,210,390,222,True] _E["Position:",""] N=Min(L7-1,Val(XN$)) CX=N mod 80 I4=N/80 I3=I4*80+CX Gosub B End If If X>397 and X<464 _G[398,210,463,222,True] _E["Search:",""] If XN$="" _T["Search aborted!"] Else N$=XN$ _E["Startaddress:","0"] N=Abs(Val(XN$)) If N-Len(N$)=>L7 _T["Illegal address!"] Else N=Hunt(S7+N To S7+L7,N$) If N Add N,-S7 CX=N mod 80 I4=N/80 I3=I4*80+CX Gosub B Else _T["String » "+N$+" « not found!"] End If End If End If End If If X>469 and X<545 _G[470,210,544,222,True] _E["From address..:","0"] N=Abs(Val(XN$)) N=Min(N,L7-1) _E["Bytelength....:",Str$(L7)-" "] C=Abs(Val(XN$)) If C=False : C=L7 : End If C=Min(C,L7) If N=>C _T["Illegal address!"] Else _E["Filename......:",B$] If XN$<>"" _T["Writing datas to "+XN$] XE=False Open Out 1,XN$ If XE=False Ssave 1,S7+N To S7+C End If Close End If End If End If If X>551 and X<575 _G[552,210,574,222,True] Gosub E End If If X>581 and X<639 _G[582,210,638,222,True] _E["File to insert:",""] If XN$<>"" Open In 1,XN$ If XE=False C=Lof(1) N=Finish(7)-(S7+I3+CX+CY*80) N=Min(C,N) Sload 1 To S7+I3+CX+CY*80,N _T["Bytes inserted:"+Str$(N)] Gosub C A=CX : B=CY : D=LINE : E=I4 : N=False Gosub B CX=A : CY=B : LINE=D : I4=E : Gosub C End If Close End If End If End If Gosub D End If Loop _INSTALLSCREEN Pop Proc A: Poke S7+I3+CX+CY*80,N If N<32 or(N>127 and N<160) Then N=46 Ink 1 : Text CX*8,CY*8+22,Chr$(N) Gosub C N=28 Gosub C Return B: Cls False,False,15 To 640,210 Ink 1 For I=False To 23 For I2=False To 79 If I*80+I2+I3127 and C<160) C=46 End If A$=A$+Chr$(C) End If Next Inc I4 Text False,I*8+22,A$ A$="" Next CX=False CY=False CXALT=False CYALT=False LINE=I4-1 Add LINE,-23 LINE=Max(False,LINE) C: C=I3+CX+CY*80 If N=28 and CX<79 and C+1False Dec CX Else If N=30 and CY>False Dec CY : Dec LINE Else If N=31 and CY<23 and C+80127 and C<161) Then C=46 Ink 1,False : Text CXALT*8,CYALT*8+22,Chr$(CALT) Ink 2,3 : Text CX*8,CY*8+22,Chr$(C) Ink 1,False CALT=C CXALT=CX CYALT=CY Return D: _G[False,210,80,222,False] _G[88,210,166,222,False] _G[175,210,277,222,False] _G[286,210,390,222,False] _G[398,210,463,222,False] _G[470,210,544,222,False] _G[552,210,574,222,False] _G[582,210,638,222,False] Return E: Rs Set False,False Rs Aptr False,C$ Rs Long False,L7 Rs Long False,LMAX _T[Format$("Name:%s - Size:%ld - Lines:%ld",Rs Start(False))] Return End Proc Procedure _DISKINFO _DEVNAME[XSD] : N$=Param$ If N$="" Then _R["No drive selected!","",False] : Pop Proc N=Instr(N$,":") D$=Left$(N$,N)+Chr$(0) Reserve As Chip Work 7,80 I=Start(7) Dreg(1)=Varptr(D$) Dreg(2)=-2 A=Doscall(-84) If A=False Then _R[D$-Chr$(0)+" not available!","",False] : Pop Proc Dreg(1)=A Dreg(2)=I N=Doscall(-114) Dreg(1)=A N=Doscall(-90) _W[34,384,132,%1110,"DISKINFO","","Ok",""] A=Param : _OAGW[A] Ink 1,False X=Deek(A+2)+14 Y=Deek(A+4)+27 Text X,Y,"Devicename : "+Left$(D$,Len(D$)-2) N=Leek(I+4) If Leek(I+20)>512 Then A$="DH" Else A$="DF" If N=-1 Then A$="RAM:" Else A$=A$+Str$(N)-" "+":" Text X,Y+9,"Unit : "+A$ A$=Peek$(I+24,4,Chr$(0)) If Len(A$)>3 If Peek(I+27)<32 A$=Left$(A$,3)+Str$(Peek(I+27))-" " End If End If Text X,Y+18,"Type of disk : "+A$ Text X,Y+27,"Bytes per block:"+Str$(Leek(I+20)) Text X,Y+36,"Blocks :"+Str$(Leek(I+12)) Text X,Y+45,"Used blocks :"+Str$(Leek(I+16)) Text X,Y+54,"Free blocks :"+Str$(Leek(I+12)-Leek(I+16)) N=Leek(I+12)-Leek(I+16) If N>2000000 A#=N/1000.0 A$=Str$(A#*Leek(I+20))+" KB" Else A$=Str$(N*Leek(I+20)) End If Text X,Y+63,"Free bytes :"+A$ A#=((100.0/Leek(I+12))*Leek(I+16)) Text X,Y+72,"Full :"+Str$(A#)+"%" Text X,Y+81,"Errors :"+Str$(Leek(I)) N=Leek(I+8) If N=80 B$="Read Only" Else If N=81 B$="Validating" Else If N=82 B$="Read/Write" End If Text X,Y+90,"Status : "+B$ _WAGW[A] _CAGW[A] End Proc 'Menü 2 Procedure _ANALYZE On Error Proc _ERROR _LIBOPEN[False] : If XE Then Pop Proc Do XE=False _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] Reserve As Work 8,1024 Open In 1,N$ If XE=False Trap Sload 1 To Start(8),Length(8) Dreg(1)=1 : Dreg(0)=Start(8) : Call 16 _T["Analyze "+Param$+": "+Peek$(Start(16)+Areg(0),128,Chr$(0))] End If Close Loop End Proc Procedure _SORT On Error Proc _ERROR _GETFPOS : N=Param _GETF : If Param$="" Then Pop Proc _CALCNAME[Param$] : A$=Param$ _T["Sort.."+A$] _DEVNAME[XSD] : A$=Param$+A$ _FLOAD[A$,7] : If XE Then Pop Proc A=Start(7) B=Finish(7) C=False Repeat A=Hunt(A To B,Chr$(10)) If A Then Inc A : Inc C Until A=False Dec C If C<1 Then _R["Can't sort, file to small!","",False] : Pop Proc Dim N$(C) A=C B=Start(7) _T[""] For I=0 To C Text 6,250,"Calc line:"+Str$(I) If Key State(69) _T["Sorting aborted!"] Pop Proc Else If Free<256 _R["Can't sort, file to large!","",False] For I=False To C N$(I)="" Next Pop Proc End If N$(I)=Peek$(B,256,Chr$(10)) Add B,Len(N$(I))+1 If N$(I)="" Then N$(I)=Chr$(255) : Dec A Next _T["Rest line:"+Str$(A)] Sort N$(0) Open Out 1,A$ If XE Then Pop Proc For I=0 To A Print #1,N$(I)+Chr$(10); Exit If XE Next Close _T["Sorting finished!"] If XSD=False Then A=X0FA Else A=X0FB Loke Start(A)+N*260+124,File Size(A$) Loke Start(A)+N*260+128,File Blocks(A$) End Proc Procedure _REPLACE On Error Proc _ERROR Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Name of file....: "+Param$] _E["String to change:",A$] : A$=XN$ _E["To replace with.:",B$] : B$=XN$ Exit If A$="" _FLOAD[N$,7] : Exit If XE A=Start(7) B=A+Length(7) Do A=Hunt(A To B,A$) Exit If A=False Inc C : Add A,Len(A$) Loop If C=False Then _T["String » "+A$+" « not found!"] : Exit _T["Strings found...:"+Str$(C)] A=Len(A$) B=Len(B$) If A>B C=Length(7)-C*(A-B) Else If A27 or I=E Rs Set False,False Rs Long False,100.0/Length(7)*(C-Start(7)) Rs Long False,I+1 Rs Long False,E+1 Rs Long False,C-Start(7) Rs Long False,Length(7) Text 6,250,Format$("Done:%ld%% - Lines:%ld/%ld - Bytes:%ld/%-15ld",Rs Start(False)) Gosub A : Exit If Param=27,2 : Exit If Param=32 Home Cls False,False,False To 640,224 End If Next Loop Erase 8 _INSTALLSCREEN Pop Proc A: _WAIT If Param=2 or Param=29 or Param=30 I=Max(True,I-56) Else If Param=116 I=True Else If Param=98 I=Max(True,E-28) End If Return End Proc Procedure _SETTAB _E["Tab-Width:",Str$(XTB)-" "] : XTB=Val(XN$) : Set Tab Max(1,XTB) End Proc Procedure _ADDSUFX On Error Proc _ERROR _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc If XSD=False Then A=X0FA Else A=X0FB _E["Add suffix [?|-?]:",""] : If XN$="" Then Pop Proc C$=XN$ If Peek(Varptr(C$))=45 : Rem -? B$=Right$(C$,Len(C$)-1) C$="" End If Do _GETDFPOS : N=Param _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Add suffix.."+Param$] D$=B$+Param$+C$ Rename N$ To A$+D$ Exit If XE Poke$ Start(A)+N*260+8,D$+String$(Chr$(0),108-Len(D$)) Loop End Proc Procedure _REMSUFX On Error Proc _ERROR _DEVNAME[XSD] : A$=Param$ : If A$="" Then Pop Proc If XSD=False Then A=X0FA Else A=X0FB _E["Rem suffix [?|-?]:",""] : If XN$="" Then Pop Proc C$=XN$ If Peek(Varptr(C$))=45 : Rem -? B$=Right$(C$,Len(C$)-1) C$="" End If Do _GETDFPOS : N=Param _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Rem suffix.."+Param$] D$=Param$ B=False If Len(D$)>Len(B$)+Len(C$) If B$<>"" If Left$(D$,Len(B$))=B$ D$=Right$(D$,Len(D$)-Len(B$)) B=True End If Else If Right$(D$,Len(C$))=C$ D$=Left$(D$,Len(D$)-Len(C$)) B=True End If End If End If If B Rename N$ To A$+D$ Exit If XE Poke$ Start(A)+N*260+8,D$+String$(Chr$(0),108-Len(D$)) End If Loop End Proc Procedure _ADDICON On Error Proc _ERROR _LIBOPEN[False] : If XE Then Pop Proc Repeat _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] If File Type(N$)=True Open In 1,N$ A$=Input$(1,4) Close If Leek(Varptr(A$))=$3F3 A=1 : A$="Tool" Else A=2 : A$="Project" End If Else A=False : A$="Drawer" End If _T["Add "+A$+"-Icon to.."+Param$] Open Out 1,N$+".info" If XE=False Dreg(1)=3 : Dreg(0)=A : Call 16 Ssave 1,Areg(0) To Areg(0)+Dreg(0) End If Close Until XE _EXAMINE[XSD] End Proc Procedure _SHOWICON Dim N(3) For I=False To 3 N(I)=Colour(I) Next Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Display as icon.."+Param$] _FLOAD[N$,7] : Exit If XE _B[36,False,639,12] : Text 39,9,N$ Cls False,False,15 To 640,223 A$=Chr$(3)+String$(Chr$(0),5) B$=Chr$(7)+String$(Chr$(0),5) If Peek$(Start(7)+92,6)=A$ ADR=Start(7)+98 Else If Peek$(Start(7)+148,6)=A$ ADR=Start(7)+154 End If If Peek$(Start(7)+92,6)=B$ ADR=Start(7)+98 Else If Peek$(Start(7)+148,6)=B$ ADR=Start(7)+154 End If If ADR=False and Leek(Start(7)+94)=False Then ADR=Start(7)+98 If ADR=False and Leek(Start(7)+150)=False Then ADR=Start(7)+154 B=Deek(Start(7)+14) If Leek(Start(7)+12)=Leek(Start(7)+82) Then Inc B If Leek(Start(7)+12)=Leek(Start(7)+138) Then Inc B A=Deek(Start(7)+12) : Dec B Do Exit If A/16*16=A Inc A Loop C=(A*B)/8 I=(120-B/2)/8 X=(320-A/2)/8+I*640 For I=ADR To ADR+C-1 Step A/8 Copy I,I+A/8 To Logbase(0)+X Add X,80 Next I=(120-B/2)/8 X=(320-A/2)/8+I*640 For I=ADR+C To ADR+C+C-1 Step A/8 Copy I,I+A/8 To Logbase(1)+X Add X,80 Next _T["Left mousekey for colours of OS1.x - right of OS2.x!"] Do _WAIT If Param=1 Palette $5A,$FFF,$2,$F80 Else If Param=2 Palette $AAA,$0,$FFF,$68B Else Exit End If Loop Palette N(0),N(1),N(2),N(3) Loop Colour Back N(0) : View _INSTALLSCREEN End Proc Procedure _SHOWPIC On Error Proc _ERROR If XN$="*" Trap Printer Open If Errtrap _R["Can`t open printer.device!","",False] Pop Proc End If End If Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Show IFF/AmBk picture.."+Param$] _FLOAD[N$,7] Exit If XE A=Hunt(Start(7) To Start(7)+512,"BMHD") B=Hunt(Start(7) To Start(7)+512,"Pac.Pic") If A B=Deek(A+$14) C=Align(B,16) If BFalse or Param=27 Erase 7 If XN$="*" Then Printer Close Pop Proc A: Screen 1 Screen Show 1 If XE=False Screen Hide False Wait 10 If XN$="*" : Rem * Flag für Option PRINTPIC Screen 1 : Printer Dump Repeat : Multi Wait : Until Printer Check Else A=Screen Mode If Btst(2,A) A$=" & Laced" Else A$="" End If If A<5 A$="Lowres"+A$ Else A$="Hires"+A$ End If _T["Width:"+Str$(Screen Width)-" "+" - Height:"+Str$(Screen Height)-" "+" - Colour:"+Str$(Screen Colour)-" "+" - Mode:"+A$] A=Hunt(Start(7) To Start(7)+512,"ANNO") If A : _T["Anno.."+Peek$(A+8,Peek(A+7),Chr$(0))] : End If Screen 1 : _WAIT End If End If Return End Proc Procedure _PRINTPIC _R["Really print?","",True] If Param Then XN$="*" : _SHOWPIC : XN$="" End Proc Procedure _SHOWFONT On Error Proc _ERROR _DEVNAME[XSD] : D$=Param$ : If Param$="" Then Pop Proc Font Open 1,"topaz.font",8 Do _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] A$=Param$ B$="" If Instr(Upper$(A$),".FONT") _FLOAD[N$,7] A=Start(7) Do A=Hunt(A To Finish(7),"/") Exit If A=False B$=B$+Peek$(A,4,Chr$(0)) Inc A Loop Poke Varptr(B$),35 A$=Left$(A$,Len(A$)-5) Do _T[A$+".."+B$] _E["Fontsize "+A$+":",""] : Exit If XN$="",2 If Hunt(Start(7) To Finish(7),"/"+XN$) Font Open 2,N$,Val(XN$) If Font Base(2) XN$=Font Name$(2) Do Font Set 1 _E["Text:",XN$] Exit If XN$="" _B[36,False,639,12] : Text 39,9,Font Name$(2) Cls False,False,15 To 640,223 Font Set 2 Ink 1,0 : Text 0,110+Text Base,XN$ Loop Font Set 1 End If Else _R["Fontsize #"+XN$+" not avail!",B$,False] End If Font Close 2 Loop End If Loop Font Set 1 Font Close _INSTALLSCREEN End Proc Procedure _PLAYANIM On Error Proc _ERROR Do Every Off _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _E["Repeat:",""] N=Max(1,Val(XN$)) _T["Load as IFF Anim.."+Param$] Iff Anim N$ To False,N Exit If XE Screen Close False _INSTALLAMBOS _INSTALLSCREEN Loop End Proc Procedure _PLAYSAM On Error Proc _ERROR Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Load as Raw-Sample.."+Param$] _FLOAD[N$,7] : Exit If XE Bank To Chip 7 : Exit If XE A=Start(7) B=Length(7) If Peek$(A,4)="FORM" C=Hunt(A To Finish(7),"BODY") If C A=C+8 B=Leek(C+4) End If End If XN$="12.00" Do _E["Freq in KB:",XN$] N#=Val(XN$)*1000 Exit If N#=False Pt Raw Play 15,A,B,N# Loop Loop End Proc Procedure _PLAYABK On Error Proc _ERROR Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Play AMOS Music Bank.."+Param$] _FLOAD[N$,7] : Exit If XE Reserve As Chip Work 3,Length(7)-20 Copy Start(7)+12,Finish(7) To Start(3)-8 Exit If XE _PLAYREQ[0,Param$] Exit If Param=1 Until XE End Proc Procedure _PLAYMED Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Play MED Module.."+Param$] Trap Med Load N$,3 If Errtrap=False A$=Param$ If Peek$(Start(3),4)="MMD1" A=Hunt(Start(3) To Finish(3),Long$($FFFFFFFF)) A$=Peek$(A+106,32,Chr$(0)) End If _PLAYREQ[1,A$] Exit If Param=1 Else _R["Can`t load as MED module!","",False] : Exit End If Loop End Proc Procedure _PLAYMOD On Error Proc _ERROR Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Play ST/PT-Module.."+Param$] _FLOAD[N$,3] : Exit If XE Bank To Chip 3 : Exit If XE _PLAYREQ[2,Peek$(Start(3),22,Chr$(0))] Exit If Param=1 Until XE End Proc 'Menü 3 Procedure _APACK On Error Proc _ERROR _E["AMOS Squash Mode [0-3]:","3"] N=Val(XN$) N=Min(Max(False,N),3) Bset 8+N,A Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _FLOAD[N$,7] : Exit If XE _T["Squash [CTRL+C=Abort].."+Param$] N=Length(7) : T=Timer C=Squash(Start(7),N,-1,A,18) If C=-1 _R["Impossible to pack",Param$,False] Else If C=-2 _R["Packing aborted of",Param$,False] Else If C>False _PKINFO[N,C+8,T] Open Out 1,N$ Exit If XE Print #1,"AS20"+Long$(N); Ssave 1,Start(7) To Start(7)+C Close Exit If XE End If Loop _EXAMINE[XSD] End Proc Procedure _PPACK On Error Proc _ERROR _LIBOPEN[1] : If XE Then Pop Proc _E["PP Mode [0-4]:","4"] B=Val(XN$) B=Min(4,Abs(B)) Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _FLOAD[N$,7] : Exit If XE _T["PP Crunch.."+Param$] A=Length(7) : T=Timer Ppk Pack 7,B : Exit If XE _PKINFO[A,Length(7),T] _FSAVE[N$,7] Until XE _EXAMINE[XSD] End Proc Procedure _XPACK _LIBOPEN[2] : If XE Then Pop Proc _E["Xpk Packer ID [4]:","SHRI"] If Len(XN$)<>4 Then Pop Proc A$=Upper$(XN$) _E["Xpk Mode [1-100]:","100"] B=Abs(Val(XN$)) : B=Min(100,B) If B=False _E["Xpk Password:",""] If XN$="" : Pop Proc : End If B$=XN$+Chr$(0) End If On Error Proc _ERROR Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _FLOAD[N$,7] : Exit If XE _T["Xpk Pack.."+Param$] A=Length(7) T=Timer If B Xpk Pack 7,A$,B Else Xpk Crypt 7,A$,B$ End If If Xpk Errn _R["XPK ERROR "+Str$(Xpk Errn),Xpk Err$,False] Else _PKINFO[A,Length(7),T] _FSAVE[N$,7] End If Loop _EXAMINE[XSD] End Proc Procedure _LPACK On Error Proc _ERROR _LIBOPEN[4] : If XE Then Pop Proc Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _FLOAD[N$,7] : Exit If XE _T["Lh-Lib Pack.."+Param$] A=Length(7) : T=Timer Lpk Pack 7 : Exit If XE _PKINFO[A,Length(7),T] _FSAVE[N$,7] Until XE _EXAMINE[XSD] End Proc Procedure _PPBKSAVE On Error Proc _ERROR _LIBOPEN[1] : If XE Then Pop Proc B=7 C=4 Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] Open In 1,N$ Exit If XE A$=Input$(1,4) Close A=Varptr(A$) If Deek(A)=Word("Am") and Leek(A)<>Long("AmBs") _T["Ppsave.."+Param$] If Leek(A)=Long("AmSp") B=1 Else If Leek(A)=Long("AmIc") B=2 Else B$=Str$(B)-" " _E["Banknumber [1-65534]:",B$] Exit If XN$="" B=Val(XN$) End If C$=Str$(C)-" " _E["PP Mode [0-4]:",C$] Exit If XN$="" C=Val(XN$) Exit If B<1 or B>65534 or C4 Load N$,B Exit If XE Ppsave N$,B,C Erase B Else _R["Not a single AMOS bank format!","",False] End If Until XE If B Then Erase B _EXAMINE[XSD] End Proc Procedure _PPBKLOAD On Error Proc _ERROR _LIBOPEN[1] : If XE Then Pop Proc Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Ppload.."+Param$] Open In 1,N$ Exit If XE A$=Input$(1,6) Close A=Varptr(A$) If Leek(A)=Long("PPbk") B=Deek(A+4) Ppload N$,B Exit If XE Save N$,B Erase B Else _R["Not an AMOS Ppsaved format!","",False] End If Until XE If B Then Erase B _EXAMINE[XSD] End Proc Procedure _DECRUNCH _LIBOPEN[3] : If XE Then Pop Proc On Error Proc _ERROR Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Decrunch..: "+Param$] Bank Load N$ : Exit If XE A$=Dpk Name$(8) : Exit If XE If A$="" _T["Not/unknown crunched!"] Else _T["Cruncher..: "+A$] Dpk Unpack 8 : Exit If XE _T["Decrunched:"+Str$(Length(8))+" bytes."] _FSAVE[N$,8] End If Until XE _EXAMINE[XSD] End Proc Procedure _CRUNCHER On Error Proc _ERROR Reserve As Work 7,80 Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] Open In 1,N$ Exit If XE Dreg(1)=Hof(1) Dreg(2)=Start(7) Dreg(3)=Length(7) Dreg(0)=Doscall(-42) Close A$=Peek$(Start(7),4) If A$="PP20" A$="PowerPacker Data" Else If A$="PX20" A$="PowerPacker Crypt" Else If A$="PPbk" A$="PowerPacker Abk" Else If A$="XPKF" A$="Xpk Packer (xpk"+Xpk Name$(7)+".library)" Else If A$="AS20" A$="AMOSPro Squasher (AmBOS format)" Else If A$="IMP!" A$="Imploder Data" Else _LIBOPEN[3] : Exit If XE A$=Dpk Name$(7) End If If A$="" Then A$="not/unknown packed" _T[Param$+".."+A$] Loop Close End Proc Procedure _ENCRYPT _CODING["Encrypt"] End Proc Procedure _DECRYPT _CODING["Decrypt"] End Proc Procedure _UNPACK On Error Proc _ERROR Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] N=File Size(N$) _T["Unpack.."+Param$] _FLOAD[N$,7] : Exit If XE If Length(7)=N _T["Not/Unknown packed!"] Else If Length(7)<>N _T["Unpacked length:"+Str$(Length(7))+" bytes"] _FSAVE[N$,7] End If Until XE _EXAMINE[XSD] End Proc Procedure _BKUNPACK On Error Proc _ERROR Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] N=File Size(N$) _T["Unpack.."+Param$] _FLOAD[N$,7] : Exit If XE If Bpk Length(7) _T["Unpack » BTKL « format"] Bpk Unpack N End If If Length(7)=N _T["Not/Unknown packed!"] Else If Length(7)<>N _T["Unpacked length:"+Str$(Length(7))+" bytes"] _FSAVE[N$,7] End If Until XE _EXAMINE[XSD] End Proc Procedure _PPBEST On Error Proc _ERROR _LIBOPEN[1] : If XE Then Pop Proc _W[50,400,88,%1110,"PPBEST","Abort","","Next"] A=Param _OAGW[A] X=Deek(A+2)+14 Y=Deek(A+4)+27 Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _FLOAD[N$,8] Exit If XE B=Length(8) E=B Cls False,X,Y-7 To X+Deek(A+6)-8,Y+Deek(A+8)-40 Ink 1,False Text X,Y,"Filename: "+Param$+" ("+Str$(B)-" "+")" For I=0 To 4 Text X,Y+9+I*9,"Cmode ["+Str$(I)-" "+"]: crunching.." D=Timer Ppk Pack 8,I D=Timer-D Exit If XE,2 A$=Str$((D mod 50)*2)-" " A$=String$("0",2-Len(A$))+A$ C=Length(8) Text X+80,Y+9+I*9,Str$(100.0-((100.0*C)/B))+"% ("+Str$(B-C)-" "+"), Out:"+Str$(C)-" "+", Sec:"+Str$(D/50)-" "+"."+A$ If C"" Then Save XN$,7 Until XE End Proc Procedure _ABKIFF On Error Proc _ERROR Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["ABK-Name: "+Param$] Load N$,7 Exit If XE Unpack 7 To 1 Exit If XE Screen Hide 1 _E["IFF-Name:",N$] If XN$<>"" Then Screen 1 : Save Iff XN$ Screen Close 1 Until XE End Proc Procedure _GETABS On Error Proc _ERROR Repeat _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Scanning for AMOS banks in.."+Param$] _FLOAD[N$,7] : Exit If XE If Leek(Start(7))<>Long("AMOS") _R[Param$,"Not an AMOS program!",False] Else A=Hunt(Start(7) To Start(7)+Length(7),"AmBs") If A>False and Deek(A+4)>False and Peek(A+6)=65 _T["Number of banks:"+Str$(Deek(A+4))] _T["Length of banks:"+Str$(Start(7)+Length(7)-A+6)+" bytes"] _E["Save banks to..:",N$-".AMOS"+".Abs"] If XN$<>"" Open Out 1,XN$ Exit If XE Ssave 1,A To Start(7)+Length(7) Close End If Else _T["No AMOS banks in "+Param$+"!"] End If End If Until XE End Proc Procedure _SPLITABS On Error Proc _ERROR Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _T["Splitting in single banks.."+Param$] Open In 1,N$ Exit If XE A$=Input$(1,4) Close If A$<>"AmBs" _R[Param$,"Not an AMOS group of banks!",False] Else Load N$ Exit If XE For I=1 To $FFFE If Length(I) _T["Number of bank:"+Str$(I)] _T["Length of bank:"+Str$(Length(I))] _E["Save bank as..:",N$-Param$+Peek$(Start(I)-8,7," ")+Str$(I)-" "+".Abk"] If XN$<>"" : Save XN$,I : End If Erase I End If Next End If Loop End Proc Procedure _SHOWASP On Error Proc _ERROR Screen Open 1,320,209,32,Lowres Screen Hide Curs Off Flash Off Cls False Screen Display 1,,57,, Do Erase 1 Screen False Screen To Front False _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] Open In 1,N$ Exit If XE A$=Input$(1,6) Close A=Varptr(A$) If Leek(A)<>Long("AmSp") and(Leek(A)<>Long("PPbk") and Deek(A+4)<>1) _R[Param$,"Not an AMOS Bob bank!",False] Else If Leek(A)=Long("PPbk") Ppload N$,1 Else Load N$,1 End If Exit If XE _T["AMOS Bob bank.: "+Param$] _T["Number of bobs:"+Str$(Length(1))] _T[""] Screen 1 Screen Show Screen To Front 1 Get Sprite Palette I=1 Do Screen False Rs Set False,False Rs Word False,I Rs Word False,Image Width(1,I) Rs Word False,Image Height(1,I) Text 6,250,Format$("Image number..: %d - W:%d / H:%d ",Rs Start(False)) Screen 1 Cls False Paste Bob False,False,I _WAIT Exit If Param=32 Exit If Param=27,2 If Param=28 : Add I,1,1 To Length(1) Else If Param=29 : Add I,-1,1 To Length(1) End If Loop End If Loop Screen Close 1 Erase 1 End Proc Procedure _SHOWAIC On Error Proc _ERROR Screen Open 1,320,209,32,Lowres Screen Hide Curs Off Flash Off Cls False Screen Display 1,,57,, Do Screen False Screen To Front False _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] Open In 1,N$ Exit If XE A$=Input$(1,6) Close A=Varptr(A$) If Leek(A)<>Long("AmIc") and(Leek(A)<>Long("PPbk") and Deek(A+4)<>2) _R[Param$,"Not an AMOS Icon bank!",False] Else If Leek(A)=Long("PPbk") Ppload N$,2 Else Load N$,2 End If Exit If XE _T["AMOS Icon bank.: "+Param$] _T["Number of icons:"+Str$(Length(2))] _T[""] Screen 1 Screen Show Screen To Front 1 Get Icon Palette I=1 Do Screen False Rs Set False,False Rs Word False,I Rs Word False,Image Width(2,I) Rs Word False,Image Height(2,I) Text 6,250,Format$("Image number...: %d - W:%d / H:%d ",Rs Start(False)) Screen 1 Cls False Paste Icon False,False,I _WAIT Exit If Param=32 Exit If Param=27,2 If Param=28 : Add I,1,1 To Length(2) Else If Param=29 : Add I,-1,1 To Length(2) End If Loop End If Loop Screen Close 1 Erase 2 End Proc Procedure _SHOWA3D N$=":APSystem/C3d.Lib" If Not Exist(N$) _R["Need » "+N$+" «","To display AMOS-3D objects!",False] : Pop Proc End If Erase Temp Screen Open False,320,200,16,Lowres Palette ,,,,,,,,,$FEF,$22F,$508,$F22,$80B,$A0C Colour Back False Cls False Double Buffer Autoback False Do _GETF : Exit If Param$="" : N$=Upper$(Param$) _CALCNAME[Param$] : A$=Upper$(Param$) If Instr(A$,".3DO") N$=N$-A$ A$=A$-".3DO" Trap Td Dir N$ Exit If Errtrap Trap Td Load A$ Exit If Errtrap Td Screen Height 200 Td Object 1,A$,False,False,1000,False,5000,-4000 X=False : Y=False : Z=False Repeat N=Asc(Inkey$) If N If N=30 Td Forward False,-50 Else If N=31 Td Forward False,50 Else If N=32 _WAIT End If Clear Key End If Add X,800 Add Y,550 Add Z,200 Td Angle 1,X,Y,Z Td Cls Td Redraw Screen Swap Wait Vbl Until Mouse Click Td Cls Screen Swap Td Clear All End If Loop N=Errtrap Trap Td Quit _INSTALLAMBOS _INSTALLSCREEN If N Then _T["Can`t load "+A$+" as AMOS-3D object!"] End Proc Procedure _SHOWMEM _E["Startadr:",""] A=Val(XN$) _T["Endadr..: "+Hex$(A+2080)] Cls False,False,15 To 640,224 Ink 1,False For I=False To 25 Text False,21+I*8,Peek$(A+I*80,80) Next _WAIT _INSTALLSCREEN End Proc Procedure _SAVEMEM On Error Proc _ERROR _E["Startadr:",""] A=Abs(Val(XN$)) _E["Endadr..:",""] B=Abs(Val(XN$)) _E["Outfile :",""] If XN$="" Then Pop Proc If A>B Then Swap A,B _DEVNAME[XSD] Open Out 1,Param$+XN$ If XE=False Then Ssave 1,A To B Close _EXAMINE[XSD] End Proc Procedure _VECTEST _W[50,280,86,%1110,"VECTORTEST","","Ok",""] A=Param _OAGW[A] For I=False To 5 Read A$,B B=Leek(Leek(4)+B) If B Then Ink 2,1 Else Ink 1,False Text 284-Len(A$)*4,76+I*9,A$+Hex$(B,8) Next _WAGW[A] _CAGW[A] Data "ColdCapture : ",$2A Data "CoolCapture : ",$2E Data "WarmCapture : ",$32 Data "KickMemPtr : ",$222 Data "KickTagPtr : ",$226 Data "KickCheckSum: ",$22A End Proc Procedure _RESET _W[76,336,23,%110,"RESET","Hardreset","Softreset","Abort"] A=Param _OAGW[A] _WAGW[A] If Param=1 Hardreset Else If Param=2 Softreset End If _CAGW[A] End Proc Procedure _BUFFER On Error Proc _ERROR _W[76,336,23,%110,"BUFFER","Read","Write","Abort"] A=Param _OAGW[A] _WAGW[A] _CAGW[A] If Param=1 _GETF If Param$<>"" Bank Load Param$ To 17 If XE : Erase 17 : End If End If Else If Param=2 If Length(17) _E["Write buffer to:",Cd Path$] If XN$<>"" Bank Save XN$,17 End If Else _R["No buffer allocated!","",False] End If End If End Proc Procedure _PUTADR On Error Proc _ERROR _GETF : If Param$="" Then Pop Proc N$=Param$ : _CALCNAME[Param$] _E["Put "+Param$+" to address:",""] A=Val(XN$) : If A=False Then Pop Proc Open In 1,Param$ If XE Then Pop Proc Sload 1 To A,Lof(1) Close End Proc Procedure _CLONE On Error Proc _ERROR _DEVNAME[XSD] : A$=Param$ : If Param$="" Then Pop Proc _XSD If XSD=False Then A=X0FA Else A=X0FB Do _GETDFPOS : N=Param _GETDF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] B$=A$+Param$ If Exist(B$) _CALCNAME[B$] _T["Clone.."+Param$] Rename B$ To B$ : Exit If XE B$=B$+Chr$(0) Dreg(1)=Varptr(B$) Dreg(2)=Leek(Start(A)+N*260+116) Dreg(0)=Doscall(-186) Dreg(1)=Varptr(B$) Dreg(2)=Start(A)+N*260+144 Dreg(0)=Doscall(-180) End If Loop _XSD : _EXAMINE[XSD] End Proc Procedure _SPLIT On Error Proc _ERROR Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] XE=False A=File Size(N$) Exit If AXX and XXY and YXY+48 and YXY+64 and Y7 If Param=8 and Len(F$)>False F$=Left$(F$,Len(F$)-1) Else If Param<>8 F$=F$+Chr$(Param) End If Ink ,0 : Text XX+10,XY+73,Right$(F$,45)+" " Ink ,3 : Text XX+10+Len(Right$(F$,45))*8,XY+73," " End If Loop Ink ,0 : Text XX+10,XY+73,Right$(F$,46)+" " _G[XX,XY+64,XX+390,XY+76,False] End If End If If X>XX-85 and XXY+82 and YLength(7) Loop End Proc Procedure _SETPRT _GETF If Param$<>"" _CALCNAME[Param$] _T["Set as actual printer.."+Param$] Reserve As Work 7,232 Areg(0)=Start(7) Dreg(0)=232 I=Intcall(-132) Poke$ Start(7)+128,Param$+String$(Chr$(0),30-Len(Param$)) Areg(0)=Start(7) Dreg(0)=232 Dreg(1)=-1 I=Intcall(-324) End If End Proc Procedure _GETDAY _E["Day..:",""] : T=Val(XN$) _E["Month:",""] : M=Val(XN$) _E["Year.:",""] : J=Val(XN$) M=Min(12,M) If(M=1 or M=3 or M=5 or M=7 or M=8 or M=10 or M=12) Then N=32 If(M=4 or M=6 or M=9 or M=11) Then N=31 If M=2 Then If(J mod 4=0) and((J mod 100) or(J mod 400=0)) Then N=30 Else N=29 T=Min(T,N) If M>2 Then J=(J+0.01) Else Add M,12 : Dec J N=T+2*M+Int(0.6*(M+1))+J+Int(J/4) N=N-Int(J/100)+Int(J/400) N=N-7*Int(N/7) For I=False To N Read A$ Next If M>12 Then Add M,-12 : Inc J _T["Date "+(Str$(T)+"."+Str$(M)+"."+Str$(J))-" "+" is a "+A$+"!"] Data "Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday" End Proc Procedure _WORKBENCH _W[76,336,23,%110,"WORKBENCH","Open","Close","Abort"] A=Param _OAGW[A] _WAGW[A] If Param=1 Open Workbench If Not Workbench _R["Can`t open Workbench!","",False] End If Else If Param=2 Close Workbench If Workbench _R["Can`t close Workbench!","",False] End If End If _CAGW[A] End Proc Procedure _STICKTEST _T["Push joystick in port 1 and test it [ESC=End]!"] _T[""] Do A$="No " : B$="No " : C$="No " : D$="No " : E$="No " Exit If Key State(69) A=Joy(1) If Btst(0,A) Then A$="Yes" If Btst(1,A) Then B$="Yes" If Btst(2,A) Then C$="Yes" If Btst(3,A) Then D$="Yes" If Btst(4,A) Then E$="Yes" Text 6,250,"Up:"+A$+" - Down:"+B$+" - Left:"+C$+" - Right:"+D$+" - Fire:"+E$ Multi Wait Loop End Proc Procedure _VALUE Do _E["Value:",""] Exit If XN$="" A=Val(XN$) _T["D:"+Str$(A)-" "+" - H:"+Hex$(A)+" - B:"+Bin$(A)+" - C:"+Long$(A)] Loop End Proc Procedure _ANIMCUT On Error Proc _ERROR _GETF If Param$="" Then Pop Proc N$=Param$ _CALCNAME[Param$] _T["Load IFF-Anim.."+Param$] Open In 1,N$ A=Frame Load(1 To 7,Lof(1)) Close If XE Then Pop Proc N$=N$-Param$ _T["Number of frames.....:"+Str$(A)] Repeat _E["[I=Show - S=Save IFF]:",""] A$=Upper$(XN$) Exit If A$<>"I" and A$<>"S" _E["Frame 1-"+Str$(A)-" "+"...........:",Str$(B+1)-" "] B=Val(XN$) : B=Max(1,Min(A,B)) C=Frame Play(7,B,1) Flash Off Screen Hide 1 Exit If XE Wait 10 If A$="S" Then _E["Save as IFF..........:",N$] Screen Show 1 If A$="S" and XN$<>"" Then Screen 1 : Save Iff XN$ : N$=XN$ If XE=False Then _WAIT Screen Close 1 Until XE End Proc Procedure _AMBOSCOLS Cls False,3,228 To 636,254 For I=False To 3 Cls I,15+I*50,228 To 56+I*50,254 _G[15+I*50,228,55+I*50,253,False] Next _G[216,228,476,235,False] _G[216,237,476,244,False] _G[216,246,476,253,False] _G[504,228,563,240,False] _G[566,228,625,240,False] _G[504,241,563,253,False] _G[566,241,625,253,False] Text 510,237,"GetDef" Text 572,237,"GetSys" Text 510,250,"SetSys" Text 584,250,"Use" Gosub A Do _WAIT : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) If Y>227 and Y<253 If X>15 and X<205 P=Point(X,Y) Gosub A Else If X>215 and X<471 X=(X-216)/16 If Y>227 and Y<236 A$=Hex$(X)-"$" Else If Y>236 and Y<245 B$=Hex$(X)-"$" Else If Y>245 and Y<254 C$=Hex$(X)-"$" End If Colour P,Val("$"+A$+B$+C$) Gosub A Else If X>503 and X<564 and Y>227 and Y<241 _G[504,228,563,240,True] Palette $789,$0,$FFF,$34A Gosub A Wait 15 _G[504,228,563,240,False] Else If X>565 and X<626 and Y>227 and Y<241 _G[566,228,625,240,True] Reserve As Work 7,232 Areg(0)=Start(7) Dreg(0)=232 N=Intcall(-132) Palette Deek(N+110),Deek(N+112),Deek(N+114),Deek(N+116) Gosub A Wait 15 _G[566,228,625,240,False] Else If X>503 and X<564 and Y>240 and Y<256 _G[504,241,563,253,True] Reserve As Work 7,232 Areg(0)=Start(7) Dreg(0)=232 N=Intcall(-132) For I=False To 3 Doke N+110+I*2,Colour(I) Next Areg(0)=N Dreg(0)=232 Dreg(1)=True N=Intcall(-324) Wait 15 _G[504,241,563,253,False] Else If X>565 and X<626 and Y>240 and Y<256 _G[566,241,625,253,True] Default Palette Colour(0),Colour(1),Colour(2),Colour(3) Wait 15 Cls False,9,228 To 636,254 Pop Proc End If End If Loop A: N$=Hex$(Colour(P),3)-"$" A$=Mid$(N$,1,1) B$=Mid$(N$,2,1) C$=Mid$(N$,3,1) Text 486,234,A$ Text 486,243,B$ Text 486,252,C$ A=Val("$"+A$) B=Val("$"+B$) C=Val("$"+C$) For I=False To 2 : Cls False,217,229+I*9 To 476,235+I*9 : Next Ink 1 Bar 217+A*16,230 To 233+A*16,233 Bar 217+B*16,239 To 233+B*16,242 Bar 217+C*16,248 To 233+C*16,251 _G[15+P2*50,228,55+P2*50,253,False] P2=P _G[15+P*50,228,55+P*50,253,True] Colour Back Colour(0) View Return End Proc Procedure _AMBOSFDIR _DEVNAME[XSD] If Param$<>"" If XSD=False A=X0FA Else A=X0FB End If _FSAVE[Param$+".ambosdir",A] End If End Proc Procedure _AMBOSMENU On Error Proc _ERROR _W[76,336,23,%110,"AmBOS MENU","Load","Save","Abort"] A=Param _OAGW[A] _WAGW[A] If Param=1 Open In 1,"S:AmBOS.menu" For B=False To 44 Exit If XE Input #1,XCM$(B) Next Close Else If Param=2 If Not Exist("S:") _R["Directory » S: « not available!","",False] Else Open Out 1,"S:AmBOS.menu" For B=False To 44 Exit If XE Print #1,XCM$(B) Next Close End If End If _CAGW[A] End Proc Procedure _AMBOSEXAM _E["Max. examining:",Str$(XEXA-1)-" "] A=Val(XN$)+1 : If A>9 Then XEXA=A End Proc Procedure _AMBOSDPTH _W[76,336,23,%110,"AmBOS DEPTH","2","4","8"] A=Param _OAGW[A] _WAGW[A] _CAGW[A] If Btst(Param,XSCRN) Then Pop Proc XSCRN=False Bset Param,XSCRN _INSTALLAMBOS _INSTALLSCREEN End Proc Procedure _AMBOSINFO _W[25,368,159,%11110,"AmBOS PRIVATE INFO","","Ok",""] A=Param _OAGW[A] X=Deek(A+2)+14 Y=Deek(A+4)+27 Ink 1,False Text X,Y,"Examine files :"+Str$(XEXA-1) Text X,Y+$9,"Examined A :" Text X,Y+18,"Examined B :" Text X,Y+27,"Currentdir : "+Right$(Cd Path$,28) Text X,Y+36,"Colors :"+Str$(XSCRN) Text X,Y+45,"Varspace :"+Str$(Free) Text X,Y+54,"Buffer :"+Str$(Length(17)) Text X,Y+63,"Chipfree :"+Str$(Chip Free) Text X,Y+72,"Fastfree :"+Str$(Fast Free) Text X,Y+81,"AmBOS.Lib :" Text X,Y+90,"PowerPacker.Lib:" Text X,Y+99,"XpkMaster.Lib :" Text X,Y+108,"DeCrunch.Lib :" Text X,Y+117,"Lh.Lib :" For I=False To 15 If Length(100+I) Then Ink 2,3 Else Ink 1,False Text X+136+I*12,Y+$9,Hex$(I)-"$" If Length(116+I) Then Ink 2,3 Else Ink 1,False Text X+136+I*12,Y+18,Hex$(I)-"$" Next Ink 1,False If Length(16) Then A$=Hex$(Start(16),8) Else A$="-" Text X+136,Y+81,A$ For I=1 To 4 If Lib Base(I) Then A$=Hex$(Lib Base(I),8) Else A$="-" Text X+136,Y+81+I*9,A$ Next _WAGW[A] _CAGW[A] End Proc Procedure _WORKINFO _B[36,False,639,12] : Text 39,9,"WORKINFO" Cls False,False,14 To 640,194 Ink 1,0 For I=0 To 21 Text 0,21+I*8,XTI$(I) Next _WAIT _INSTALLSCREEN End Proc Procedure _ABOUT _W[25,384,150,%1110,"AmBOS "+XAV$,"","Ok",""] A=Param : _OAGW[A] Ink 1,0 Y=53 Do Read A$ Exit If A$="" X=Text Length(A$) Text 320-X/2,Y,A$ Add Y,8 Loop _WAGW[A] _CAGW[A] Data "Coded in AMOSPro V2.0 and APCmp V2.0" Data "Using "+Left$(Explode$,31) Data " " Data "Giftware" Data "Send me what ever you think about" Data " " Data "Volker Stepprath" Data "Tegeler Str.7" Data "40789 Monheim" Data "Germany" Data " " Data "E-Mail: Peacefloete"+Chr$(64)+"aol.com" Data " " Data "AmBOS "+XAV$+" FD © 2002 by Testaware" Data "" End Proc 'Menü 5-8 Procedure _CALLOWN[A,B] Wait 15 B=(XOM-5)*14+B A$=XCM$(B) If A=2 or Len(A$)=False If A$<>"" A$=Flip$(A$) B$=Peek$(Varptr(A$),Len(A$),"=") B$=Flip$(B$) A$=Flip$(A$) A$=Peek$(Varptr(A$),Len(A$),"=") End If _E["Menuname..:",A$] : A$=XN$ _E["Doscommand:",B$] : A$=A$+"="+XN$ If Len(A$)<3 : A$="" : End If XCM$(B)=A$ _MENU Else A$=Flip$(A$) A$=Peek$(Varptr(A$),Len(A$),"=") XN$=Flip$(A$)+Chr$(0) _RUN End If End Proc 'Unterfunktionen Procedure _ACDC[A] XB=Number(A) XS=Start(XB) XL=Length(XB) 'DOS CSI-Codes ($1B/$9B) Konvertierung A=Hunt(XS To Finish(XB),Chr$(27)) If A If Instr("BCDEFILPRSUWXY",Peek$(A+1,1)) A=False End If Else A=Hunt(XS To Finish(XB),Chr$(155)) End If If A _T["Convert DOS csi-codes.."] F=Finish(XB) B=Bank Free(XB) Trap Reserve As Work B,XL+5000 If Errtrap=False N=XS Do N=Hunt(N To F,Chr$(155)) Exit If N=False Poke N,27 Inc N Loop C=Start(B) Do N=Hunt(XS To F,Chr$(27)) Exit If N=False If XSC Then Swap B,C Reserve As Chip Work 7,5632 Dev Open 1,"trackdisk.device",58,A,False Loke Dev Base(1)+36,512 Loke Dev Base(1)+40,Start(7) Loke Dev Base(1)+44,False Trap Dev Do 1,10 For I=B To C Text X,Y,"Reading block :"+Str$(I) Text X,Y+9,"Blocks to go :"+Str$(C-I)+" " Text X,Y+18,"Filelength :"+Str$((I-B)*512+512) Text X,Y+27,"Bytes to write:"+Str$((C-I)*512)+" " Loke Dev Base(1)+40,Start(7)+I2 Loke Dev Base(1)+44,I*512 Trap Dev Do 1,2 Add I2,512,False To 5120 If I2=False Then Ssave 1,Start(7) To Start(7)+5632 : Wait 50 _WAGW[Start(11)] : Exit If XE+Param Next If XE+Param=False and I2>False Then Trap Ssave 1,Start(7) To Start(7)+I2 Close Loke Dev Base(1)+36,False : Trap Dev Do 1,9 Loke Dev Base(1)+44,False : Trap Dev Do 1,10 Dev Close If XE+Param=False Then Repeat : _WAGW[Start(11)] : Until Param End Proc Procedure _CALCNAME[A$] 'A$ = Device+Filename A$=Flip$(A$) A$=Peek$(Varptr(A$),Len(A$),"/") A$=Peek$(Varptr(A$),Len(A$),":") A$=Flip$(A$) End Proc[A$] Procedure _CODING[A$] On Error Proc _ERROR Do _GETF : Exit If Param$="" : N$=Param$ : _CALCNAME[Param$] _E[A$+"code:",""] Exit If XN$="" B$="JVuodl"+XN$+"iktehr" _T[A$+".."+Param$] Bank Load N$ To 7 : Exit If XE A=Start(7) B=A+Length(7)-4 Repeat Loke A,(Leek(A) xor Leek(Varptr(B$)+C)) Loke A,(Leek(A) xor $414D4F53) Add C,1,False To Len(B$)-4 Add A,4 Until A>B _FSAVE[N$,7] : Exit If XE Loop End Proc Procedure _CONVAB[N] 'N = True = Asm 'N = False = Basic On Error Proc _ERROR _T["Converting: "+Param$] N$=Param$ _DEVNAME[XSD] Bank Load Param$+N$ To 7 If XE Then Pop Proc _E["[L]ong - [W]ord - [B]yte:",""] A$=Upper$(XN$) If A$="L" A=3 Else If A$="W" A=1 Else If A$="B" A=False Else Goto A End If If N A$=Tab$+"DC."+A$+Tab$ : B$=";" Else A$="Data " : B$="Rem " End If _E["Number of items per line:",""] B=Val(XN$) If B=False Then Goto A _XSD _DEVNAME[XSD] _XSD _E["Save to:",Param$+N$] If XN$="" Then Goto A Open Out 1,XN$ If XE Then Goto A Print #1,B$+"*"+Str$(Length(7)/(A+1))+" Datas *"+Chr$(10); For I=False To Length(7)-1 If A=False B$=Hex$(Peek(Start(7)+I),2) Else If A=1 B$=Hex$(Deek(Start(7)+I),4) Else If A=3 B$=Hex$(Leek(Start(7)+I),8) End If Add I,A C$=C$+B$+"," Inc C If C=B Print #1,A$+Left$(C$,Len(C$)-1)+Chr$(10); C$="" C=False End If If XE+Key State(69) Then Goto A Next If C and XE=False Then Print #1,A$+Left$(C$,Len(C$)-1)+Chr$(10); Goto B A: _T["Converting aborted!"] B: Close End Proc Procedure _CONVAP[N] On Error Proc _ERROR _T["Converting: "+Param$] N$=Param$ _DEVNAME[XSD] A$=Param$+N$ If N Pload A$,7 Else Bank Load A$ To 7 End If If XE Then Goto A _XSD _DEVNAME[XSD] _XSD _E["Save as:",Param$+N$] If XN$="" Then Goto A N$=XN$ _E["Number of items per line:",""] B=Val(XN$) : If B<1 Then Goto A A=Length(7)-1 Dec B Open Out 1,N$ If XE Then Goto A Print #1,"Rem *"+Str$(A+1)+" Datas *"+Chr$(10); For I=False To A N$="" For I2=False To B If I+I2<=A N$=N$+Str$(Peek(Start(7)+I+I2))+"," End If Next Add I,B If XE+Key State(69) Then Goto A Print #1,"Data "+Left$(N$,Len(N$)-1)-" "+Chr$(10); Next Goto B A: _T["Converting aborted!"] B: Close End Proc Procedure _COPYING[A$,B$] On Error Proc _ERROR If File Type(A$)=-2 If File Type(B$)<>-2 _T["Mkdir.."+B$] Mkdir B$ End If Pop Proc End If _T["Copy.."+A$+" ("+Str$(File Size(A$))-" "+" bytes)"] Open In 1,A$ If XE Then Goto A Open Out 2,B$ If XE Then Goto A A=Lof(1) If A Trap Reserve As Work 7,A If Errtrap Reserve As Work 7,Min(50000,A) End If Repeat Dreg(1)=Hof(1) Dreg(2)=Start(7) Dreg(3)=Length(7) A=Doscall(-42) Dreg(1)=Hof(2) Dreg(2)=Start(7) Dreg(3)=A B=Doscall(-48) Wait Vbl Until AD Add C,512 Next Loke Dev Base(1)+36,False Trap Dev Do 1,9 Loke Dev Base(1)+44,False Trap Dev Do 1,10 Dev Close Close If XE+Param=False Then Repeat : _WAGW[Start(11)] : Until Param End Proc Procedure _DATE[D] Y=1978 Do If(Y-1 and 3)=False L=1 Else L=False End If Exit If D<365+L Add D,-365-L Inc Y Loop M=1 For I=1 To 12 Read N Exit If D5 _LIBOPEN[1] If XE=False _E["Password:",""] If Ppk Password(N,XN$) Ppk Unpack N,XN$ Else _R["Wrong password!","",False] End If End If Else Ppk Unpack N End If Else If A$="XPKF" _LIBOPEN[2] If XE=False Xpk Unpack N If Xpk Errn=-13 _E["Password:",""] Xpk Unpack N,XN$ End If If Xpk Errn _R["XPK ERROR "+Str$(Xpk Errn),Xpk Err$,False] End If End If Else If A$="AS20" A=Bank Free(N) Reserve As Work A,Leek(Start(N)+4) If XE=False Copy Start(N)+8,Start(N)+Length(N) To Start(A) B=Unsquash(Start(A),Length(N)-8) Bank Swap A,N End If Erase A Else If A$="IMP!" A=Bank Free(N+1) Imploder Unpack N To A If XE=False Bank Swap A,N End If Erase A Else If A$="LH18" Lpk Unpack N End If End If End If End Proc Procedure _DEVNAME[A] '-> A = False/True '=> Param$ = Devicename If A=False Then A=X0FA Else A=X0FB If Length(A) If Peek(Start(A))<>2 A$=Peek$(Start(A)+8,252,Chr$(0)) End If End If End Proc[A$] Procedure _DEVSDIR[A,B] 'A = BnkNr. 'B = Position If Length(A) A$=Peek$(Start(A)+8,252,Chr$(0)) A$=A$+Peek$(Start(A)+8+B*260,108,Chr$(0)) End If End Proc[A$] Procedure _DIRALL[A$] If Exist(A$)=False Then Pop Proc If Length(7)=False Reserve As Work 8,(XEXA+1)*260 XDA=Start(8) Poke$ XDA,A$ Add XDA,Len(A$)+1 Reserve As Chip Work 7,260 Poke$ Start(7),A$+Chr$(0) End If If XDA+260>Finish(8) Then Pop Proc A=Bank Free(1) Reserve As Chip Work A,260 A=Start(A) N$=A$+Chr$(0) Dreg(1)=Varptr(N$) Dreg(2)=-2 B=Doscall(-84) Dreg(1)=B Dreg(2)=A Dreg(0)=Doscall(-102) C=Start(7) Do Exit If Key State(69) Dreg(1)=B Dreg(2)=A Dreg(0)=Doscall(-108) Exit If Dreg(0)=False If Leek(A+4)True A$=Peek$(N+CX,256,Chr$(0)) Dec CX Poke$ N+CX,A$+Chr$(0) End If Else If A=28 If Key Shift CX=Max(False,Hunt(N To N+256,Chr$(0))-N-1) Else If Peek(N+CX+1)<>False Inc CX End If Else If A=29 If Key Shift CX=False Else If CX-1>True Dec CX End If Else If A>False A$=Peek$(N+CX,256,Chr$(0)) Poke$ N+CX,Chr$(A)+A$ Inc CX Else If Key State(70) If Key Shift Ink ,0 : Text X,250,Space$(XM+2) A$=Peek$(N,CX,Chr$(0)) Fill N To N+512,False Poke$ N,A$+" " Else If Peek(N+CX+1)<>False A$=Peek$(N+CX+1,256,Chr$(0)) Poke$ N+CX,A$+Chr$(0) Wait 5 End If End If Gosub A Loop A$=Peek$(N,256,Chr$(0)) If A$<>"" Then XN$=Left$(A$,Len(A$)-1) Ink 1,0 : Text X,250,Right$(XN$,XM)+" " _GETMESS[XN$] Erase Number(N) Pop Proc A: If CX>XM Then A=CX-XM Else A=False A$=Peek$(N+A,XM,Chr$(0)) Ink 1,0 : Text X,250,A$+" " A=Min(XM,CX) Ink 2,3 : Text X+A*8,250,Peek$(N+CX,1) Return End Proc Procedure _ERROR Screen False XE=Errn A$=Err$(XE) If Len(A$)=False If Length(16)=False B$="LIBS:ambos.library" If Exist(B$) Trap Bank Load B$ To 16 If Errtrap=False Trap Ppk Unpack 16 Trap Xpk Unpack 16 Trap Bpk Unpack 16 End If End If End If If Length(16) Dreg(1)=4 : Dreg(0)=XE : Call 16 A$=Peek$(Start(16)+Areg(0),128,Chr$(0)) End If End If If A$="" Then A$="Fatal error occured" _W[60,336,64,%1110,"ERROR","","Oh No",""] A=Param : _OAGW[A] B$="AmBOS Error #"+Str$(XE)-" "+"!" Ink 1,False Text 320-Len(A$)*4,93,Right$(A$,40) Text 320-Len(B$)*4,103,Right$(B$,40) _WAGW[A] _CAGW[A] Resume Next End Proc Procedure _EXADEVS[A] 'Ausgabe des Device-Namen, A = False/True _DEVNAME[A] A$=Right$(Param$,36) Cls 3,2+341*Abs(A),182 To 297+341*Abs(A),191 Ink 1,3 : Text 6+341*Abs(A),189,A$ Gr Writing False : Ink 2,False : Text 4+341*Abs(A),188,A$ : Gr Writing 1 End Proc Procedure _EXAENTR[A] 'Eingabe des Device-Namen, A = False/True N=Abs(A)*341 _G[N,180,N+298,192,True] _G[N+1,181,N+297,191,False] If A=False Then B=X0FA Else B=X0FB _DEVNAME[A] _E["Dev:",Param$] If XN$<>"" If Exist(XN$) Poke$ Start(B)+8,XN$+Chr$(0) _EXAMINE[A] Else _R["Device not available!","",False] End If End If _G[N,180,N+298,192,False] _G[N+1,181,N+297,191,True] End Proc Procedure _EXAMINE[N] '-> N = False/True 'FIBlk: BYTE 0 type (0=DIR, 1=FILE, 2=DEVICE) ' BYTE 1 status (0=NOTSET, 1=SET) ' CHAR 8 name (104 bytes) ' LONG 112 diskkey ' LONG 116 protection ' LONG 124 by tesize ' LONG 128 blocksize ' STRC 132 datestamp (12 bytes) ' CHAR 144 comment (116 bytes) 'FIBnk: STRC 0 device: (260 bytes) ' STRC 1 fib_files..(260 bytes..) On Error Proc _ERROR If N=False Then A=X0FA Else A=X0FB If Length(A)=False Then Pop Proc Proc _DEVNAME[N] If Not Exist(Param$) Then Pop Proc A$=Param$ 'XSD mit rechter Maus geschaltet dann.. If XAFD If Exist(A$+".ambosdir") _FLOAD[A$+".ambosdir",A] If XE=False : Bank As Data A : Goto _A : End If End If End If XE=False If File Type(A$)=-2 If XE : Goto _A : End If Reserve As Data A,XEXA*260 If XE : Erase A : Goto _A : End If A$=A$+Chr$(0) Dreg(1)=Varptr(A$) Dreg(2)=-2 B=Doscall(-84) If B=False Erase A Goto _A End If Cd Set A$-Chr$(0) Poke$ Start(A)+8,Cd Path$ Reserve As Chip Work 7,260 Dreg(1)=B Dreg(2)=Start(7) If Doscall(-102) For C=1 To XEXA-1 Dreg(1)=B Dreg(2)=Start(7) Exit If Doscall(-108)=False or Key State(69) Copy Start(7),Start(7)+Length(7) To Start(A)+C*260 Next Bank Shrink A To C*260 End If Dreg(1)=B B=Doscall(-90) If C>1 Dec C Dim N$(C) For B=1 To C D=Start(A)+B*260 Loke D+112,Leek(D) Loke D,False If Leek(D+4) InfoBlock 'B => Lock 'C => Examine/ExNext ok? On Error Proc _ERROR A=Peek(Varptr(A$)+Len(A$)-1) : If A<>47 and A<>58 Then A$=A$+"/" A=Peek(Varptr(B$)+Len(B$)-1) : If A<>47 and A<>58 Then B$=B$+"/" A=Bank Free(1) Reserve As Chip Work A,260 A=Start(A) C$=A$+Chr$(0) Dreg(1)=Varptr(C$) Dreg(2)=-2 B=Doscall(-84) Dreg(1)=B Dreg(2)=A C=Doscall(-102) Repeat Exit If Key State(69) Dreg(1)=B Dreg(2)=A C=Doscall(-108) Exit If C=False Gosub EXAMULT Exit If XE If Leek(A+4)>False _EXAMULT[N,A$+C$,B$+C$] End If Until XE Erase Number(A) Dreg(1)=B C=Doscall(-90) Pop Proc EXAMULT: C$=Peek$(A+8,108,Chr$(0)) If N=False _COPYING[A$+C$,B$+C$] Else If N=1 If Leek(A+4)"" _COPYING[A$+C$,B$+XN$] Else _T[C$+" not copied!"] End If Else _COPYING[A$+C$,B$+C$] End If End If Return End Proc Procedure _EXANAME[A,B] 'Dateieintrag formatieren 'A = BnkNr. 'B = Position (Dir 0 / File 1 / Dev 2) A=Start(A)+B*260 B=Peek(A) N$=Peek$(A+8,29,Chr$(0)) If B=False A$=" [DIR]" Else If B=1 A$=Right$(Str$(Leek(A+124))-" ",7) A$=String$(" ",7-Len(A$))+A$ Else If B=2 A$=" [DEV]" End If N$=N$+String$(" ",29-Len(N$))+A$ End Proc[N$] Procedure _EXASCRD[A] If A=False If XPOSA>False Scroll 3 If Peek(Start(X0FA)+XPOSA*260)=1 : Ink 1 Else Ink 3 : End If If Peek(Start(X0FA)+XPOSA*260+1) Ink 2,1 Else Ink ,False End If _EXANAME[X0FA,XPOSA] Text 5,39,Param$ Dec XPOSA _SCROLLBAR[False] End If Else If XPOSB>False Scroll 4 If Peek(Start(X0FB)+XPOSB*260)=1 : Ink 1 Else Ink 3 : End If If Peek(Start(X0FB)+XPOSB*260+1) Ink 2,1 Else Ink ,False End If _EXANAME[X0FB,XPOSB] Text 346,39,Param$ Dec XPOSB _SCROLLBAR[True] End If End If End Proc Procedure _EXASCRU[A] If A=False If XPOSA+18False For I=1 To D E=I+C _EXANAME[B,E] If Peek(Start(B)+E*260)=1 : Ink 1 Else Ink 3 : End If If Peek(Start(B)+E*260+1) Ink 2,1 Else Ink ,False End If Text 5+341*Abs(A),31+I*8,Param$ Next End If Else Cls False,1+341*Abs(A),31 To 298+341*Abs(A),178 End If _EXADEVS[A] End Proc Procedure _EXIT Every Off Open Workbench Request On Lib Close Erase All Wait 10 If Prg State<>1 Amos To Back Wait Vbl Default End If End End Proc Procedure _FLOAD[A$,A] On Error Proc _ERROR Open In 7,A$ If XE Then Pop Proc Close 7 Bank Load A$ To A If XE=False Then Proc _DEPACK[A] End Proc Procedure _FORMAT[A] _DRIVETEST[A] : If Param Then Pop Proc N$="DF"+Str$(A)-" "+":" N=Drive State(A) If N=-1 Then _R["No disk in drive "+N$+"!","",False] : Pop Proc If N=-2 Then _R["Disk in drive "+N$,"Is write protected!",False] : Pop Proc X=Deek(Start(11)+2)+50 Y=Deek(Start(11)+4)+38 Reserve As Chip Work 7,5632 Dev Open 1,"trackdisk.device",58,A,False Loke Dev Base(1)+36,5632 Loke Dev Base(1)+40,Start(7) Loke Dev Base(1)+44,False Trap Dev Do 1,10 For I=False To 159 Text X,Y,"Formatting track:"+Str$(I) Text X,Y+9,"Tracks to go :"+Str$(159-I)+" " Loke Dev Base(1)+44,I*5632 : Trap Dev Do 1,11 _WAGW[Start(11)] : Exit If Param Next If Param=False N=Start(7) For I=$204 To $2DF Poke N+I,$FF Next Doke N+2,$2 Poke N+15,$48 Loke N+20,$A661AEF3 Doke N+$13A,$1 Doke N+$13E,$371 Poke N+$1B0,$5 Poke N+$1B1,$45 Poke N+$1B2,$4D Poke N+$1B3,$50 Poke N+$1B4,$54 Poke N+$1B5,$59 Poke N+$1FF,$1 Loke N+$200,$C000C037 Poke N+$272,$3F Poke N+$2DC,$3F Loke Dev Base(1)+44,$6E000 Trap Dev Do 1,11 Fill Start(7) To Start(7)+5632,False Poke$ Start(7),"DOS" Loke Dev Base(1)+44,False Trap Dev Do 1,11 End If Loke Dev Base(1)+36,False Trap Dev Do 1,9 Loke Dev Base(1)+44,False Trap Dev Do 1,10 Dev Close End Proc Procedure _FSAVE[A$,A] On Error Proc _ERROR Open Out 1,A$ If XE=False Trap Ssave 1,Start(A) To Finish(A) End If Close End Proc Procedure _G[X,Y,A,B,N] If N Then C=1 : D=2 Else C=2 : D=1 Ink C : Polyline X,B To X,Y To A,Y Ink D : Polyline To A,B To X,B Ink 1,False End Proc Procedure _GETDEVICES[N] 'N = False/True If N=False Then A=X0FA Else A=X0FB Reserve As Data A,100*260 A$=Dev First$("**") Wait Vbl Do Inc B If A$="" Then Exit C=Instr(A$,":") A$=Left$(A$,C) A$=Right$(A$,C-1) Poke Start(A)+B*260,2 Poke$ Start(A)+8+B*260,A$ A$=Dev Next$ Loop If Hunt(Start(A) To Start(A)+Length(A),"RAM:")=False Poke Start(A)+B*260,2 Poke$ Start(A)+8+B*260,"RAM:" Inc B End If Bank Shrink A To B*260 If N=False XPOSA=False XANZA#=B Else XPOSB=False XANZB#=B End If Cls False,1+341*Abs(N),31 To 298+341*Abs(N),178 _X0FAB[N] _SCROLLBAR[N] End Proc Procedure _GETDF If XSD=False Then A=X0FA : B=XANZA# Else A=X0FB : B=XANZB# If Length(A) For I=1 To B Exit If Key State(69) If Peek(Start(A)+I*260+1) Poke Start(A)+I*260+1,False A$=Peek$(Start(A)+8,252,Chr$(0)) A$=A$+Peek$(Start(A)+I*260+8,108,Chr$(0)) Exit End If Next End If End Proc[A$] Procedure _GETDFPOS If XSD=False Then A=X0FA : B=XANZA# Else A=X0FB : B=XANZB# If Length(A) For I=1 To B Exit If Peek(Start(A)+I*260+1) Next End If End Proc[I] Procedure _GETF If XSD=False Then A=X0FA : B=XANZA# Else A=X0FB : B=XANZB# If Length(A) For I=1 To B Exit If Key State(69) If Peek(Start(A)+I*260)=1 and Peek(Start(A)+I*260+1)=1 Poke Start(A)+I*260+1,False A$=Peek$(Start(A)+8,252,Chr$(0)) A$=A$+Peek$(Start(A)+I*260+8,104,Chr$(0)) Exit End If Next End If End Proc[A$] Procedure _GETFPOS If XSD=False Then A=X0FA : B=XANZA# Else A=X0FB : B=XANZB# If Length(A) For I=1 To B Exit If Peek(Start(A)+I*260)=1 and Peek(Start(A)+I*260+1)=1 Next End If End Proc[I] Procedure _GETMESS[A$] If A$<>"" and A$<>XTI$(21) For I=1 To 21 XTI$(I-1)=XTI$(I) Next XTI$(21)=A$ End If End Proc Procedure _HELP _G[496,False,529,12,True] _LIBOPEN[False] : If XE Then _G[496,False,529,12,False] : Pop Proc _R["Helpmode activated,","Select option to explain!",False] Colour 18,$90 Do Proc _WAIT : Exit If Param=True A=True X=X Screen(X Mouse) Y=Y Screen(Y Mouse) If Y>194 and Y<208 X=X/80 A=X Y=195 Else If X<558 and(Y>209 and Y<223) X=X/80 A=X+8 Y=210 Else If X>563 and X<636 and Y>209 and Y<223 X=(X-564)/20 Y=(Y-210)/7 XOM=X+Y*4 _NEWMENU : _MENU Else If Param=27 or X>496 and X<529 and Y<12 Exit End If If A>True Cls False,False,14 To 640,194 _G[X*80+1,Y,X*80+78,Y+12,True] A$=XMEN$(0,A) If Instr(A$,"=") Ink 2,False : Text 276,21,"DOS COMMAND" Ink 1 : Text 320-Len(A$)*4,31,A$ Else Dreg(1)=0 : Dreg(0)=XOM*15+A : Call 16 A=Start(16) A$=Peek$(A+Areg(0),128,Chr$(0)) Ink 2,False : Text 320-Len(A$)*4,21,A$ A=1+A+Areg(0)+Len(A$) B=31 Ink 1 Repeat A$=Peek$(A,75,Chr$(0)) Text 16,B,A$ Add A,75 Add B,8 Until Instr(A$,"!") If Areg(1) A=Start(16) A$=Peek$(A+Areg(1),128,Chr$(0)) Add B,8 Ink 2,False : Text 320-Len(A$)*4,B,A$ A=1+A+Areg(1)+Len(A$) Add B,9 Ink 1 Repeat A$=Peek$(A,75,Chr$(0)) Text 16,B,A$ Add A,75 Add B,8 Until Instr(A$,"!") End If End If Wait 10 _G[X*80+1,Y,X*80+78,Y+12,False] End If Loop Colour 18,$C00 _INSTALLSCREEN End Proc Procedure _ICONIFY _G[606,False,639,12,True] Every Off Open Workbench Reserve As Chip Work 7,52 Wait 30 N$="AmBOS"+Chr$(0) N=Start(7) Doke N+4,Len(N$)*8+77 Doke N+6,10 Poke N+8,2 Poke N+9,3 Loke N+10,$200 Loke N+14,14 Loke N+26,Varptr(N$) Doke N+46,1 Amos Lock Amos To Back Screen Close False Areg(0)=N N=Intcall(-204) Areg(0)=Leek(N+86) A=Execall(-384) Areg(0)=N N=Intcall(-72) Amos Unlock Amos To Front _INSTALLAMBOS _INSTALLSCREEN End Proc Procedure _INSTALL[A,B] _LIBOPEN[False] : If XE Then Pop Proc _DRIVETEST[A] : If Param Then Pop Proc A$="DF"+Str$(A)-" "+":" N=Drive State(A) If N=-1 Then _R["No disk in drive "+A$+"!","",False] : Pop Proc If N=-2 Then _R["Disk in drive "+A$,"Is write protected!",False] : Pop Proc Reserve As Chip Work 7,1024 Dev Open 1,"trackdisk.device",58,A,0 Loke Dev Base(1)+36,1024 Loke Dev Base(1)+40,Start(7) Loke Dev Base(1)+44,False Trap Dev Do 1,10 Dreg(1)=2 : Dreg(0)=B : Call 16 Copy Areg(0),Areg(0)+Dreg(0) To Start(7) Loke Dev Base(1)+44,False Trap Dev Do 1,3 Trap Dev Do 1,4 Loke Dev Base(1)+36,False Trap Dev Do 1,9 Dev Close End Proc Procedure _INSTALLAMBOS Screen Open False,640,256,XSCRN,Hires Flash Off Curs Off Colour 17,$FFF Colour 18,$C00 Colour 19,$0 Colour Back Colour(0) View Limit Mouse X Hard(0),Y Hard(0) To X Hard(0)+640,Y Hard(0)+256 Wait Vbl End Proc Procedure _INSTALLSCREEN 'Pfeile Cls 0 : Ink 1 : For I=False To 4 : Draw 5-I,1+I To 5+I,1+I : Next : Bar 4,6 To 6,9 : Get Block 1,0,0,10,9,0 : Cls 0 Put Block 1,304,154 : Put Block 1,325,154 : Vrev Block 1 : Put Block 1,304,169 : Put Block 1,325,169 : Del Block 1 'Exit _B[False,False,33,12] : _G[13,6,20,7,False] _B[36,False,107,12] _B[110,False,143,12] _B[146,False,493,12] _B[496,False,529,12] _B[532,False,603,12] 'Iconify _B[606,False,639,12] : Cls 1,613,3 To 633,10 : Cls 2,614,4 To 632,9 : Cls 1,621,3 To 633,6 : Cls 3,622,4 To 632,5 A$="AmBOS "+XAV$+" © 10-06-02 by Testaware" Gr Writing False Ink 1 : Text 182,10,A$ Ink 2 : Text 180,9,A$ Gr Writing 1 Text 123,9,"R" Text 509,9,"H" 'S Oben _NEWGG[False] : _NEWGG[True] _G[275,15,298,27,False] : _G[301,15,338,27,XAFD] : _G[341,15,364,27,False] Bar 307,19 To 312,23 : Bar 305,20 To 314,22 'Pfeil oben & Dateifenster Bar 318,20 To 332,22 : Draw 329,17 To 329,25 : Draw 330,18 To 330,24 : Draw 331,19 To 331,23 : Plot 333,21 If XSD Then A=False : B=True Else A=True : B=False _G[0,30,298,178,A] : _G[341,30,639,178,B] If XSD=False Then _XSD : _SOURCEDEST 'Balken _G[301,30,317,150,False] : _SCROLLBAR[False] : _G[301,152,317,164,False] : _G[301,166,317,178,False] _G[322,30,338,150,False] : _SCROLLBAR[True] : _G[322,152,338,164,False] : _G[322,166,338,178,False] _G[301,180,317,192,False] : Bar 306,184 To 311,188 : Bar 304,185 To 313,187 _G[322,180,338,192,False] : Bar 327,184 To 332,188 : Bar 325,185 To 334,187 _G[False,180,298,192,False] : _G[1,181,297,191,True] _G[341,180,639,192,False] : _G[342,181,638,191,True] _OPTIONOFF : _NEWMENU _G[False,225,639,255,False] : _G[1,226,638,254,True] For I=False To 6 : Read X,N$ : Text X,24,N$ : Text X+367,24,N$ : Next Def Scroll 1,2,41 To 296,177,0,-8 Def Scroll 2,345,41 To 638,177,0,-8 Def Scroll 3,2,33 To 296,169,0,8 Def Scroll 4,345,33 To 638,169,0,8 Def Scroll 5,6,229 To 636,253,0,-1 Ink 2 Text 283,24,Hex$(X0FA-100)-"$" Text 349,24,Hex$(X0FB-116)-"$" _EXASHOW[False] _EXASHOW[True] _MENU : _MEMTIME Data 10,"Devs",58,"GetDir",113,"Parent",172,"Match",225,"C",243,"A",261,"S" End Proc Procedure _LIBOPEN[A] If A If Lib Base(A) : Pop Proc : End If End If On Error Proc _ERROR If A=False : A$="ambos.library" Else If A=1 : A$="powerpacker.library" Else If A=2 : A$="xpkmaster.library" Else If A=3 : A$="decrunch.library" Else If A=4 : A$="lh.library" End If If A Lib Open A,A$,False Else If Length(16)=False _FLOAD["LIBS:"+A$,16] End If End If If XE Then _T["LIBS:"+A$+" not available!"] End Proc Procedure _MATCH[A] _E["Pattern [*|?|-?]:",""] : If XN$="" Then Pop Proc A$=XN$ If Peek(Varptr(A$))=45 D=True : A$=Right$(A$,Len(A$)-1) : Rem -? Else If A$="*" C=True End If If A Then B=X0FB Else B=X0FA If Length(B) If C If A : C=X0FA : Else C=X0FB : End If If Length(C) D=Length(B)/260-1 E=Length(C)/260-1 For I=1 To D _EXANAME[B,I] A$=Upper$(Param$) For G=1 To E _EXANAME[C,G] B$=Upper$(Param$) If A$=B$ Poke Start(B)+I*260+1,1 Exit End If Next Next _EXASHOW[A] End If Else C=Length(B)/260-1 If C>False For I=1 To C _EXANAME[B,I] If D If Instr(Param$,A$)=False Poke(Start(B)+I*260+1),1 End If Else If Instr(Param$,A$) Poke(Start(B)+I*260+1),1 End If End If Next _EXASHOW[A] End If End If End If End Proc Procedure _MEMTIME Ink 2,3 A=Avail Free : Text 39,9,Format$("%08ld",Varptr(A)) Dreg(1)=Rs Start(False) A=Doscall(-192) Multi Wait _SYSTIME[A+4] Text 535,9,Param$ Ink 1,False Every On End Proc Procedure _MENU If XOM<5 Ink 1 Restore "L"+Chr$(65+XOM) For I=0 To 1 For I2=0 To 14 Read XMEN$(I,I2) Next Next For I=False To 7 A$=XMEN$(0,I) Cls False,I*80+3,196 To I*80+78,207 N=Text Length(A$) If XMEN$(1,I)<>"" Ink 3 Else Ink 1 End If Text I*80+40-N/2,204,A$ Next For I=False To 6 A$=XMEN$(0,8+I) Cls False,I*80+3,211 To I*80+78,222 N=Text Length(A$) If XMEN$(1,8+I)<>"" Ink 3 Else Ink 1 End If Text I*80+40-N/2,219,A$ Next Else Ink 2 A=(XOM-5)*14 For I=False To 7 Cls False,I*80+3,196 To I*80+78,207 N$=XCM$(I+A) XMEN$(0,I)=N$ If N$<>"" N$=Peek$(Varptr(N$),Min(9,Len(N$)),"=") N=Text Length(N$) Text I*80+40-N/2,204,N$ End If Next For I=False To 6 Cls False,I*80+3,211 To I*80+78,222 N$=XCM$(A+I+8) XMEN$(0,8+I)=N$ If N$<>"" N$=Peek$(Varptr(N$),Min(9,Len(N$)),"=") N=Text Length(N$) Text I*80+40-N/2,219,N$ End If Next End If LA: Data "COPY","MOVE","RENAME","PROTECT","COMMENT","DELETE","MAKEDIR","FILEINFO" Data "READ","PRINT","EXECUTE","COMPARE","JOIN","EDITOR","DISKINFO" ' Data "COPYTO","MOVETO","","","","","","" Data "HEXDUMP","","CLI","","SIDEJOIN","","" LB: Data "ANALYZE","SORT","REPLACE","SEARCH","REMDSEQ","READAPF","ADDSUFX","ADDICON" Data "SHOWPIC","SHOWFONT","PLAYANIM","PLAYSAM","PLAYABK","PLAYMED","PLAYMOD" ' Data "","","","","REMASEQ","SETTAB","REMSUFX","SHOWICON" Data "PRINTPIC","","","","","","" LC: Data "APACK","PPACK","XPACK","LPACK","PPBKSAVE","DECRUNCH","ENCRYPT","UNPACK" Data "PPBEST","PACKINFO","CONVASM","CONVBAS","CONVASC","CONVPBK","REMHUNK" ' Data "","","","","PPBKLOAD","CRUNCHER","DECRYPT","BKUNPACK" Data "","","","","","","" LD: Data "IFFABK","GETABS","SHOWASP","SHOWAIC","SHOWA3D","SHOWMEM","VECTEST","RESET" Data "BUFFER","PUTADR","CLONE","SPLIT","SIZE","DEVSCAN","DISKTOOL" ' Data "ABKIFF","SPLITABS","","","","SAVEMEM","","" Data "","","","","","","" LE: Data "ASSIGN","SPEAK","SETPRT","GETDAY","WORKBENCH","STICKTEST","VALUE","ANIMCUT" Data "AMBOSCOLS","AMBOSFDIR","AMBOSMENU","AMBOSEXAM","AMBOSDPTH","AMBOSINFO","ABOUT" ' Data "","","","","","","","" Data "","","","","","WORKINFO","" End Proc Procedure _NEWGG[A] A=Abs(A)*367 For I=False To 3 : _G[I*55+A,15,I*55+52+A,27,False] : Next For I=False To 2 : _G[I*18+220+A,15,I*18+236+A,27,False] : Next End Proc Procedure _NEWMENU N=XOM If N>3 Then Y=1 : Add N,-4 For I=False To 3 _B[I*20+561,210,I*20+576,215] _B[I*20+561,217,I*20+576,222] Next _G[N*20+561,210+Y*7,N*20+576,215+Y*7,True] End Proc Procedure _OPTIONOFF For I=False To 7 : _G[1+I*80,195,(I+1)*80-2,207,False] : Next For I=False To 6 : _G[1+I*80,210,(I+1)*80-2,222,False] : Next End Proc Procedure _PARENT[A] 'A = False/True If A=False Then B=X0FA Else B=X0FB If Length(B) A$=Peek$(Start(B)+8,252,Chr$(0)) If A$<>"" If Exist(A$) Cd Set A$ Cd Parent A$=Cd Path$ A$=A$+Chr$(0) Poke$ Start(B)+8,A$ _EXAMINE[A] End If End If End If End Proc Procedure _PKINFO[A,B,C] T=(Timer-C)/50 Rs Set False,False Rs Long False,A Rs Long False,B Rs Word False,100-(100*B)/A Rs Long False,A-B Rs Word False,T/60 Rs Word False,T mod 60 _T[Format$("In:%ld - Out:%ld - Gain:%d%% (%ld bytes) - Time:%02d:%02d",Rs Start(False))] End Proc Procedure _PLAYREQ[A,A$] On Error Proc _ERROR _W[76,336,23,%110,A$,"Abort","00:00","Next"] B=Param : _OAGW[B] Gosub B If XE Then Goto C Every 50 Gosub A : Gosub A Do If Mouse Key+Asc(Inkey$)<>False Every Off _WAGW[B] Exit If Param<>2 C=False D=False Gosub B Ink 2,3 Every 50 Gosub A : Gosub A End If Loop If A=0 Music Off Else If A=1 Med Stop Else If A=2 Pt Stop End If C: Every Off _CAGW[B] Erase 3 Pop Proc A: Rs Set False,False Rs Long False,D Rs Long False,C Text 302,101,Format$("%02ld:%02ld",Rs Start(False)) Add C,1,False To 59 If C=False Then Add D,1,False To 99 Every On Return B: If A=0 Music 1 Else If A=1 Med Play 3 Else If A=2 Pt Play 3 End If Return End Proc Procedure _R[A$,B$,N] 'A$ = Messagetext oben 'B$ = Messagetext unten 'N = True > Ja/Nein - False > Abbruch 'Param = False ( 0) » Nein / Abbruch 'Param = True (-1) » Ja If N D$="Don`t" F$="Ok" Else E$="Ok" End If _W[60,336,64,%1110,"INFO",D$,E$,F$] A=Param : _OAGW[A] Ink 1,False A$=Right$(A$,40) B$=Right$(B$,40) If B$<>"" Text 320-Len(A$)*4,93,A$ Text 320-Len(B$)*4,103,B$ Else Text 320-Len(A$)*4,97,A$ End If Clear Key Clear Mouse _WAGW[A] _CAGW[A] If Param<3 Then A=False Else A=True End Proc[A] Procedure _RUN Open Workbench If Workbench Amos To Back Screen Close False End If B$="CON:0/0/640/256/AmBOS - [Left Amiga + A]"+Chr$(0) Dreg(1)=Varptr(B$) Dreg(2)=1006 A=Doscall(-30) A$=XN$+Chr$(0) Dreg(1)=Varptr(A$) Dreg(2)=0 Dreg(3)=A B=Doscall(-222) If Workbench Repeat Multi Wait Until Amos Here End If Dreg(1)=A B=Doscall(-36) If Workbench _INSTALLAMBOS _INSTALLSCREEN Every Off End If End Proc Procedure _SCROLLBAR[N] N=Abs(N) Cls False,306+N*21,32 To 313+N*21,150 If N=False XBARPOSA#=XPOSA*XLENA# If XANZA#<18 XBARA#=148 XBARPOSA#=False End If A=XBARPOSA# B=XBARA#+A Else XBARPOSB#=XPOSB*XLENB# If XANZB#<18 XBARB#=148 XBARPOSB#=False End If A=XBARPOSB# B=XBARB#+A End If Cls 1,306+N*21,32+A To 313+N*21,Min(149,34+B) End Proc Procedure _SCROLLTOPBUTTOM[A,B] 'A = False/True, B = Mousekey If A=False C=XANZA# If B=1 : XPOSA=False Else XPOSA=Max(0,C-18) : End If Else C=XANZB# If B=1 : XPOSB=False Else XPOSB=Max(0,C-18) : End If End If _SCROLLBAR[A] _EXASHOW[A] End Proc Procedure _SELECT[A,B,C] 'A = False/True 'B = Mousekey 'C = Selected Y Position C=(C-32)/8 If A=False and C+1<=XANZA# D=XPOSA+C+1 E=Peek(Start(X0FA)+D*260) F=Peek(Start(X0FA)+D*260+1) If E=False or E=1 Add F,1,False To 1 Poke Start(X0FA)+D*260+1,F Else If E=2 F=1 End If If F Ink 1+F,F Else If E=1 Ink 1,0 Else Ink 3,0 End If End If _EXANAME[X0FA,D] Text 5,39+C*8,Param$ If E=2 or E=False and B=2 _DEVSDIR[X0FA,D] If Exist(Param$) Poke$ Start(X0FA)+8,Param$+Chr$(0) _EXAMINE[False] End If End If Else If A=True and C+1<=XANZB# D=XPOSB+C+1 E=Peek(Start(X0FB)+D*260) F=Peek(Start(X0FB)+D*260+1) If E=False or E=1 Add F,1,False To 1 Poke Start(X0FB)+D*260+1,F Else If E=2 F=1 End If If F Ink 1+F,F Else If E=1 Ink 1,0 Else Ink 3,0 End If End If _EXANAME[X0FB,D] Text 346,39+C*8,Param$ If E=2 or E=False and B=2 _DEVSDIR[X0FB,D] If Exist(Param$) Poke$ Start(X0FB)+8,Param$+Chr$(0) _EXAMINE[True] End If End If End If End Proc Procedure _SOURCEDEST _G[301,15,338,27,True] _XSD Get Block 1,302,16,36,10,1 Cls False,302,16 To 338,27 Hrev Block 1 Put Block 1,288,16 Del Block 1 _G[False,30,298,178,1-Abs(XSD)] _G[341,30,639,178,XSD] Wait 5 _G[301,15,338,27,XAFD] End Proc Procedure _SYSTIME[A] B=Leek(A) Rs Set False,False Rs Word False,B/60 Rs Word False,B mod 60 Rs Word False,Leek(A+4)/50 End Proc[Format$("%02d:%02d:%02d",Rs Start(False))] Procedure _T[A$] Screen False For I=False To 7 : Wait Vbl : Scroll 5 : Next If Len(A$)>78 A=Instr(A$,"..") If A Inc A A$=Left$(A$,A)+Right$(A$,78-A) Else A$=Right$(A$,78) End If End If Ink 1,False : Text 6,250,A$ _GETMESS[A$] End Proc Procedure _TPTR[A] A=Start(A) B=A D=B If Hunt(B To Finish(A),Chr$(27)) Then L=256 Else L=80 Repeat B=Hunt(B To Min(Finish(A),B+L),Chr$(10)) If B Inc B Inc C D=B Else If B=False Inc C Add D,80 If D27 and A<32 and Key Shift=%1000 X=X Hard(0) : Y=Y Hard(0) If A=28 : Add X,16 Else If A=29 : Add X,-16 Else If A=30 : Add Y,-16 Else If A=31 : Add Y,16 End If Screen Display Screen,X,Y,, Wait Vbl A=False End If If A>False and A<3 If Y Screen(Y Mouse)<13 and X Screen(X Mouse)<34 If Screen=False Every Off _G[False,False,33,12,True] Wait 10 : A=True End If End If End If Multi Wait Until A Clear Key End Proc[A] Procedure _X0FAB[N] Ink 2,False If N=False XANZA#=Length(X0FA)/260-1 XPOSA=False If XANZA#<1 XLENA#=115 Else XLENA#=115/XANZA# End If If XANZA#/18<1 XBARA#=115 Else XBARA#=115/(XANZA#/19) End If XBARA#=XBARA#-XLENA# Text 283,24,Hex$(X0FA-100)-"$" Else XANZB#=Length(X0FB)/260-1 XPOSB=False If XANZB#<1 XLENB#=115 Else XLENB#=115/XANZB# End If If XANZB#/18<1 XBARB#=115 Else XBARB#=115/(XANZB#/19) End If XBARB#=XBARB#-XLENB# Text 349,24,Hex$(X0FB-116)-"$" End If Cls False,1+341*Abs(N),31 To 298+341*Abs(N),178 _EXASHOW[N] End Proc Procedure _XSD Add XSD,1,-1 To False End Proc Procedure _OAGW[A] XX=Deek(A+2) XY=Deek(A+4) XB=Deek(A+6) XB=Min(Screen Width-8,XB+16) XH=Deek(A+8) XH=Min(Screen Height-8,XH+8) XM=Deek(A+10) If Btst(1,XM) Then N=2 Else N=1 Get Cblock Deek(A),XX,XY,XB+N*16,XH+N*6 If Btst(1,XM) Gr Writing False Set Pattern 2 Ink 1,False Bar XX+16,XY+8 To XX+XB+14,XY+XH+7 Gr Writing 1 Set Pattern False End If If Btst(2,XM) Then N=13 Else N=False Cls False,XX,XY+N To XX+XB,XY+XH Gr Writing False Set Pattern 2 Ink 2,False Bar XX+1,XY+N+1 To XX+XB-1,XY+XH-1 Gr Writing 1 Set Pattern False _G[XX,XY+N,XX+XB,XY+XH,False] If Btst(2,XM) _B[XX,XY,XX+XB,XY+12] A$=Peek$(Leek(A+12),Deek(Leek(A+12)-2)) Gr Writing False : Ink 1,0 : Text XX+XB/2-Len(A$)*4+2,XY+10,A$ Ink 2 : Text XX+XB/2-Len(A$)*4,XY+9,A$ : Gr Writing 1 N=16 Else N=3 End If If Btst(3,XM) Cls 0,XX+6,XY+N To XX+XB-6,XY+XH-18 _G[XX+6,XY+N,XX+XB-6,XY+XH-18,False] _G[XX+7,XY+N+1,XX+XB-7,XY+XH-19,True] Else If Btst(4,XM) Cls 0,XX+6,XY+N To XX+XB-6,XY+XH-3 _G[XX+6,XY+N,XX+XB-6,XY+XH-3,False] _G[XX+7,XY+N+1,XX+XB-7,XY+XH-4,True] Else If Btst(5,XM) Y=XH/2 Cls 0,XX+6,XY+N To XX+XB-6,XY+Y-2 Cls 0,XX+6,XY+Y To XX+XB-6,XY+XH-18 _G[XX+6,XY+N,XX+XB-6,XY+Y-2,False] _G[XX+7,XY+N+1,XX+XB-7,XY+Y-3,True] _G[XX+6,XY+Y,XX+XB-6,XY+XH-18,False] _G[XX+7,XY+Y+1,XX+XB-7,XY+XH-19,True] End If N=Min(100,(XB-6)/3-4) Doke A+34,N If Leek(A+16) _B[6+XX,XY+XH-15,6+XX+N,XY+XH-3] A$=Peek$(Leek(A+16),Deek(Leek(A+16)-2)) Text 7+XX+N/2-Len(A$)*4,XY+XH-6,A$ Doke A+28,6+XX End If If Leek(A+20) X=XX+XB/2 _B[X-N/2,XY+XH-15,X+N/2,XY+XH-3] A$=Peek$(Leek(A+20),Deek(Leek(A+20)-2)) Text 1+X-Len(A$)*4,XY+XH-6,A$ Doke A+30,X-N/2 End If If Leek(A+24) _B[XX+XB-6-N,XY+XH-15,XX+XB-6,XY+XH-3] A$=Peek$(Leek(A+24),Deek(Leek(A+24)-2)) Text XX+XB-6-N/2-Len(A$)*4,XY+XH-6,A$ Doke A+32,XX+XB-6-N End If Doke A+36,XY+XH-15 Doke A+38,12 Clear Key Clear Mouse End Proc Procedure _CAGW[A] If Deek(A) Put Cblock Deek(A),Deek(A+2),Deek(A+4) Del Cblock Deek(A) Erase Number(A) End If End Proc Procedure _WAGW[A] XM=Deek(A+10) X1=Deek(A+28) X2=Deek(A+30) X3=Deek(A+32) XB=Deek(A+34) Y0=Deek(A+36) YH=Deek(A+38) Do Do B=Mouse Key Exit If B B=Asc(Inkey$) Exit If B Multi Wait Exit If Btst(0,XM) Loop Exit If X1+X2+X3=False or B=False If X1+X3=False Then X=2 : Exit If X1 and B=27 X=1 : Exit Else If X2 and B=32 X=2 : Exit Else If X3 and B=13 X=3 : Exit End If X=X Screen(X Mouse) Y=Y Screen(Y Mouse) If Y>Y0 and YX1 and XX2 and XX3 and X"" Then Loke N+16,Varptr(B$) If C$<>"" Then Loke N+20,Varptr(C$) If D$<>"" Then Loke N+24,Varptr(D$) End Proc[N]