home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Amos / amprocom.dms / in.adf / Tiny_Shell.AMOS / Tiny_Shell.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1993-06-19  |  11.2 KB  |  489 lines
  1. ' ---------------------------------- 
  2. '
  3. '    AMOS Compiler tiny - Shell
  4. '              V 2.00
  5. '
  6. '        By Francois LIONET
  7. '     & Jean-Baptiste BOLCATO
  8. '
  9. '  (c) 1993 Europress Software Ltd.
  10. '
  11. ' ---------------------------------- 
  12.  
  13. Set Accessory 
  14. Resource Bank 16
  15.  
  16. Global PATH$,DPATH$,PRAM$,CNAME$,FACC,ER$
  17. Global FLAG$,TEMP_SRCE$,TEMP_DEST$
  18. Global SCR,SCX,SCY,SCSX,SCSY,DY,SOP
  19.  
  20. ' screens opening speed
  21. SOP=20
  22.  
  23. ' screens definitions
  24. ADAT=Leek(Dreg(3))
  25. If ADAT Then SCSX=Deek(ADAT) : SCX=Deek(ADAT+4) : SCY=Deek(ADAT+6)+16
  26. If SCSX<640 Then SCSX=640 : SCX=128 : SCY=68
  27. SCSY=64
  28. Auto View Off 
  29. _OPEN_FREE_SCREEN[SCSX,SCSY] : SCR=Param
  30. _INIT_WORK
  31.  
  32. ' open screen
  33. Screen Show SCR : Auto View On 
  34. For Y=1 To SCSY Step SOP
  35.    Screen Display SCR,SCX,SCY,,Y
  36.    Wait Vbl 
  37. Next 
  38. Screen Display SCR,,SCY,,SCSY : Wait Vbl 
  39.  
  40. ' An accessory?
  41. If Prg Under<>1
  42.    _WARN[Resource$(8)] : _QUIT
  43. End If 
  44.  
  45. For S=0 To 7 : If S<>SCR : Trap Screen Close S : End If : Next 
  46.  
  47. ' several paths
  48. DPATH$=Resource$(0)
  49. PRAM$="RAM:AMOS_Compiler_Temp/"
  50.  
  51. ' load default config
  52. C$="AMOSPro_Compiler_Config"
  53. CNAME$=PRAM$+C$
  54. _CONFIG_LOAD[CNAME$]
  55. If Param
  56.    CNAME$=Dir$+C$
  57.    _CONFIG_LOAD[CNAME$]
  58.    If Param
  59.       CNAME$=Dir$+"s/"+C$
  60.       _CONFIG_LOAD[CNAME$]
  61.       If Param
  62.          CNAME$="S:"+C$
  63.          _CONFIG_LOAD[CNAME$]
  64.          If Param
  65.             CNAME$=Fsel$(Dir$+"**","",Resource$(73),Resource$(74))
  66.             _CONFIG_LOAD[CNAME$]
  67.             If Param
  68.                ER$=Resource$(75)
  69.                _GEST_ERR2
  70.                Edit 
  71.             End If 
  72.          End If 
  73.       End If 
  74.    End If 
  75. End If 
  76.  
  77. ' extract shell preferences
  78. _CONFIG_GET[72]
  79. FLAG$=Param$
  80. If Len(FLAG$)<43
  81.    ER$=Resource$(77) : _GEST_ERR2
  82. End If 
  83.  
  84. ' Load APCmp program 
  85. If Not Extension_5_00AE 
  86.    _INFO[Resource$(25)]
  87.    Repeat 
  88.       Trap Extension_5_0098 DPATH$+"APCmp"
  89.       If Errtrap
  90.          _WAIT[10]
  91.          _NOINFO
  92.          _WARN[Resource$(80)]
  93.          F$=Fsel$("","",Resource$(82))
  94.          If Exist(Dir$+"APCmp")
  95.             DPATH$=Dir$
  96.          Else 
  97.             ER$=Resource$(81) : _GEST_ERR2
  98.          End If 
  99.       Else 
  100.          _NOINFO
  101.       End If 
  102.    Until Extension_5_00AE 
  103. End If 
  104.  
  105. ' go ram & save dpath$, cname$ 
  106. If Exist(PRAM$+"AMOSPro_Compiler_Config")
  107.    DPATH$=PRAM$
  108.    Open In 1,PRAM$+"Compiler_Origin"
  109.    Trap Input #1,PATH$
  110.    Trap Input #1,CNAME$
  111.    Close 
  112. End If 
  113.  
  114. ' Copy Libs into ram-disc? 
  115. _GETFLAG[24]
  116. If Param
  117.    If Exist("Ram:")
  118.       If DPATH$<>PRAM$
  119.          _COPY_RAMLIBS[DPATH$,PRAM$]
  120.          If Param
  121.             PATH$=DPATH$
  122.             Open Out 1,PRAM$+"Compiler_Origin"
  123.             Print #1,PATH$
  124.             Print #1,CNAME$
  125.             Close 
  126.             DPATH$=PRAM$
  127.          End If 
  128.       End If 
  129.    End If 
  130. End If 
  131.  
  132. _CONFIG_GET[9] : TEMP_SRCE$=Param$
  133. _CONFIG_GET[10] : TEMP_DEST$=Param$
  134.  
  135. X=Free
  136. _COMPILE
  137. _QUIT
  138.  
  139. Procedure _CONFIG_GET[N]
  140.    Shared _CONFBK,CONFL
  141.    A=Start(_CONFBK)+8+1
  142.    If N>0
  143.       For C=1 To N
  144.          L=Peek(A) : If L=255 : Pop Proc[""] : End If 
  145.          Add A,L+2
  146.       Next 
  147.    End If 
  148.    L=Peek(A)
  149. End Proc[Peek$(A+1,L)]
  150. Procedure _CONFIG_LOAD[F$]
  151.    Shared _CONFBK,_CONFL
  152.    If Not Exist(F$) : Pop Proc[1] : End If 
  153.    Trap Open In 1,F$ : If Errtrap : Pop Proc[2] : End If 
  154.    _CONFL=Lof(1) : Close 
  155.    For B=65000 To 0 Step -1 : Exit If Length(B)=0 and Length(B+1)=0 : Next B
  156.    _CONFBK=B
  157.    Trap Reserve As Work B,1024*6 : If Errtrap : Pop Proc[3] : End If 
  158.    Trap Bload F$,Start(B) : If Errtrap : Erase B : Pop Proc[2] : End If 
  159.    If Peek$(Start(B),4)<>"CCt1" : Erase B : Pop Proc[4] : End If 
  160. End Proc[0]
  161. Procedure _COMPILE
  162.    Shared _CONFBK
  163.    COMP_STP=100
  164.    On Error Proc _GEST_ERR
  165.    Resume Label _FINISH_COMPILE
  166.    Timer=0 : _INFO[Resource$(9)]
  167.    S$=TEMP_SRCE$
  168.    Call Editor Equ("AEd_SaveAsName"),0,S$ : A$=Param$
  169.    Repeat : Until Timer>50 : _NOINFO
  170.    If A$<>"" : _WARN[A$] : _QUIT : End If 
  171.    Ask Editor Equ("AEdAsk_ProgramName") : SS$=Param$
  172.    If SS$="" : SS$="Unnamed.AMOS" : End If 
  173.    D$=TEMP_DEST$ : DD$=SS$ : F=0
  174.    For C=Len(DD$) To 1 Step -1
  175.       A$=Mid$(DD$,C,1)
  176.       Exit If(A$="/") or(A$=":")
  177.       If A$="." : DD$=Left$(DD$,C-1)+"_C"+Mid$(DD$,C) : F=1 : Exit : End If 
  178.    Next 
  179.    If F=0 : DD$=DD$+"_C.AMOS" : End If 
  180.    Call Editor Equ("AEd_CloseName"),1,DD$
  181.    C$="TYPE=3 "
  182.    _GETFLAG[4] : If Param=0 : C$=C$+"NO" : End If : C$=C$+"ERR "
  183.    _GETFLAG[14] : If Param=0 : C$=C$+"NO" : End If : C$=C$+"LONG "
  184.    _GETFLAG[5] : If Param=0 : C$=C$+"NO" : End If : C$=C$+"DEF "
  185.    _GETFLAG[6] : If Param=0 : C$=C$+"NO" : End If : C$=C$+"WB "
  186.    C$=C$+'TEMP="Ram:" '
  187.    C$=C$+'LIBS="'+DPATH$+'" '
  188.    _GETFLAG[24]
  189.  
  190.    ' Go for it now!!! 
  191.     Extension_5_006E "Step",COMP_STP
  192.     Extension_5_006E "Conf",Start(_CONFBK)
  193.    Dialog Open 2,1
  194.    Vdialog$(2,0)=Resource$(14)+Resource$(15)+"..."
  195.    D=Dialog Run(2,10)
  196.    Set Slider 2,2,2,0,4,4,4,0
  197.    HSX1=(SCSX-600)/2+24+14 : HSY1=(SCSY-50)/2+18
  198.    HSX2=(SCSX+600)/2-24-15 : HSY2=(SCSY-50)/2+32
  199.  
  200.    ' start compilation
  201.    E$=""
  202.    Clear Key 
  203.    A$="Gaga" : MAGIC=Leek(Varptr(A$))
  204.    COM$='FROM "'+S$+'" TO "'+D$+'" '+C$
  205.    Timer=0
  206.     Extension_5_006E COM$,MAGIC
  207.    STATUS=Param
  208.    COMP_ERR$= Extension_5_0078 
  209.    
  210.    ' Compilation main loop
  211.    While STATUS
  212.       Hslider HSX1,HSY1 To HSX2,HSY2,COMP_STP,0,STATUS
  213.       K$=Inkey$
  214.       Exit If K$=Chr$(27)
  215.       Multi Wait 
  216.        Extension_5_006E "Cont",MAGIC
  217.       STATUS=Param
  218.    Wend 
  219.    
  220.    ' result (user break, error or success)
  221.    COMP_ERR$= Extension_5_0078 
  222.    SIZE= Extension_5_00BE 
  223.    NBINST= Extension_5_00BE 
  224.    If K$=Chr$(27)
  225.       COMP_ERR$=Resource$(111)
  226.        Extension_5_006E "Stop",MAGIC
  227.       SIZE=0 : NBINST=0
  228.    End If 
  229.    
  230.    ' erase temporary file 
  231.    Trap Kill TEMP_SRCE$
  232.    
  233.    ' result report
  234.    Trap Dialog Close 2
  235.    _END_COMPILE[SIZE,NBINST,Timer,SS$,COMP_ERR$]
  236.    If COMP_ERR$=""
  237.       Call Editor Equ("AEd_OpenLoad"),1,D$
  238.       Trap Kill D$
  239.       If Param$="" : Call Editor Equ("AEd_Rename"),0,DD$ : End If 
  240.    Else 
  241.       If SIZE<0
  242.          Call Editor Equ("AEd_GotoLine"),NBINST
  243.          Call Editor Equ("AEd_StartLine")
  244.       End If 
  245.    End If 
  246.    _FINISH_COMPILE:
  247.    Trap Screen Show 9
  248.    Screen Show SCR
  249.    Clear Key 
  250. End Proc
  251. Procedure _COPY_RAMLIBS[S$,D$]
  252.    Dim F$(64)
  253.    Trap Dialog Freeze 1
  254.    Dialog Open 2,1
  255.    Vdialog$(2,0)=Resource$(40)
  256.    Trap D=Dialog Run(2,15)
  257.    If Errtrap=0
  258.       Set Slider 2,2,2,0,4,4,4,0
  259.       SX=336
  260.       HSX1=(SCSX-SX)/2+32+2 : HSY1=(SCSY-50)/2+26
  261.       HSX2=(SCSX+SX)/2-32-19 : HSY2=(SCSY-50)/2+35
  262.       Hslider HSX1,HSY1 To HSX2,HSY2,10,0,0
  263.    End If 
  264.    F$(0)="AMOSPro.Lib"
  265.    F$(1)="Compiler.Lib"
  266.    F$(2)="Def_Compiled.info"
  267.    F$(3)="AMOSPro_Default_Resource.Abk"
  268.    F$(4)="AMOSPro_Editor_Resource.Abk"
  269.    F$(5)="Header_AMOS.AMOS"
  270.    F$(6)="Header_CLI.Lib"
  271.    F$(7)="Header_Backstart.Lib"
  272.    F$(8)="AMOSPro_Editor_Config"
  273.    NCOP=8
  274.    _GETFLAG[37]
  275.    If Param
  276.       Inc NCOP
  277.       F$(NCOP)="AMOSPro_CompilerA_Resource.Abk"
  278.    End If 
  279.    R=-16
  280.    Repeat 
  281.       If Resource$(R)<>""
  282.          Inc NCOP
  283.          A$=Resource$(R)
  284.          S=Instr(A$," ") : If S : A$=Left$(A$,S-1) : End If 
  285.          F$(NCOP)=A$
  286.       End If 
  287.       Dec R
  288.    Until R<-26
  289.    Set Dir ,""
  290.    Trap Open In 1,DPATH$+F$(0)
  291.    If Errtrap
  292.       _NOINFO
  293.       _WARN[F$(I)+Resource$(41)]
  294.       _WARN[Resource$(42)]
  295.       Goto _NORAM
  296.    End If 
  297.    Close 1
  298.    For I=0 To NCOP
  299.       If Exist(S$+F$(I))
  300.          Trap Open In 1,S$+F$(I)
  301.          Trap TL=TL+Lof(1)
  302.          Trap Close 1
  303.       End If 
  304.    Next I
  305.    If Chip Free+Fast Free<TL+100*1024
  306.       _NOINFO
  307.       _WARN[Resource$(43)]
  308.       Goto _NORAM
  309.    End If 
  310.    Trap Mkdir Left$(D$,Len(D$)+(Right$(D$,1)="/"))
  311.    For I=0 To NCOP
  312.       A$=S$+F$(I) : B$=D$+F$(I)
  313.       If Not Exist(B$)
  314.          _FCOPY[A$,B$]
  315.       End If 
  316.       If HSX1 : Hslider HSX1,HSY1 To HSX2,HSY2,NCOP,0,I : End If 
  317.    Next I
  318.    _FCOPY[CNAME$,D$+"AMOSPro_Compiler_config"]
  319.    F=-1
  320.    _NORAM:
  321.    _NOINFO
  322.    Set Dir ,".info/*.info/*.*.info"
  323. End Proc[F]
  324. Procedure _DEL_RAMLIBS[S$]
  325.    On Error Goto _ERR
  326.    Dim F$(64)
  327.    Set Dir 32,""
  328.    If Upper$(Left$(S$,4))="RAM:"
  329.       _INFO[Resource$(44)]
  330.       _WAIT[10]
  331.       A$=Dir First$(S$+"**")
  332.       I=0
  333.       While A$<>""
  334.          F$(N)=Left$(A$,32)-" " : Inc N
  335.          A$=Dir Next$
  336.       Wend 
  337.       If N>0
  338.          For I=0 To N-1
  339.             Trap Kill S$+F$(I)
  340.          Next I
  341.       End If 
  342.       Trap Kill S$
  343.       _END: _NOINFO : Pop Proc
  344.    End If 
  345.    _ERR: Resume _END
  346. End Proc
  347. Procedure _END_COMPILE[SZ,NBI,T,D$,E$]
  348.    Dialog Open 2,1
  349.    Vdialog(2,0)=Max(400,Len(E$)*8+24)
  350.    Vdialog(2,1)=48
  351.    If E$=""
  352.       Vdialog$(2,3)=Resource$(110)
  353.       T=T/50 : M=T/60 : S=T mod 60
  354.       Vdialog$(2,4)=Resource$(121)+" "+Str$(SZ)+" "+Resource$(12)+" -"+Str$(NBI)+" "+Resource$(122)
  355.       A$=Resource$(120)+" "
  356.       If M>0 : A$=A$+Str$(M)+" minutes," : End If 
  357.       A$=A$+Str$(S)+" seconds."
  358.       Vdialog$(2,5)=A$
  359.    Else 
  360.       Vdialog$(2,3)=Resource$(112)
  361.       Vdialog$(2,4)=D$
  362.       Vdialog$(2,5)=E$
  363.    End If 
  364.    ' bell warning!
  365.    _GETFLAG[36]
  366.    If Param : Play 3,70,0 : End If 
  367.    D=Dialog Run(2,12)
  368.    _WAIT[250]
  369.    Dialog Close 2
  370. End Proc[D]
  371. Procedure _FCOPY[S$,D$]
  372.    On Error Goto _ERR
  373.    Open In 1,S$
  374.    Open Out 2,D$
  375.    LF=Lof(1)
  376.    Do 
  377.       Exit If P>=LF
  378.       L=Min(1024,LF-P)
  379.       A$=Input$(1,L)
  380.       Print #2,A$;
  381.       Add P,L
  382.    Loop 
  383.    Close 
  384.    Pop Proc[0]
  385.    _ERR: Resume _ER2
  386.    _ER2: Trap Kill D$ : Close : Pop Proc[-1]
  387. End Proc
  388. Procedure _GEST_ERR
  389.    _WARN[Err$(Errn)]
  390.    Resume Label 
  391. End Proc
  392. Procedure _GEST_ERR2
  393.    For I=0 To 7 : Trap Screen Close I : Next I
  394.    Auto View On 
  395.    Screen Open 0,640,24,2,Hires
  396.    Screen Display 0,,100,,
  397.    Palette 0,$FFF : Curs Off 
  398.    If Errn=0
  399.       A$=ER$
  400.    Else 
  401.       A$=Err$(Errn)
  402.    End If 
  403.    Centre ">> "+A$+" <<"
  404.    Print : Print : Centre "Press any key"
  405.    Wait Key 
  406.    Screen Close 0
  407.    Edit 
  408. End Proc
  409. Procedure _GETFLAG[N]
  410. End Proc[Asc(Mid$(FLAG$,N,1))-48]
  411. Procedure _INFO[A$]
  412.    Trap Dialog Freeze 1
  413.    Dialog Open 2,1
  414.    Vdialog$(2,0)=A$
  415.    Trap D=Dialog Run(2,14)
  416. End Proc[Errtrap]
  417. Procedure _INIT_WORK
  418.    Trap Dialog Close 1
  419.    Trap Dialog Open 1,1,10,1024*10
  420.    If Errtrap=0
  421.       D=Dialog Run(1,0)
  422.    Else 
  423.       _GEST_ERR2
  424.    End If 
  425. End Proc[Errtrap]
  426. Procedure _NOINFO
  427.    Trap Dialog Close 2
  428.    Trap Dialog Unfreeze 1
  429. End Proc
  430. Procedure _OPEN_FREE_SCREEN[SX,SY]
  431.    For S=0 To 7
  432.       Trap Screen S
  433.       If Errtrap
  434.          Trap Resource Screen Open S,SX,SY,0
  435.          If Errtrap : Pop Proc[-1] : End If 
  436.          Screen Hide S
  437.          Cls 0 : Paper 0 : Pen 0 : Flash Off 
  438.          Wait Vbl 
  439.          Pop Proc[S]
  440.       End If 
  441.    Next 
  442. End Proc[-1]
  443. Procedure _WAIT[T]
  444.    For I=1 To T
  445.       Multi Wait 
  446.       Exit If Mouse Key
  447.    Next I
  448.    Repeat 
  449.       Multi Wait 
  450.    Until Mouse Key=0
  451. End Proc
  452. Procedure _WARN[A$]
  453.    L=Len(A$)*8
  454.    Dialog Open 3,1
  455.    Vdialog$(3,0)=A$
  456.    Trap D=Dialog Run(3,13)
  457.    If Errtrap=0
  458.       _WAIT[200]
  459.       Trap Dialog Close 3
  460.    Else 
  461.       Trap Dialog Close 3
  462.       Pop Proc[65535]
  463.    End If 
  464. End Proc[(D=2)]
  465. Procedure _QUIT
  466.    _GETFLAG[26] : If Param=0 : Extension_5_00A0 : End If 
  467.    If DPATH$=PRAM$
  468.       _GETFLAG[25]
  469.       If Param=0
  470.          _DEL_RAMLIBS[PRAM$]
  471.       End If 
  472.    End If 
  473.    Trap Dialog Close 
  474.    Trap Screen SCR
  475.    If Errtrap=0
  476.       For Y=1 To SCSY Step SOP
  477.          Screen Offset SCR,,Y
  478.          Screen Display SCR,,,,SCSY-Y
  479.          Wait Vbl 
  480.       Next 
  481.       Screen Close SCR
  482.    End If 
  483.    Trap Close 
  484.    For I=2 To 15 : Trap Erase I : Next I
  485.    Trap Erase 65000
  486.    Trap Kill TEMP_SRCE$
  487.    Trap Kill TEMP_DEST$
  488.    Edit 
  489. End Proc