home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / Ascii-Ansi / ASCIIpaint.lha / apaint / AsciiPaint21.AMOS / AsciiPaint21.amosSourceCode next >
Encoding:
AMOS Source Code  |  1994-11-20  |  35.3 KB  |  1,353 lines
  1. Set Buffer 100
  2. Break Off : Request Off 
  3. Screen Open 1,640,256,16,Hires
  4. Flash Off 
  5. For T=0 To 20 : Colour T,$0 : Next 
  6. _MAKEICONS
  7. Palette $AAA,$0,$B00,$80,$EB0,$24C,$D6A,$CC,$FFF,$AAA,$0,$FFF,,,,,,$765,$987,$CA8
  8. Curs Off : Cls 0 : Colour Back $0
  9. Reserve Zone 25
  10. Degree 
  11.  
  12. Dim CODE(16),O(80,28),BIN(16,2,2),POS(2,2),FARG(80,28),M$(12)
  13. Global CODE(),O(),FARG(),BIN(),POS(),M$()
  14. Global DISPLAY,_COL,ANSI,O$,BACK,CHSIZE,PAL,BLANK_T,BLANK_G
  15. _COL=2 : BACK=1 : ANSI=2 : CHSIZE=1 : PAL=1
  16.  
  17. SETUP
  18. GADGET[1,1,1] : GADGET[2,1,2]
  19. ABOUT
  20. _MAIN
  21.  
  22. Procedure _MAIN
  23.    MO=1
  24.    Do 
  25.       Menu On 
  26.       If Choice=True
  27.          MEN=Choice(1) : OPT=Choice(2) : BI=Choice(3)
  28.          If MEN=1
  29.             If OPT=1
  30.                _MESSAGE[" Delete current picture ?",1]
  31.                If Param=1 : _CLEAR : GADGET[MO,0,1] : End If 
  32.             End If 
  33.             If OPT=2 : LADDA[BI] : GADGET[MO,0,1] : End If 
  34.             If OPT=3 : SPARA : End If 
  35.             If OPT=4 : ABOUT : End If 
  36.             If OPT=5
  37.                _MESSAGE["End Program ?",1] : If Param=1 : Edit : End If 
  38.             End If 
  39.          End If 
  40.          If MEN=2
  41.             If OPT=1 : ANSI=BI : MENY : End If 
  42.             If OPT=2 : CHSIZE=BI : MENY : End If 
  43.             If OPT=3 : PAL=BI
  44.                BACK=1 : Colour 9,$AAA
  45.                MENY : _PALETTE
  46.             End If 
  47.             If OPT=4
  48.                If BI=2
  49.                   If PAL=2 or PAL=3
  50.                      _MESSAGE["You should not use black background in WB mode!",0]
  51.                   Else 
  52.                      BACK=BI : Colour 9,$0
  53.                   End If 
  54.                End If 
  55.                If BI=1
  56.                   BACK=BI : Colour 9,$AAA
  57.                End If 
  58.                MENY
  59.             End If 
  60.             If OPT=5
  61.                If BI=1
  62.                If BLANK_T=0 : BLANK_T=1 Else BLANK_T=0 : End If 
  63.                Else 
  64.                If BLANK_G=0 : BLANK_G=1 Else BLANK_G=0 : End If 
  65.                End If 
  66.                MENY
  67.             End If 
  68.             If OPT=6 : DEFINE : End If 
  69.             If OPT=7 : _ZOOM : End If 
  70.          End If 
  71.       End If 
  72.       
  73.       X=(X Screen(X Mouse)) : Y=(Y Screen(Y Mouse))
  74.       If Y>27
  75.          Menu Off 
  76.          If Mouse Key<>0
  77.             If DISPLAY=0
  78.                If MO=1 : _RITA : End If 
  79.                If MO=2 : _LINJE : End If 
  80.                If MO=3 : _BOX[1] : End If 
  81.                If MO=4 : _BOX[2] : End If 
  82.                If MO=5 : _CIRCLE : End If 
  83.             End If 
  84.             If DISPLAY=1
  85.                DISPLAY=0 : GADGET[6,0,1]
  86.                CONV[DISPLAY,0] : GADGET[MO,0,1]
  87.             End If 
  88.          End If 
  89.       End If 
  90.       If Mouse Key=1
  91.          MZ=Mouse Zone
  92.          If MZ=6 : Inc DISPLAY
  93.             If DISPLAY=2 : DISPLAY=0 : End If 
  94.             GADGET[6,0,1] : CONV[DISPLAY,0] : GADGET[MO,0,1]
  95.          End If 
  96.          If MZ=>1 and MZ<=5
  97.             MO=MZ : If MZ<>OMZ : GADGET[MO,0,1] : OMZ=MZ
  98.             End If 
  99.          End If 
  100.          If MZ=>7 and MZ<=14 and MZ<>OMZ
  101.             _COL=MZ-5 : GADGET[_COL,0,2] : OMZ=MZ
  102.          End If 
  103.       End If 
  104.       Multi Wait 
  105.    Loop 
  106. End Proc
  107.  
  108. Procedure _CIRCLE
  109.    Repeat 
  110.       Y=(Y Screen(Y Mouse))
  111.       If Mouse Key<>0
  112.          If Mouse Key=1 : F=_COL : FI=_COL : End If 
  113.          If Mouse Key=2 : F=0 : FI=9 : End If 
  114.          
  115.          SX=(X Screen(X Mouse))/4 : SY=(Y Screen(Y Mouse))/4
  116.          
  117.          Repeat 
  118.             XX=(X Screen(X Mouse)+4)/4 : YY=(Y Screen(Y Mouse))/4
  119.             
  120.             X1=XX*4 : X2=(SX*4)+(SX*4-XX*4)
  121.             Y1=YY*4 : Y2=(SY*4)+(SY*4-YY*4)
  122.             If SX<XX : Swap X1,X2 : End If 
  123.             If SY<YY : Swap Y1,Y2 : End If 
  124.             
  125.             If Y1>24 : Bob 1,X1,Y1,1 : Bob 3,X2,Y1,3
  126.             Else Bob Off 1 : Bob Off 3
  127.             End If 
  128.             Bob 2,X1,Y2,2 : Bob 4,X2,Y2,4
  129.             
  130.             Wait Vbl 
  131.             Multi Wait 
  132.          Until Mouse Key=0
  133.          Bob Off : Wait Vbl : Ink FI
  134.          XADD=Abs(SX-XX)*4 : YADD=Abs(SY-YY)*4
  135.          
  136.          For T=0 To 360
  137.             X=(Cos(T)*XADD+SX*4)/4 : Y=(Sin(T)*YADD+SY*4)/4
  138.             Y=((Y*4)-28)/4
  139.             If Y>-1 and Y<56 and X>-1 and X<160
  140.  
  141.                RX=X : RY=Y
  142.                
  143.                Ror.w 1,RX : Bclr 15,RX
  144.                Ror.w 1,RY : Bclr 15,RY
  145.                
  146.                TX=X mod 2 : TY=Y mod 2
  147.                
  148.                If F<>0
  149.                   FARG(RX,RY)=F
  150.                   If BIN(O(RX,RY),TX,TY)=0
  151.                      O(RX,RY)=O(RX,RY)+POS(TX,TY)
  152.                   End If 
  153.                Else 
  154.                   If BIN(O(RX,RY),TX,TY)<>0
  155.                      O(RX,RY)=O(RX,RY)-POS(TX,TY)
  156.                      
  157.                   End If 
  158.                End If 
  159.                Ink FI : Bar X*4,Y*4+28 To X*4+3,Y*4+31
  160.             End If 
  161.          Next 
  162.          
  163.       End If 
  164.       Multi Wait 
  165.    Until Y<27
  166. End Proc
  167. Procedure _ZOOM
  168.    Menu Off 
  169.    Wind Save : Paper 0
  170.    Wind Open 1,190,48,30,11,1
  171.    Border 2,0,1 : Curs Off 
  172.    Ink 11 : Polyline 184,135 To 184,48 To 422,48
  173.    Draw 185,134 To 185,48 : Ink 1 : Box 223,59 To 386,116
  174.    Draw 224,60 To 224,116 : Ink 11
  175.    Polyline 224,116 To 386,116 To 386,59 : Draw 385,60 To 385,116
  176.    Ink 1,0 : Text 250,125," <ESC> to Exit "
  177.    
  178.    For Y=0 To 27
  179.       For X=0 To 79
  180.          TMP=O(X,Y) : J=8 : XX=X*2 : YY=Y*2
  181.          For T=1 To 4
  182.             If TMP=>J
  183.                TMP=TMP-J
  184.                Ink FARG(X,Y)
  185.             Else Ink 0
  186.             End If 
  187.             Ror.w 1,J
  188.             Bclr 15,J
  189.             If T=1 Then Plot XX+225,YY+60
  190.             If T=2 Then Plot XX+226,YY+60
  191.             If T=3 Then Plot XX+225,YY+61
  192.             If T=4 Then Plot XX+226,YY+61
  193.             If Inkey$=Chr$(27) Then Wind Close : Pop Proc
  194.          Next 
  195.       Next 
  196.    Next 
  197.    Repeat : I$=Inkey$ : Multi Wait : Until I$=Chr$(27)
  198.    Wind Close 
  199. End Proc
  200. Procedure _LINJE
  201.    Repeat 
  202.       Y=Y Screen(Y Mouse)
  203.       If Mouse Key<>0
  204.          SX=X Screen(X Mouse)/4*4 : SY=Y Screen(Y Mouse)/4*4
  205.          If SY<28 : SY=28 : End If 
  206.          
  207.          If Mouse Key=1 : FI=_COL : F=_COL : End If 
  208.          If Mouse Key=2 : FI=0 : F=9 : End If 
  209.          Repeat 
  210.             EX=X Screen(X Mouse)/4*4 : EY=Y Screen(Y Mouse)/4*4
  211.             If EY<28 : EY=28 : End If 
  212.             If SX>EX
  213.                B1=3 : B2=4 : B3=1 : B4=2
  214.             Else 
  215.                B1=1 : B2=2 : B3=3 : B4=4
  216.             End If 
  217.             Bob 1,SX-2,SY-1,B1 : Bob 2,SX-2,SY+5,B2
  218.             Bob 3,EX+2,EY-1,B3 : Bob 4,EX+2,EY+5,B4
  219.             Multi Wait 
  220.          Until Mouse Key=0
  221.          Bob Off : Wait Vbl 
  222.          
  223.          If SX>EX
  224.             Swap EX,SX : Swap EY,SY
  225.          End If 
  226.          
  227.          XNR#=(EX-SX) : YNR#=(EY-SY)
  228.          XX#=0 : YY#=0 : Ink F
  229.          
  230.          If Abs(XNR#)>Abs(YNR#)
  231.             For T=0 To XNR#/4
  232.                If XNR#=0 : XNR#=1 : End If 
  233.                YY#=YY#+(YNR#/XNR#)*4
  234.                YY=YY# : YY=YY/4*4
  235.                If SY+YY<28 : YY=-(SY-28) : End If 
  236.                
  237.                Bar SX+T*4,SY+YY To SX+T*4+3,SY+YY+3
  238.                TX=SX/4+T : TY=SY/4+YY/4-7
  239.                Gosub _CHECKDRAW
  240.             Next 
  241.          Else 
  242.          If(YNR#/4)=>0 : ST=1 : Else ST=-1 : XNR#=XNR#-(Abs(XNR#)*2) : End If 
  243.             For T=0 To YNR#/4 Step ST
  244.                If YNR#=0 : YNR#=1 : End If 
  245.                XX#=XX#+(XNR#/YNR#)*4
  246.                XX=XX# : XX=XX/4*4
  247.                
  248.                Bar SX+XX,SY+T*4 To SX+XX+3,SY+T*4+3
  249.                TX=SX/4+XX/4 : TY=SY/4+T-7
  250.                Gosub _CHECKDRAW
  251.             Next 
  252.          End If 
  253.       End If 
  254.       Multi Wait 
  255.    Until Y<27
  256.    Pop Proc
  257.    
  258.    _CHECKDRAW:
  259.  
  260.    RX=TX : RY=TY
  261.  
  262.    Ror.w 1,RX
  263.    Bclr 15,RX
  264.    Ror.w 1,RY
  265.    Bclr 15,RY
  266.    
  267.    WX=TX mod 2 : WY=TY mod 2
  268.    If FI<>0
  269.       If BIN(O(RX,RY),WX,WY)=0
  270.          O(RX,RY)=O(RX,RY)+POS(WX,WY)
  271.       End If 
  272.    Else 
  273.       O(RX,RY)=O(RX,RY)-POS(WX,WY)
  274.    End If 
  275.    
  276.    ' Best�mmer f�rgen & kontrollerar v�rdena... 
  277.    If O(RX,RY)>15 Then O(RX,RY)=15
  278.    If O(RX,RY)<0 Then O(RX,RY)=0
  279.    If FI<>0 Then FARG(RX,RY)=_COL
  280.    If O(RX,RY)=0 and FI=0 Then FARG(RX,RY)=0
  281.    Return 
  282.    
  283. End Proc
  284. Procedure _BOX[MO]
  285.    Repeat 
  286.       X=(X Screen(X Mouse)) : Y=(Y Screen(Y Mouse))
  287.       If Mouse Key<>0
  288.          If Mouse Key=1 : F=_COL : FI=15 : End If 
  289.          If Mouse Key=2 : F=9 : FI=0 : End If 
  290.          
  291.          SX=(X Screen(X Mouse))/8 : SY=(Y Screen(Y Mouse))/8
  292.          If SY>30 : SY=30 : End If 
  293.          Repeat 
  294.             XX=(X Screen(X Mouse)+4)/8 : YY=(Y Screen(Y Mouse))/8
  295.             If Y Screen(Y Mouse)<28 : YY=3 : End If 
  296.             
  297.             If SX>XX
  298.                X1=XX : X2=SX
  299.             Else 
  300.                X1=SX : X2=XX
  301.             End If 
  302.             If SY>YY
  303.                Y1=YY : Y2=SY
  304.             Else 
  305.                Y1=SY : Y2=YY
  306.             End If 
  307.             
  308.             If Y1<3 : Y1=3 : End If 
  309.             
  310.             If Abs(SX-XX)<=1 : X2=X1+1 : End If 
  311.             If Abs(SY-YY)<=1 : Y2=Y1+1 : End If 
  312.             
  313.             Bob 1,X1*8,Y1*8+4,1 : Bob 2,X1*8,Y2*8+4,2
  314.             Bob 3,X2*8,Y1*8+4,3 : Bob 4,X2*8,Y2*8+4,4
  315.             Wait Vbl 
  316.             Multi Wait 
  317.          Until Mouse Key=0
  318.          Bob Off : Wait Vbl : Ink F
  319.          XX1=X1*8 : XX2=X2*8-1 : YY1=Y1*8+4 : YY2=Y2*8+3
  320.          Y1=Y1-3 : Y2=Y2-3
  321.          
  322.          If MO=1
  323.             For T=X1 To X2-1
  324.                O(T,Y1)=FI : FARG(T,Y1)=F
  325.                O(T,Y2-1)=FI : FARG(T,Y2-1)=F
  326.             Next 
  327.             
  328.             Bar XX1,YY1 To XX2,YY1+7
  329.             Bar XX1,YY2-7 To XX2,YY2
  330.             
  331.             For T=Y1 To Y2-1
  332.                O(X1,T)=FI : FARG(X1,T)=F
  333.                O(X2-1,T)=FI : FARG(X2-1,T)=F
  334.             Next 
  335.             
  336.             Bar XX1,YY1 To XX1+7,YY2
  337.             Bar XX2-7,YY1 To XX2,YY2
  338.          End If 
  339.          
  340.          If MO=2
  341.             For R=Y1 To Y2-1
  342.                For T=X1 To X2-1
  343.                   O(T,R)=FI : FARG(T,R)=F
  344.                Next 
  345.                Bar XX1,(R+3)*8+4 To XX2,(R+3)*8+11
  346.             Next 
  347.          End If 
  348.          
  349.       End If 
  350.       Multi Wait 
  351.    Until Y<27
  352. End Proc
  353. Procedure _CLEAR
  354.    Ink 9 : Bar 0,28 To 640,251
  355.    For Y=0 To 28
  356.       For X=0 To 79
  357.          FARG(X,Y)=0 : O(X,Y)=0
  358.       Next 
  359.    Next 
  360.    DISPLAY=0
  361. End Proc
  362. Procedure _MAKEICONS
  363.    Cls 9
  364.    For F=2 To 8
  365.       For E=0 To 15
  366.          TMP=E : J=8
  367.          For T=1 To 4
  368.             If TMP=>J
  369.                TMP=TMP-J
  370.                Ink F
  371.             Else Ink 9
  372.             End If 
  373.             Ror.w 1,J
  374.             Bclr 15,J
  375.             If T=1 Then Bar 1,1 To 4,4
  376.             If T=2 Then Bar 5,1 To 8,4
  377.             If T=3 Then Bar 1,5 To 4,8
  378.             If T=4 Then Bar 5,5 To 8,8
  379.          Next 
  380.          Get Icon 8+E+(F-2)*16,1,1 To 17,9
  381.          Ink 9,9 : Bar 0,0 To 20,20
  382.       Next 
  383.    Next 
  384. End Proc
  385. Procedure _RITA
  386.    Repeat 
  387.       X=(X Screen(X Mouse)) : Y=(Y Screen(Y Mouse))
  388.       
  389.       XX=X : YY=Y+28
  390.       Ror.w 2,XX : Bclr 15,XX : Bclr 14,XX
  391.       Ror.w 2,YY : Bclr 15,YY : Bclr 14,YY
  392.       
  393.       ' Ror.w 2,XX => XX=XX/4
  394.       
  395.       NV=XX+YY
  396.       
  397.       If Mouse Key<>0 and OV<>NV and Y>28
  398.          If YY<7 : YY=7 : End If 
  399.          
  400.          RX=XX : RY=YY
  401.          Ror.w 1,RX : Bclr 15,RX
  402.          Ror.w 1,RY : Bclr 15,RY
  403.          
  404.          If CHSIZE=1
  405.             TX=XX mod 2 : TY=YY mod 2
  406.          End If 
  407.          RY=RY-7
  408.          
  409.          If Mouse Key=1
  410.             If CHSIZE=1
  411.                If BIN(O(RX,RY),TX,TY)=0
  412.                   O(RX,RY)=O(RX,RY)+POS(TX,TY)
  413.                End If 
  414.                Ink _COL : Bar XX*4,YY*4-28 To XX*4+3,YY*4-25
  415.             Else 
  416.                O(RX,RY)=15 : Ink _COL
  417.                Bar RX*8,RY*8+28 To RX*8+7,RY*8+35
  418.             End If 
  419.             FARG(RX,RY)=_COL
  420.          End If 
  421.          
  422.          If Mouse Key=2
  423.             If CHSIZE=1
  424.                If BIN(O(RX,RY),TX,TY)=1
  425.                   O(RX,RY)=O(RX,RY)-POS(TX,TY)
  426.                   If O(RX,RY)=0
  427.                      FARG(RX,RY)=0
  428.                   End If 
  429.                   Ink 9 : Bar XX*4,YY*4-28 To XX*4+3,YY*4-25
  430.                End If 
  431.             Else 
  432.                O(RX,RY)=0 : Ink 9
  433.                Bar RX*8,RY*8+28 To RX*8+7,RY*8+35
  434.             End If 
  435.          End If 
  436.          OV=NV
  437.       End If 
  438.       Multi Wait 
  439.    Until Y<27
  440. End Proc
  441. Procedure _PALETTE
  442.    Restore(PAL)
  443.    For T=2 To 8
  444.       Read F
  445.       Colour T,F
  446.    Next 
  447.    
  448.    1 Data $B00,$80,$EB0,$24C,$D6A,$CC,$FFF
  449.    2 Data $0,$FFF,$68A,$E44,$5D5,$4D,$EA0
  450.    3 Data $0,$FFF,$68A,$999,$BBB,$BA9,$FBA
  451.    
  452. End Proc
  453. Procedure DEFINE
  454.    Wind Save : Ink 1 : Paper 0 : Pen 1
  455.    Wind Open 1,148,50,35,24,1
  456.    Curs Off : Border 2,0,1 : Menu Off 
  457.    Ink 11 : Polyline 152,241 To 152,50 To 422,50
  458.    Draw 153,240 To 153,50
  459.    Dim OCODE(16)
  460.    For E=0 To 15
  461.       TMP=E : J=8
  462.       For T=1 To 4
  463.          If TMP=>J
  464.             TMP=TMP-J
  465.             Ink 1
  466.          Else Ink 11
  467.          End If 
  468.          Ror.w 1,J
  469.          Bclr 15,J
  470.          If T=1 Then Bar 188,66+E*8 To 193,68+E*8
  471.          If T=2 Then Bar 194,66+E*8 To 199,68+E*8
  472.          If T=3 Then Bar 188,69+E*8 To 193,71+E*8
  473.          If T=4 Then Bar 194,69+E*8 To 199,71+E*8
  474.       Next 
  475.       Locate 7,E+1 : Print " =   "+Chr$(CODE(E))
  476.       Locate 16,E+1 : Print "= ";CODE(E);Space$(2)
  477.       OCODE(E)=CODE(E)
  478.    Next 
  479.    Locate 0,18 : Print "    Use Cursor keys to move.  "
  480.    Locate 3,20 : Print " ESC = Cancel  Return = OK "
  481.    RAD=0 : KOL=1 : Gosub _PRINT
  482.    
  483.    Do 
  484.       While I$="" : I$=Inkey$ : Multi Wait : Wend 
  485.       C=Asc(I$) : Gosub _PRINT
  486.       If C=27
  487.          Wind Close 
  488.          For T=0 To 15 : CODE(T)=OCODE(T) : Next 
  489.          Pop Proc
  490.       End If 
  491.       If C=13 Then Wind Close : Pop Proc
  492.       If C=30 and RAD>0 Then Dec RAD
  493.       If C=31 and RAD<15 Then Inc RAD
  494.       If C=28 and KOL=1 Then KOL=2
  495.       If C=29 and KOL=2 Then KOL=1
  496.       If KOL=1 and C>31
  497.          CODE(RAD)=Val(Right$(Str$(C),Len(Str$(C))-1))
  498.       End If 
  499.       If KOL=2 and C>47 and C<58 Then Gosub _ASCII
  500.       I$="" : C=0 : Gosub _PRINT
  501.       Multi Wait 
  502.    Loop 
  503.    
  504.    _PRINT:
  505.    Pen 1 : Paper 0 : If KOL=1 and I$="" Then Pen 0 : Paper 1
  506.    Locate 12,RAD+1 : Print Chr$(CODE(RAD))
  507.    Pen 1 : Paper 0 : If KOL=2 and I$="" Then Pen 0 : Paper 1
  508.    Locate 18,RAD+1 : Print CODE(RAD);Space$(2)
  509.    Return 
  510.    
  511.    _ASCII:
  512.    Paper 0 : Pen 1
  513.    Locate 0,18 : Print "    Type in an Ascii code.   "
  514.    Paper 11 : Pen 1
  515.    Repeat 
  516.       If C>47 and C<58
  517.          A$=A$+I$
  518.          TMP=Val(A$)
  519.          Locate 18,RAD+1 : Print TMP;Space$(4-Len(A$))
  520.       End If 
  521.       While Inkey$=I$ : Multi Wait : Wend 
  522.       I$=""
  523.       While I$="" : I$=Inkey$ : Multi Wait : Wend 
  524.       C=Asc(I$)
  525.    Until C=13 or Len(A$)=3
  526.    A$=""
  527.    If TMP>31 and TMP<255
  528.       CODE(RAD)=TMP
  529.       Gosub _PRINT
  530.    Else 
  531.       Pen 0 : Paper 1
  532.       Locate 3,18 : Print "  Not a valid Asciicode!! "
  533.       Wait 100
  534.    End If 
  535.    Pen 1 : Paper 0
  536.    Locate 0,18 : Print "    Use Cursor keys to move.  "
  537.    Return 
  538. End Proc
  539. Procedure SETUP
  540.    Limit Mouse 128,40 To 446,292
  541.    Hot Spot 1,0,0 : Hot Spot 2,0,4
  542.    Hot Spot 3,4,0 : Hot Spot 4,4,4
  543.    Cls 0 : Ink 9 : Bar 0,28 To 640,251
  544.    Ink 11 : Draw 0,26 To 640,26 : Draw 0,252 To 640,252
  545.    Ink 1 : Draw 0,27 To 640,27 : Draw 0,253 To 640,253
  546.    
  547.    Pen 11
  548.    Menu$(1)=" Project  "
  549.    Menu$(1,1)=" New...    "
  550.    Menu$(1,2)=" Open IFF  "
  551.    Menu$(1,2,1)=" Normal      "
  552.    Menu$(1,2,2)=" Fast mode   "
  553.    Menu$(1,2,3)=" Extra Fast  "
  554.    Menu$(1,3)=" Save Text "
  555.    Menu$(1,4)=" About...  "
  556.    Menu$(1,5)=" Quit      "
  557.    
  558.    M$(1)="  None        "
  559.    M$(2)="� Normal      "
  560.    M$(3)="  BackGround  "
  561.    M$(4)="� 1/4 Char  "
  562.    M$(5)="  1/1 Char  "
  563.    M$(6)="� ANSI      "
  564.    M$(7)="  Workbench "
  565.    M$(8)="  MagicWB   "
  566.    M$(9)="� Grey  "
  567.    M$(10)="  Black "
  568.    M$(11)="  Text     "
  569.    M$(12)="  Graphics "
  570.    
  571.    
  572.    Menu$(2)=" Options      "
  573.    Menu$(2,1)=" ANSI Mode    "
  574.    Menu$(2,1,1)=M$(1)
  575.    Menu$(2,1,2)=M$(2)
  576.    Menu$(2,1,3)=M$(3)
  577.    Menu$(2,2)=" Pen size     "
  578.    Menu$(2,2,1)=M$(4)
  579.    Menu$(2,2,2)=M$(5)
  580.    Menu$(2,3)=" Palette      "
  581.    Menu$(2,3,1)=M$(6)
  582.    Menu$(2,3,2)=M$(7)
  583.    Menu$(2,3,3)=M$(8)
  584.    Menu$(2,4)=" Paper Colour "
  585.    Menu$(2,4,1)=M$(9)
  586.    Menu$(2,4,2)=M$(10)
  587.    Menu$(2,5)=" Blank line   "
  588.    Menu$(2,5,1)=M$(11)
  589.    Menu$(2,5,2)=M$(12)
  590.    Menu$(2,6)=" Define Chars "
  591.    Menu$(2,7)=" Zoom out     "
  592.    
  593.    Menu Static(1)
  594.    Menu Static(1,1)
  595.    Menu Static(1,2,1)
  596.    Menu Static(2)
  597.    Menu Static(2,1)
  598.    Menu Static(2,1,1)
  599.    Menu Static(2,2,1)
  600.    Menu Static(2,3,1)
  601.    Menu Static(2,4,1)
  602.    Menu Static(2,5,1)
  603.    Menu On 
  604.    Restore CODE
  605.    For T=0 To 15
  606.       Read CODE(T)
  607.    Next 
  608.    Restore BIN
  609.    For T=0 To 15
  610.       For Y=0 To 1
  611.          For X=0 To 1
  612.             Read BIN(T,X,Y)
  613.          Next 
  614.       Next 
  615.    Next 
  616.    J=8
  617.    For Y=0 To 1
  618.       For X=0 To 1
  619.          POS(X,Y)=J
  620.          J=J/2
  621.       Next 
  622.    Next 
  623.    CODE:
  624.    Data 32,46,46,110,96,93,47,74,39,92,91,76,34,55,70,35
  625.    BIN:
  626.    Data 0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,1,0,1,0,0
  627.    Data 0,1,0,1,0,1,1,0,0,1,1,1,1,0,0,0,1,0,0,1
  628.    Data 1,0,1,0,1,0,1,1,1,1,0,0,1,1,0,1,1,1,1,0
  629.    Data 1,1,1,1
  630. End Proc
  631. Procedure SPARA
  632.    DISPLAY=1 : CONV[DISPLAY,1]
  633.    Menu Off 
  634.    FREQ
  635.    F$=Param$
  636.    If F$="" Then _MESSAGE["Nothing selected!",0] : Pop Proc
  637.    
  638.    If Exist(F$)
  639.       _MESSAGE[" Overwrite existing file?",1]
  640.       SVAR=Param
  641.       If SVAR=0
  642.          Pop Proc
  643.       End If 
  644.    End If 
  645.    
  646.    Open Out 1,F$
  647.    Print #1,O$
  648.    Close 1
  649.    O$=""
  650. End Proc
  651. Procedure ABOUT
  652.    Wind Save : Paper 0
  653.    Wind Open 1,150,48,40,11,1
  654.    Border 2,0,1 : Curs Off 
  655.    Ink 11 : Polyline 152,135 To 152,48 To 470,48
  656.    Draw 153,134 To 153,48
  657.    Paste Icon 170,60,7
  658.    Repeat : Multi Wait : Until Mouse Key<>0
  659.    Wind Close 
  660. End Proc
  661. Procedure LADDA[ST]
  662.    Menu Off 
  663.    FREQ
  664.    F$=Param$
  665.    On Error Goto _ERROR
  666.    If Exist(F$)
  667.       Load Iff(F$),2
  668.       If PP=1 : Pop Proc : End If 
  669.       If Screen<>2
  670.          _MESSAGE["Could not load picture...",0]
  671.          Pop Proc
  672.       End If 
  673.       SC=Screen Colour : SW=Screen Width : SH=Screen Height
  674.       Flash Off 
  675.       
  676.       If SC>8
  677.          Screen To Front 1 : Screen 1 : _MESSAGE["Too many colours!",0]
  678.          Screen Close 2 : Pop Proc
  679.       End If 
  680.       If SC<8
  681.          Screen To Front 1 : Screen 1
  682.          _MESSAGE["Only"+Str$(SC)+" colours, use it anyway ?",1]
  683.          If Param=0
  684.             Screen Close 2 : Pop Proc
  685.          End If 
  686.       End If 
  687.       
  688.       If SW<640
  689.          Screen To Front 1 : Screen 1
  690.          _MESSAGE["Picture is less than 640 pixels wide!",0]
  691.          Pop Proc
  692.       End If 
  693.       If SW>640
  694.          Screen To Front 1 : Screen 1
  695.          _MESSAGE["More than 640 pixels wide, use it anyway ?",1]
  696.          If Param=0 : Pop Proc : End If 
  697.       End If 
  698.       If SH>256
  699.          Screen To Front 1 : Screen 1
  700.          _MESSAGE["More than 256 pixels high, use it anyway ?",1]
  701.          If Param=0 : Pop Proc : End If 
  702.       End If 
  703.       
  704.    Else 
  705.       If F$=""
  706.          _MESSAGE["Nothing selected !",0]
  707.       Else _MESSAGE["File dosent exist !",0]
  708.       End If 
  709.       Pop Proc
  710.    End If 
  711.    Screen 1 : _CLEAR
  712.    Hide 
  713.    Screen 2 : Screen To Front 2
  714.    Palette $0,$B00,$80,$EB0,$24C,$D6A,$CC,$FFF
  715.    Pen 1 : Paper 0
  716.    
  717.    ' Konverteringsrutinen...
  718.  
  719.    If ST=3 Then ST=4
  720.    Dim C(SC)
  721.    For Y=0 To 28
  722.       Y8=Y*8
  723.       For X=0 To 79
  724.          X8=X*8
  725.          For T=1 To 4
  726.             If T=1 Then XX=0 : YY=0
  727.             If T=2 Then XX=4 : YY=0
  728.             If T=3 Then XX=0 : YY=4
  729.             If T=4 Then XX=4 : YY=4
  730.             For PX=0 To 3 Step ST
  731.                For PY=0 To 3 Step ST
  732.                   F=Point(X8+XX+PX,Y8+YY+PY)
  733.                   Inc C(F)
  734.                   If F=>1 Then Inc A
  735.                Next 
  736.             Next 
  737.             If A=>1 Then TKN=TKN+(2^(4-T))
  738.             A=0
  739.          Next 
  740.          CC=0
  741.          For R=1 To SC
  742.             If C(R)>CC Then CC=C(R) : F=R
  743.             C(R)=0
  744.          Next 
  745.          O(X,Y)=TKN : FARG(X,Y)=F+1
  746.          TKN=0
  747.       Next 
  748.       Ink 7 : Locate 30,30 : Print " Converting - ";(Y*100)/28;"% Done..."
  749.    Next 
  750.    Cls 0
  751.    Screen 1 : Screen To Front 1 : Show On 
  752.    GADGET[6,0,1] : DISPLAY=0
  753.    CONV[DISPLAY,0] : GADGET[MO,0,1]
  754.    Pop Proc
  755.    
  756.    _ERROR:
  757.    ERR=Errn
  758.    Screen 1 : Screen To Front 1
  759.    _MESSAGE["Could not load that file as IFF-ILBM !",0]
  760.    PP=1
  761.    Resume Next 
  762. End Proc
  763. Procedure GADGET[NR,ST,F]
  764.    If F=1
  765.       X=10 : Y=2 : B=(310-4*6)/6 : H=20
  766.       For T=1 To 6
  767.       If NR=T : CC=1 : C=11 Else CC=11 : C=1 : End If 
  768.          If ST=1
  769.             Paste Icon X+4,Y+1,T
  770.             Set Zone T,X,Y To X+B,Y+H
  771.          End If 
  772.          Ink C
  773.          Box X,Y To X+B,Y+H
  774.          Draw X+B-1,Y+1 To X+B-1,Y+H-1
  775.          Ink CC
  776.          Polyline X,Y+H To X,Y To X+B-1,Y
  777.          Draw X+1,Y+H-1 To X+1,Y+1
  778.          Add X,B+4
  779.       Next 
  780.    End If 
  781.    If F=2
  782.       X=320 : Y=2 : B=(310-4*7)/7 : H=20
  783.       For T=1 To 7
  784.       If NR-1=T : CC=1 : C=11 Else CC=11 : C=1 : End If 
  785.          Ink C
  786.          Box X,Y To X+B,Y+H
  787.          Draw X+B-1,Y+1 To X+B-1,Y+H-1
  788.          Ink CC
  789.          Polyline X,Y+H To X,Y To X+B-1,Y
  790.          Draw X+1,Y+H-1 To X+1,Y+1
  791.          If ST=1
  792.             Ink T+1 : Bar X+2,Y+1 To X+B-2,Y+H-1
  793.             Set Zone T+6,X,Y To X+B,Y+H
  794.          End If 
  795.          Add X,B+4
  796.       Next 
  797.    End If 
  798. End Proc
  799. Procedure CONV[DISPLAY,SA]
  800.    ' Den h�r rutinen "konverterar" mellan Text/Grafik 
  801.    If DISPLAY=0
  802.       Ink 9
  803.       For Y=0 To 27
  804.          If BLANK_G=1 : Bar 0,Y*8+28 To 640,Y*8+35 : End If 
  805.          YY=Y*8+28
  806.          For X=0 To 79
  807.             If O(X,Y)<>0
  808.                Paste Icon X*8,YY,8+O(X,Y)+(FARG(X,Y)-2)*16
  809.             End If 
  810.          Next 
  811.       Next 
  812.    End If 
  813.    If DISPLAY=1
  814.       O$="" : BG=-1
  815.       If BACK=1 : Ink 1,9
  816.       Else Ink 8,9
  817.       End If 
  818.       
  819.       If ANSI=1
  820.          For Y=0 To 27
  821.             If BLANK_T=1 : Ink 9 : Bar 0,Y*8+28 To 640,Y*8+35 : End If 
  822.             
  823.          If BACK=1 : Ink 1,9 Else Ink 8,9 : End If 
  824.             For X=0 To 79
  825.                TMP$=TMP$+Chr$(CODE(O(X,Y)))
  826.             Next 
  827.             Text 0,(Y*8)+34,TMP$
  828.             If SA=1
  829.                Gosub DELSPACE
  830.                O$=O$+TMP$+Chr$(10)
  831.             End If 
  832.             TMP$=""
  833.          Next 
  834.       End If 
  835.       
  836.       If ANSI=2
  837.          For Y=0 To 27
  838.             If BLANK_T=1 : Ink 9 : Bar 0,Y*8+28 To 640,Y*8+35 : End If 
  839.             YY=Y*8
  840.             LC=FARG(X,Y) : Ink FARG(X,Y),9
  841.             For X=0 To 79
  842.                If FARG(X,Y)<>LC and FARG(X,Y)<>0
  843.                   If SA=1
  844.                      TMP$=TMP$+Chr$(27)+"[3"+Right$(Str$(FARG(X,Y)-1),1)+"m"
  845.                   End If 
  846.                   LC=FARG(X,Y) : Ink FARG(X,Y),9
  847.                End If 
  848.                If SA=1
  849.                   TMP$=TMP$+Chr$(CODE(O(X,Y)))
  850.                End If 
  851.                If O(X,Y)<>0
  852.                   Text X*8,YY+34,Chr$(CODE(O(X,Y)))
  853.                End If 
  854.             Next 
  855.             If SA=1
  856.                Gosub DELSPACE : O$=O$+TMP$+Chr$(10)
  857.                TMP$=""
  858.             End If 
  859.          Next 
  860.       End If 
  861.       
  862.       If ANSI=3
  863.          For Y=0 To 27
  864.             If BLANK_T=1 : Ink 9 : Bar 0,Y*8+28 To 640,Y*8+35 : End If 
  865.             For X=0 To 79
  866.                If O(X,Y)=15
  867.                   If SA=1
  868.                      If FARG(X,Y)<>BG
  869.                         TMP$=TMP$+Chr$(27)+"[4"+Right$(Str$(FARG(X,Y)-1),1)+"m"
  870.                         BG=FARG(X,Y)
  871.                      End If 
  872.                      TMP$=TMP$+Chr$(32)
  873.                   End If 
  874.                   Ink 9,FARG(X,Y) : Text X*8,(Y*8)+34," "
  875.                Else 
  876.                   If SA=1
  877.                      If FARG(X,Y)<>0 and FARG(X,Y)<>LC
  878.                         TMP$=TMP$+Chr$(27)+"[3"+Right$(Str$(FARG(X,Y)-1),1)
  879.                         If BG<>0
  880.                            TMP$=TMP$+";40m" : BG=0
  881.                         Else TMP$=TMP$+"m"
  882.                         End If 
  883.                      End If 
  884.                      If BG<>0
  885.                         TMP$=TMP$+Chr$(27)+"[40m" : BG=0
  886.                      End If 
  887.                      LC=FARG(X,Y)
  888.                   End If 
  889.                   If O(X,Y)<>0
  890.                      Ink FARG(X,Y),9 : Text X*8,(Y*8)+34,Chr$(CODE(O(X,Y)))
  891.                   End If 
  892.                   If SA=1
  893.                      TMP$=TMP$+Chr$(CODE(O(X,Y)))
  894.                   End If 
  895.                End If 
  896.             Next 
  897.             If SA=1
  898.                Gosub DELSPACE : O$=O$+TMP$+Chr$(10)
  899.                TMP$=""
  900.             End If 
  901.          Next 
  902.       End If 
  903.    End If 
  904.    Pop Proc
  905.    
  906.    DELSPACE:
  907.    L=Len(TMP$)
  908.    While Mid$(TMP$,L,1)=Chr$(CODE(0))
  909.       Dec L
  910.       If L=0 : Exit : End If 
  911.    Wend 
  912.    TMP$=Left$(TMP$,L)
  913.    Return 
  914. End Proc
  915. Procedure MENY
  916.    For T=1 To 12
  917.       Left$(M$(T),1)=" "
  918.    Next 
  919.    Pen 11 : Paper 1
  920.    M$(ANSI)="�"+Right$(M$(ANSI),13)
  921.    M$(CHSIZE+3)="�"+Right$(M$(CHSIZE+3),11)
  922.    M$(PAL+5)="�"+Right$(M$(PAL+5),11)
  923.    M$(BACK+8)="�"+Right$(M$(BACK+8),7)
  924.    If BLANK_T=1 Then M$(11)="�"+Right$(M$(11),10)
  925.    If BLANK_G=1 Then M$(12)="�"+Right$(M$(12),10)
  926.    
  927.    Menu$(2,1,1)=M$(1)
  928.    Menu$(2,1,2)=M$(2)
  929.    Menu$(2,1,3)=M$(3)
  930.    Menu$(2,2,1)=M$(4)
  931.    Menu$(2,2,2)=M$(5)
  932.    Menu$(2,3,1)=M$(6)
  933.    Menu$(2,3,2)=M$(7)
  934.    Menu$(2,3,3)=M$(8)
  935.    Menu$(2,4,1)=M$(9)
  936.    Menu$(2,4,2)=M$(10)
  937.    Menu$(2,5,1)=M$(11)
  938.    Menu$(2,5,2)=M$(12)
  939.    
  940. End Proc
  941. Procedure FREQ
  942.    On Error Goto MALFUNCTION
  943.    
  944.    PATH$=Dir$
  945.    BLACK=1 : WHITE=11 : LAMP=10 : _STZON=15 : X=148 : Y=50
  946.    X=X/16*16
  947.    NUM=500
  948.    _HIDE$="*.info/*.*.info/*.*.*.info"
  949.    Set Slider BLACK,0,0,0,BLACK,WHITE,0,1
  950.    Dim OUT$(NUM),DEV$(80),FILES(NUM),FILE$(NUM)
  951.    Dim X1(8),X2(8),Y1(8),Y2(8)
  952.    Wind Save : Paper 0 : Wind Open 1,X,Y,42,24,1
  953.    Curs Off : Border 2,0,BLACK
  954.    Add X,4
  955.    Window 1
  956.    Gosub RITA
  957.    Gosub _GETDIR
  958.    Gosub _UPDATE
  959.    Gosub _UPDATE2
  960.    Ink BLACK,0
  961.    
  962.    Do 
  963.       MX=X Screen(X Mouse)/8 : MY=Y Screen(Y Mouse)/8
  964.       MZ=Mouse Zone-_STZON
  965.       If MZ=1 Then Gosub _FILES
  966.       
  967.       If Mouse Key=1 and MZ=>2 and MZ=<10
  968.          If MZ<=8 and MZ>=3
  969.             Swap BLACK,WHITE
  970.             X1=X1(MZ) : X2=X2(MZ) : Y1=Y1(MZ) : Y2=Y2(MZ)
  971.             Gosub GADGET : Swap BLACK,WHITE
  972.          End If 
  973.          
  974.          If MZ=2
  975.             _MAXX#=_MAX
  976.             SCR#=(86/_MAXX#)
  977.             Repeat 
  978.                MV=(Y Screen(Y Mouse)-(Y+11+((86/_MAXX#)*6)))/SCR#
  979.                If MV=>0 and _MAX>12
  980.                   If MV+12<=_MAX-1
  981.                      _TOP=MV : _BOTTOM=_TOP+12
  982.                   Else 
  983.                      _BOTTOM=_MAX-1 : _TOP=_BOTTOM-12
  984.                   End If 
  985.                   Gosub _UPDATE
  986.                End If 
  987.                Multi Wait 
  988.             Until Mouse Key<>1
  989.          End If 
  990.          
  991.          If MZ=4 or MZ=3
  992.             Repeat 
  993.                If MZ=3 and(Mouse Zone-_STZON)=MZ
  994.                   If _TOP=>1 : Dec _TOP
  995.                      If _MAX<_BOTTOM-1 : _BOTTOM=_MAX
  996.                      Else Dec _BOTTOM
  997.                      End If 
  998.                   End If 
  999.                End If 
  1000.                If MZ=4 and(Mouse Zone-_STZON)=MZ : Rem Down 
  1001.                   If _BOTTOM+1<_MAX
  1002.                      Inc _TOP : Inc _BOTTOM
  1003.                   End If 
  1004.                End If 
  1005.                Gosub _UPDATE
  1006.                Multi Wait 
  1007.             Until Mouse Key<>1
  1008.          End If 
  1009.          While Mouse Key=1 : Multi Wait : Wend 
  1010.          If MZ<=8 and MZ>=3 : Gosub GADGET : End If 
  1011.          If MZ=Mouse Zone-_STZON
  1012.             
  1013.             If MZ=8
  1014.                PATH$="" : FIL$="" : Gosub _QUIT
  1015.             End If 
  1016.             
  1017.             If MZ=7 : Gosub _PARENT : End If 
  1018.             If MZ=6
  1019.                Gosub _GETDEVS
  1020.                Gosub _UPDATE
  1021.                Gosub _UPDATE2
  1022.             End If 
  1023.             If MZ=5
  1024.                Gosub _SHUTDOWN
  1025.                If PATH$="" or FIL$="" : Pop Proc[""]
  1026.                Else PATH$=PATH$+FIL$ : Pop Proc[PATH$]
  1027.                End If 
  1028.             End If 
  1029.             If MZ=9
  1030.                Gosub _WRITE
  1031.                If ED$=""
  1032.                   Gosub _GETDEVS
  1033.                Else 
  1034.                   If Exist(ED$)
  1035.                      PATH$=ED$
  1036.                      If Right$(PATH$,1)<>"/" and Right$(PATH$,1)<>":"
  1037.                         PATH$=PATH$+"/"
  1038.                      End If 
  1039.                      Gosub _GETDIR
  1040.                   End If 
  1041.                End If 
  1042.                Gosub _UPDATE2 : Gosub _UPDATE
  1043.             End If 
  1044.             If MZ=10 : Gosub _WRITE : Gosub _UPDATE2 : End If 
  1045.          End If 
  1046.          Multi Wait 
  1047.       End If 
  1048.    Loop 
  1049.    
  1050.    _WRITE:
  1051.    If MZ=10 : ED$=FIL$ : L=31 : End If 
  1052.    If MZ=9 : ED$=PATH$ : L=33 : End If 
  1053.    Repeat 
  1054.       I$="" : Ink 0,BLACK
  1055.       OUT$=ED$
  1056.       If Len(OUT$)=>L Then OUT$=Right$(ED$,L)
  1057.       If MZ=9 Then PY=135 Else PY=155
  1058.       
  1059.       Ink BLACK,0 : Text 20+X,PY+Y,OUT$+Space$(L-Len(OUT$)+1)
  1060.       Ink 0,BLACK : Text 20+X+(Len(OUT$)*8),PY+Y," "
  1061.       
  1062.       While I$="" : I$=Inkey$ : Multi Wait 
  1063.          If Mouse Key=1 Then Return 
  1064.       Wend 
  1065.       If I$=Chr$(8)
  1066.          ED$=Left$(ED$,(Len(ED$)-1))
  1067.       End If 
  1068.       If MZ=9
  1069.          If I$=Chr$(13) or Asc(I$)<32
  1070.          Else 
  1071.             ED$=ED$+I$
  1072.          End If 
  1073.       End If 
  1074.       If MZ=10
  1075.          If I$=Chr$(13) or Asc(I$)<32 or I$="/" or I$=":"
  1076.          Else 
  1077.             ED$=ED$+I$
  1078.          End If 
  1079.       End If 
  1080.       
  1081.       Multi Wait 
  1082.    Until I$=Chr$(13)
  1083.    
  1084.    If MZ=10 : FIL$=ED$ : End If 
  1085.    Return 
  1086.    
  1087.    _PARENT:
  1088.    If Len(PATH$)=0 Then Return 
  1089.    For T=(Len(PATH$)-1) To 0 Step -1
  1090.       If Mid$(PATH$,T,1)="/" or Mid$(PATH$,T,1)=":"
  1091.          PATH$=Left$(PATH$,T)
  1092.          Exit 
  1093.       End If 
  1094.    Next 
  1095.    
  1096.    If T=-1 Then PATH$="" : Gosub _GETDEVS Else Gosub _GETDIR
  1097.    
  1098.    FIL$=""
  1099.    Gosub _UPDATE
  1100.    Gosub _UPDATE2
  1101.    Return 
  1102.    
  1103.    _FILES:
  1104.    OCR=-1
  1105.    Repeat 
  1106.       CR=Y Screen(Y Mouse)/8-(Y/8)-2
  1107.       If OCR<>CR and OCR=>0 and OCR<=12 and OCR<=_MAX-1
  1108.          Ink BLACK,0 : Text 20+X,(OCR*8)+20+Y,OUT$(OCR+_TOP)
  1109.       End If 
  1110.       If OCR<>CR and CR=>0 and CR<=12 and CR<=_MAX-1
  1111.          Ink 0,BLACK : Text 20+X,(CR*8)+20+Y,OUT$(CR+_TOP)
  1112.       End If 
  1113.       OCR=CR
  1114.       If Mouse Key=1
  1115.          CHOSED=CR+_TOP
  1116.          If CHOSED<_MAX
  1117.             If LIST=1
  1118.                PATH$=DEV$(CHOSED)
  1119.                Gosub _GETDIR
  1120.                Gosub _UPDATE
  1121.                Gosub _UPDATE2
  1122.                LIST=2
  1123.             Else 
  1124.                If FILES(CHOSED)=2
  1125.                   FIL$=FILE$(CHOSED)
  1126.                   Gosub _UPDATE2
  1127.                End If 
  1128.                If FILES(CHOSED)=1
  1129.                   PATH$=PATH$+FILE$(CHOSED)+"/"
  1130.                   Gosub _GETDIR
  1131.                   Gosub _UPDATE
  1132.                   Gosub _UPDATE2
  1133.                End If 
  1134.             End If 
  1135.          End If 
  1136.       End If 
  1137.       Multi Wait 
  1138.    Until Mouse Zone-_STZON<>1
  1139.    If OCR=>0 and OCR<=12 and OCR<=_MAX-1
  1140.       Ink BLACK,0 : Text 20+X,(OCR*8)+20+Y,OUT$(OCR+_TOP)
  1141.    End If 
  1142.    Return 
  1143.    
  1144.    _GETDIR:
  1145.    Set Dir 30,_HIDE$ : Flash LAMP,"(F00,1)(ff0,1)(888,1)"
  1146.    NR=0
  1147.    F$=Dir First$(PATH$)
  1148.    Repeat 
  1149.       OUT$(NR)=F$
  1150.       If Left$(OUT$(NR),1)="*"
  1151.          OUT$(NR)=Mid$(OUT$(NR),2)
  1152.          Gosub _NOSPACE
  1153.          FILE$(NR)=OUT$(NR)
  1154.          OUT$(NR)=OUT$(NR)+Space$(26-Len(OUT$(NR)))+"(Drawer)"
  1155.          FILES(NR)=1
  1156.       Else 
  1157.          OUT$(NR)=Mid$(OUT$(NR),1)
  1158.          SIZE$=Right$(OUT$(NR),8)-" "
  1159.          OUT$(NR)=Mid$(Left$(OUT$(NR),Len(OUT$(NR))-8),2)
  1160.          Gosub _NOSPACE
  1161.          FILE$(NR)=OUT$(NR)
  1162.          OUT$(NR)=OUT$(NR)+Space$(34-(Len(OUT$(NR))+Len(SIZE$)))+SIZE$
  1163.          FILES(NR)=2
  1164.       End If 
  1165.       F$=Dir Next$
  1166.       Inc NR
  1167.       Multi Wait 
  1168.    Until F$=""
  1169.    _MAX=NR : _TOP=0
  1170.    If _MAX>12
  1171.       _BOTTOM=12
  1172.    Else 
  1173.       _BOTTOM=_MAX-1
  1174.    End If 
  1175.    Flash Off : Colour LAMP,Colour(0)
  1176.    Ink 0 : Bar 17+X,11+Y To 298+X,119+Y
  1177.    Return 
  1178.    
  1179.    _NOSPACE:
  1180.    For S=Len(OUT$(NR)) To 1 Step -1
  1181.       If Mid$(OUT$(NR),S,1)<>" "
  1182.          Exit 
  1183.       End If 
  1184.    Next S
  1185.    OUT$(NR)=Left$(OUT$(NR),S)
  1186.    Return 
  1187.    
  1188.    _GETDEVS:
  1189.    PATH$="" : FIL$=""
  1190.    Flash LAMP,"(F00,1)(ff0,1)(888,1)" : NR=0
  1191.    TS$=Dev First$("Dev:")
  1192.    While TS$<>""
  1193.       TS$=Mid$(TS$-" ",1)
  1194.       If Exist(TS$)
  1195.          DEV$(NR)=TS$
  1196.          DI$=Disc Info$(TS$)
  1197.          VOL$=Left$(DI$,Instr(DI$,":"))
  1198.          FRE$=DI$-VOL$-" " : VOL$=Left$(VOL$,23)
  1199.          OUT$(NR)=TS$+Space$(1)+VOL$+Space$(20-Len(VOL$))+Space$(9-Len(FRE$))+FRE$
  1200.          Inc NR
  1201.       End If 
  1202.       TS$=Dev Next$
  1203.    Wend 
  1204.    
  1205.    TS$=Dev First$("Ass:")
  1206.    While TS$<>""
  1207.       DEV$(NR)=Mid$(TS$-" ",1)
  1208.       OUT$(NR)=DEV$(NR)
  1209.       Gosub _NOSPACE
  1210.       OUT$(NR)=OUT$(NR)+Space$(28-Len(OUT$(NR)))+"Assign"
  1211.       Inc NR
  1212.       TS$=Dev Next$
  1213.    Wend 
  1214.    
  1215.    _MAX=NR : _TOP=0
  1216.    If _MAX>10 Then _BOTTOM=12 Else _BOTTOM=_MAX-1
  1217.    LIST=1
  1218.    Flash Off : Colour LAMP,Colour(0)
  1219.    Ink 0 : Bar 17+X,11+Y To 298+X,119+Y
  1220.    Return 
  1221.    
  1222.    _UPDATE:
  1223.    Ink BLACK,0
  1224.    For T=_TOP To _BOTTOM
  1225.       Text 20+X,(YP*8)+20+Y,OUT$(T)
  1226.       Inc YP
  1227.    Next 
  1228.    Vslider 307+X,11+Y To 318+X,99+Y,_MAX,_TOP,13
  1229.    YP=0
  1230.    Return 
  1231.    
  1232.    _UPDATE2:
  1233.    Ink BLACK,0
  1234.    Text 20+X,135+Y,Space$(34)
  1235.    Text 20+X,155+Y,Space$(32)
  1236.    Text 20+X,135+Y,Right$(PATH$,34)
  1237.    Text 20+X,155+Y,Right$(FIL$,32)
  1238.    Return 
  1239.    
  1240.    RITA:
  1241.    For T=1 To 14
  1242.       Read X1,Y1,X2,Y2
  1243.       Add X1,X : Add X2,X : Add Y1,Y : Add Y2,Y
  1244.       If T<=10 Then Set Zone _STZON+T,X1,Y1 To X2,Y2
  1245.       If T=12 Then Swap BLACK,WHITE
  1246.       If T=>2 and T=<8 Then X1(T)=X1 : Y1(T)=Y1 : X2(T)=X2 : Y2(T)=Y2
  1247.       Gosub GADGET
  1248.    Next 
  1249.    Swap BLACK,WHITE
  1250.    Ink BLACK,0 : Text 40+X,175+Y,"OK"
  1251.    Text 100+X,175+Y,"Volumes" : Text 188+X,175+Y,"Parent"
  1252.    Text 270+X,175+Y,"Cancel"
  1253.    Polygon 309+X,113+Y To 317+X,113+Y To 313+X,117+Y
  1254.    Polygon 309+X,108+Y To 317+X,108+Y To 313+X,104+Y
  1255.    Ink LAMP : Bar 292+X,151+Y To 318+X,154+Y
  1256.    
  1257.    Data 12,10,300,120,305,10,320,100,305,101,320,110,305,111,320,120
  1258.    Data 12,165,84,180,94,165,166,180,176,165,248,180,258,165,330,180
  1259.    Data 12,125,300,140,12,145,280,160,4,0,339,191
  1260.    Data 290,150,320,155,14,126,298,139,14,146,278,159
  1261.    Return 
  1262.    
  1263.    MALFUNCTION:
  1264.    Restore Errn+0 : Read MESS$
  1265.    If Errn=25 or Errn=92
  1266.       _MESSAGE[MESS$,0]
  1267.       Resume _QUIT
  1268.    Else 
  1269.       _MESSAGE[MESS$,1]
  1270.       Window 1
  1271.       If Param=1
  1272.          Resume 
  1273.       Else 
  1274.          Resume _QUIT
  1275.       End If 
  1276.    End If 
  1277.    
  1278.    25 Data "Out of memory! Close something and retry"
  1279.    83 Data "Disc Not Validated, retry?"
  1280.    86 Data "Volume '"+PATH$+"' Is Not Available, retry?"
  1281.    92 Data "Thats Not An AmigaDos Disk!"
  1282.    93 Data "There Is No Disk In The Drive, retry?"
  1283.    94 Data "I/O Error, retry?"
  1284.    
  1285.    GADGET:
  1286.    Ink WHITE : Box X1,Y1 To X2,Y2
  1287.    Draw X1+1,Y1+1 To X1+1,Y2-1
  1288.    Ink BLACK : Polyline X1+1,Y2 To X2,Y2 To X2,Y1
  1289.    Draw X2-1,Y1+1 To X2-1,Y2-1
  1290.    Return 
  1291.    
  1292.    _SHUTDOWN:
  1293.    Wind Close 
  1294.    Return 
  1295.    
  1296.    _QUIT:
  1297.    Wind Close 
  1298.    Pop Proc[""]
  1299.    Return 
  1300.    
  1301. End Proc[PATH$]
  1302. Procedure _MESSAGE[TXT$,_ASK]
  1303.    Menu Off 
  1304.    XB=(Len(TXT$)+6)/2*2 : X=((640-XB*8)/2)/16*16
  1305.    Y1=140 : Y2=150 : BLACK=1 : WHITE=11
  1306.    Y=5 : If _ASK=1 Then Y=7
  1307.    Ink 1,0
  1308.    Wind Save : Wind Open 3,X,110,XB,Y,2
  1309.    Curs Off : Border 2,0,1
  1310.    Ink WHITE : Polyline X+8,109+Y*8 To X+8,110 To X+6+(XB*8),110
  1311.    Draw X+9,108+Y*8 To X+9,110
  1312.    Pen 1 : Paper 0 : Clw : Locate 1,1 : Print TXT$
  1313.    If _ASK=0
  1314.       While Mouse Key=0 : Multi Wait : Wend 
  1315.       Wind Close 
  1316.       Menu On : Pop Proc
  1317.    Else 
  1318.       Ink 1,0
  1319.       Text 275,148,"Yes      No"
  1320.       X1=265 : X2=310 : Gosub GADGET
  1321.       Set Zone 16,X1,Y1 To X2,Y2
  1322.       X1=330 : X2=370 : Gosub GADGET
  1323.       Set Zone 15,X1,Y1 To X2,Y2
  1324.       
  1325.       Repeat 
  1326.          While Mouse Key=0 : Multi Wait : Wend 
  1327.          MZ=Mouse Zone
  1328.          If MZ=>15 and MZ<=16
  1329.             Swap BLACK,WHITE
  1330.             If MZ=15
  1331.                X1=330 : X2=370 : SVAR=0 : Gosub GADGET
  1332.             End If 
  1333.             If MZ=16
  1334.                X1=265 : X2=310 : SVAR=1 : Gosub GADGET
  1335.             End If 
  1336.             While Mouse Key=1 : Multi Wait : Wend 
  1337.             Swap BLACK,WHITE : Gosub GADGET
  1338.          End If 
  1339.          Multi Wait 
  1340.       Until Mouse Zone=MZ and MZ=>15 and MZ<=16
  1341.       Wind Close 
  1342.       Menu On 
  1343.       Pop Proc[SVAR]
  1344.    End If 
  1345.    GADGET:
  1346.    Ink WHITE
  1347.    Box X1,Y1 To X2,Y2
  1348.    Draw X1+1,Y1+1 To X1+1,Y2-1
  1349.    Ink BLACK
  1350.    Polyline X1+1,Y2 To X2,Y2 To X2,Y1
  1351.    Draw X2-1,Y1+1 To X2-1,Y2-1
  1352.    Return 
  1353. End Proc