home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 451-475 / apd459 / anthraxed.amos / anthraxed.amosSourceCode
AMOS Source Code  |  1994-01-01  |  11KB  |  357 lines
  1. 'Great little program this!
  2. 'total amos power! 
  3. '
  4. Set Buffer 100
  5. NC=31
  6. Dim TB$(NC),FX(NC),A$(999),C$(15),C(15),B$(9)
  7. INIT : Set Tab 8
  8. Do 
  9.    Clear Key : A$="" : Repeat : Multi Wait : A$=Inkey$ : Until A$<>""
  10.    A=Scancode : B=Key Shift and 251
  11.    If A=95 Then B$=A$(Y) : IMP[Y,B$] : X=0 : Locate 0,Y : COOR
  12.    If A=65 and B=0 Then DEL[1]
  13.    If A=65 and(B and 3) Then B$="" : DEL[0]
  14.    If A=70 Then DEL[0]
  15.    If A=68 Then VAID
  16.    If A=79 and B=0 Then LEFT
  17.    If A=78 and B=0 Then RIGHT
  18.    If A=79 and(B and 3) Then X=0 : Locate 0,Y : COOR
  19.    If A=78 and(B and 3) Then X=Len(B$) : POS[X,B$] : Locate Param,Y : COOR
  20.    If A=76 and(B and 8) Then POSA[0,0]
  21.    If A=77 and(B and 8) Then POSA[0,MX]
  22.    If A=77 Then ENBAS
  23.    If A=76 Then ENHAUT
  24.    B=Asc(A$) : If B=9 or(B>31 and B<128) Then WRITE
  25. Loop 
  26. Procedure POSA[A,B]
  27.    Shared A$(),Y,SCR,X,MX,B$
  28.    A$(Y+SCR)=B$
  29.    If B=<14 Then SCR=0 : Y=B Else SCR=B-14 : Y=14
  30.    If SCR<0 Then Y=B : SCR=0
  31.    PRES[SCR] : B$=A$(Y+SCR)
  32.    POS[A,B$] : Locate Param,Y : X=A : SLID : COOR
  33. End Proc
  34. Procedure ABOUT
  35.    MSG["About ..."]
  36.    Screen Open 1,336,40,2,0 : Screen Hide 1
  37.    Screen Display 1,128,150,320,1
  38.    Paper 0 : Cls 
  39.    Flash Off : Curs Off 
  40.    Print : Centre "Anthrax Editor vs 1.0"
  41.    A$="  THIS BRILLIANT TEXT EDITOR WAS WRITTEN Francois merlin   alias  mr Dos! /For pic n mix 93   "
  42.    Def Scroll 1,0,24 To 336,32,-1,0
  43.    Screen Show 1 : For I=1 To 20 : Screen Display 1,128,150-I,320,I*2 : Wait Vbl : Next : T=1
  44.    Repeat 
  45.       For I=0 To 7 : Scroll 1 : Wait Vbl : Next 
  46.       Print At(40,3);Mid$(A$,T,1);
  47.       Add T,1,1 To Len(A$)
  48.    Until Mouse Click
  49.    For I=20 To 1 Step -1 : Screen Display 1,128,150-I,320,I*2 : Wait Vbl : Next 
  50.    Screen Close 1
  51. End Proc
  52. Procedure PRES[SCR]
  53.    Shared X,Y,A$(),B$,MX
  54.    D=29 : If D+SCR>MX Then D=MX-SCR
  55.    For I=0 To D : IMP[I,A$(I+SCR)] : Next 
  56. End Proc
  57. Procedure INIT
  58.    Shared TB$(),FX(),NC,MX,X,Y
  59.    Screen Open 0,640,256,4,Hires
  60.    Screen Display 0,128,40,320,256
  61.    Paper 1 : Cls : Pen 2 : Curs Pen 3
  62.    Flash Off : Colour 0,0 : Colour 1,2 : Colour 2,$888 : Colour 3,$80
  63.    MX=0 : Home : Limit Mouse 128,40 To 448,296
  64.    Wind Open 1,16,11,78,30 : PRES[0] : X=0 : Y=0 : Locate X,Y : BR
  65.    Gr Writing 1 : Vslider 0,11 To 14,255,1,0,240 : Set Pattern 0 : Gr Writing 0
  66.    Read A$ : Repeat 
  67.       Inc A : Menu$(A)=A$ : Read C,A$ : B=1
  68.       Repeat 
  69.          If A$<>"" Then Menu$(A,B)=A$+Space$(C-Len(A$)) Else Menu$(A,B)=String$("-",C) : Menu Inactive(A,B)
  70.       Read A$ : Inc B : Until A$="FIN"
  71.    Read A$ : Until A$="FIN" : Menu On : On Menu Proc MENU,MENU : On Menu On 
  72.    Data "Project ",9,"About","","Clear","Load","Save","Save As","Quit","FIN"
  73.    Data "Search ",9,"Find","Find Next","Find Top","FIN"
  74.    Data "FIN"
  75. End Proc
  76. Procedure MENU
  77.    A=Choice(1) : B=Choice(2)
  78.    If A=1 Then On B Proc ABOUT,RIEN,CLEAR,XLOAD,XSAVE,XSAVEAS,QUIT
  79.    If A=2 Then On B Proc FIND,FINDN,FINDT
  80.    On Menu On 
  81. End Proc
  82. Procedure RIEN
  83. End Proc
  84. Procedure CLEAR
  85.    Shared MX,SCR,Y,X,A$(),B$
  86.    MX=0 : Y=0 : SCR=0 : X=0 : Clw : B$="" : MSG["Cleared."]
  87. End Proc
  88. Procedure DEL[V]
  89.    Shared X,B$,A$(),Y,MX,SCR
  90.    If V
  91.       If X>0
  92.          B$=Left$(B$,X-1)+Mid$(B$,X+1) : Dec X : IMP[Y,B$+"        "] : POS[X,B$] : Locate Param, : COOR : Pop Proc
  93.       End If : Gosub DEL : PREVLINE : COOR : Pop Proc
  94.       DEL:
  95.       If B$<>""
  96.          Pop Proc
  97.       End If 
  98.       SCR : B$=A$(Y+SCR)
  99.       Clw : PRES[SCR] : SLID : Return 
  100.    End If 
  101.    If B$<>""
  102.       B$=Left$(B$,X)+Mid$(B$,X+2) : IMP[Y,B$+"        "] : POS[X,B$] : Locate Param,Y : COOR : Pop Proc
  103.    End If 
  104.    Gosub DEL : X=0 : Locate 0,Y : COOR
  105. End Proc
  106. Procedure SCR
  107.    Shared A$(),Y,MX,SCR
  108.    If MX=0 Then A$(0)="" : Pop Proc
  109.    For I=Y+SCR To MX
  110.       A$(I)=A$(I+1)
  111.    Next : A$(I)="" : Dec MX
  112. End Proc
  113. Procedure PREVLINE
  114.    Shared Y,B$,X,SCR
  115.    If Y+SCR=0 Then Pop Proc
  116.    ENHAUT
  117.    X=Len(B$) : POS[X,B$]
  118.    Locate Param,Y
  119. End Proc
  120. Procedure VAID
  121.    Shared A$(),B$,X,Y,MX,SCR
  122.    A$(Y+SCR)=Left$(B$,X)
  123.    IMP[Y,A$(Y+SCR)+Chr$(0)]
  124.    If Y=29 Then Inc SCR Else Inc Y
  125.    Inc MX
  126.    If Y+SCR<MX
  127.       Locate 0,Y : Vscroll 1
  128.       For I=MX To Y+SCR Step -1
  129.          A$(I)=A$(I-1)
  130.       Next 
  131.    End If 
  132.    A$(Y+SCR)=Mid$(B$,X+1) : B$=A$(Y+SCR) : X=0
  133.    IMP[Y,B$] : Locate 0,Y : COOR : SLID
  134. End Proc
  135. Procedure LEFT
  136.    Shared X,B$
  137.    If X=0 Then PREVLINE : COOR : Pop Proc
  138.    If Mid$(B$,X,1)=Chr$(9) Then POS[X-1,B$] : Locate Param, Else Cleft 
  139.    Dec X : COOR
  140. End Proc
  141. Procedure RIGHT
  142.    Shared X,B$
  143.    If X=Len(B$) Then NXTLINE : COOR : Pop Proc
  144.    If Mid$(B$,X+1,1)=Chr$(9) Then Locate(X Curs/8)*8+8, Else Cright 
  145.    Inc X : COOR
  146. End Proc
  147. Procedure NXTLINE
  148.    Shared X,Y,SCR,MX
  149.    If Y+SCR=MX Then Pop Proc
  150.    X=0 : ENBAS
  151. End Proc
  152. Procedure ENBAS
  153.    Shared X,Y,B$,A$(),MX,SCR,B
  154.    If Y+SCR=MX Then Pop Proc
  155.    If B and 3 Then PGD : Pop Proc
  156.    A$(Y+SCR)=B$
  157.    If Y=29 Then Vscroll 3 : Inc SCR : IMP[29,A$(Y+SCR)] Else Inc Y
  158.    POS[X,B$]
  159.    B$=A$(Y+SCR)
  160.    POS2[Param,B$] : X=Param : If X>Len(B$) Then X=Len(B$)
  161.    POS[X,B$]
  162.    Locate Param,Y : COOR : SLID
  163. End Proc
  164. Procedure SLID
  165.    Shared MX,SCR,Y
  166.    Gr Writing 1
  167.    Vslider 0,11 To 14,255,MX+28,SCR+Y,29
  168.    Gr Writing 0 : Set Pattern 0
  169. End Proc
  170. Procedure PGD
  171.    Shared X,Y,B$,A$(),MX,SCR
  172.    A$(Y+SCR)=B$
  173.    If Y+SCR+28>=MX Then SCR=MX-29 : Y=0
  174.    SCR=SCR+Y : Y=29 : PRES[SCR]
  175.    POS[X,B$]
  176.    B$=A$(Y+SCR)
  177.    POS2[Param,B$] : X=Param : If X>Len(B$) Then X=Len(B$)
  178.    POS[X,B$]
  179.    Locate Param,Y : COOR : SLID
  180. End Proc
  181. Procedure PGU
  182.    Shared X,Y,B$,A$(),MX,SCR
  183.    A$(Y+SCR)=B$
  184.    If Y+SCR-29<=0 Then SCR=0 : Y=29
  185.    SCR=SCR-29+Y : Y=0 : PRES[SCR]
  186.    POS[X,B$]
  187.    B$=A$(Y+SCR)
  188.    POS2[Param,B$] : X=Param : If X>Len(B$) Then X=Len(B$)
  189.    POS[X,B$]
  190.    Locate Param,Y : COOR : SLID
  191. End Proc
  192. Procedure ENHAUT
  193.    Shared X,Y,B$,A$(),SCR,B
  194.    If SCR+Y=0 Then Pop Proc
  195.    If B and 3 Then PGU : Pop Proc
  196.    A$(Y+SCR)=B$
  197.    If Y=0 Then Vscroll 1 : Dec SCR : IMP[0,A$(SCR)] Else Dec Y
  198.    POS[X,B$]
  199.    B$=A$(Y+SCR)
  200.    POS2[Param,B$] : X=Param : If X>Len(B$) Then X=Len(B$)
  201.    POS[X,B$]
  202.    Locate Param,Y : COOR : SLID
  203. End Proc
  204. Procedure POS[X,A$]
  205.    If X : For I=1 To X : If Mid$(A$,I,1)=Chr$(9) : J=(J/8)*8+7 : End If : Inc J : Next : End If 
  206. End Proc[J]
  207. Procedure POS2[X,A$]
  208.    If X : Repeat : If Mid$(A$,I+1,1)=Chr$(9) : J=(J/8)*8+7 : End If : Inc I : Inc J : Until J>=X : End If 
  209. End Proc[I]
  210. Procedure WRITE
  211.    Shared B$,X,Y,A$
  212.    If Len(B$)=79 Then Pop Proc
  213.    B$=Left$(B$,X)+A$+Mid$(B$,X+1)
  214.    Inc X : CX=X Curs
  215.    IMP[Y,B$]
  216.    If A$=Chr$(9) Then Locate(CX/8)*8+8, Else Locate CX+1,
  217.    COOR
  218. End Proc
  219. Procedure IMP[Y,B$]
  220.    Shared SCR
  221.    Locate 0,Y
  222.    Cline : Print Left$(B$,77);
  223. End Proc
  224. Procedure COOR
  225.    Shared SCR,MX,FLG
  226.    If FLG Then FLG=0 : BR
  227.    Ink 2 : Bar 450,0 To 640,9 : Ink 0
  228.    Text 450,7,"X:"+Str$(X Curs)+" Y:"+Str$(Y Curs+SCR)+" Mx:"+Str$(MX)
  229. End Proc
  230. Procedure ANTIVIRUS
  231.    A=Leek(4)
  232.    If Leek(A+42)<>0 Then A=1 : Goto ALERT
  233.    If Leek(A+46)<>0 Then A=2 : Goto ALERT
  234.    If Leek(A+546)<>0 Then A=3 : Goto ALERT
  235.    If Leek(A+550)<>0 Then A=4 : Goto ALERT
  236.    Every On : Pop Proc
  237.    ALERT:
  238.    Loke Leek(4)+42,0
  239.    Loke Leek(4)+46,0
  240.    Loke Leek(4)+546,0
  241.    Loke Leek(4)+550,0
  242.    Amos To Front 
  243.    Screen Open 7,320,200,2,0
  244.    Paper 0 : Cls 
  245.    Flash Off : Curs Off 
  246.    Flash 1,"(FFF,30)(000,30)"
  247.    Flash 0,"(000,30)(f00,30)" : Pen 1
  248.    Home : Print "VIRUS FOUND TP"+Str$(A)
  249.    Print "PLEASE STOP WORK"
  250.    Zoom 7,0,0,128,16 To 7,0,16,320,184
  251.    Home : Print "                " : Print "                "
  252.    Clear Key : Wait Key : Screen Close 7 : Every On 
  253. End Proc
  254. Procedure EXECUTE[A$]
  255.    If Intcall(-210)=0 Then Print "WorkBench Not Open" : Pop Proc
  256.    Amos To Back 
  257.    A$=A$+Chr$(0) : B$="CON:0/0/640/200/Amos Basic"+Chr$(0)
  258.    Dreg(1)=Varptr(B$) : Dreg(2)=1005 : D=Doscall(-30)
  259.    If D=0 Then Print "Can't Open A Window" : Pop Proc
  260.    Dreg(1)=Varptr(A$) : Dreg(2)=D : Dreg(3)=D
  261.    A=Doscall(-222) : Dreg(1)=D : A=Doscall(-36) : Amos To Front 
  262. End Proc
  263. Procedure XSAVE
  264.    Shared MX,A$(),FILE$,DR$
  265.    If FILE$="" Then XSAVEAS : Pop Proc
  266.    MSG["Saving ... "+FILE$]
  267.    Open Out 1,DR$+FILE$
  268.    For I=0 To MX-1
  269.       Print #1,A$(I)+Chr$(10);
  270.    Next 
  271.    Close 1 : BR
  272. End Proc
  273. Procedure XSAVEAS
  274.    Shared MX,A$(),FILE$
  275.    SELECT["Save a File"] : A$=Param$ : If A$="" Then Pop Proc
  276.    MSG["Saving ... "+FILE$]
  277.    Open Out 1,A$
  278.    For I=0 To MX-1
  279.       Print #1,A$(I)+Chr$(10);
  280.    Next 
  281.    Close 1 : BR
  282. End Proc
  283. Procedure XLOAD
  284.    Shared MX,A$(),X,Y,SCR,FILE$,B$
  285.    SELECT["Load a File"] : A$=Param$ : If A$="" Then Pop Proc
  286.    Set Input 10,-1 : Open In 1,A$ : Clw : MX=0
  287.    MSG["Loading ... "+FILE$]
  288.    B=Lof(1) : Close 1 : C$=Space$(B)
  289.    Bload A$,Varptr(C$) : PX=1
  290.    Repeat 
  291.       AX=Instr(C$,Chr$(10),PX)
  292.       If AX Then A$(MX)=Mid$(C$,PX,AX-PX)
  293.       PX=AX+1 : Inc MX
  294.    Until PX>=B
  295.    X=0 : Y=0 : SCR=0
  296.    B$=A$(0) : PRES[0] : SLID : Home : BR
  297. End Proc
  298. Procedure SELECT[A$]
  299.    Shared FILE$,DR$
  300.    MSG["Select a File."] : A$=Fsel$(DR$,FILE$,A$)
  301.    If A$<>"" Then If Exist(A$)=0 Then A$=""
  302.    If A$="" Then MSG["Not Done."]
  303.    For I=Len(A$) To 1 Step -1
  304.       B$=Mid$(A$,I,1) : If B$=":" Then Exit 
  305.       If B$="/" Then Exit 
  306.    Next 
  307.    FILE$=Mid$(A$,I+1)
  308.    DR$=Left$(A$,I) : If DR$<>"" Then Dir$=DR$
  309. End Proc[A$]
  310. Procedure FINDT
  311.    Shared A$(),MX,FIND$
  312.    REQUEST["Enter String To Search:"] : FIND$=Param$
  313.    If FIND$="" Then Pop Proc Else MSG["Searching ..."]
  314.    For I=0 To MX
  315.       A=Instr(A$(I),FIND$,1)
  316.       If A>0 Then POSA[A-1,I] : MSG["Found."] : Pop Proc
  317.    Next : MSG["Not Found."]
  318. End Proc
  319. Procedure FINDN
  320.    Shared A$(),MX,FIND$,X,Y,SCR
  321.    DB=X+2 : MSG["Searching ..."] : For I=Y+SCR To MX
  322.       A=Instr(A$(I),FIND$,DB) : DB=1
  323.       If A>0 Then POSA[A-1,I] : MSG["Found."] : Pop Proc
  324.    Next : MSG["Not Found."]
  325. End Proc
  326. Procedure FIND
  327.    Shared A$(),MX,FIND$,X,Y,SCR
  328.    REQUEST["Enter String To Search:"] : FIND$=Param$
  329.    If FIND$="" Then Pop Proc Else MSG["Searching ..."]
  330.    DB=X : For I=Y+SCR To MX
  331.       A=Instr(A$(I),FIND$,DB+1) : DB=0
  332.       If A>0 Then POSA[A-1,I] : MSG["Found."] : Pop Proc
  333.    Next : MSG["Not Found."]
  334. End Proc
  335. Procedure REQUEST[A$]
  336.    Ink 2 : Bar 0,0 To 640,9 : Ink 0 : Memorize X : Memorize Y 
  337.    Text 2,7,A$ : Locate Len(A$),0 : Pen 0 : Paper 2
  338.    Wind Open 2,Len(A$)*8+8,1,79-Len(A$),1
  339.    Line Input "";A$ : Wind Close : Window 1 : Paper 1 : Pen 2
  340.    If A$="" Then MSG["Not Done."] Else BR
  341.    Remember X : Remember Y 
  342. End Proc[A$]
  343. Procedure BR
  344.    Shared FILE$,FLG
  345.    Ink 2 : Bar 0,0 To 640,9 : Ink 0 : Gr Writing 0 : FLG=0
  346.    Text 2,7,"Anthrax Editor vs 1.0 by Junkie  Source:"+FILE$ : COOR
  347. End Proc
  348. Procedure MSG[A$]
  349.    Shared FLG
  350.    Ink 2 : Bar 0,0 To 640,9 : Ink 0
  351.    Text 8,7,A$ : FLG=1
  352. End Proc
  353. Procedure QUIT
  354.    REQUEST["Are you sure Y/N ?"] : FIND$=Param$
  355.    If FIND$="Y" Then End 
  356.    If FIND$="y" Then End 
  357. End Proc