AMOS PD CD

home *** CD-ROM | disk | FTP | other *** search

/ AMOS PD CD / amospdcd.iso / 326-350 / apd347 / notebook.amos / notebook.amosSourceCode < prev next >

Wrap

AMOS Source Code | 1992-09-02 | 106.1 KB | 3,672 lines

Rem ******** Rem *************** NoteBook1200 *************** Rem ********** Bill Currie 1991/93 ********* Rem ******************* ' Set Buffer 60 Music Off : Track Stop : Erase 6 : Erase 5 : Erase 3 : Erase 7 ' Global F$ Dim LQZ$(200),MITQZ$(70) Global LQZ$(),FLEQZ$,MITQZ$(),LLQZ$ Global DRECTORYQZ$,MESSAGE1QZ$,MESSAGE2QZ$ Global NQZ,XQZ,IQZ,CRQZ CRQZ=0 ' Global PLTYPE$,TXTNEWMARKER$ PLTYPE$="" : TXTNEWMARKER$="no" Global TRY$ Global AMOSMUSIC,AMOSMUSIC$,TRACKERMUSIC,TRACKERMUSIC$,MEDMUSIC,MEDMUSIC$ Global FFMUSIC,FFMUSIC$,RAWMUSIC,RAWMUSIC$ Global MUZIC,MUZIC$ Global MM,FQ,VL,VC$ MM=0 : FQ=12000 : VL=63 : VC$="1100" FF$=Dir$ : GG$=Dir$ Global IBOOK,I2BOOK,MTCH,MTCH1,S$ ' Set Dir ,"" Rem Globals for colour mix ' Dim FSC(4) Global NWFSC,FSC(),IV NWFSC=0 ' Global SECS,IP,KEY Global KX,ZNE,CBO,XL,YL,WRD$ Procedure PBT[XL,YL,WRD$,ZNE,CBO] Locate XL,YL Pen CBO : Ink CBO UD[ZNE] : L=Len(WRD$) If(ZNE<>0) Then Print Zone$(WRD$,ZNE); If ZNE=0 Then Print WRD$; XB1=X Graphic(X Curs-L) : YB1=Y Graphic(Y Curs) XB2=X Graphic(X Curs) : YB2=Y Graphic(Y Curs+1)-1 Box XB1-2,YB1 To XB2+2,YB2 End Proc Procedure UD[KX] If KX=Mouse Zone Then Inverse On If KX<>Mouse Zone Then Inverse Off If KX=0 Then Inverse Off End Proc ' NWTYPE Procedure NWTYPE BV=0 : BD=0 : BN=0 : BMI=0 End Proc N=0 ' Dim L$(200),FLE$(200),L2$(200),FLE2$(200),MIT$(70) Global L$(),L2$(),DRECTORY$,DRECTORY1$,DRECTORY2$,MESSAGE1$ Global M,FLE$() Global KEEPX1,KEEPX2,KEEPY1,KEEPY2,KEEPN,KEEPN2,CASE Global M2,N2,FLE2$() Global MIT$() Global SOURCE,VIFF,FIFF$,VASC,FASC$,BV Global TALKING Global GX1,GY1,GX2,GY2,KM Global FF$,GG$ ZP Procedure ZP BV=0 : VIFF=0 : VASC=0 If MUZIC=1 Then MUZIC=0 : MM=0 : Music Off : Track Stop : Erase 3 : Erase 7 : CLEAN_UP AMOSMUSIC=0 : TRACKERMUSIC=0 : MEDMUSIC=0 : FFMUSIC=0 : RAWMUSIC=0 End Proc FIFF$="" : FASC$="" ' RESET Procedure RESET For I=1 To 200 : L$(I)="" : L2$(I)="" : FLE$(I)="" : FLE2$(I)="" : Next I CASE=0 End Proc Procedure RESET1 For I=1 To 200 : L$(I)="" : Next I End Proc Procedure RESET2 For I=1 To 200 : L2$(I)="" : Next I End Proc ' DRECTORY1$=Dir$ DRECTORY2$=Dir$ DRECTORY$=DRECTORY1$ MESSAGE1$="" INITDIRS Procedure INITDIRS DD1$=Dir$ : DD2$=Dir$ If Exist("df0:") Dir$="df0:" If DD2$<>Dir$ DD2$=Dir$ : Goto MISSREST End If End If If Exist("df1:") Dir$="df1:" If DD2$<>Dir$ DD2$=Dir$ : Goto MISSREST End If End If If Exist("dh1:") Dir$="dh1:" If DD2$<>Dir$ DD2$=Dir$ : Goto MISSREST End If End If If Exist("dh2:") Dir$="dh2:" If DD2$<>Dir$ DD2$=Dir$ : Goto MISSREST End If End If If Exist("dh0:") Dir$="dh0:" If DD2$<>Dir$ DD2$=Dir$ : Goto MISSREST End If End If MISSREST: DRECTORY2$=DD2$ Dir$=DD1$ End Proc WN1DIR WN2DIR ' Rem AMOS copyright notice AMOSC Procedure AMOSC Screen Open 0,320,256,32,Lowres Curs Off : Paper 0 : Cls 0 : Print Get Icon Palette Locate 0,1 Centre ">>> Program by Bill Currie <<<" Flash 3,"(f00,32)(f80,32)(ff0,32)(0f0,32)(08f,32)(88f,32)(f0f,32)" Pen 3 : Ink 3 : Box 50,40 To 270,150 Locate 0,11 Centre Border$("NoteBook",1) Ink 0 : Pen 2 Paste Icon 230,20,2 _SMALL_COPYRIGHT[225] End Proc Procedure _SMALL_COPYRIGHT[YDISPLAY] ' Auto View Off ' Screen Open 7,320,24,16,0 : Curs Off : Flash Off : Cls 0 Screen Display 7,,-100,, Paste Bob 260,3,1 Paper 0 : Pen 7 : Print At(1,1);"This program was written using" Get Sprite Palette View : Wait Vbl ' For Y=1 To Screen Height/2 Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2 Screen Offset 7,,Screen Height/2-Y View : Wait Vbl Next ' Do If Mouse Key=1 Then Exit Loop ' For Y=Screen Height/2 To 0 Step -1 Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2 Screen Offset 7,,Screen Height/2-Y View : Wait Vbl Next ' Screen Close 7 Auto View On ' Cls End Proc INFO Procedure INFO Cls Locate 0,10 Centre "NoteBook" Print : Centre "**********" Print : Print : Print : Print : Pen 1 : Centre "Other AMOS Program Disks available :" Print : Print : Pen 3 : Centre "ScrapBook: Loose-leaf ScrapBook " Print : Centre "Evaluator: EVALuates formulae" Locate 0,15 Do If Mouse Key=1 Then Exit Loop End Proc ' Rem ################## Selector SubSystem ###################### ' Procedure MAKEBOOK On Error Goto ER Goto OK ER: ERR Resume XIT OK: FILESELECT If SOURCE=1 For II=1 To M F$=FLE$(II) J$(II)=F$ ALTERF$ K$(II)=F$ Next II N=M End If If SOURCE=2 For II=1 To M2 F$=FLE2$(II) J$(II)=F$ ALTERF$ K$(II)=F$ Next II N=M2 End If BN=1 : EASYLOOK XIT: End Proc Procedure MULTIPLEPGINSERT On Error Goto ER Goto OK ER: ERR Resume XIT OK: Cls 0 KEEEPN=N : KEEEPX=X : KEEEPI=I If N<200 Then Goto PRCEED Locate 0,10 : Centre "No more pages - max 200" Locate 0,15 : Centre "RIGHT mouse key to continue" While Mouse Key<>2 : Wend Wait 50 Goto XIT PRCEED: MESSAGE1$="Select Pages to insert,after" FILESELECT If SOURCE=1 If FLE$(1)="" Goto XIT End If N=KEEEPN : X=KEEEPX : I=KEEEPI II=1 Do If N=200 ERR : Exit End If If II>M Exit End If F$=FLE$(II) NN=X+KEEEPI-2 I=N Do If NN=N Exit End If J$(I+1)=J$(I) K$(I+1)=K$(I) I=I-1 If I=NN Exit End If Loop N=N+1 : X=X+1 : II=II+1 NN=NN+1 J$(NN)=F$ ALTERF$ K$(NN)=F$ Loop End If If SOURCE=2 If FLE2$(1)="" Goto XIT End If N=KEEEPN : X=KEEEPX : I=KEEEPI II=1 Do If N=200 ERR : Exit End If If II>M2 Exit End If F$=FLE2$(II) NN=X+KEEEPI-2 I=N Do If NN=N Exit End If J$(I+1)=J$(I) K$(I+1)=K$(I) I=I-1 If I=NN Exit End If Loop N=N+1 : X=X+1 : II=II+1 NN=NN+1 J$(NN)=F$ ALTERF$ K$(NN)=F$ Loop End If XIT: End Proc ' Procedure FILESELECT On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 0,640,256,4,Hires Flash Off : Curs Off : Paper 0 : Cls 0 : Colour 3,$FF0 CB[0] Double Buffer : Locate 35,12 : Centre Border$("Selector",1) Wait 50 SCN3 KEY=1 SELECTOR_WINDOWS XIT: End Proc Procedure SCN3 On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 0,640,256,4,Hires Flash Off : Curs Off : Paper 0 : Cls 0 : Colour 3,$FF0 If NWFSC=1 Then For III=0 To 3 : Colour III,FSC(III) : Next III CB[0] Double Buffer : Wind Open 1,0,0,40,24 : Paper 0 : Curs Off Wind Open 2,320,0,40,24 : Paper 0 : Curs Off Wind Open 3,0,192,80,8 : Paper 0 : Curs Off Pen 1 : Locate 0,7 : Centre "(Multiple) File Selector : Directory Manager" XIT: End Proc Procedure WN1DIR On Error Goto ER Goto OK ER: ERR Resume XIT OK: M=0 RESET1 N=1 FF$=DRECTORY1$ L$(1)=Dir First$(DRECTORY1$) Do N=N+1 L$(N)=Dir Next$ If L$(N)="" Then N=N-1 : Exit Loop KEEPY1=1 KEEPN=N DRECTORY$=DRECTORY1$ XIT: End Proc Procedure WN2DIR On Error Goto ER Goto OK ER: ERR Resume XIT OK: M2=0 RESET2 N2=1 FF$=DRECTORY2$ L2$(1)=Dir First$(DRECTORY2$) Do N2=N2+1 L2$(N2)=Dir Next$ If L2$(N2)="" Then N2=N2-1 : Exit Loop KEEPY2=1 KEEPN2=N2 DRECTORY$=DRECTORY2$ XIT: End Proc ' Procedure SELECTOR_WINDOWS On Error Goto ER Goto OK ER: ERR Resume XIT OK: KEY=1 WN1: DRECTORY$=DRECTORY1$ REASYLOOK: SOURCE=1 Autoback 1 Window 1 : Locate 0,0 : Cline : Pen 1 : Centre " Source " : Ink 1 : Box 126,0 To 178,7 Window 2 : Locate 0,0 : Cline : Pen 2 : Centre "Destination" : Ink 2 : Box 430,0 To 522,7 Window 1 : Pen 1 MESSAGE1$=Left$(DRECTORY1$,30)+"..." Pen 1 : Locate 0,22 : Cline : Centre MESSAGE1$ MAKEFSZONES[0] If(VIFF=1) and(KEY<>5) Then MAKEFSZONES[31] If(VASC=1) and(KEY<>5) Then MAKEFSZONES[35] If(BV=1) and(KEY<>5) Then MAKEFSZONES[41] Pen 2 Autoback 0 Rem main loop Y=KEEPY1 N=KEEPN Do If Key State(95)=True Then HELPSELECTOR X=1+Int((N*Y)/170) : KEEPX1=X Rem Read mouse If Mouse Zone=1 and Mouse Key Then Y=Y Screen(Y Mouse) : KEEPY1=Y For I=2 To 21 If Mouse Zone=I and Mouse Key and BV=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : J$(X+I-2)=FLE$(M) : SCN : PROG$="PE" : DISPLAY : PROG$="FS" : SCN3 : M=M-1 : KEY=4 : Goto REASYLOOK2 If Mouse Zone=I and Mouse Key and VIFF=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : FIFF$=FLE$(M) : SCN : DISPLAYIFF : SCN3 : M=M-1 : KEY=4 : Goto REASYLOOK2 If Mouse Zone=I and Mouse Key and VASC=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : FASC$=FLE$(M) : SCN : DISPLAYASCII : SCN3 : M=M-1 : KEY=4 : Goto REASYLOOK2 ' If Mouse Zone=I and Mouse Key and AMOSMUSIC=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : AMOSMUSIC$=FLE$(M) : MUZIC$=AMOSMUSIC$ : SOUNDSAMOS : M=M-1 : ZP If Mouse Zone=I and Mouse Key and TRACKERMUSIC=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : TRACKERMUSIC$=FLE$(M) : MUZIC$=TRACKERMUSIC$ : SOUNDSTRACKER : M=M-1 : ZP 'If Mouse Zone=I and Mouse Key and MEDMUSIC=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : MEDMUSIC$=FLE$(M) : MUZIC$=MEDMUSIC$ : SOUNDSMED : M=M-1 : ZP If Mouse Zone=I and Mouse Key and FFMUSIC=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : FFMUSIC$=FLE$(M) : MUZIC$=FFMUSIC$ : SOUNDSIFF["Music"] : M=M-1 : ZP If Mouse Zone=I and Mouse Key and RAWMUSIC=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : RAWMUSIC$=FLE$(M) : MUZIC$=RAWMUSIC$ : SOUNDSIFF["Music"] : M=M-1 : ZP If Mouse Zone=I and Mouse Key and MUZIC=1 and X+I-2<N+1 Then M=M+1 : GTFILE[1] : MUZIC$=FLE$(M) : SOUNDSIFF["Sound"] : M=M-1 ' If Mouse Zone=I and Mouse Key and Instr(L$(X+I-2)," ")=1 Then M=M+1 : GTFILE[1] : L$(X+I-2)=">"+Mid$(Str$(M),2)+"<"+L$(X+I-2) If Mouse Zone=I and Mouse Key and Instr(L$(X+I-2),"*")=1 Then GTDIREC : DRECTORY1$=DRECTORY$ : RESET1 : WN1DIR : Goto REASYLOOK Next I If Mouse Zone=22 and Mouse Key Then ZP : MAKEFSZONES[0] : RESET1 : WN1DIR : Goto REASYLOOK If Mouse Zone=23 and Mouse Key Then ZP : MAKEFSZONES[0] : Goto WN2 If Mouse Zone=24 and Mouse Key Then MAKEFSZONES[24] : ZP : DRECTORY$=DRECTORY1$ : GTPAR : DRECTORY1$=DRECTORY$ : RESET1 : WN1DIR : Goto REASYLOOK If Mouse Zone=25 and Mouse Key Then MAKEFSZONES[25] : ZP : GTNEWDRECTORY : DRECTORY1$=DRECTORY$ : RESET1 : WN1DIR : Goto REASYLOOK If Mouse Zone=26 and Mouse Key Then MAKEFSZONES[26] : ZP : MDIR : MAKEFSZONES[0] If Mouse Zone=27 and Mouse Key Then MAKEFSZONES[27] : ZP : ERASDIR : MAKEFSZONES[0] If Mouse Zone=28 and Mouse Key Then MAKEFSZONES[28] : ZP : CPYFILES : MAKEFSZONES[0] If Mouse Zone=29 and Mouse Key Then MAKEFSZONES[29] : ZP : KLLFILES : MAKEFSZONES[0] If Mouse Zone=30 and Mouse Key Then MAKEFSZONES[30] : ZP : RETITLE : MAKEFSZONES[0] If(Mouse Zone=31) and(Mouse Key) and(VIFF=0) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[31] : VIFF=1 If(Mouse Zone=31) and(Mouse Key) and(VIFF=1) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[0] If Mouse Zone=32 and Mouse Key Then MAKEFSZONES[32] : ZP : AUTOVIEW : KEY=4 : Goto REASYLOOK2 If Mouse Zone=33 and Mouse Key Then While Mouse Key<>0 : Wend : MAKEFSZONES[33] : ZP : MUSI : MAKEFSZONES[0] If(Mouse Zone=34) and(Mouse Key) and(MUZIC=0) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[34] : CLARIFY : MUZIC=1 If(Mouse Zone=34) and(Mouse Key) and(MUZIC=1) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[0] If(Mouse Zone=35) and(Mouse Key) and(VASC=0) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[35] : VASC=1 If(Mouse Zone=35) and(Mouse Key) and(VASC=1) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[0] If Mouse Zone=36 and Mouse Key Then MAKEFSZONES[36] : ZP : BYFREE : MAKEFSZONES[0] If(Mouse Zone=41) and(Mouse Key) and(BV=0) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[41] : BV=1 If(Mouse Zone=41) and(Mouse Key) and(BV=1) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[0] If Mouse Zone=42 and Mouse Key Then MAKEFSZONES[42] : ZP : RNFILE : MAKEFSZONES[0] If Mouse Zone=43 and Mouse Key Then MAKEFSZONES[43] : ZP : GTCOLOUR : MIX : For III=0 To 3 : FSC(III)=Colour(III) : Next III : NWFSC=1 : CB[0] If Mouse Zone=44 and Mouse Key Then MAKEFSZONES[44] : ZP : HELPSELECTOR : MAKEFSZONES[0] If Mouse Zone=45 and Mouse Key Then MAKEFSZONES[45] : ZP : SCN : Goto XIT X=KEEPX1 : Y=KEEPY1 If Y>170 Then Y=170 Rem If slider has moved change it If Y<>YM and Mouse Key=1 : YM=Y : End If Rem Update display For I=1 To 20 Locate 2,I : Cline If(KEY<>1) and(KEY<>5) Then UD[I+1] Print Left$(L$(X+I-1),38); Inverse Off Next I VSLIDE[Y] Rem Double buffering smooths the effect Screen Swap : Wait Vbl For I=1 To 20 Locate 2,I If(KEY<>1) and(KEY<>5) Then UD[I+1] Print Left$(L$(X+I-1),38); Inverse Off Next I VSLIDE[Y] If KEY=1 Then Goto WN2 If KEY=5 Then KEY=0 : Goto WN2 Loop WN2: DRECTORY$=DRECTORY2$ REASYLOOK2: SOURCE=2 Autoback 1 Window 1 : Locate 0,0 : Cline : Pen 2 : Centre "Destination" : Ink 2 : Box 110,0 To 202,7 Window 2 : Locate 0,0 : Cline : Pen 1 : Centre " Source " : Ink 1 : Box 446,0 To 498,7 Window 2 : Pen 2 MESSAGE1$=Left$(DRECTORY2$,30)+"..." Pen 1 : Locate 0,22 : Cline : Centre MESSAGE1$ MAKEFSZONES[0] If(VIFF=1) and(KEY<>4) Then MAKEFSZONES[31] If(VASC=1) and(KEY<>4) Then MAKEFSZONES[35] If(BV=1) and(KEY<>4) Then MAKEFSZONES[41] Pen 2 Autoback 0 Rem main loop N2=KEEPN2 Y=KEEPY2 Do If Key State(95)=True Then HELPSELECTOR X=1+Int((N2*Y)/170) : KEEPX2=X Rem Read mouse If Mouse Zone=1 and Mouse Key Then Y=Y Screen(Y Mouse) : KEEPY2=Y For I=2 To 21 If Mouse Zone=I and Mouse Key and BV=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : J$(X+I-2)=FLE2$(M2) : SCN : PROG$="PE" : DISPLAY : PROG$="FS" : SCN3 : M2=M2-1 : KEY=5 : Goto REASYLOOK If Mouse Zone=I and Mouse Key and VIFF=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : FIFF$=FLE2$(M2) : SCN : DISPLAYIFF : SCN3 : M2=M2-1 : KEY=5 : Goto REASYLOOK If Mouse Zone=I and Mouse Key and VASC=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : FASC$=FLE2$(M2) : SCN : DISPLAYASCII : SCN3 : M2=M2-1 : KEY=5 : Goto REASYLOOK ' If Mouse Zone=I and Mouse Key and AMOSMUSIC=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : AMOSMUSIC$=FLE2$(M2) : MUZIC$=AMOSMUSIC$ : SOUNDSAMOS : M2=M2-1 : ZP If Mouse Zone=I and Mouse Key and TRACKERMUSIC=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : TRACKERMUSIC$=FLE2$(M2) : MUZIC$=TRACKERMUSIC$ : SOUNDSTRACKER : M2=M2-1 : ZP 'If Mouse Zone=I and Mouse Key and MEDMUSIC=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : MEDMUSIC$=FLE2$(M2) : MUZIC$=MEDMUSIC$ : SOUNDSMED : M2=M2-1 : ZP If Mouse Zone=I and Mouse Key and FFMUSIC=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : FFMUSIC$=FLE2$(M2) : MUZIC$=FFMUSIC$ : SOUNDSIFF["Music"] : M2=M2-1 : ZP If Mouse Zone=I and Mouse Key and RAWMUSIC=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : RAWMUSIC$=FLE2$(M2) : MUZIC$=RAWMUSIC$ : SOUNDSIFF["Music"] : M2=M2-1 : ZP If Mouse Zone=I and Mouse Key and MUZIC=1 and X+I-2<N2+1 Then M2=M2+1 : GTFILE[2] : MUZIC$=FLE2$(M2) : SOUNDSIFF["Sound"] : M2=M2-1 ' If Mouse Zone=I and Mouse Key and Instr(L2$(X+I-2)," ")=1 Then M2=M2+1 : GTFILE[2] : L2$(X+I-2)=">"+Mid$(Str$(M2),2)+"<"+L2$(X+I-2) If Mouse Zone=I and Mouse Key and Instr(L2$(X+I-2),"*")=1 Then GTDIREC2 : DRECTORY2$=DRECTORY$ : RESET2 : WN2DIR : Goto REASYLOOK2 Next I If Mouse Zone=22 and Mouse Key Then ZP : MAKEFSZONES[0] : Goto WN1 If Mouse Zone=23 and Mouse Key Then ZP : MAKEFSZONES[0] : RESET2 : WN2DIR : Goto REASYLOOK2 If Mouse Zone=24 and Mouse Key Then MAKEFSZONES[24] : ZP : GTPAR : DRECTORY2$=DRECTORY$ : RESET2 : WN2DIR : Goto REASYLOOK2 If Mouse Zone=25 and Mouse Key Then MAKEFSZONES[25] : ZP : GTNEWDRECTORY : DRECTORY2$=DRECTORY$ : RESET2 : WN2DIR : Goto REASYLOOK2 If Mouse Zone=26 and Mouse Key Then MAKEFSZONES[26] : ZP : MDIR : MAKEFSZONES[0] If Mouse Zone=27 and Mouse Key Then MAKEFSZONES[27] : ZP : ERASDIR : MAKEFSZONES[0] If Mouse Zone=28 and Mouse Key Then MAKEFSZONES[28] : ZP : CPYFILES : MAKEFSZONES[0] If Mouse Zone=29 and Mouse Key Then MAKEFSZONES[29] : ZP : KLLFILES : MAKEFSZONES[0] If Mouse Zone=30 and Mouse Key Then MAKEFSZONES[30] : ZP : RETITLE : MAKEFSZONES[0] If(Mouse Zone=31) and(Mouse Key) and(VIFF=0) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[31] : VIFF=1 If(Mouse Zone=31) and(Mouse Key) and(VIFF=1) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[0] If Mouse Zone=32 and Mouse Key Then MAKEFSZONES[32] : ZP : AUTOVIEW : KEY=5 : Goto REASYLOOK If Mouse Zone=33 and Mouse Key Then While Mouse Key<>0 : Wend : MAKEFSZONES[33] : ZP : MUSI : MAKEFSZONES[0] If(Mouse Zone=34) and(Mouse Key) and(MUZIC=0) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[34] : CLARIFY : MUZIC=1 If(Mouse Zone=34) and(Mouse Key) and(MUZIC=1) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[0] If(Mouse Zone=35) and(Mouse Key) and(VASC=0) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[35] : VASC=1 If(Mouse Zone=35) and(Mouse Key) and(VASC=1) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[0] If Mouse Zone=36 and Mouse Key Then MAKEFSZONES[36] : ZP : BYFREE : MAKEFSZONES[0] If(Mouse Zone=41) and(Mouse Key) and(BV=0) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[41] : BV=1 If(Mouse Zone=41) and(Mouse Key) and(BV=1) Then ZP : While Mouse Key<>0 : Wend : MAKEFSZONES[0] If Mouse Zone=42 and Mouse Key Then MAKEFSZONES[42] : ZP : RNFILE : MAKEFSZONES[0] If Mouse Zone=43 and Mouse Key Then MAKEFSZONES[43] : ZP : GTCOLOUR : MIX : For III=0 To 3 : FSC(III)=Colour(III) : Next III : NWFSC=1 : CB[0] If Mouse Zone=44 and Mouse Key Then MAKEFSZONES[44] : ZP : HELPSELECTOR : MAKEFSZONES[0] If Mouse Zone=45 and Mouse Key Then MAKEFSZONES[45] : ZP : SCN : Goto XIT X=KEEPX2 : Y=KEEPY2 If Y>170 Then Y=170 Rem If slider has moved change it If Y<>YM and Mouse Key=1 : YM=Y : End If Rem Update display For I=1 To 20 Locate 2,I : Cline If(KEY<>1) and(KEY<>4) Then UD[I+1] Print Left$(L2$(X+I-1),38); Inverse Off Next I VSLIDE[Y] Rem Double buffering smooths the effect Screen Swap : Wait Vbl For I=1 To 20 Locate 2,I If(KEY<>1) and(KEY<>4) Then UD[I+1] Print Left$(L2$(X+I-1),38); Inverse Off Next I VSLIDE[Y] If KEY=1 Then KEY=2 : Goto WN1 If KEY=4 Then KEY=0 : Goto WN1 Loop XIT: End Proc Procedure MAKEFSZONES[PL] Autoback 1 On Error Goto ER Goto OK ER: ERR Resume XIT OK: MIT$(24)="Parent" MIT$(25)="New Directory" MIT$(26)="Make Dir" MIT$(27)="Erase Dir" MIT$(28)="Copy" MIT$(29)="Delete /!\" MIT$(30)="Rename" MIT$(31)="Picture.IFF" MIT$(32)="AutoView" MIT$(33)="Music" MIT$(34)="Sounds" MIT$(35)="Text ASCII" MIT$(36)="Memory" MIT$(41)="ViewPage" MIT$(42)="[Run] /!\" MIT$(43)="Colours" MIT$(44)="Help" MIT$(45)="End" Reserve Zone Reserve Zone 46 Set Zone 22,112,0 To 200,7 Set Zone 23,432,0 To 520,7 Set Zone 1,0,0 To 10,170 Writing 1 For I=2 To 21 Locate 3,I-1 Print Zone$(" ",I) Next I Writing 0 Window 3 For II=24 To 30 CL=3 If II=PL Then CL=1 PBT[5,(II-24),MIT$(II),II,CL] Next II For II=31 To 36 CL=3 If II=PL Then CL=1 PBT[21,(II-31),MIT$(II),II,CL] Next II For II=41 To 45 CL=3 If II=PL Then CL=1 PBT[41,(II-41),MIT$(II),II,CL] Next II Autoback 0 Window SOURCE Pen 2 XIT: End Proc Procedure VSLIDEFS[Y] Set Slider 0,1,3,1,0,3,3,1 Rem Display a slider bar using the Vslider command Vslider 0,0 To 10,170,170,Y,5 End Proc ' Procedure HELPSELECTOR On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 2,640,256,4,Hires Curs Off : Paper 0 : Cls 0 Colour 1,$FF0 : Set Tab 7 Print Print : Centre "***** HELP *****" Print : Centre " Selector - Multiple File Handler" Print : Print Print Tab$+" Files - Delete,Rename,Copy Files" Print Tab$+" - use NoteBook to Delete or Copy Single Files" Print Tab$+" Make,Erase Directory. Display Free bytes" Print Tab$+" L.Amiga A to toggle WB for Format,Disk Copy etc" Print Print Tab$+" DisplayIFF - Pictures. Use Left Mouse Key to Exit" Print Tab$+" Use Right Mouse Key for all/part Screen Printout" Print Tab$+" AutoView - for IFF Pictures Use Left Mouse Key to Exit" Print Tab$+" Music - Toggles Music (AMOS/Tracker module/Raw/IFF) on/off" Print Tab$+" Sounds - Raw/IFF Music Sample Player" Print Tab$+" Text.ASCII - Left Mouse to continue, Right Mouse to interrupt" Print Tab$+" - At End - Left Mouse to exit" Print Tab$+" - Right Mouse for Speech/Printout Menu" Print Tab$+" ViewPage - for NoteBook Text and Main NoteBook Menu" Print Print Tab$+" Print - (Display IFF menu) needs WorkBench Preferences" Print Tab$+" L.Amiga A to toggle Prefs & change " Print Tab$+" - (ASCII menu) - prints ASCII text" Flash 3,"(f00,32)(f80,32)(ff0,32)(0f0,32)(08f,32)(88f,32)(f0f,32)" Print : Centre "If Display IFF Picture Menu is unreadable" Pen 3 Print : Centre "[O] or [NumL] or [F3]" Pen 2 Print : Centre "cycle pen colours" Ink 1 : Box 50,10 To 580,220 While Mouse Key<>0 : Wend While Key State(90)=True : Wend Do If(Mouse Key=1) or(Key State(95)) Then Exit Loop Screen Close 2 Wait 50 XIT: End Proc Procedure GTFILE[TIPE] On Error Goto ER Goto OK ER: ERR Resume XIT OK: Rem Assuming file {L$(X+I-2)} has no 'double-space' !!! If TIPE=1 POSN=Instr(L$(X+I-2)," ") LL$=Left$(L$(X+I-2),POSN-1) End If If TIPE=2 POSN=Instr(L2$(X+I-2)," ") LL$=Left$(L2$(X+I-2),POSN-1) End If POSN=Instr(LL$," ") : LL$=Mid$(LL$,POSN+1) If(TIPE=1) and(Right$(DRECTORY$,1)=":") Then FLE$(M)=DRECTORY$+LL$ : Goto XIT If(TIPE=1) and(Right$(DRECTORY$,1)<>":") Then FLE$(M)=DRECTORY$+"/"+LL$ : Goto XIT If(TIPE=2) and(Right$(DRECTORY$,1)=":") Then FLE2$(M2)=DRECTORY$+LL$ : Goto XIT If(TIPE=2) and(Right$(DRECTORY$,1)<>":") Then FLE2$(M2)=DRECTORY$+"/"+LL$ : Goto XIT XIT: End Proc Procedure GTDIREC On Error Goto ER Goto OK ER: ERR Resume XIT OK: Rem Assuming directory has no 'double space' !!! POSN=Instr(L$(X+I-2)," ") If Right$(DRECTORY$,1)=":" Then DRECTORY$=DRECTORY$+Mid$(L$(X+I-2),2,POSN-2) : Goto XIT If Right$(DRECTORY$,1)<>":" Then DRECTORY$=DRECTORY$+"/"+Mid$(L$(X+I-2),2,POSN-2) XIT: End Proc Procedure GTDIREC2 On Error Goto ER Goto OK ER: ERR Resume XIT OK: Rem Assuming directory has no 'double space' !!! POSN=Instr(L2$(X+I-2)," ") If Right$(DRECTORY$,1)=":" Then DRECTORY$=DRECTORY$+Mid$(L2$(X+I-2),2,POSN-2) : Goto XIT If Right$(DRECTORY$,1)<>":" Then DRECTORY$=DR$+"/"+Mid$(L2$(X+I-2),2,POSN-2) XIT: End Proc Procedure GTPAR On Error Goto ER Goto OK ER: ERR Resume XIT OK: If Right$(DRECTORY$,1)=":" Then Goto XIT POSION=Instr(Flip$(DRECTORY$),"/") POSION2=Instr(Flip$(DRECTORY$),":") If POSION<>0 Then DRECTORY$=Left$(DRECTORY$,Len(DRECTORY$)-POSION) If POSION=0 Then DRECTORY$=Left$(DRECTORY$,Len(DRECTORY$)-POSION2+1) XIT: End Proc Procedure GTNEWDRECTORY Dim DIT$(11) On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,56,4,Hires Screen Display 1,200,100,320,56 Curs Off : Cls 1 : Colour 0,$70 Print : Centre "Select New Directory" DIT$(1)="DF0:" DIT$(2)="DF1:" DIT$(3)="DH0:" DIT$(4)="DH1:" DIT$(5)="DH2:" DIT$(6)="DH3:" DIT$(7)="DH4:" DIT$(8)="DH5:" DIT$(9)="DH6:" DIT$(10)="DH7:" DIT$(11)="Other" Reserve Zone Reserve Zone 11 Paper 0 : Locate 0,3 For II=1 To 6 If Exist(DIT$(II)) Then Cright : Print Zone$(DIT$(II),II); Next II Locate 0,5 For II=7 To 10 If Exist(DIT$(II)) Then Cright : Print Zone$(DIT$(II),II); Next II Locate 30,5 Print Zone$(DIT$(11),11) Do For I=1 To 10 If Mouse Zone=I and Mouse Key If Exist(DIT$(I)) DRECTORY$=DIT$(I) : Dir$=DIT$(I) : Goto XIT End If End If Next I If Mouse Zone=11 and Mouse Key Then Exit Loop Cls 1 : Paper 1 : Home Locate 0,2 : Centre "Directory Change" RETRY: Locate 0,4 : Input " Enter New Directory ";DRECTORY3$ If(DRECTORY3$="") or(DRECTORY3$=":") Then Goto XIT If Instr(DRECTORY3$,":")=0 Then Cls : Locate 0,1 : Centre "Error - No ':' detected" : Goto RETRY If Right$(DRECTORY3$,1)="/" Then DRECTORY3$=Left$(DRECTORY3$,Len(DRECTORY3$)-1) If Not Exist(DRECTORY3$) Then Cls : Locate 0,1 : Centre "Directory Not Found" : Goto RETRY DRECTORY$=DRECTORY3$ XIT: Screen Close 1 End Proc Procedure CPYFILES On Error Goto ER Goto OK ER: ERR Resume XIT OK: If SOURCE=1 For III=1 To M Erase 6 F$=FLE$(III) ALTERF$ If Right$(DRECTORY2$,1)=":" G$=DRECTORY2$+F$ End If If Right$(DRECTORY2$,1)<>":" G$=DRECTORY2$+"/"+F$ End If Open In 1,FLE$(III) : LFILE=Lof(1) : Close 1 Reserve As Work 6,LFILE Bload FLE$(III),Start(6) Bsave G$,Start(6) To Start(6)+LFILE Next III End If If SOURCE=2 For III=1 To M2 Erase 6 F$=FLE2$(III) ALTERF$ If Right$(DRECTORY1$,1)=":" G$=DRECTORY1$+F$ End If If Right$(DRECTORY1$,1)<>":" G$=DRECTORY1$+"/"+F$ End If Open In 1,FLE2$(III) : LFILE=Lof(1) : Close 1 Reserve As Work 6,LFILE Bload FLE2$(III),Start(6) Bsave G$,Start(6) To Start(6)+LFILE Next III End If XIT: Erase 6 End Proc Procedure KLLFILES On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,48,4,Hires Screen Display 1,200,100,320,48 Curs Off : Cls 1 : Flash Off : Colour 3,$FF0 Print : Centre "/!\ All Marked Files Will be Deleted /!\" Print : Print Reserve Zone Reserve Zone 2 Pen 3 Locate 10,3 : Print Border$(Zone$("Confirm",1),1) Locate 25,3 : Print Border$(Zone$("Cancel",2),1) Do If Mouse Zone=2 and Mouse Key Then Screen Close 1 : Goto XIT If Mouse Zone=1 and Mouse Key Then Screen Close 1 : Exit Loop If SOURCE=1 For III=1 To M Kill FLE$(III) Next III End If If SOURCE=2 For III=1 To M2 Kill FLE2$(III) Next III End If XIT: End Proc Procedure RETITLE On Error Goto ER Goto OK ER: ERR Resume XIT OK: FG$=FF$ Dir$=FF$ RETIT: FILESELECTQZ[FG$,"SWITCH"," Select File to Retitle"," Quit to Leave "] If F$="" Then Goto XIT ' Rem Temp Dir Change FG$=Flip$(Dir$) If Instr(FG$,"/")<>0 FG$=Mid$(FG$,Instr(FG$,"/")) : FG$=Flip$(FG$) : Goto OK2 End If If Instr(FG$,":")<>0 FG$=Mid$(FG$,Instr(FG$,":")) : FG$=Flip$(FG$) : Goto OK2 End If OK2: ' L=Len(F$) If L<=28 Then A$=" ReName: "+F$ If L>28 Then A$=" ReName: ... "+Right$(F$,25) KEEPKEEPF$=F$ ' If FGMARKER=1 Then FGMARKER=2 : GF$=FG$ FILESELECTQZ[FG$,"SWITCH",A$," as . . ."] G$=F$ F$=KEEPKEEPF$ If G$="" Then Goto XIT Rename F$ To G$ Goto RETIT XIT: Curs Off End Proc Procedure BYFREE Clear Key On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,48,4,Hires Screen Display 1,200,100,320,48 Curs Off : Cls 1 KEEPDIR$=Dir$ If SOURCE=1 Then Dir$=DRECTORY1$ If SOURCE=2 Then Dir$=DRECTORY2$ If SOURCE=0 Then Dir$=FF$ Print Print : Centre " Free Memory (bytes) " Print Print : Centre " Disk "+Str$(Dfree) Print : Centre "{"+"Chip:"+Str$(Chip Free)+" "+"Fast:"+Str$(Fast Free)+"}" Print Wait 50 Do : Exit If Mouse Key=1 : Loop Screen Close 1 XIT: Dir$=KEEPDIR$ End Proc Procedure DISPLAYIFF On Error Goto ER Goto OK ER: ERR Resume XIT OK: If Exist(FIFF$) Then Load Iff FIFF$,0 : Goto OK2 Cls 0 Locate 0,8 Centre "File" Locate 0,10 Centre FIFF$ Print Print Centre "does not exist" Wait 50 While Mouse Key<>1 : Wend Goto XIT OK2: PCL=0 Pen PCL CHANGEPEN[1,0] BEGINNINGS: Menu Del Menu$(1)=" Options " Menu$(1,1)=" Print Screen " Menu$(1,2)=" Exit " Menu$(1,3)=" [(LO24,0)(SS6)A(LO36,0)(SS0)A]><Prefs " Do KK$="" Menu Off Menu On While KK$="" and Mouse Key<>1 and Choice<>-1 KK$=Inkey$ If Key State(37)=True Then Hide On : While Key State(37)=True : Wend : Clear Key : Wait 50 : While(Inkey$="") and(Mouse Key=0) and(Key Shift=0) : Wend : While Scancode=37 : Clear Key : Wait 9 : Wend : Show On Wend If Mouse Key=1 Then Exit If KK$<>"" Then Goto NCH If Choice(1)=1 and Choice(2)=1 Then PRNTOUT[0] If Choice(1)=1 and Choice(2)=2 Then Exit NCH: S=Scancode CN=Screen Colour If Key State(95)=True Then HELPSELECTOR : Goto BEGINNINGS If Key State(90)=True Then PCL=(PCL+1) mod CN : Pen PCL : Goto BEGINNINGS If Key State(82)=True Then PCL=(PCL+1) mod CN : Pen PCL : Goto BEGINNINGS If Key State(24)=True Then PCL=(PCL+1) mod CN : Pen PCL : Goto BEGINNINGS If Key State(93)=True Then PRNTOUT[0] : Goto BEGINNINGS If Key State(87)=True Then PRNTOUT[0] : Goto BEGINNINGS If S=29 Then Exit If S=86 Then Exit If S=93 Then PRNTOUT[0] If S=87 Then PRNTOUT[0] Loop XIT: SCN End Proc Procedure DISPLAYASCII TALKING=0 On Error Goto ER Goto OK ER: TALKING=0 ERR Resume XIT OK: If Exist(FASC$) Then Goto OK2 Cls 0 Locate 0,8 Centre "File" Locate 0,10 Centre FASC$ Print Print Centre "does not exist" Wait 50 While Mouse Key<>1 : Wend Goto XIT OK2: Screen Open 0,640,256,2,Hires Curs Off : Colour 1,$FF0 : Cls 0 Wait 25 While Mouse Key<>0 : Wend TLK: Cls 0 Open In 1,FASC$ Rem Old NoteBook Codes could be Page Numbers - so next four lines ignored ! ' If Lof(1)>=3 Then A$=Input$(1,3) : If(Instr("12",Mid$(A$,1,1))<>0) and(Instr("01",Mid$(A$,2,1))<>0) and Asc(Mid$(A$,3,1))=13 Then Pof(1)=3 : LFILE=Lof(1)-3 : Goto OK3 ' Pof(1)=0 ' If Lof(1)>=5 Then A$=Input$(1,5) : If(Instr("12",Mid$(A$,2,1))<>0) and(Instr("01",Mid$(A$,4,1))<>0) and Asc(Mid$(A$,5,1))=13 Then Pof(1)=5 : LFILE=Lof(1)-5 : Goto OK3 ' Pof(1)=0 If Lof(1)>=16 Then A$=Input$(1,16) : If(Mid$(A$,1,13)="*NB*NB*NB*NB*") Then Pof(1)=16 : LFILE=Lof(1)-16 : Goto OK3 Pof(1)=0 If Lof(1)>=13 Then A$=Input$(1,13) : If(Mid$(A$,1,10)="*NB*NB*NB*") Then Pof(1)=13 : LFILE=Lof(1)-13 : Goto OK3 Pof(1)=0 : LFILE=Lof(1) OK3: COUNTMAX=LFILE/400 COUNT=0 While Mouse Key<>0 : Wend COUNTMKR=0 Do If COUNTMKR=1 Then COUNTMKR=0 : Exit COUNT=COUNT+1 LREM=400 If COUNT>COUNTMAX Then LREM=LFILE-400*COUNTMAX : COUNTMKR=1 A$=Input$(1,LREM) For I=1 To LREM If Asc(Mid$(A$,I,1))=10 Then Print Chr$(10);Chr$(13); : Goto XX If Asc(Mid$(A$,I,1))<=31 Then Goto XX If(X Curs>70) and(Mid$(A$,I,1)=" ") and(Instr(Mid$(A$,I+1,80-X Curs)," ")=0) Then Print Chr$(10);Chr$(13); : Goto XX If(X Curs=0) and(Mid$(A$,I,1)=" ") and(Mid$(A$,I+1,1)<>" ") Then Goto XX Print Mid$(A$,I,1); If TALKING=1 Then SY$=SY$+Mid$(A$,I,1) XX: If Y Curs>30 Then While Mouse Key<>1 : Wend : While Mouse Key<>0 : Wend : For J=1 To 27 : Print : Next J : Cmove 0,-27 Next I If TALKING=1 Then Say SY$ : SY$="" Clear Key While Mouse Key=0 If Key State(95)=True Then HELPSELECTOR Wend If Mouse Key=2 Then Exit Loop Close 1 Wait 50 Print : Print : Centre "!!!!!!!!! End !!!!!!!!!" Print : Centre "( Right Mouse - Menu : Left Mouse - Exit )" Wait 50 BEGINNINGS: Pen 1 : Paper 0 Menu Del Menu$(1)=" Options " Menu$(1,1)=" Print " '''''''''''''''''''''''''''''' On Error Goto ERSAY Goto OKSAY ERSAY: Resume NOSAY OKSAY: Set Talk ,,, Menu$(1,2)=" Say " NOSAY: ''''''''''''''''''''''''''''' ' Menu$(1,2)=" Say " Menu$(1,3)=" End " Do TALKING=0 KK$="" Menu Off Menu On While Mouse Key<>1 and Choice<>-1 Wend If Mouse Key=1 Then Exit If KK$<>"" Then Goto NCH If Choice(1)=1 and Choice(2)=1 Then PRASC If Choice(1)=1 and Choice(2)=2 Then TALK If TALKING=1 Then Home : Goto TLK If Choice(1)=1 and Choice(2)=3 Then Exit NCH: Loop XIT: End Proc Procedure PRASC Open In 1,FASC$ Open Port 2,"PRT:" Rem Old NoteBook Codes could be Page Numbers - so next four lines ignored ! ' If Lof(1)>=3 Then A$=Input$(1,3) : If(Instr("12",Mid$(A$,1,1))<>0) and(Instr("01",Mid$(A$,2,1))<>0) and Asc(Mid$(A$,3,1))=13 Then Pof(1)=3 : LFILE=Lof(1)-3 : Goto OK3 ' Pof(1)=0 ' If Lof(1)>=5 Then A$=Input$(1,5) : If(Instr("12",Mid$(A$,2,1))<>0) and(Instr("01",Mid$(A$,4,1))<>0) and Asc(Mid$(A$,5,1))=13 Then Pof(1)=5 : LFILE=Lof(1)-5 : Goto OK3 ' Pof(1)=0 If Lof(1)>=16 Then A$=Input$(1,16) : If(Mid$(A$,1,13)="*NB*NB*NB*NB*") Then Pof(1)=16 : LFILE=Lof(1)-16 : Goto OK3 Pof(1)=0 If Lof(1)>=13 Then A$=Input$(1,13) : If(Mid$(A$,1,10)="*NB*NB*NB*") Then Pof(1)=13 : LFILE=Lof(1)-13 : Goto OK3 Pof(1)=0 : LFILE=Lof(1) OK3: COUNTMAX=LFILE/400 COUNT=0 While Mouse Key<>0 : Wend COUNTMKR=0 Do If COUNTMKR=1 Then COUNTMKR=0 : Exit COUNT=COUNT+1 LREM=400 If COUNT>COUNTMAX Then LREM=LFILE-400*COUNTMAX : COUNTMKR=1 A$=Input$(1,LREM) For I=1 To LREM If Asc(Mid$(A$,I,1))=10 Then Print #2,Chr$(10);Chr$(13); : Goto XX If(X Curs>70) and(Mid$(A$,I,1)=" ") and(Instr(Mid$(A$,I+1,80-X Curs)," ")=0) Then Print #2,Chr$(10);Chr$(13); : Goto XX If(X Curs=0) and(Mid$(A$,I,1)=" ") and(Mid$(A$,I+1,1)<>" ") Then Goto XX Print #2,Mid$(A$,I,1); XX: Next I Loop Close 1 Close 2 XIT: End Proc Procedure TALK TALKING=0 Clear Key On Error Goto ER Goto OK ER: TALKING=0 ERR Resume XIT OK: Screen Open 1,320,56,4,Hires Screen Display 1,200,100,320,56 Curs Off : Cls 1 Print : Centre "Enter TALK parameters" Print Input " Sex Male(0) Female(1) ";S1 Input " Mode Normal(0) Rythmic(1) ";S2 Input " Pitch Low(65) - High(320) ";S3 Input " Speed Words/Minute 40 - 400 ";S4; Curs Off Screen Close 1 If(S1<>0) and(S1<>1) Then S1=0 If(S2<>0) and(S2<>1) Then S2=0 If(S3>320) or(S3<65) Then S3=150 If(S4<40) or(S4>400) Then S4=150 Set Talk S1,S2,S3,S4 TALKING=1 XIT: End Proc Procedure AUTOVIEW On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,48,4,Hires Screen Display 1,200,100,320,48 Curs Off : Cls 1 : Flash Off : Colour 3,$FF0 : Colour 2,$A Reserve Zone Reserve Zone 5 Pen 3 Print : Centre "Time" MN#=0 : SE#=30 Do Paper 1 : Locate 2,3 : Print "Mins"; Paper 2 : Locate 7,3 : Print MN#;" "; Locate 12,3 : Print Zone$(Chr$(147)+Chr$(148),1); Locate 18,3 : Print Zone$(Chr$(149)+Chr$(150),2); Paper 1 : Locate 2,4 : Print "Secs"; Paper 2 : Locate 7,4 : Print SE#;" "; Locate 12,4 : Print Zone$(Chr$(147)+Chr$(148),3); Locate 18,4 : Print Zone$(Chr$(149)+Chr$(150),4); Locate 25,4 : Print Zone$("Exit",5); If Mouse Zone=1 and Mouse Key Then MN#=MN#+1 : Wait 10 : If MN#>60 Then MN#=60 If Mouse Zone=2 and Mouse Key Then MN#=MN#-1 : Wait 10 : If MN#<0 Then MN#=0 If Mouse Zone=3 and Mouse Key Then SE#=SE#+1 : Wait 10 : If SE#>60 Then SE#=60 If Mouse Zone=4 and Mouse Key Then SE#=SE#-1 : Wait 10 : If SE#<0 Then SE#=0 If Mouse Zone=5 and Mouse Key Then Exit Loop WT#=SE#*50+MN#*60*50 WT=1+Int(WT#) Screen Close 1 SCN Do If SOURCE=1 H=0 For III=1 To M Load Iff FLE$(III),0 For IJ=1 To WT Wait Vbl If Mouse Key=1 : Goto XIT : End If KH$=Inkey$ If(KH$="H") or(KH$="h") H=H+1 If H mod 2=1 Hide Else Show End If While Inkey$<>"" : Wend : Clear Key End If Next IJ Next III End If If SOURCE=2 H=0 For III=1 To M2 Load Iff FLE2$(III),0 For IJ=1 To WT Wait Vbl If Mouse Key=1 : Goto XIT : End If KH$=Inkey$ If(KH$="H") or(KH$="h") H=H+1 If H mod 2=1 Hide Else Show End If While Inkey$<>"" : Wend : Clear Key End If Next IJ Next III End If Loop XIT: Clear Key Show SCN3 End Proc Procedure RNFILE On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,48,4,Hires Screen Display 1,200,100,320,48 Curs Off : Cls 1 : Flash Off : Colour 3,$FF0 Centre "/!\ Current Program will be Lost /!\" Print : Centre "FOR COMPILED AMOS PROGRAMS" Print : Centre "Eg ScrapBook,NoteBook,Evaluator" Reserve Zone Reserve Zone 2 Pen 3 Locate 10,4 : Print Border$(Zone$("Confirm",1),1) Locate 25,4 : Print Border$(Zone$("Cancel",2),1) Do If Mouse Zone=2 and Mouse Key Then Screen Close 1 : Goto XIT If Mouse Zone=1 and Mouse Key Then Screen Close 1 : Exit Loop FILESELECTQZ[DRECTORY$,"SWITCH","Select New Program",""] If F$="" Then Goto XIT Run F$ Wait 50 XIT: End Proc ' Procedure MUSI MM=MM+1 If(MM mod 2)<>1 Music Off : Track Stop : Erase 3 : Erase 7 Goto XIT End If On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,48,4,Hires Screen Display 1,200,100,320,48 Curs Off : Cls 1 : Colour 0,$77 Print : Centre "*** Music ***" Reserve Zone Reserve Zone 6 Paper 0 Locate 1,3 : Print Zone$("Amos",1) Locate 7,3 : Print Zone$("Tracker",2) Rem Locate 16,3 : Print Zone$("Med",3) Locate 21,3 : Print Zone$("IFF",4) Locate 26,3 : Print Zone$("Raw",5) Locate 33,3 : Print Zone$("Quit",6) Do If Mouse Zone=1 and Mouse Key Then AMOSMUSIC=1 : Exit If Mouse Zone=2 and Mouse Key Then TRACKERMUSIC=1 : Exit If Mouse Zone=3 and Mouse Key Then MEDMUSIC=1 : Exit If Mouse Zone=4 and Mouse Key Then FFMUSIC=1 : Exit If Mouse Zone=5 and Mouse Key Then RAWMUSIC=1 : Exit If Mouse Zone=6 and Mouse Key Then Exit Loop Screen Close 1 XIT: End Proc Procedure SOUNDSAMOS On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,64,4,Hires Screen Display 1,200,100,320,64 Curs Off : Cls 1 : Colour 0,$77 Paper 0 Locate 0,3 : Centre "AMOS Music Player" On Error Goto ER2 Goto OK2 ER2: Erase 3 Screen Close 1 CLEAN_UP ERR Resume XIT OK2: Load MUZIC$ Music 1 Cls 1 : Home Paper 1 : Locate 0,2 : Centre "Keep Parameters ?" Reserve Zone Reserve Zone 2 Paper 0 Locate 13,4 : Print Zone$("Yes",1) Locate 24,4 : Print Zone$("No",2) Do If Mouse Zone=1 and Mouse Key Then Goto XIT2 If Mouse Zone=2 and Mouse Key Then Goto MPRMS Loop MPRMS: Paper 1 : Cls : Home : Print : Centre "Sound & Music" Print : Centre "To Keep Parameters Press [Enter]" Print : Input " Tempo 1-100 ? ";SS If(SS>=1) and(SS<=100) Tempo SS End If Input " Volume 1-63 ? ";VV If(VV>=1) and(VV<=63) Mvolume VV End If Clear Key Print : Input " OK (y/n) ? ";O$ If(O$="Y") or(O$="y") or(O$="") Goto XIT2 End If Goto MPRMS XIT2: Screen Close 1 XIT: End Proc Procedure SOUNDSTRACKER On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,64,4,Hires Screen Display 1,200,100,320,64 Curs Off : Cls 1 : Colour 0,$77 Paper 0 Locate 0,3 : Centre "Tracker Music Player" On Error Goto ER2 Goto OK2 ER2: Erase 3 Screen Close 1 CLEAN_UP ERR Resume XIT OK2: Track Loop On Track Load MUZIC$,3 Track Play 3 Wait 200 Screen Close 1 XIT: End Proc ' Procedure CLARIFY On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,48,4,Hires Screen Display 1,200,100,320,48 Curs Off : Cls : Colour 0,$77 Cls 1 : Music Off : Track Stop : Erase 3 : MM=0 : Erase 7 : CLEAN_UP Paper 0 Print : Print : Centre "RAW / IFF Sound Player" Wait 100 Screen Close 1 XIT: End Proc Procedure SOUNDSIFF[TIPE$] On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,64,4,Hires Screen Display 1,200,100,320,64 Curs Off : Cls 1 : Colour 0,$77 If TIPE$="Sound" Then MM=0 Music Off : Track Stop : Erase 3 : Erase 7 Paper 0 Locate 0,3 : Centre "RAW / IFF "+TIPE$+" Player" On Error Goto ER2 Goto OK2 ER2: Screen Close 1 ERR Resume XIT OK2: Open In 1,MUZIC$ LMUSF=Lof(1) Close 1 CLEAN_UP If Chip Free<LMUSF-10000 Then Screen Close 1 : ERR : Goto XIT Reserve As Chip Work 7,LMUSF Bload MUZIC$,Start(7) FIRST=Hunt(Start(7) To Start(7)+50,"FORM") If FIRST=Start(7) Then FQ=Deek(Start(7)+32) If(FQ<3000) or(FQ>50000) Then ERR : FQ=12000 Sam Loop On Volume VL VC=0 : For I=1 To 4 : VC=VC+Instr("1",Mid$(VC$,I,1))*2^(4-I) : Next I Sam Raw VC,Start(7),Length(7),FQ Paper 1 : Cls 1 : Home If FIRST=Start(7) Then Locate 0,1 : Centre "IFF" If FIRST<>Start(7) Then Locate 0,1 : Centre "RAW" Locate 0,2 : Centre "Keep Parameters ?" Paper 0 Reserve Zone Reserve Zone 2 Paper 0 Locate 13,4 : Print Zone$("Yes",1) Locate 24,4 : Print Zone$("No",2) Do If Mouse Zone=1 and Mouse Key Then Screen Close 1 : Goto XIT If Mouse Zone=2 and Mouse Key Then Goto GPRMS Loop GPRMS: R$="y" ' On Error Goto ER1 Goto PRMS ER1: Screen Hide 1 ERR Screen Show 1 VLL=VL : VCC$=VC$ : FQQ=FQ Volume VLL Sam Raw VCC,Start(7),Length(7),FQQ Resume PRMS ' PRMS: Paper 1 : Cls 1 : Home If FIRST=Start(7) Then Centre "Iff Sound & Music" If FIRST<>Start(7) Then Centre "Raw Sound & Music" Print : Print " Volume ";VL; : Input " : Requd 1-63 ";VLL If(VLL<=0) or(VLL>=64) Then VLL=VL Print " Voices ";VC$; : Input " : Requd LRLR 0,1 ";VCC$ If Len(VCC$)<>4 Then VCC$=VC$ If Instr(VCC$,"1")=0 Then VCC$=VC$ For I=1 To 4 : If Instr("01",Mid$(VCC$,I,1))=0 Then VCC$=VC$ : Next I Print " Rate ";FQ; : Input " : Requd 3000-50000 ";FQQ If(FQQ<3000) or(FQQ>50000) Then FQQ=FQ Print " Repeat ";R$; : Input " : Requd y/n ? ";RR$ If(RR$="y") or(RR$="Y") Then Sam Loop On : R$="y" If(RR$="n") or(RR$="N") Then Sam Loop Off : R$="n" Volume VLL Music Off : Track Stop VCC=0 : For I=1 To 4 : VCC=VCC+Instr("1",Mid$(VCC$,I,1))*2^(4-I) : Next I Sam Raw VCC,Start(7),Length(7),FQQ VL=VLL : VC$=VCC$ : FQ=FQQ Print : Input " OK (y/n) ? ";O$ If(O$="Y") or(O$="y") or(O$="") Then Screen Close 1 : Goto XIT Goto PRMS XIT: End Proc Procedure CLEAN_UP On Error Goto ER Goto OK ER: Resume OK2 OK: Reserve As Chip Data 10,1000000000 OK2: On Error Goto ER3 Goto OK3 ER3: Resume OK4 OK3: Reserve As Data 10,1000000000 OK4: End Proc ' Procedure MDIR Clear Key On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,56,4,Hires Screen Display 1,200,100,320,56 Curs Off : Cls 1 Print : Centre "Make Directory" Print : Print : Centre "Enter new directory {eg df0:new}" Print : Print Input " ";NDIR$ Curs Off On Error Goto ER2 Goto OK2 ER2: Screen Close 1 ERR Resume XIT OK2: Mkdir NDIR$ Screen Close 1 XIT: End Proc Procedure ERASDIR Clear Key On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,48,4,Hires Screen Display 1,200,100,320,48 Curs Off : Cls 1 Print : Centre "Enter EMPTY directory {eg df0:new}" Print : Print Input " Erase ";NDIR$ Curs Off Dreg(1)=Varptr(NDIR$) H=Doscall(-72) If H<>0 Then Goto XIT2 If H=0 Then Centre "Not Done." Do : Exit If Mouse Key=1 : Loop XIT2: Wait 50 Screen Close 1 XIT: End Proc ' Procedure PRNTOUT[SCR] On Error Goto ER Goto OK ER: ERR Resume XIT OK: SO=Screen Screen SCR Screen Show SCR SBSE=Screen Base+72 VM=Deek(SBSE) : DEPTH=Deek(SBSE+8) : SW=Screen Width : SH=Screen Height ''''''''''''''''''''''''''''''''''''''''''''''''''''' Screen Open 5,320,48,4,Hires Screen Display 5,200,100,320,48 Curs Off : Cls 1 : Flash Off : Colour 3,$FF0 Print : Centre "Select" Reserve Zone Reserve Zone 4 ' Pen 3 : Locate 0,2 : Centre "Mem: Chip "+Str$(Chip Free)+" Fast "+Str$(Fast Free) ' Locate 0,3 : Centre " Screen "+Str$(DEPTH*SW*SH/8) ' If Chip Free<((DEPTH*SW*SH/2)+10000) Then Close 5 : ERR : Goto XIT Pen 3 : Paper 0 Set Zone 1,0,0 To 150,6 : Ink 2 : Box 1,1 To 150,3 Locate 7,4 : Print Zone$("All",2) Locate 17,4 : Print Zone$("Part",3) Locate 27,4 : Print Zone$("Cancel",4) Do If(Mouse Zone=1) and Mouse Key Then While Mouse Key<>0 : Screen Display 5,200,Y Mouse,320,48 : Wend If Mouse Zone=2 and Mouse Key Then Screen Close 5 : CASE=1 : Exit If Mouse Zone=3 and Mouse Key Then Screen Close 5 : CASE=2 : Exit If Mouse Zone=4 and Mouse Key Then Screen Close 5 : Goto XIT Loop While Mouse Key<>0 : Wend : Wait 25 If CASE=2 GROWBOX End If If CASE=1 GX1=0 : GX2=SW : GY1=0 : GY2=SH End If If GX2-GX1<1 or GY2-GY1<1 Then ERR : Goto XIT ''''''''''''''''''''''''''''''''''''''''''''''''''' ' Create Claire's screen table If Btst(13,VM) Then VMODE=2 : Rem Lowres If Btst(15,VM) Then VMODE=32770 : Rem Hires If Btst(11,VM) Then VMODE=2050 : Rem Ham If Btst(2,VM) Then VMODE=VMODE+4 : Rem Laced SN$="Claire's Screen " Erase 5 Reserve As Work 5,32 WSBSE=Start(5) ' Create ExtIO Loke WSBSE+$0,0 : Rem xpos & ypos Doke WSBSE+$4,SW : Rem width Doke WSBSE+$6,SH : Rem height Doke WSBSE+$8,DEPTH : Rem Bitplanes Doke WSBSE+$A,0 Doke WSBSE+$C,VMODE : Rem View modes Doke WSBSE+$E,15 : Rem Screen type 'custom' Loke WSBSE+16,0 : Rem Fonts Loke WSBSE+20,Varptr(SN$) : Rem Point to screen name Loke WSBSE+24,0 : Rem No gadgets Loke WSBSE+28,0 : Rem No bitmap ' Create Claire's screen Areg(0)=WSBSE SCRH=Intcall(-198) : Rem screen handle Areg(0)=SCRH : H=Intcall(-246) : Rem move Claire's screen to back ' Copy over bitplanes H=$C0 For X=0 To DEPTH-1 ' Loke(SCRH+H),Logbase(X) Copy Logbase(X),Logbase(X)+((SW*SH)/8) To Leek(SCRH+H) Add H,4 Next X ' Setup Printer Dump VPORT=SCRH+44 : Rem View Port RPORT=SCRH+84 : Rem Rast Port SCM=Leek(VPORT+4) : Rem Colour Map VMODE=Deek(VPORT+32) : Rem viewModes ' Set RGB Palette For X=0 To(2^DEPTH)-1 RGB$=Hex$(Colour(X),3) Areg(0)=VPORT : Dreg(0)=X Dreg(1)=Val("$"+Mid$(RGB$,2,1)) Dreg(2)=Val("$"+Mid$(RGB$,3,1)) Dreg(3)=Val("$"+Mid$(RGB$,4,1)) H=Gfxcall(-288) Next ' Create Port Dreg(0)=-1 : SIGBIT=Execall(-330) : Rem Sig bit Dreg(0)=40 : Dreg(1)=65537 MSGPORT=Execall(-198) : Rem Reserve 40 Bytes of Memory for MsgPort details If MSGPORT=0 Then SCR=-2 : Goto XIT4 Poke MSGPORT+8,4 : Rem Type=NT_MSGPORT Poke MSGPORT+9,0 : Rem Priority ' PNAME$="Claire's Printer Port " : Rem printer port name PNAME$="Prt:" : Rem printer port name Loke MSGPORT+10,Varptr(PNAME$) : Rem Pass adr. of port name Poke MSGPORT+14,0 : Rem flags Poke MSGPORT+15,SIGBIT : Rem sig bit Areg(1)=0 : SIGTASK=Execall(-294) : Rem get sigtask Loke MSGPORT+16,SIGTASK : Rem Pass Sigtask Areg(1)=MSGPORT : H=Execall(-354) : Rem Add Port ' Create ExtIO Dreg(0)=64 : Dreg(1)=65537 IOREQUEST=Execall(-198) : Rem Reserve 64 bytes for IoRequest details If IOREQUEST=0 Then SCR=-2 : Goto XIT3 Poke IOREQUEST+8,5 : Rem Type=NT_MESSAGE Poke IOREQUEST+9,0 : Rem Priority Loke IOREQUEST+14,MSGPORT ' Open the Printer Device DEVNAME$="printer.device"+Chr$(0) Areg(0)=Varptr(DEVNAME$) : Dreg(0)=0 : Areg(1)=IOREQUEST : Dreg(1)=0 PERROR=Execall(-444) : Rem Open Printer (device) If PERROR<>0 Then SCR=-2 : Goto XIT2 ' Dump the RastPort Doke IOREQUEST+28,11 : Rem command Loke IOREQUEST+32,RPORT : Rem rastport Loke IOREQUEST+36,SCM : Rem colourMap Loke IOREQUEST+40,VMODE : Rem viewmodes Doke IOREQUEST+44,GX1 : Rem Xpos Doke IOREQUEST+46,GY1 : Rem Ypos Doke IOREQUEST+48,GX2-GX1 : Rem Width Doke IOREQUEST+50,GY2-GY1 : Rem Length Loke IOREQUEST+52,0 : Rem destCol Loke IOREQUEST+56,0 : Rem destRow Doke IOREQUEST+60,$84 : Rem FullCol Aspect Areg(1)=IOREQUEST IOERROR=Execall(-456) : Rem pass IOrequest table - Send Screen to Printer If IOERROR<>0 Then SCR=-2 : Goto XIT1 ' Close up printer dump XIT1: Rem close printer device Areg(1)=IOREQUEST : H=Execall(-450) XIT2: Rem Delete ExtIO Poke IOREQUEST+3,$FF Loke IOREQUEST+20,-1 Loke IOREQUEST+24,-1 Areg(1)=IOREQUEST : Dreg(0)=64 : H=Execall(-210) XIT3: Rem Delete port Areg(1)=MSGPORT : H=Execall(-360) Poke MSGPORT+8,$FF Loke MSGPORT+20,-1 Dreg(0)=SIGBIT : H=Execall(-336) Areg(1)=MSGPORT : Dreg(0)=40 : H=Execall(-210) XIT4: Rem Close Dummy screen Areg(0)=SCRH H=Intcall(-66) XIT: Erase 5 Screen SO : H=Free Screen Show SO End Proc[SCR] Procedure GROWBOX On Error Goto ER Goto OK ER: ERR ' Wait 50 Resume OK OK: Change Mouse 2 GRABBED=False Gr Writing 2 Repeat Rem Wait until the left mouse button is pressed If Mouse Key=1 Rem Get coordinates of top corner GX1=X Screen(X Mouse) : GY1=Y Screen(Y Mouse) : GX2=GX1 : GY2=GY1 C=Point(GX1,GY1) Box GX1,GY1 To GX2,GY2 While Mouse Key=1 Rem Drag box around with the mouse Box GX1,GY1 To GX2,GY2 GX2=X Screen(X Mouse) : GY2=Y Screen(Y Mouse) Box GX1,GY1 To GX2,GY2 Wend Box GX1,GY1 To GX2,GY2 GRABBED=True Rem Make GX1,GY1 the coords of the TOP left corner Plot GX1,GY1,C Ink KEEPINK If GX1>GX2 : T=GX1 : GX1=GX2 : GX2=T : End If If GY1>GY2 : T=GY1 : GY1=GY2 : GY2=T : End If End If Rem Wait until mouse button is released Until GRABBED Rem Restore writing mode to normal If KM=0 Then Change Mouse 1 Gr Writing 1 If GX2<GX1+1 Then GX2=GX1+1 If GY2<GY1+1 Then GY2=GY1+1 Rem Box GX1,GY1 To GX2,GY2 Gr Writing 1 End Proc ' Procedure ERR On Error Goto ER Goto OK ER: Resume XIT OK: Screen Open 3,320,48,4,Hires Screen Display 3,200,100,320,48 Curs Off : Cls 1 Print : Centre "Error - Out of Memory/Range?" Print Print : Centre "Press Left Mouse Key" Wait 50 Do : Exit If Mouse Key=1 : Loop Screen Close 3 XIT: End Proc ' Procedure REZGET[SCN] Screen SCN AMOS=Screen Base+72 VM=Deek(AMOS) If Btst(13,VM) Then REZ=Lowres If Btst(15,VM) Then REZ=Hires If Btst(11,VM) Then REZ=Lowres : Rem HAM If Btst(2,VM) Then REZ=REZ+Laced End Proc ' Procedure GTCOLOUR On Error Goto ER Goto OK ER: ERR Resume XIT OK: CN=Screen Colour If CN=4096 Then CN=16 If CN=64 Then CN=32 Screen Open 1,160,56,32,Lowres Screen Display 1,200,100,320,56 Flash Off Curs Off : Get Palette 0 : Cls 2 Reserve Zone CN+1 Paper 2 : Pen 1 Locate 0,2 Print "Select colour:" Print : Print " "; For I=1 To Int(CN/2) Paper I-1 : Print Zone$(" ",I); Next I Paper 2 : Print : Print " "; For I=Int(CN/2)+1 To CN Paper I-1 : Print Zone$(" ",I); Next I Set Zone CN+1,0,0 To 150,6 : Ink 1 : Box 1,1 To 150,3 RETRY: Do If Mouse Key=1 and(Mouse Zone>0) and(Mouse Zone<=CN) Then C1=Mouse Zone : Locate 15,2 : Paper C1-1 : Print " "; : Wait 50 : Clear Key : Exit If(Mouse Zone=CN+1) and(Mouse Key=1) Then Ink 0 : Box 1,1 To 150,3 : Do : Screen Display 1,200,Y Mouse,160,56 : Exit If Mouse Key=2 : Loop : Ink 1 : Box 1,1 To 150,3 Loop DR=C1-1 XIT: End Proc Procedure MIX If Screen Colour=4096 and DR>16 Then Goto XIT If Screen Colour=64 and DR>32 Then Goto XIT On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,56,16,Hires Screen Display 1,200,100,320,56 Curs Off : Flash Off Reserve Zone 6 Set Zone 1,20,10 To 180,15 Set Zone 2,20,26 To 180,31 Set Zone 3,20,42 To 180,47 Locate 34,1 : Print Border$(Zone$("Undo",5),1); Locate 34,5 : Print Border$(Zone$("Exit",4),1); Set Zone 6,0,0 To 320,6 : Ink 2 : Box 1,1 To 250,3 Screen 0 : C=Colour(DR) : Screen 1 RETRY: C1=Int(C/256) : C2=Int((C-256*C1)/16) : C3=C mod 16 KEEPCOLOUR=C Colour 5,C : Paper 5 : Locate 34,3 : Print " " : Paper 1 Locate 25,1 : Print "Red"; Locate 25,3 : Print "Green"; Locate 25,5 : Print "Blue"; Hslider 20,10 To 180,15,16,C1,1 Hslider 20,26 To 180,31,16,C2,1 Hslider 20,42 To 180,47,16,C3,1 Do X=X Screen(X Mouse) : X=Int((X-20)/10) If(Mouse Zone=1) and(Mouse Key=1) Hslider 20,10 To 180,15,16,X,1 : C1=X End If If(Mouse Zone=2) and(Mouse Key=1) Hslider 20,26 To 180,31,16,X,1 : C2=X End If If(Mouse Zone=3) and(Mouse Key=1) Hslider 20,42 To 180,47,16,X,1 : C3=X End If If(Mouse Zone=4) and(Mouse Key=1) Then Exit If(Mouse Zone=5) and(Mouse Key=1) Then C=KEEPCOLOUR : Goto RETRY If(Mouse Zone=6) and(Mouse Key=1) Then Ink 0 : Box 1,1 To 250,3 : Do : Screen Display 1,200,Y Mouse,320,56 : Exit If Mouse Key=2 : Loop : Ink 2 : Box 1,1 To 250,3 C=C1*256+C2*16+C3 Colour 5,C : Paper 5 : Locate 34,3 : Print " " : Paper 1 Screen 0 : Colour DR,C If DR=0 CB[0] End If Screen 1 Loop Screen Close 1 XIT: Ink KEEPINK End Proc Procedure CB[IV] On Error Goto ER Goto OK ER: ERR Resume XIT OK: Colour Back(Colour(IV)) Screen Open 6,16,8,2,Lowres Screen Display 6,0,0,16,8 Screen Close 6 XIT: End Proc ' Rem ########## Selector Subsystem End ################ ' Rem ################### NoteBook ##################### ' Global FR,FR$,FAC,FAC$,PC,PNC FR=1 : FR$="1" : FAC=0 : FAC$="0" : PC=0 : PNC=2 ' Rem FR = 1 for Lowres, 2 for Hires - (Scaling factor) Rem FAC = 0 for 'normal' screens, 1 for Interlace Rem PC = Page Colour (ie Paper), PNC = Pen Colour (ie Pen) ' Global MOSTPAGES MOSTPAGES=10 Dim K$(200) : Dim J$(200) : Dim TX$(MOSTPAGES,60) Global K$(),J$(),TX$() Global F$,G$ Global BV,BMI,BD,BN,MARKER,MF$,I,X,N,NN,KEEPY Global KK$ Global PAGE,PL,PMAX,MERGECD MERGECD=0 Global TYPE,KEEPPAGE,LEAF,LW,WRAP$,NWRAPLINES Global FF$,GG$ Global CR,DR Dim PLTC(8) Global PLTC() Global NDIR$ PAL[3] WRAP$="No" : NWRAPLINES=-1 ' NTEBOOK Procedure NTEBOOK BEGINOVER: PAGE=1 : PL=1 : PMAX=1 BN=0 : BV=0 : BMI=0 : BD=0 : MARKER=0 : N=0 : FR=1 SCN2 CB[0] THEMENU Do Menu Off Menu On BL=0 If Key State(95)=True Then SCN : HELP : SCN2 If Choice<>-1 Then Goto NOCHOICE Rem If Choice=-1 : Rem and Choice(1)=1 Then If Choice(1)=1 and Choice(2)=1 Then SCN : BV=1 : BOOK : Goto BEGINOVER If Choice(1)=1 and Choice(2)=2 Then SCN : MAKEBOOK : Goto BEGINOVER If Choice(1)=1 and Choice(2)=3 Then SCN : FILESELECT : Goto BEGINOVER If Choice(1)=1 and Choice(2)=4 Then SCN : HELP : SCN2 If Choice(1)=1 and Choice(2)=5 Then SCN : AMOSC : End If Choice(1)=2 and Choice(2)=1 Then TXTLOAD : SCN : TXTNEW[1,0] : FR=1 : FAC=0 : Goto BEGINOVER If Choice(1)=3 and Choice(2)=1 and Choice(3)=1 Then FR=1 : FAC=0 : SCN : TXTNEW[2,2] : FR=1 : FAC=0 : TYP3=0 : Goto BEGINOVER If Choice(1)=3 and Choice(2)=1 and Choice(3)=2 Then FR=1 : FAC=1 : SCN : TXTNEW[2,2] : FR=1 : FAC=0 : TYP3=0 : Goto BEGINOVER If Choice(1)=3 and Choice(2)=1 and Choice(3)=3 Then FR=2 : FAC=0 : SCN : TXTNEW[2,2] : FR=1 : FAC=0 : TYP3=0 : Goto BEGINOVER If Choice(1)=3 and Choice(2)=1 and Choice(3)=4 Then FR=2 : FAC=1 : SCN : TXTNEW[2,2] : FR=1 : FAC=0 : TYP3=0 : Goto BEGINOVER If Choice(1)=3 and Choice(2)=2 Then TXTLOAD : SCN : TXTNEW[2,2] : FR=1 : FAC=0 : TYP3=0 : Goto BEGINOVER Rem For the Colour Menu If Choice(1)=4 and Choice(2)=1 Then CR=Choice(3) : DR=CR-1 : PNC=DR If Choice(1)=4 and Choice(2)=2 Then CR=Choice(3) : DR=CR-1 : PC=DR Rem For Files Menu If Choice(1)=5 and Choice(2)=1 Then SCN : RUBOUT : SCN2 If Choice(1)=5 and Choice(2)=2 Then SCN : RETITLE : SCN2 If Choice(1)=5 and Choice(2)=3 Then SCN : CPY : SCN2 If Choice(1)=5 and Choice(2)=4 Then SCN : MDIR : SCN2 If Choice(1)=5 and Choice(2)=5 Then SCN : ERASDIR : SCN2 If Choice(1)=5 and Choice(2)=7 Then SCN : SOURCE=0 : BYFREE : SCN2 NOCHOICE: Loop End Proc Procedure THEMENU Menu Del Menu$(1)=" Options " Menu$(1,1)=" Load Book " Menu$(1,2)=" Make Book " Menu$(1,3)=" Selector " Menu$(1,4)=" Help " Menu$(1,5)=' Quit ' Menu$(2)=" Print " Menu$(2,1)=" Text " Menu$(3)=' Pages ' Menu$(3,1)=' New ' Menu$(3,1,1)=" Large print " Menu$(3,1,2)=" Half-large " Menu$(3,1,3)=" Small print " Menu$(3,1,4)=" Half-small " Menu$(3,2)=' Load ' Menu$(4)=" Colour " Menu$(4,1)=" Pen " Menu$(4,2)=" Paper " Rem Create a colour bar For C=1 To 8 D=C-1 Menu$(4,1,C)="(IN 1,"+Str$(D)-""+")(BA 20,10)" Menu$(4,2,C)="(IN 1,"+Str$(D)-""+")(BA 20,10)" Next C Menu$(5)=" Files " Menu$(5,1)="Delete" Menu$(5,2)="ReName" Menu$(5,3)="Copy" Menu$(5,4)="MakeDir" Menu$(5,5)="EraseDir" Menu$(5,6)="(IN1,1)(SS 6)A(SS 0)(LO10,0)A><WB(IN1,0)" Menu$(5,7)="Memory" End Proc ' Procedure SCN If PLTYPE$="" ' Screen Close 0 Screen Open 0,320*FR,256*(FAC+1),8,32768*(FR-1)+4*FAC Curs Off : Cls 0 : Paper 0 : Pen 2 : Cls 0 Colour 7,$FF0 Screen 0 CB[0] Limit Mouse 128,42 To 320*FR+128,44+256*(FAC+1) Menu Off ' MOSTPAGESCALC End If End Proc Procedure SCN2 Screen Close 0 Screen Open 0,320*FR,256,8,32768*(FR-1) Curs Off : Cls 0 : Paper 0 : Pen 2 : Cls 0 Colour 7,$FF0 Screen 0 Limit Mouse 128,42 To 320*FR+128,44+256 Menu Off Paste Icon 49,49,3 Locate 0,10 Centre Border$("NoteBook",2) Ink 4 Ellipse 160*FR,84,50*FR,30 Ink 7 Ellipse 160*FR,84,60*FR,40 End Proc ' Procedure BOOK On Error Goto ERBOOK A$="Please select Book" : B$="of your choice" MAKEBOOK: N=0 FILESELECTQZ[FF$,"SWITCH",A$,B$] : SD If F$="" Then Goto BKENDS If Len(F$)<5 Then A$="Not a ... .book" : B$="ReSelect or Quit" : Goto MAKEBOOK If Right$(F$,5)<>".book" Then A$="Not a ... .book" : B$="ReSelect or Quit" : Goto MAKEBOOK Open In 1,F$ Input #1,N For I=1 To N Input #1,J$(I) Input #1,K$(I) Next I Close 1 EASYLOOK Goto BKENDS ERBOOK: A$="Error! Retry/Quit" : B$="Select Book" Resume MAKEBOOK BKENDS: End Proc Procedure ALTERF$ Shared F$ Do A=0 A=Instr(F$,"/") If A<>0 Then F$=Mid$(F$,A+1,Len(F$)) If A=0 Then Exit Loop Do A=0 A=Instr(F$,":") If A<>0 Then F$=Mid$(F$,A+1,Len(F$)) If A=0 Then Exit Loop A$=Right$(F$,4) If A$=".IFF" Then F$=F$-A$ If A$=".iff" Then F$=F$-A$ If A$=".Iff" Then F$=F$-A$ End Proc ' Procedure EASYLOOK On Error Goto ER Goto OK ER: ERR Resume XLOOK OK: KEEPY=1 REASY: SCN Double Buffer : Cls 0 Curs Off Autoback 1 Pen 7 Under On : Locate 0,0 : Centre "Fast File Finder" : Under Off Locate 0,20 : Centre "Select page" If BV=1 Then Locate 0,22 : Centre "to view" If BN=1 Then Locate 0,22 : Centre "to view" If BMI=1 Then Locate 0,22 : Centre "to insert, after" If BD=1 Then Locate 0,22 : Centre "to remove" Pen 2 MAKEZONES Autoback 0 Rem main loop Y=KEEPY Do X=1+Int((N*Y)/170) Rem Read mouse If Mouse Zone=1 and Mouse Key Then Y=Y Screen(Y Mouse) : KEEPY=Y For I=2 To 16 If Mouse Zone=I and Mouse Key and X+I-2<N+1 and BV=1 Then SCN : DISPLAY : Goto REASY If Mouse Zone=I and Mouse Key and X+I-2<N+1 and BN=1 Then SCN : DISPLAY : Goto REASY If Mouse Zone=I and Mouse Key and X+I-2<N+1 and BMI=1 Then SCN : MULTIPLEPGINSERT : Goto REASY If Mouse Zone=I and Mouse Key and X+I-2<N+1 and BD=1 Then SCN : TXTDEL : Goto REASY Next I If Mouse Zone=17 and Mouse Key Then NWTYPE : BV=1 : Goto REASY If Mouse Zone=18 and Mouse Key Then NWTYPE : BMI=1 : Goto REASY If Mouse Zone=19 and Mouse Key Then NWTYPE : BD=1 : Goto REASY If Mouse Zone=20 and Mouse Key Then BOOKSAVE : Goto REASY If Mouse Zone=21 and Mouse Key Then BOOKSAVE : SCN : Goto XLOOK If Mouse Zone=22 and Mouse Key Then BOOKSORT : SCN : Goto REASY If Mouse Zone=23 and Mouse Key Then BOOKSEARCH : SCN : Goto REASY If Y>170 Then Y=170 Rem If slider has moved change it If Y<>YM and Mouse Key=1 : YM=Y : End If Rem Update display For I=1 To 15 Locate 5,I+1 : Cline If X+I-1<=N Then UD[I+1] : Print Left$(K$(X+I-1),25); : Inverse Off Next I VSLIDE[Y] Rem Double buffering smooths the effect Screen Swap : Wait Vbl For I=1 To 15 Locate 5,I+1 If X+I-1<=N Then UD[I+1] : Print Left$(K$(X+I-1),25); : Inverse Off Next I VSLIDE[Y] Loop XLOOK: If N=0 Then Goto XIT For I=1 To N J$(I)="" K$(I)="" Next I XIT: End Proc Procedure MAKEZONES Reserve Zone 23 Set Zone 1,0,0 To 10,170 For I=2 To 16 Locate 5,I Print Zone$(" ",I) Next I Pen 5 Locate 1,26 : Print Border$(Zone$("Display",17),1) Locate 10,26 : Print Border$(Zone$("Insert",18),1) Locate 18,26 : Print Border$(Zone$("Delete",19),1) Locate 26,26 : Print Border$(Zone$("Save",20),1) Locate 32,26 : Print Border$(Zone$("End",21),1) Locate 1,29 : Print Border$(Zone$("Sort",22),1) Locate 7,29 : Print Border$(Zone$("Search",23),1) Pen 2 End Proc Procedure VSLIDE[Y] Set Slider 0,1,7,5,0,7,7,1 Rem Display a slider bar using the Vslider command Vslider 0,0 To 10,170,170,Y,5 End Proc ' Procedure BOOKSORT On Error Goto ER Goto OK ER: ERR Resume XIT OK: For IBOOK=1 To N K$(IBOOK)=K$(IBOOK)+Space$(50-Len(K$(IBOOK)))+J$(IBOOK) Next IBOOK Sort K$(0) IBOOK=0 Do If K$(IBOOK)<>"" Then Exit Inc IBOOK Loop For I2BOOK=1 To N K$(I2BOOK)=K$(I2BOOK+IBOOK-1) Next I2BOOK For IBOOK=N+1 To 200 K$(IBOOK)="" Next IBOOK For IBOOK=1 To N J$(IBOOK)=Mid$(K$(IBOOK),51) Next IBOOK For IBOOK=1 To N F$=J$(IBOOK) ALTERF$ K$(IBOOK)=F$ Next IBOOK XIT: End Proc Procedure BOOKSEARCH On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 4,320,56,4,Hires Screen Display 4,200,100,320,56 Curs Off : Cls 1 : Flash Off : Colour 3,88 Print : Centre "Search" Reserve Zone Reserve Zone 2 Paper 3 Locate 5,4 : Print Zone$("New",1) Locate 15,4 : Print Zone$("Continue",2) Paper 1 Do If Mouse Key<>0 and Mouse Zone=1 Then Exit If Mouse Key<>0 and Mouse Zone=2 Then Goto XIT2 Loop Cls : Print : Centre "Search" Print : Print : Centre "[Enter] String to Search For" Print : Print : Input " Find ";S$ Curs Off IBOOK=0 : MTCH=0 XIT2: KEEPMTCH=MTCH Do Inc IBOOK If IBOOK>N Then Exit If Instr(K$(IBOOK),S$)<>0 Then MTCH=IBOOK : Exit Loop If MTCH=KEEPMTCH Then Cls : Print : Print : Centre "Not Found" : Wait 100 Screen Close 4 MTCH1=Int(((MTCH-1)*170)/N) Y Mouse=Y Hard(MTCH1) : X Mouse=X Hard(50) Y=Y Screen(Y Mouse) KEEPY=Y X=1+Int((N*Y)/170) For I=1 To 15 Locate 5,I+1 : Cline If X+I-1<=N Then UD[I+1] : Print Left$(K$(X+I-1),25); : Inverse Off If X+I-1=MTCH Then Y Mouse=Y Hard(8*(I+2)-4) Next I VSLIDE[Y] Rem Double buffering smooths the effect Screen Swap : Wait Vbl For I=1 To 15 Locate 5,I+1 If X+I-1<=N Then UD[I+1] : Print Left$(K$(X+I-1),25); : Inverse Off Next I VSLIDE[Y] XIT: End Proc ' Procedure BOOKSAVE TRY$="ok" If N=0 Then Goto XIT On Error Goto ER Goto OK ER: ERR Goto XIT OK: A$="Save as ..." : B$="... .book" RETRYSAVE: FILESELECTQZ[FF$,"SWITCH",A$,B$] : SD If F$="" Then Goto XIT EXCLUDE_FROM_SAVE[F$] If TRY$="not ok" If Len(F$)<33 A$=F$ End If If Len(F$)>=30 A$="..."+Right$(F$,30) End If B$="Disallowed ! Try Again !" : Goto RETRYSAVE End If If Right$(F$,5)<>".book" Then F$=F$+".book" If Exist(F$) Then OVERWRITE If TRY$="not ok" If Len(F$)<33 A$=F$ End If If Len(F$)>=30 A$="..."+Right$(F$,30) End If B$="Already Exists ! Try Again !" : Goto RETRYSAVE End If Open Out 1,F$ Print #1,N For I=1 To N Print #1,J$(I) Print #1,K$(I) Next I Close 1 XIT: End Proc ' Procedure DISPLAY If Exist(J$(X+I-2)) Then Goto OKT While Mouse Key<>0 : Wend Locate 0,10 : Centre "File" Locate 0,12 : Centre J$(X+I-2) Print : Print : Centre "does not exist" While Mouse Key<>1 : Wend Goto XIT OKT: On Error Goto ER Goto OK ER: ERR Resume XIT OK: Open In 1,J$(X+I-2) On Error Goto ER2 Goto OK2 ER2: ERR Close 1 Resume XIT OK2: MARKER=3 : TXTLOAD : SCN : TXTNEW[2,0] XIT: FR=1 : FAC=0 SCN End Proc ' Procedure TXTINS Cls 0 If N<200 Then Goto PRCEED Locate 0,10 : Centre "No more pages - max 200" Locate 0,15 : Centre "RIGHT mouse key to continue" While Mouse Key<>2 : Wend Wait 50 Goto XIT PRCEED: On Error Goto ERTXTINS Goto OKTXTINS ERTXTINS: A$="Error! Retry/Quit" : B$="Select Page to insert,after" Resume MAKETXTINS OKTXTINS: A$="Select Page" : B$="to insert,after" MAKETXTINS: FILESELECTQZ[FF$,"SWITCH","Select Page","to insert,after"] : SD If F$="" Then Goto XIT NN=X+I-2 I=N Do If NN=N Then Exit J$(I+1)=J$(I) K$(I+1)=K$(I) I=I-1 If I=NN Then Exit Loop N=N+1 NN=NN+1 J$(NN)=F$ ALTERF$ K$(NN)=F$ XIT: End Proc Procedure TXTDEL For I=(X+I-2) To(N-1) J$(I)=J$(I+1) K$(I)=K$(I+1) Next I J$(N)="" K$(N)="" N=N-1 Bob Update Off End Proc ' Procedure HELP On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 2,640,256,4,Hires Curs Off : Paper 0 : Cls 0 Flash Off : Colour 3,$FF0 Set Tab 10 Print : Print Print Tab$+" ***** HELP *****" Print Print Tab$+" Load Book - Load an existing Book File to" Print Tab$+" - Display - view pages" Print Tab$+" - Insert - insert page(s),after" Print Tab$+" - Delete - remove page(s) (from the book)" Print Tab$+" - Save - Save as ... .book appended" Print Tab$+" - Sort - Sort Files" Print Tab$+" - Search - Find File(s) containing a String" Print Print Tab$+" New Book - Create a new NoteBook of up to 200 (sets of) pages" Print Tab$+" - (loads Selector for Page Selection from Source)" Print Tab$+" - ([End] when finished selection)" Print Tab$+" - (Use presented options)" Print Print Tab$+" Selector - Loads Multiple File Handler & Directory Manager" Print Print Tab$+" Print - Text - Print page(s) to printer" Print Print Tab$+" Page(s) - New - Enter new (set of) notes" Print Tab$+" - Load - Load a (set of) pages" Print Print Tab$+" Colour - Select Colours for Text Display" Print Print Tab$+" Files - L.Amiga A toggles WB for Format,Disk Copy etc" Print Ink 3 : Box 20,1 To 600,235 While Mouse Key<>0 : Wend While Key State(90)=True : Wend Do : Exit If(Mouse Key=1) or(Key State(95)=True) : Loop Clear Key Screen Close 2 Wait 50 XIT: End Proc Procedure HELPTXT On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 2,640,256,4,Hires Curs Off : Paper 0 : Cls 0 Flash Off : Colour 3,$FF0 Set Tab 10 Print Print Tab$+" ***** HELP *****" Print Print Tab$+" Options "; Print " Save Text - Save pages" Set Tab 19 Print Tab$+" Print Text - Print page(s) to printer" Print Tab$+" New - Create new page(s)" Print Tab$+" Load Text - Load new pages" Print Tab$+" Quit - [End][F7] - (Save) & Exit" Set Tab 10 Print Tab$+" Page "; Print "Forward - [PgDn][F2],- Next Page" Set Tab 19 Print Tab$+" Back - [PgUp][F1] - Previous Page" Print Tab$+" Insert Blank, after - Insert a blank page" Print Tab$+" Delete - Delete current page" Print Tab$+" Merge, after - Merge pages in " Set Tab 10 Print Tab$+" Lines "; Print " Insert, before - [Ins][F4] - Insert a line before" Set Tab 19 Print Tab$+" Delete - [Del][F5] - Delete current line" Print Tab$+" WrapRound - Yes - Select Number of lines" Print Tab$+" - No - No WrapRound" Set Tab 10 Print Tab$+" Colour "; Print " Pen - Select Colour " Set Tab 19 Print Tab$+" Paper - Select Colour " Print Tab$+" Remix - Change current colours" Print Tab$+" Palette - Save - Save current colours in memory" Print Tab$+" Use - Use colours saved to memory" Pen 3 Set Tab 10 Print Print Tab$+" Steady (or Double Click) Left Mouse to save or quit a page" Print Tab$+" Quick Left Mouse click to position cursor" Print Tab$+" [Home][F6] - Cursor to Start" Pen 2 Print Print Tab$+" Max pages in group = 10" Ink 3 : Box 20,1 To 600,235 While Mouse Key<>0 : Wend While Key State(90)=True : Wend Do : Exit If(Mouse Key=1) or(Key State(95)=True) : Loop Clear Key Screen Close 2 Wait 50 XIT: End Proc ' Procedure TXTNEW[PRTYPE,SVETYPE] TXTNEWMARKER$="yes" NEWSTART: If PLTYPE$="" WRAP$="No" : Cls : PAGE=1 : LEAF=1 PL=27*(FAC+1)+3*FAC : Rem Page length LW=34*FR+6*(FR-1) : Rem Line width End If NEWPAGE: If PLTYPE$="" If PMAX<PAGE : PMAX=PAGE : End If If MARKER=2 : Goto UNDESIRED : End If Paper PC : Pen PNC LEAF=PAGE Wind Open LEAF,0,0,39*FR,30*(FAC+1),1 End If If PRTYPE=1 Then PLTYPE$="" : Locate 1,1 : TXPR : KK$="" : Wind Close : Goto XTXTNEW If PLTYPE$="" Home : For I=1 To PL : Print " ";TX$(LEAF,I) : Next I : Locate 1,1 End If PLTYPE$="" MISSOUT: Menu Del Menu$(1)=" Options " Menu$(1,1)=" Save Text " Menu$(1,2)=" Print Text " Menu$(1,3)=' New ' Menu$(1,3,1)=" Large print " Menu$(1,3,2)=" Half-large " Menu$(1,3,3)=" Small print " Menu$(1,3,4)=" Half-small " Menu$(1,4)=" Load Text " Menu$(1,5)=" Quit " Menu$(1,6)=" Help " Menu$(2)=" Page " Menu$(2,1)=" Forward " Menu$(2,2)=" Back " Menu$(2,3)=" Insert Blank, after " Menu$(2,4)=" Delete " Menu$(2,5)=" Merge, after " Menu$(3)=" Lines " Menu$(3,1)=" Insert, before " Menu$(3,2)=" Delete " Menu$(3,3)=" WrapRound " Menu$(3,3,1)=" Yes " Menu$(3,3,2)=" No " Menu$(4)=" Colour " Menu$(4,1)=" Pen " Menu$(4,2)=" Paper " Menu$(4,3)=" Remix " Menu$(4,4)=" Palette " Menu$(4,4,1)=" Save " Menu$(4,4,2)=" Use " Rem Create a colour bar For C=1 To 8 D=C-1 Menu$(4,1,C)="(IN 1,"+Str$(D)-""+")(BA 20,10)" Menu$(4,2,C)="(IN 1,"+Str$(D)-""+")(BA 20,10)" Menu$(4,3,C)="(IN 1,"+Str$(D)-""+")(BA 20,10)" Next C Do Menu Off Menu On JUDGEMENT=0 While KK$="" and Choice<>-1 and Mouse Key<>1 KK$=Inkey$ Wend If Mouse Key=1 Then JUDGEMENT=1 : Wait 10 : If Mouse Key=1 and SVETYPE=2 Then Goto XXTXTNEW If Mouse Key=1 Then JUDGEMENT=1 : Wait 10 : If Mouse Key=1 and SVETYPE<>2 Then Goto XTXTNEW If JUDGEMENT=1 Then Locate X Text(X Screen(X Mouse)),Y Text(Y Screen(Y Mouse)) : Goto LEAVE If KK$<>"" Then Goto NCH If Choice(1)=1 and Choice(2)=1 Then TXTSAVE : KK$="" : Goto MISSOUT If Choice(1)=1 and Choice(2)=2 Then KEEPPAGE=PAGE : TXPR : KK$="" : Wind Close : PAGE=KEEPPAGE : Goto NEWPAGE If Choice(1)=1 and Choice(2)=3 and Choice(3)=1 Then FR=1 : FAC=0 : SCN : For PAGE=1 To PMAX : For I=1 To PL : TX$(PAGE,I)="" : Next I : Next PAGE : PMAX=1 : Goto NEWSTART If Choice(1)=1 and Choice(2)=3 and Choice(3)=2 Then FR=1 : FAC=1 : SCN : For PAGE=1 To PMAX : For I=1 To PL : TX$(PAGE,I)="" : Next I : Next PAGE : PMAX=1 : Goto NEWSTART If Choice(1)=1 and Choice(2)=3 and Choice(3)=3 Then FR=2 : FAC=0 : SCN : For PAGE=1 To PMAX : For I=1 To PL : TX$(PAGE,I)="" : Next I : Next PAGE : PMAX=1 : Goto NEWSTART If Choice(1)=1 and Choice(2)=3 and Choice(3)=4 Then FR=2 : FAC=1 : SCN : For PAGE=1 To PMAX : For I=1 To PL : TX$(PAGE,I)="" : Next I : Next PAGE : PMAX=1 : Goto NEWSTART If Choice(1)=1 and Choice(2)=4 Then KK$="" : For PAGE=1 To PMAX : For I=1 To PL : TX$(PAGE,I)="" : Next I : Next PAGE : TXTLOAD : SCN : Goto NEWSTART If Choice(1)=1 and Choice(2)=5 and SVETYPE=2 Then KK$="" : Goto XXTXTNEW If Choice(1)=1 and Choice(2)=5 and SVETYPE<>2 Then KK$="" : Goto XTXTNEW If Choice(1)=1 and Choice(2)=6 Then HELPTXT : Goto LEAVE If Choice(1)=2 and Choice(2)=1 and PAGE=PMAX Then KK$="" : Locate 0,0 : Centre "Last Page !" : Curs Off : Wait 100 : Cline : Locate 1,1 : Curs On : Goto LEAVE If Choice(1)=2 and Choice(2)=1 Then PAGE=PAGE+1 : KK$="" : Wind Close : Goto NEWPAGE If Choice(1)=2 and Choice(2)=2 and PAGE>1 Then PAGE=PAGE-1 : KK$="" : Wind Close : Goto NEWPAGE If Choice(1)=2 and Choice(2)=2 and PAGE=1 Then KK$="" : Locate 0,0 : Centre "First Page !" : Curs Off : Wait 100 : Cline : Locate 1,1 : Curs On : Goto LEAVE If Choice(1)=2 and Choice(2)=3 Then INSERTPAGE : Goto LEAVE : Rem Wind Close : Goto NEWPAGE If Choice(1)=2 and Choice(2)=4 Then OMITPAGE : Goto LEAVE If Choice(1)=2 and Choice(2)=5 Then MERGEPAGES : Goto LEAVE If Choice(1)=3 and Choice(2)=1 Then INSERTLINE : Goto LEAVE If Choice(1)=3 and Choice(2)=2 Then OMITLINE : Goto LEAVE If Choice(1)=3 and Choice(2)=3 and Choice(3)=1 Then WRAP$="Yes" : WRAPLINES : Goto LEAVE If Choice(1)=3 and Choice(2)=3 and Choice(3)=2 Then WRAP$="No" : Goto LEAVE Rem For the Colour Menu If Choice(1)=4 and Choice(2)=1 Then CR=Choice(3) : DR=CR-1 : PNC=DR : Pen PNC : Memorize X : Memorize Y : Clw : For I=1 To PL : Print " ";TX$(PAGE,I) : Next I : Remember X : Remember Y : Goto MISSOUT If Choice(1)=4 and Choice(2)=2 Then CR=Choice(3) : DR=CR-1 : PC=DR : Paper PC : Memorize X : Memorize Y : Clw : For I=1 To PL : Print " ";TX$(PAGE,I) : Next I : Remember X : Remember Y : Goto MISSOUT If Choice(1)=4 and Choice(2)=3 Then CR=Choice(3) : DR=CR-1 : Memorize X : Memorize Y : MIX : Remember X : Remember Y : Goto MISSOUT If Choice(1)=4 and Choice(2)=4 and Choice(3)=1 Then PAL[1] If Choice(1)=4 and Choice(2)=4 and Choice(3)=2 Then PAL[2] NCH: S=Scancode ' If S=95 Then HELPTXT : Clear Key : Goto LEAVE ' Rem Page Forward If((S=31) or(S=81)) and(PAGE=PMAX) Then KK$="" : Locate 0,0 : Centre "Last Page !" : Curs Off : Wait 200 : Cline : Locate 1,1 : Curs On : Goto LEAVE If((S=31) or(S=81)) Then PAGE=PAGE+1 : KK$="" : Wind Close : Goto NEWPAGE ' Rem Page Back If((S=63) or(S=80)) and(PAGE>1) Then PAGE=PAGE-1 : KK$="" : Wind Close : Goto NEWPAGE If((S=63) or(S=80)) and(PAGE=1) Then KK$="" : Locate 0,0 : Centre "First Page !" : Curs Off : Wait 200 : Cline : Locate 1,1 : Curs On : Goto LEAVE ' If S=29 Then KK$="" : Goto XXTXTNEW If S=86 Then KK$="" : Goto XXTXTNEW If S=61 Then Locate 1,1 : Goto LEAVE If S=85 Then Locate 1,1 : Goto LEAVE If S=65 Then CHARACTERDELLEFT : Goto LEAVE If S=70 Then CHARACTERDEL : Goto LEAVE ' If(S=68) or(S=67) or(S=69) Then Locate 1,Y Curs+1 : Goto LEAVE If(S=76 or S=62) and Y Curs=1 Then Goto LEAVE If(S=76 or S=62) and Y Curs<>1 Then Cup : Goto LEAVE If(S=77 or S=30) and Y Curs=PL Then Goto LEAVE If(S=77 or S=30) and Y Curs<>PL Then Cdown : Goto LEAVE If(S=79 or S=45) and X Curs=1 and Y Curs=1 Then Goto LEAVE If(S=79 or S=45) and(X Curs=1) and(Y Curs>1) Then Locate LW,Y Curs-1 : Goto LEAVE If(S=79 or S=45) and X Curs<>1 Then Cleft : Goto LEAVE If(S=78 or S=47) and(X Curs=LW) and Y Curs=PL-1 Then Goto LEAVE If(S=78 or S=47) and(X Curs=LW) and Y Curs<PL-1 Then Locate 1,Y Curs+1 : Goto LEAVE If(S=78 or S=47) and X Curs<>LW Then Cright : Goto LEAVE If S=15 Then INSERTLINE : Goto LEAVE If S=83 Then INSERTLINE : Goto LEAVE If S=60 Then OMITLINE : Goto LEAVE If S=84 Then OMITLINE : Goto LEAVE CHINS LEAVE: KK$="" If Y Curs=PL Then Cup Loop XXTXTNEW: TXTSAVE If(Right$(F$,4)=":XXX") or(Right$(F$,4)="/XXX") Then F$="" : Goto MISSOUT If(Right$(F$,4)=":xxx") or(Right$(F$,4)="/xxx") Then F$="" : Goto MISSOUT XTXTNEW: Cls Border 0,, UNDESIRED: MARKER=0 For PAGE=1 To PMAX : For I=1 To PL : TX$(PAGE,I)="" : Next I : Next PAGE TXTNEWMARKER$="no" End Proc Procedure CHARACTERDEL LEAF=PAGE TX$(LEAF,Y Curs+1)=Left$(TX$(LEAF,Y Curs+1),X Curs-1)+Mid$(TX$(LEAF,Y Curs+1),X Curs+1) TX$(LEAF,Y Curs+1)=Left$(TX$(LEAF,Y Curs+1),LW) Memorize X : Memorize Y : Locate 1,Y Curs : Cline : Print TX$(LEAF,Y Curs+1); Remember X : Remember Y If WRAP$="Yes" Then WRAPAROUND[2,NWRAPLINES] End Proc Procedure CHARACTERDELLEFT LEAF=PAGE If X Curs=1 Then Goto XIT TX$(LEAF,Y Curs+1)=Left$(TX$(LEAF,Y Curs+1),X Curs-2)+Mid$(TX$(LEAF,Y Curs+1),X Curs) Memorize X : Memorize Y : Locate 1,Y Curs : Cline : Print TX$(LEAF,Y Curs+1); Remember X : Remember Y : Cleft If WRAP$="Yes" Then WRAPAROUND[2,NWRAPLINES] XIT: End Proc Procedure CHINS LEAF=PAGE If WRAP$="Yes" Then WRAPAROUND[1,NWRAPLINES] L=Len(TX$(LEAF,Y Curs+1)) If L<X Curs+1 Then TX$(LEAF,Y Curs+1)=TX$(LEAF,Y Curs+1)+Space$(X Curs+1-L) TX$(LEAF,Y Curs+1)=Left$(TX$(LEAF,Y Curs+1),X Curs-1)+KK$+Mid$(TX$(LEAF,Y Curs+1),X Curs) TX$(LEAF,Y Curs+1)=Left$(TX$(LEAF,Y Curs+1),LW) Memorize X : Memorize Y : Locate 1,Y Curs : Cline : Print TX$(LEAF,Y Curs+1); Remember X : Remember Y : Cright If X Curs=LW-1 Then Bell If Y Curs<>PL-1 and X Curs=LW+1 Then Locate 1,Y Curs+1 If Y Curs=PL-1 and X Curs=LW+1 Then Remember X : Remember Y End Proc Procedure INSERTLINE LEAF=PAGE For N=PL To Y Curs+1 Step -1 TX$(LEAF,N)=TX$(LEAF,N-1) Next N TX$(LEAF,Y Curs+1)="" RY=Y Curs Clw Home For N=1 To PL Print " ";TX$(LEAF,N) Next N Locate 1,RY End Proc Procedure OMITLINE LEAF=PAGE For N=Y Curs+1 To 27*(FAC+1)+3*FAC TX$(LEAF,N)=TX$(LEAF,N+1) Next N TX$(LEAF,PL)="" RY=Y Curs Clw Home For N=1 To 27*(FAC+1)+3*FAC Print " ";TX$(LEAF,N) Next N Locate 1,RY End Proc ' Procedure WRAPAROUND[INSDELTYP,NWRAPLINES] VPLACE=Y Curs Curs Off Memorize X : Memorize Y NUM=VPLACE+NWRAPLINES If NWRAPLINES=-1 Then NUM=PL If NUM>PL Then NUM=PL If INSDELTYP=1 Then Goto T1 If INSDELTYP=2 Then Goto T2 T1: For III=NUM To VPLACE+1 Step -1 X$=Mid$(TX$(LEAF,III),LW,1) If X$="" Then X$=" " If III=PL Then X$=" " TX$(LEAF,III+1)=X$+Left$(TX$(LEAF,III+1),LW-1) Locate 1,III : Cline : Print TX$(LEAF,III+1); Next III Goto XIT ' T2: L=Len(TX$(LEAF,VPLACE+1)) If L<LW Then TX$(LEAF,VPLACE+1)=TX$(LEAF,VPLACE+1)+Space$(LW-L) TX$(LEAF,VPLACE+1)=Left$(TX$(LEAF,VPLACE+1),LW-1)+Mid$(TX$(LEAF,VPLACE+2),1,1) : Locate 1,VPLACE : Cline : Print TX$(LEAF,VPLACE+1); If NUM<>PL Then NUM=NUM+1 For III=VPLACE+1 To NUM-1 L=Len(TX$(LEAF,III+1)) If L<LW Then TX$(LEAF,III+1)=TX$(LEAF,III+1)+Space$(LW-L) X$=Mid$(TX$(LEAF,III+2),1,1) If III=(NUM-1) Then X$=" " TX$(LEAF,III+1)=Mid$(TX$(LEAF,III+1),2)+X$ : Locate 1,III : Cline : Print TX$(LEAF,III+1); Next III Goto XIT ' XIT: Remember X : Remember Y Curs On End Proc Procedure WRAPLINES While Mouse Key<>0 : Wend Screen Open 1,300,56,4,Hires Screen Display 1,200,100,320,56 Curs Off : Cls : Flash Off : Colour 3,$70 Reserve Zone 3 Set Zone 1,0,0 To 150,6 : Ink 2 : Box 1,1 To 150,3 Paper 3 Locate 9,3 : Print Zone$(" All ",2) Locate 21,3 : Print Zone$(" Part ",3) Paper 1 : Pen 2 Do If Mouse Key=1 and Mouse Zone=1 Then Ink 0 : Box 1,1 To 150,3 : While Mouse Key=1 : Screen Display 1,200,Y Mouse,160,56 : Wend : Ink 2 : Box 1,1 To 150,3 If Mouse Key and Mouse Zone=2 Then While Mouse Key<>0 : Wend : NWRAPLINES=-1 : Exit If Mouse Key and Mouse Zone=3 Then While Mouse Key<>0 : Wend : MAKECHOICE : Exit Loop Screen Close 1 Wait 50 End Proc Procedure MAKECHOICE Cls Wind Open 1,48,24,25,1 Window 1 Paper 2 : Pen 1 : Clw Input " Number of lines : ";NWRAPLINES; Curs Off If NWRAPLINES<=0 Then WRAP$="No" Wait 50 End Proc ' ' Procedure TXTSAVE TRY$="ok" Clear Key On Error Goto ER A$="Save as ..." : B$="Quit text or XXX & OK to resume text" Goto OK ER: A$="/!\Error! Save as .... " Resume OK OK: RETRYSAVE: ' If Exist(FF$) FILESELECTQZ[FF$,"SWITCH",A$,B$] : SD : Goto OK2 End If FILESELECTQZ[Dir$,"SWITCH",A$,B$] : SD : Goto OK2 OK2: If F$="" Then Goto XIT If(Right$(F$,4)=":XXX") or(Right$(F$,4)="/XXX") Then Goto XIT If(Right$(F$,4)=":xxx") or(Right$(F$,4)="/xxx") Then Goto XIT ' EXCLUDE_FROM_SAVE[F$] If TRY$="not ok" If Len(F$)<33 A$=F$ End If If Len(F$)>=30 A$="..."+Right$(F$,30) End If B$="Disallowed ! Try Again !" : Goto RETRYSAVE End If If Exist(F$) Then OVERWRITE If TRY$="not ok" If Len(F$)<33 A$=F$ End If If Len(F$)>=30 A$="..."+Right$(F$,30) End If B$="Already Exists ! Try Again !" : Goto RETRYSAVE End If If TRY$="not ok" Then Goto RETRYSAVE Open Out 1,F$ ' Rem Creating a String of codes to allow for updates CODELINE$="*NB*NB*NB*NB*" If FR=1 Then CODELINE$=CODELINE$+"1" If FR=2 Then CODELINE$=CODELINE$+"2" If FAC=0 Then CODELINE$=CODELINE$+"0" If FAC=1 Then CODELINE$=CODELINE$+"1" Print #1,CODELINE$ ' For PAGE=1 To PMAX LEAF=PAGE For I=1 To PL Print #1,TX$(LEAF,I) Next I Next PAGE Close 1 XIT: End Proc Procedure EXCLUDE_FROM_SAVE[F$] IX=Instr(F$,":") If IX=0 Then TRY$="not ok" : Goto XIT FX$=Mid$(F$,IX+1) Restore NEWDATA Read NX IX=0 Do IX=IX+1 Read A$ If FX$=A$ Then TRY$="not ok" : Exit If IX=NX Then TRY$="ok" : Exit Loop NEWDATA: Data 53 Data ".info","Disk.info","CLI","CLI.info" Data "Prefs.info","PrReadMe","PrReadMe.info" Data "NoteBook","NoteBook.info","NoteBook.AMOS","NbReadMe","NbReadMe.info" Data "Shopper","Shopper.info","Shopper.AMOS","ShReadMe","ShReadMe.info" Data "c/endcli","c/LoadWB","c/path","c/ppmore","c/Run" Data "devs/clipboard.device","devs/Mountlist","devs/narrator.device" Data "devs/parallel.device","devs/printer.device","devs/ramdrive.device" Data "devs/serial.device","devs/system-configuration" Data "devs/printers/custom","devs/printers/generic" Data "l/Disk-Validator","l/FastFileSystem","l/Port-Handler" Data "l/ram-handler","l/Speak-Handler" Data "libs/diskfont.library","libs/icon.library","libs/info.library" Data "libs/mathieeedoubbas.library","mathtrans.library","translator.library" Data "Prefs/.info","Prefs/Pointer.info","Prefs/Preferences" Data "Prefs/Preferences.info","Prefs/Printer.info","Prefs/Serial.info" Data "s/startup-sequence" Data "System/DiskCopy","System/FastMemFirst","System/Format" XIT: End Proc Procedure OVERWRITE On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,56,4,Hires Screen Display 1,200,100,320,56 Curs Off : Cls 1 : Colour 0,$A5 If Len(F$)>43 Then Locate 0,1 : Centre "..."+Right$(F$,40) If Len(F$)<=43 Then Locate 0,1 : Centre F$ Print : Print : Centre "/!\ file already exits /!\" Reserve Zone Reserve Zone 2 Paper 0 Locate 5,5 : Print Zone$("Overwrite",1) Locate 25,5 : Print Zone$(" Retry ",2) Do If Mouse Zone=1 and Mouse Key Then TRY$="ok" : Exit If Mouse Zone=2 and Mouse Key Then TRY$="not ok" : Exit Loop Screen Close 1 XIT: End Proc ' Procedure TXTLOAD If MARKER=3 Then Goto SHWOFF On Error Goto ER A$="Select" : B$="a text file" Goto OK ER: A$="Error! Retry?" : B$="Select a text file or Quit" Resume OK OK: MARKER=1 FILESELECTQZ[FF$,"SWITCH",A$,B$] : SD If(F$="") and(TXTNEWMARKER$="no") Then MARKER=2 : Goto XIT If(F$="") and(TXTNEWMARKER$="yes") Then MARKER=2 : PLTYPE$="nl" : Goto XIT If(Right$(F$,5)=".info") and(TXTNEWMARKER$="no") Then ERR : MARKER=2 : Goto XIT If(Right$(F$,5)=".info") and(TXTNEWMARKER$="yes") Then ERR : MARKER=2 : PLTYPE$="nl" : Goto XIT ' Open In 1,F$ ' SHWOFF: MARKER=1 ' Rem Code Line {first effort} - allows for upgrades with more codes Rem code$(i) as mid$(codelines,i*2-1,2) etc ........ Rem remembering that single digit +ve nos are preceded by a space ' Rem CodeLine - most recent versions begin with *NB*NB*NB* or *NB*NB*NB*NB* and are completely string$ ' Rem Current version no.s are 1, First (or external!) version no.s are 2 (back to front?) ' VERSION=1 ' On Error Goto ER2 Goto OK2 ER2: ERR Close 1 Resume XIT OK2: ' Line Input #1,CODELINE$ ' If Left$(CODELINE$,13)="*NB*NB*NB*NB*" ' If Mid$(CODELINE$,14,1)="1" : FR=1 : End If If Mid$(CODELINE$,14,1)="2" : FR=2 : End If If Mid$(CODELINE$,15,1)="0" : FAC=0 : End If If Mid$(CODELINE$,15,1)="1" : FAC=1 : End If Goto CODESDONE End If ' If Left$(CODELINE$,10)="*NB*NB*NB*" ' If Mid$(CODELINE$,11,1)="1" : FR=1 : End If If Mid$(CODELINE$,11,1)="2" : FR=2 : End If If Mid$(CODELINE$,12,1)="0" : FAC=0 : End If If Mid$(CODELINE$,12,1)="1" : FAC=1 : End If Goto CODESDONE End If ' If Len(CODELINE$)<>4 and Len(CODELINE$)<>2 Then TX$(1,1)=CODELINE$ : VERSION=2 : FAC=0 : FR=2 : Goto CODESDONE ' If Len(CODELINE$)=4 Then FR=Val(Mid$(CODELINE$,1,2)) : FAC=Val(Mid$(CODELINE$,3,2)) If Len(CODELINE$)=2 Then FR=Val(Mid$(CODELINE$,1,2)) ' If(FR<>1 and FR<>2) or(FAC<>0 and FAC<>1) Then TX$(1,1)=CODELINE$ : VERSION=2 : FAC=0 : FR=2 : Goto CODESDONE ' CODESDONE: ' SCN WRAP$="No" Cls PAGE=1 LEAF=PAGE PL=27*(FAC+1)+3*FAC : Rem Page length LW=34*FR+6*(FR-1) : Rem Line width ' MOSTPAGESCALC PMAX=PAGE Paper PC : Pen PNC Wind Open LEAF,0,0,39*FR,30*(FAC+1),1 I=VERSION NXPG: Clw : Home Do If Eof(1) Then Goto NMR Line Input #1,TX$(LEAF,I) ' Rem Correction for previous NoteBook Files, removing space at line start If Left$(CODELINE$,13)<>"*NB*NB*NB*NB*" Then TX$(LEAF,I)=Mid$(TX$(LEAF,I),2) ' Print " ";TX$(LEAF,I) If Eof(1) Then Goto NMR If I=PL Then Exit I=I+1 Loop LEAF=LEAF+1 If LEAF>MOSTPAGES Then ERR : LEAF=LEAF-1 : Goto NMR I=1 Goto NXPG NMR: If I=1 Then LEAF=LEAF-1 PMAX=LEAF Close 1 If PMAX=1 Then PLTYPE$="1P" : Locate 1,1 XIT: End Proc Procedure MERGEPAGES Memorize X : Memorize Y : Locate 0,0 : Cline : Curs Off If PMAX=MOSTPAGES Centre "No More Pages Allowed - 10 Pages Maximum" : Wait 100 Locate 0,0 : Cline : Remember X : Remember Y : Curs On Goto XIT End If Centre "Merge after THIS page ? y/n" Do A$=Inkey$ If(A$="Y") or(A$="y") Then Exit If(A$="N") or(A$="n") Locate 0,0 : Cline : Remember X : Remember Y : Curs On Goto XIT End If Loop Locate 0,0 : Cline ' A$="Select" : B$="a text file" On Error Goto ERMERGEPAGES Goto MAKEPAGES ERMERGEPAGES: A$="Error! Retry?" : B$="Select a text file or Quit" Resume MAKEPAGES ' MAKEPAGES: FILESELECTQZ[FF$,"SWITCH",A$,B$] : SD If F$="" Then Remember X : Remember Y : Curs On : Goto XIT On Error Goto ER Goto OK ER: ERR Resume XIT OK: Open In 1,F$ On Error Goto ER2 Goto OK2 ER2: ERR Resume NMR OK2: ' Rem Code Line {first effort} - allows for upgrades with more codes Rem code$(i) as mid$(codelines,i*2-1,2) etc ........ Rem remembering that single digit +ve nos are preceded by a space ' Rem CodeLine - most recent versions begin with *NB*NB*NB* or *NB*NB*NB*NB* and are completely string$ ' Rem Current version no.s are 1, First (or external!) version no.s are 2 (back to front?) ' VERSION=1 ' Line Input #1,CODELINE$ ' If Left$(CODELINE$,13)="*NB*NB*NB*NB*" ' If Mid$(CODELINE$,14,1)="1" : MERGEFR=1 : End If If Mid$(CODELINE$,14,1)="2" : MERGEFR=2 : End If If Mid$(CODELINE$,15,1)="0" : MERGEFAC=0 : End If If Mid$(CODELINE$,15,1)="1" : MERGEFAC=1 : End If Goto CODESDONE End If ' If Left$(CODELINE$,10)="*NB*NB*NB*" ' If Mid$(CODELINE$,11,1)="1" : MERGEFR=1 : End If If Mid$(CODELINE$,11,1)="2" : MERGEFR=2 : End If If Mid$(CODELINE$,12,1)="0" : MERGEFAC=0 : End If If Mid$(CODELINE$,12,1)="1" : MERGEFAC=1 : End If Goto CODESDONE End If ' If Len(CODELINE$)<>4 and Len(CODELINE$)<>2 Then TX$(1,1)=CODELINE$ : VERSION=2 : MERGEFAC=0 : MERGEFR=2 : Goto CODESDONE ' If Len(CODELINE$)=4 Then MERGEFR=Val(Mid$(CODELINE$,1,2)) : MERGEFAC=Val(Mid$(CODELINE$,3,2)) If Len(CODELINE$)=2 Then MERGEFR=Val(Mid$(CODELINE$,1,2)) ' If(FR<>1 and FR<>2) or(FAC<>0 and FAC<>1) Then TX$(1,1)=CODELINE$ : VERSION=2 : MERGEFAC=0 : MERGEFR=2 : Goto CODESDONE ' CODESDONE: ' If(FAC<>MERGEFAC) or(FR<>MERGEFR) Then Locate 0,0 : Cline : Centre "Not Done, Different Page-Types" : Wait 100 : Locate 0,0 : Cline : Curs On : Remember X : Remember Y : Close 1 : Goto XIT ' PL=27*(FAC+1)+3*FAC ' KI=VERSION NXPG: If PMAX=MOSTPAGES Then Locate 0,0 : Curs Off : Cline : Centre "No more Pages" : Wait 100 : Locate 0,0 : Cline : Locate 1,1 : Curs On : Goto NMR MERGECD=1 INSERTPAGE Clw : Home Do If Eof(1) Then Goto NMR Line Input #1,TX$(PAGE,KI) ' Rem Correction for previous NoteBook Files, removing space at line start If Left$(CODELINE$,13)<>"*NB*NB*NB*NB*" Then TX$(PAGE,KI)=Mid$(TX$(PAGE,KI),2) ' Print " ";TX$(PAGE,KI) If Eof(1) Then Goto NMR If KI=PL Then Goto NMRR KI=KI+1 Loop NMRR: KI=1 : Goto NXPG NMR: Locate 1,1 Close 1 XIT: MERGECD=0 End Proc ' Procedure INSERTPAGE Memorize X : Memorize Y : Locate 0,0 : Cline : Curs Off If PMAX=MOSTPAGES Centre Str$(MOSTPAGES)+" Pages Maximum" : Wait 100 Locate 0,0 : Cline : Remember X : Remember Y : Curs On KK$="" Goto XXINSERTPAGE End If If MERGECD=1 Then MERGECD=0 : Goto NOCHOICE Centre "New Page After This ? y/n" Do A$=Inkey$ If A$="Y" Then Exit If A$="y" Then Exit If A$="N" Then Goto XINSERTPAGE If A$="n" Then Goto XINSERTPAGE Loop NOCHOICE: Locate 0,0 : Cline Curs On PMAX=PMAX+1 For LEAF=PMAX To PAGE+2 Step -1 For I=1 To PL TX$(LEAF,I)=TX$(LEAF-1,I) Next I Next LEAF For I=1 To PL TX$(PAGE+1,I)="" Next I PAGE=PAGE+1 Clw : Home For I=1 To PL : Print " ";TX$(PAGE,I) : Next I : Locate 1,1 Goto XXINSERTPAGE XINSERTPAGE: Locate 0,0 : Cline Curs On Remember X : Remember Y XXINSERTPAGE: End Proc Procedure OMITPAGE Memorize X : Memorize Y : Locate 0,0 : Cline : Curs Off Centre "Lose THIS page ? y/n" Do A$=Inkey$ If A$="Y" Then Exit If A$="y" Then Exit If A$="N" Then Goto XOMITPAGE If A$="n" Then Goto XOMITPAGE Loop Locate 0,0 : Cline : Curs On ' If PAGE<PMAX PMAX=PMAX-1 For LEAF=PAGE To PMAX For I=1 To PL TX$(LEAF,I)=TX$(LEAF+1,I) Next I Next LEAF For I=1 To PL TX$(PMAX+1,I)="" Next I Clw : Home For I=1 To PL : Print " ";TX$(PAGE,I) : Next I : Locate 1,1 Goto XXOMITPAGE End If ' If(PAGE=PMAX) and(PMAX>1) For I=1 To PL TX$(PMAX,I)="" Next I PMAX=PMAX-1 PAGE=PAGE-1 Clw : Home For I=1 To PL : Print " ";TX$(PAGE,I) : Next I : Locate 1,1 Goto XXOMITPAGE End If ' If(PAGE=PMAX) and(PMAX=1) ' For I=1 To PL TX$(PMAX,I)="" Next I Clw : Home : Locate 1,1 Goto XXOMITPAGE ' End If ' XOMITPAGE: Locate 0,0 : Cline : Curs On : Remember X : Remember Y XXOMITPAGE: End Proc ' Procedure TXPR On Error Goto ER Goto OK ER: ERR Resume XIT OK: Open Port 1,"PRT:" Curs Off MEMPG=PAGE If PMAX=0 Then Goto XIT Memorize X : Memorize Y Clw PAGE=1 NEXPG: Clw For I=1 To PL Print " ";TX$(PAGE,I) Next I Locate 0,0 Centre "Print THIS page? y/n" Do A$=Inkey$ If A$="Y" Then Exit If A$="y" Then Exit If A$="N" Then Goto NPR If A$="n" Then Goto NPR Loop Locate 0,0 : Cline For I=1 To PL ' Lprint TX$(PAGE,I) Print #1,TX$(PAGE,I) Next I Locate 0,0 NPR: PAGE=PAGE+1 If PAGE<=PMAX Then Goto NEXPG Close 1 PAGE=MEMPG Curs On Remember X : Remember Y XIT: End Proc ' Rem Files ' Procedure RUBOUT RBOUT: A$="Select File to Delete" : B$="IRREVERSIBLE - Quit to Leave" On Error Goto ER Goto OK ER: A$="/!\Error! Select File to Delete" Resume OK OK: FILESELECTQZ[FF$,"SWITCH",A$,B$] : SD If F$="" Then Goto XIT Kill F$ Goto RBOUT XIT: End Proc Procedure CPY Clear Key On Error Goto ER Goto OK ER: ERR Resume XIT OK: Do Erase 6 FILESELECTQZ[FF$,"SWITCH","Select File to Copy",""] : SD If F$="" Then Goto XIT KEEPKEEPF$=F$ FILESELECTQZ[GG$,"SWITCH",Right$(F$,38),"Copy to"] G$=F$ F$=KEEPKEEPF$ SDG If G$="" Then Goto XIT Open In 1,F$ : LFILE=Lof(1) : Close 1 Reserve As Work 6,LFILE Bload F$,Start(6) Bsave G$,Start(6) To Start(6)+LFILE Loop XIT: Erase 6 End Proc ' Procedure SD Rem Automatic Directory Setter Rem Global FF$ : FF$=Dir$ needed at start Rem After file selector {using Fsel$...} append : SD If F$="" Then Goto XIT KEEPFF$=FF$ FF$=F$ I10=Instr(FF$,":") FF2$=Right$(FF$,Len(FF$)-I10) If Instr(FF2$,":")<>0 Then FF$=KEEPFF$ : Goto XIT FF$=Flip$(FF$) I11=Instr(FF$,"/") If I11=0 Then FF$=Left$(Flip$(FF$),I10) : Goto XIT FF$=Left$(Flip$(FF$),(Len(FF$)-I11+1)) XIT: End Proc Procedure SDG If G$="" Then Goto XIT KEEPGG$=GG$ GG$=G$ I10=Instr(GG$,":") GG2$=Right$(GG$,Len(GG$)-I10) If Instr(GG2$,":")<>0 Then GG$=KEEPGG$ : Goto XIT GG$=Flip$(GG$) I11=Instr(GG$,"/") If I11=0 Then GG$=Left$(Flip$(GG$),I10) : Goto XIT GG$=Left$(Flip$(GG$),(Len(GG$)-I11+1)) XIT: End Proc ' ' Procedure PAL[PLT] If PLT=1 Then For IPT=0 To 7 : PLTC(IPT)=Colour(IPT) : Next IPT If PLT=3 Then For IPT=0 To 7 : PLTC(IPT)=Colour(IPT)*0.7 : Next IPT : PLTC(1)=$FFF : PLTC(7)=$80 If PLT=2 Then For IPT=0 To 7 : Colour IPT,PLTC(IPT) : Next IPT : CB[0] End Proc Rem Procedure ERRING On Error Goto ER Goto OK ER: ERR Resume XIT OK: XIT: End Proc Rem Procedure MOSTPAGESCALC MOSTPAGES=10 If(FR=2) or(FAC=1) Then MOSTPAGES=6 If(FR=2) and(FAC=1) Then MOSTPAGES=3 End Proc Rem Procedure CHANGEPEN[XPAP,YPEN] A=Colour(XPAP) D=0 SC=Screen Colour If SC=4096 Then SC=16 For I=0 To SC-1 B=Colour(I) A1=A mod 16 : A2=(A mod 256)/16 : A3=A/256 B1=B mod 16 : B2=(B mod 256)/16 : B3=B/256 C=Abs(B1-A1)+Abs(B2-A2)+Abs(B3-A3) If C>D D=C IS=I End If Next I PCL=IS : KEEPPEN=IS : Pen IS Ink IS : KEEPINK=IS Paper XPAP : KEEPPAPER=XPAP End Proc ' Rem Own File Selector ' 'Global F$ ' 'Dim LQZ$(200),MITQZ$(70) 'Global LQZ$(),FLEQZ$,MITQZ$(),LLQZ$ 'Global DRECTORYQZ$,MESSAGE1QZ$,MESSAGE2QZ$ 'Global NQZ,XQZ,IQZ,CRQZ 'CRQZ=0 ' 'FILESELECTQZ[Dir$,"SWITCH","Please Select","a File"] Procedure FILESELECTQZ[DRECTORYQZ$,SWITCH$,MESSAGE1QZ$,MESSAGE2QZ$] '''''''''''''''''''''''''''''''''''''''''''''' If Not Exist(DRECTORYQZ$) Then ERR : Goto XIT5 If SWITCH$="-AMOS-" F$=Fsel$(DRECTORYQZ$,"",MESSAGE1QZ$,MESSAGE2QZ$) : Goto XIT5 End If If SWITCH$="CUSTOM" Goto FRESH End If MARKQZ$="" On Error Goto ER3 Goto OK3 ER3: ERR MARKQZ$="SP" Resume XIT4 OK3: Screen Open 1,320,56,4,Hires Screen Display 1,200,100,320,56 Curs Off : Cls 1 : Colour 0,$70 Locate 0,1 : Centre "Single File Selector" Locate 0,5 : Centre "Choose Preferred" Reserve Zone Reserve Zone 2 Paper 0 Locate 12,3 : Print Zone$("-AMOS-",1); Locate 22,3 : Print Zone$("CUSTOM",2) Do If Mouse Zone=1 and Mouse Key Then Screen Close 1 : F$=Fsel$(DRECTORYQZ$,"",MESSAGE1QZ$,MESSAGE2QZ$) : Goto XIT5 If Mouse Zone=2 and Mouse Key Then Exit Loop Screen Close 1 ''''''''''''''''''''''''''''''''''''''''''''''''''''' FRESH: If Right$(DRECTORYQZ$,1)="/" Then DRECTORYQZ$=Left$(DRECTORYQZ$,Len(DRECTORYQZ$)-1) NQZ=0 On Error Goto ER Goto OK ER: ERR Resume XIT OK: FLEQZ$="" Gosub WN1DIR Screen Open 2,640,192,4,Hires Flash Off : Curs Off If CRQZ=0 : Colour 0,$7A : End If If CRQZ=1 : Colour 0,$390 : End If If CRQZ=2 : Colour 0,$A77 : End If If CRQZ=3 : Colour 0,$BB5 : End If Colour 1,$700 : Paper 0 : Cls 0 : Colour 3,$FF0 Screen Display 2,140,65,320,192 Wind Open 1,0,0,40,24 : Paper 0 : Curs Off ' Wind Open 2,320,0,40,24 : Paper 0 : Curs Off Wind Open 2,320,0,40,24 : Paper 0 : Curs Off Gosub SELECTOR_WINDOWS WN1DIR: Gosub RESET NQZ=1 FFQZ$=DRECTORYQZ$ LQZ$(1)=Dir First$(DRECTORYQZ$) Do NQZ=NQZ+1 LQZ$(NQZ)=Dir Next$ If LQZ$(NQZ)="" Then NQZ=NQZ-1 : Exit Loop Return SELECTOR_WINDOWS: RESTART: Y Mouse=Y Hard(0) WN1: XQZ=1 REASYLOOK: Window 2 : Pen 1 Locate 0,0 : Cline : Pen 1 : Centre "Single File Selector" Locate 0,2 : Cline : Centre MESSAGE1QZ$ Locate 0,3 : Cline : Centre MESSAGE2QZ$ Window 1 : Pen 1 Locate 0,0 : Cline : Centre "Source" : Ink 3 : Box 1,1 To 30,3 WN12: XQZ=1 MESSAGEQZ$=Left$(DRECTORYQZ$,30)+"..." Locate 0,22 : Cline : Pen 1 : Centre MESSAGEQZ$ REASYLOOK2: XKQZ=0 PLQZ=0 : Gosub MAKEFSZONES Pen 2 Rem main loop Do For IQZ=2 To 21 ' If Mouse Zone=IQZ and Mouse Key and Instr(LQZ$(XQZ+IQZ-2)," ")=1 Then Gosub GTFILE : Gosub SEEFILE : Goto REASYLOOK2 If Mouse Zone=IQZ and Mouse Key and Instr(LQZ$(XQZ+IQZ-2),"*")=1 Then Gosub GTDIREC : Gosub RESET : Gosub SEEFILE : Gosub WN1DIR : Y Mouse=Y Hard(0) : Goto WN12 Next IQZ If Mouse Zone=22 and Mouse Key Then While Mouse Key<>0 : Screen Display 2,140,Y Mouse,320,192 : Wend If Mouse Zone=23 and Mouse Key CRQZ=(CRQZ+1) mod 4 If CRQZ=0 : Colour 0,$7A : End If If CRQZ=1 : Colour 0,$390 : End If If CRQZ=2 : Colour 0,$A77 : End If If CRQZ=3 : Colour 0,$BB5 : End If While Mouse Key<>0 : Wend End If If Mouse Zone=24 and Mouse Key Then PLQZ=24 : Gosub MAKEFSZONES : Gosub GTPAR : Gosub RESET : Gosub SEEFILE : Gosub WN1DIR : Goto WN12 If Mouse Zone=25 and Mouse Key Then PLQZ=25 : Gosub MAKEFSZONES : GTNEWDRECTORYQZ : Gosub RESET : Gosub SEEFILE : Gosub WN1DIR : Y Mouse=Y Hard(0) : Goto WN12 If Mouse Zone=26 and Mouse Key Then PLQZ=26 : Gosub MAKEFSZONES : GTANOTHERFILEQZ : PLQZ=0 : Gosub MAKEFSZONES : Gosub SEEFILE : Goto REASYLOOK2 If Mouse Zone=27 and Mouse Key Then F$=FLEQZ$ : Goto XIT If Mouse Zone=28 and Mouse Key Then F$="" : Goto XIT If Mouse Zone=29 and Mouse Key and XQZ<NQZ-15 Then XQZ=XQZ+1 If Mouse Zone=30 and Mouse Key and XQZ>1 Then XQZ=XQZ-1 Rem Update display If XQZ<>XKQZ XKQZ=XQZ For IQZ=1 To 20 Locate 2,IQZ : Cline If Mouse Zone=IQZ+1 Inverse On End If Print Left$(LQZ$(XQZ+IQZ-1),38); Inverse Off Next IQZ End If Loop Return MAKEFSZONES: MITQZ$(24)=" Parent " MITQZ$(25)="New Directory" MITQZ$(26)=" New File " MITQZ$(27)=" Ok " MITQZ$(28)=" Quit " Reserve Zone Reserve Zone 30 Set Zone 22,0,0 To 25,5 Writing 1 For IQZ=2 To 21 Locate 3,IQZ-1 Print Zone$(" ",IQZ) Next IQZ Writing 0 Window 2 For IIQZ=24 To 28 Pen 3 : Ink 3 If IIQZ=PLQZ Then Pen 1 : Ink 1 Locate 14,(IIQZ-24)*2+6 : Print Zone$(MITQZ$(IIQZ),IIQZ); L=Len(MITQZ$(IIQZ)) XB1QZ=X Graphic(X Curs-L) : YB1QZ=Y Graphic(Y Curs) XB2QZ=X Graphic(X Curs) : YB2QZ=Y Graphic(Y Curs+1)-1 Box XB1QZ-2,YB1QZ To XB2QZ+2,YB2QZ Next IIQZ Window 1 Pen 3 Locate 5,0 : Print Zone$(Chr$(147)+Chr$(148),29); Locate 8,0 : Print Zone$(Chr$(149)+Chr$(150),30); Locate 12,0 : Print Zone$("*",23); Pen 2 Return RESET: For IQZ=1 To 200 : LQZ$(IQZ)="" : Next IQZ FLEQZ$="" : LLQZ$="" Return SEEFILE: Window 2 Pen 2 Locate 0,22 : Autoback 1 : Cline Centre LLQZ$ : F$=FLEQZ$ Pen 3 Window 1 Return GTFILE: Rem Assuming file {lqz$(xqz+iqz-2)} has no 'double-space' ! POSN=Instr(LQZ$(XQZ+IQZ-2)," ") LLQZ$=Left$(LQZ$(XQZ+IQZ-2),POSN-1) POSN=Instr(LLQZ$," ") : LLQZ$=Mid$(LLQZ$,POSN+1) If(Right$(DRECTORYQZ$,1)=":") Then FLEQZ$=DRECTORYQZ$+LLQZ$ : Goto XITGTFILE If(Right$(DRECTORYQZ$,1)="/") Then FLEQZ$=DRECTORYQZ$+LLQZ$ : Goto XITGTFILE If(Right$(DRECTORYQZ$,1)<>":") Then FLEQZ$=DRECTORYQZ$+"/"+LLQZ$ : Goto XITGTFILE XITGTFILE: Return GTPAR: If Right$(DRECTORYQZ$,1)=":" Then Goto XITGTPAR POSIONQZ=Instr(Flip$(DRECTORYQZ$),"/") POSION2QZ=Instr(Flip$(DRECTORYQZ$),":") If POSIONQZ<>0 Then DRECTORYQZ$=Left$(DRECTORYQZ$,Len(DRECTORYQZ$)-POSIONQZ) If POSIONQZ=0 Then DRECTORYQZ$=Left$(DRECTORYQZ$,Len(DRECTORYQZ$)-POSION2QZ+1) XITGTPAR: Return GTDIREC: Rem Assuming directory has no 'double space' ! POSN=Instr(LQZ$(XQZ+IQZ-2)," ") If Right$(DRECTORYQZ$,1)=":" Then DRECTORYQZ$=DRECTORYQZ$+Mid$(LQZ$(XQZ+IQZ-2),2,POSN-2) : Goto XITGTDIREC If Right$(DRECTORYQZ$,1)<>":" Then DRECTORYQZ$=DRECTORYQZ$+"/"+Mid$(LQZ$(XQZ+IQZ-2),2,POSN-2) XITGTDIREC: Return XIT: If Not Exist(DRECTORYQZ$) Then ERR : Goto RESTART While Mouse Key<>0 : Wend Screen Close 2 XIT4: If MARKQZ$="SP" On Error Goto ER5 Goto OK5 ER5: ERR Resume XIT5 OK5: F$=Fsel$(DRECTORYQZ$,"",MESSAGE1QZ$,MESSAGE2QZ$) End If XIT5: While Mouse Key<>0 : Wend End Proc Procedure GTANOTHERFILEQZ Clear Key On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,48,4,Hires Screen Display 1,200,100,320,48 Curs Off : Cls 1 : Colour 0,$70 Print : Centre "Enter file name required" Print : Print Wind Open 1,32,32,30,1 : Paper 2 : Pen 1 : Clw Input " ";LLQZ$ Curs Off ' Wait 50 If LLQZ$="" Then Goto XIT2 If(Right$(DRECTORYQZ$,1)=":") Then FLEQZ$=DRECTORYQZ$+LLQZ$ : Goto XIT2 If(Right$(DRECTORYQZ$,1)<>":") Then FLEQZ$=DRECTORYQZ$+"/"+LLQZ$ : Goto XIT2 XIT2: Screen Close 1 XIT: End Proc Procedure GTNEWDRECTORYQZ Dim DITQZ$(11) On Error Goto ER Goto OK ER: ERR Resume XIT OK: Screen Open 1,320,56,4,Hires Screen Display 1,200,100,320,56 Curs Off : Cls 1 : Colour 0,$70 Print : Centre "Select New Directory" DITQZ$(1)="DF0:" DITQZ$(2)="DF1:" DITQZ$(3)="DH0:" DITQZ$(4)="DH1:" DITQZ$(5)="DH2:" DITQZ$(6)="DH3:" DITQZ$(7)="DH4:" DITQZ$(8)="DH5:" DITQZ$(9)="DH6:" DITQZ$(10)="DH7:" DITQZ$(11)="Other" Reserve Zone Reserve Zone 11 Paper 0 : Locate 0,3 For IIQZ=1 To 6 If Exist(DITQZ$(IIQZ)) Then Cright : Print Zone$(DITQZ$(IIQZ),IIQZ); Next IIQZ Locate 0,5 For IIQZ=7 To 10 If Exist(DITQZ$(IIQZ)) Then Cright : Print Zone$(DITQZ$(IIQZ),IIQZ); Next IIQZ Locate 30,5 Print Zone$(DITQZ$(11),11) Do For IQZ=1 To 10 If Mouse Zone=IQZ and Mouse Key If Exist(DITQZ$(IQZ)) DRECTORYQZ$=DITQZ$(IQZ) : Dir$=DITQZ$(IQZ) : Goto XIT End If End If Next IQZ If Mouse Zone=11 and Mouse Key Then Exit Loop Cls 1 : Paper 1 : Home Locate 0,2 : Centre "Directory Change" RETRY: Locate 0,4 : Input " Enter New Directory ";DRECTORY3QZ$ If(DRECTORY3QZ$="") or(DRECTORY3QZ$=":") Then Goto XIT If Instr(DRECTORY3QZ$,":")=0 Then Cls : Locate 0,1 : Centre "Error - No ':' detected" : Goto RETRY If Right$(DRECTORY3QZ$,1)="/" Then DRECTORY3QZ$=Left$(DRECTORY3QZ$,Len(DRECTORY3QZ$)-1) If Not Exist(DRECTORY3QZ$) Then Cls : Locate 0,1 : Centre "Directory Not Found" : Goto RETRY DRECTORYQZ$=DRECTORY3QZ$ XIT: Screen Close 1 End Proc ' Rem Rem *********** Rem **** End **** Rem ***************************************************