Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Amos/amproe2x.dms/in.adf/Interpreter_Config.AMOS/Interpreter_Config.amosSourceCode

AMOS Source Code | 1993-06-16 | 13.3 KB | 522 lines

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' AMOSPro Interpreter Configuration V 2.0
'
' By Fran�ois Lionet
'
' Additionnal code by Jean-Baptiste Bolcato
'
' (c) 1993 Europress Software Ltd.
'
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Set Buffer 16
' If called from the editor's menu
Set Accessory
' Will only have effect it the program is runned alone...
Close Editor

Global XDI,YDI,YSI,SOP,QUIT,OPEN
Global BNAME$
Global STMX,NST
Global MX,MY,MK,MZ,MS
Global BKPOS,BKCHANGE,ABK,ADAT,BK,TBNK,BKCHUNKS
Global ESX,ESY,D_NAME$

' Maximum number of strings
STMX=64
Dim ST$(STMX)
Global ST$(),STAD
Dim FLAGS(16)
Global FLAGS()

' Default work bank
BK=10

' Location of the default config
D_NAME$="S:AMOSPro_Interpreter_Config"

' Opening speed
SOP=16 : OPEN=False

' Get Editor size
ADAT=Leek(Dreg(3))
If ADAT Then ESX=Deek(ADAT) : XDI=Deek(ADAT+4)
If ESX<640 Then ESX=640 : XDI=128
ESY=200 : YDI=45 : YSI=ESY

Resource Bank 16
INIT_SCREEN
BANK_NEW
MN_MAIN

Procedure MN_MAIN
   Do
      If BNAME$=""
         Vdialog$(1,0)=Resource$(2)+Resource$(53)
      Else
         If BNAME$=D_NAME$
            Vdialog$(1,0)=Resource$(2)+Resource$(54)
         Else
            Vdialog$(1,0)=Resource$(2)+Right$(BNAME$,32)
         End If
      End If
      D=Dialog Run(1,1)
      OPEN_SCREEN[0]
      Repeat
         Multi Wait
         D=Dialog(1)
         On D Proc MN_LEAVE,MN_DLOAD,MN_NLOAD,MN_SAVE,MN_SAVEAS,MN_EXT,MN_SETUP1,MN_SETUP2,MN_FILES
      Until QUIT
      QUIT=0
   Loop
End Proc
Procedure MN_LEAVE
   D=2
   If BKCHANGE : D=Dialog Box(1,1,Resource$(11)) : End If
   If D=2
      MN_QUIT
   End If
End Proc
Procedure MN_DLOAD
   MN_LOADIT[D_NAME$]
End Proc
Procedure MN_NLOAD
   MN_LOADIT[""]
End Proc
Procedure MN_LOADIT[F$]
   Dialog Freeze
   D=2 : If BKCHANGE : D=Dialog Box(1,1,Resource$(11)) : End If
   If D=2
      BANK_NEW : QUIT=-1
      If F$=""
         F$=Fsel$("**","",Resource$(14))
         If F$="" : Goto _END : End If
      End If
      BNAME$=""
      On Error Goto _ERR
      Open In 1,F$ : L=Lof(1) : Close
      Reserve As Work BK,L+8*1024
      Bload F$,Start(BK) : ABK=Start(BK)
      If Peek$(ABK,4)="PId1"
         STAD=ABK+Leek(ABK+4)+8
         If Peek$(STAD,4)="PIt1"
            ADAT=ABK+8 : BNAME$=F$
            ' Strings
            A=STAD+8
            For ST=1 To STMX
               L=Peek(A+1) : Exit If L=$FF
               ST$(ST)=Peek$(A+2,L)
               Add A,L+2
            Next
         End If
      End If
      If BNAME$="" : D=Dialog Box(1,2,Resource$(15)) : End If
   End If
   Goto _END
   _ERR: Resume _DIA
   _DIA: Bell : D=Dialog Box(1,2,Resource$(55)) : BNAME$="" : Goto _END
   _END: Dialog Unfreeze
End Proc
Procedure MN_SAVE
   MN_SAVEIT[BNAME$]
End Proc
Procedure MN_SAVEAS
   MN_SAVEIT[""]
End Proc
Procedure MN_SAVEIT[F$]
   If BNAME$="" : D=Dialog Box(1,2,Resource$(56)) : Pop Proc : End If
   Dialog Freeze
   If F$=""
      F$=Fsel$("**","",Resource$(14))
      If F$="" : Goto _END : End If
   End If

   ' Poke the strings back into the bank
   AP=STAD+8
   For S=1 To STMX
      Poke AP,0
      Poke AP+1,Len(ST$(S))
      Poke$ AP+2,ST$(S)
      Add AP,2+Len(ST$(S))
   Next
   Poke AP,0 : Poke AP+1,$FF : Add AP,2
   Loke STAD+4,AP-STAD-8
   AP=AP+AP mod 2

   ' Save the data zone to disc
   On Error Goto _ERR
   Bsave F$,ABK To AP
   BKCHANGE=0 : BNAME$=F$
   D=Dialog Box(1,2,Resource$(52))
   Goto _END

   _ERR: Resume _DIA
   _DIA: D=Dialog Box(1,2,Resource$(57)) : BNAME$="" : Goto _END
   _END: Dialog Unfreeze
End Proc
Procedure MN_EXT
   If BNAME$="" : D=Dialog Box(1,2,Resource$(56)) : Pop Proc : End If
   Dim TMP$(26)
   For S=16 To 42
      TMP$(N)=ST$(S) : Inc N
   Next
   POS=0
   Do
      Vdialog(1,2)=POS
      Vdialog(1,3)=Array(TMP$(0))
      D=Dialog Run(1,2)
      Repeat
         Multi Wait
         D=Dialog(1)
         POS=Rdialog(1,2)
         Exit If D=1,2
         If D=3
            N=Rdialog(1,3)
            MN_EDIT[Resource$(18)+Str$(N+1),TMP$(N)]
            TMP$(N)=Param$
            QUIT=-1 : Inc BKCHANGE
         End If
      Until QUIT
      QUIT=0
   Loop
   N=0
   For S=16 To 42
      ST$(S)=TMP$(N) : Inc N
   Next
   QUIT=-1
End Proc
Procedure MN_FILES
   If BNAME$="" : D=Dialog Box(1,2,Resource$(56)) : Pop Proc : End If
   Dim TMP$(15)
   For S=1 To 15
      TMP$(N)=ST$(S) : Inc N
   Next
   POS=0
   Do
      Vdialog(1,2)=POS
      Vdialog(1,3)=Array(TMP$(0))
      D=Dialog Run(1,4)
      Repeat
         Multi Wait
         D=Dialog(1)
         POS=Rdialog(1,2)
         Exit If D=1,2
         If D=3
            N=Rdialog(1,3)
         If N=0 : T=23 Else T=24 : End If
            MN_EDIT[Resource$(T),TMP$(N)]
            TMP$(N)=Param$
            QUIT=-1 : Inc BKCHANGE
         End If
      Until QUIT
      QUIT=0
   Loop
   N=0
   For S=1 To 15
      ST$(S)=TMP$(N) : Inc N
   Next
   QUIT=-1
End Proc
Procedure MN_EDIT[T$,S$]
   Vdialog$(1,1)=S$
   Vdialog$(1,2)=T$
   D=Dialog Run(1,3)
   If D=2 : S$=Rdialog$(1,3) : End If
End Proc[S$]
Procedure MN_SETUP1
   If BNAME$="" : D=Dialog Box(1,2,Resource$(56)) : Pop Proc : End If
   Do
      ' Grab the flags
      For F=0 To 8
         If Peek(ADAT+34+F)
            Vdialog(1,2+F)=1
         Else
            Vdialog(1,2+F)=0
         End If
      Next
      D=Dialog Run(1,5)
      Repeat
         Multi Wait
         D=Dialog(1)
         Exit If D=1,2
         If D=11 : MN_SCREEN[Resource$(43),ADAT+48,480,704,80,288,2,1] : End If
         If D=12 : MN_SCREEN[Resource$(44),ADAT+58,320,704,80,288,2,1] : End If
         If D=13 : MN_DEFAULT : End If
      Until QUIT
      QUIT=0
   Loop
   For F=0 To 8
      Poke ADAT+34+F,Vdialog(1,2+F)
   Next
   QUIT=-1 : Inc BKCHANGE
End Proc
Procedure MN_SETUP2
   If BNAME$="" : D=Dialog Box(1,2,Resource$(56)) : Pop Proc : End If
   Do
      ' Number of bobs
      SETVDIA[16,Deek(ADAT+8),8,256,1]
      ' Number of sprites
      SETVDIA[20,Leek(ADAT+16),16,312,2]
      ' Copper List
      SETVDIA[24,Leek(ADAT+12)/1024,2,32,1]
      ' Variable name buffer
      SETVDIA[28,Leek(ADAT+20)/1024,1,32,1]
      ' Default buffer
      SETVDIA[32,Leek(ADAT+26)/1024,1,2048,1]
      ' Ports
      Vdialog$(1,2)=ST$(43) : Vdialog$(1,3)=ST$(44)
      ' Amiga-A
      If Leek(ADAT+148)
         A$=Upper$(Chr$(Peek(ADAT+151))) : S=Peek(ADAT+149)
      Else
         A$="A" : S=$40
      End If
      Vdialog$(1,4)=A$
      For A=0 To 7
         B=0 : If Btst(A,S) : B=1 : End If
         Vdialog(1,A+5)=B
      Next
      D=Dialog Run(1,6)
      Repeat
         Multi Wait
         D=Dialog(1)
         Exit If D=1,2
      Until QUIT
      QUIT=0
   Loop
   ' Number of bobs
   Doke ADAT+8,Vdialog(1,16)
   ' Number of sprites
   Loke ADAT+16,Vdialog(1,20)
   ' Copper List
   Loke ADAT+12,Vdialog(1,24)*1024
   ' Variable name buffer
   Loke ADAT+20,Vdialog(1,28)*1024
   ' Default buffer
   Loke ADAT+26,Vdialog(1,32)*1024
   ' Ports
   ST$(43)=Rdialog$(1,2) : ST$(44)=Rdialog$(1,3)
   ' Amiga-A
   A$=Upper$(Left$(Rdialog$(1,4),1))
   If A$>="A" and A$<="Z"
      Poke ADAT+151,Asc(A$) : Poke ADAT+150,Asc(Lower$(A$))
      S=0 : For A=0 To 7 : If Rdialog(1,A+5) : Bset A,S : End If : Next
      Poke ADAT+149,S
   End If
   QUIT=-1 : Inc BKCHANGE
End Proc
Procedure MN_DEFAULT
   NPLAN_MAX=4 : Rem 16 colours max (boost up to 8 when AGA-256 colours)
   Dim S(256),SS(256),C(NPLAN_MAX)
   For C=0 To 15 : S(C)=Deek(ADAT+C*2+80) : SS(C)=S(C) : Next
   NPLAN=Deek(ADAT+72)
   C(1)=2 : C(2)=4 : C(3)=8 : C(4)=16
   Rem C(5)=32 : C(6)=64: C(7)=128 : C(8)=256
   CUR=0
   HIR=1 : If Deek(ADAT+76) and $8000 : Inc HIR : End If
   LAC=1 : If Deek(ADAT+76) and $4 : Inc LAC : End If
   Reserve As Work 100,16 : SCR=Start(100)
   Loke SCR,Leek(ADAT+68)
   X=Deek(ADAT+144) : If X=0 : X=128 : End If
   Y=Deek(ADAT+146) : If Y=0 : Y=50 : End If
   Doke SCR+4,X : Doke SCR+6,Y : Doke SCR+8,0
   Do
      NCOL=C(NPLAN) : W=ESX-88-24
      SETVDIA[16,NPLAN,1,NPLAN_MAX+1,1]
      Vdialog(1,3)=HIR-1
      Vdialog(1,4)=LAC-1
      Vdialog(1,20)=NCOL
      D=Dialog Run(1,8)
      Ink 1 : Bar 88,113 To ESX-24,119
      Do
         NCOL=C(NPLAN)
         If CUR>NCOL : CUR=NCOL : End If
         C=S(CUR) : Colour 1,C
         R=(C and $F00)/$100 : G=(C and $F0)/$10 : B=C and $F
         Dialog Update 1,6,CUR,1,NCOL
         Dialog Update 1,7,R
         Dialog Update 1,8,G
         Dialog Update 1,9,B
         CUR$=Str$(CUR)
         If Len(CUR$)=2 : CUR$=CUR$+" " : End If
         If Len(CUR$)=4 : CUR$=CUR$-" " : End If
         Ink 3,Point(31,118) : Text 32,118,CUR$
         Repeat
            Multi Wait
            D=Dialog(1)
            Exit If D=1,3
            If D=3 : HIR=Vdialog(1,3)+1 : End If
            If D=4 : LAC=Vdialog(1,4)+1 : End If
            If D=7 : R=Rdialog(1,7) : Inc F : End If
            If D=8 : G=Rdialog(1,8) : Inc F : End If
            If D=9 : B=Rdialog(1,9) : Inc F : End If
            If D=10 : C=SS(CUR) : S(CUR)=C : Colour 1,C : Exit : End If
            If F : Gosub _SET : Colour 1,C : End If
            If D=6 : Gosub _SET : CUR=Rdialog(1,6) : Exit : End If
            If D=16 : NPLAN=Vdialog(1,16) : Exit : End If
            If D=5
               If HIR=1 : If Deek(SCR)>384 : Doke SCR,Deek(SCR)/2 : End If : End If
               If LAC=1 : If Deek(SCR+2)>288 : Doke SCR+2,Deek(SCR+2)/2 : End If : End If
               MN_SCREEN[Resource$(67),SCR,240,384*HIR,32,288*LAC,HIR,LAC]
               Exit 2
            End If
         Until QUIT
         QUIT=0
      Loop
   Loop

   ' *** modidy here to save more than 16 colours! ***
   For C=0 To 15 : Doke ADAT+C*2+80,S(C) : Next : Doke ADAT+78,S(0)
   Doke ADAT+72,NPLAN : Doke ADAT+74,NCOL
   R=0
   If HIR=2 : R=$8000 : End If
   If LAC=2 : R=R or $4 : End If
   Loke ADAT+68,Leek(SCR)
   Doke ADAT+144,Deek(SCR+4)
   Doke ADAT+146,Deek(SCR+6)
   Doke ADAT+76,R
   Inc BKCHANGE
   Erase 100 : QUIT=True : Pop Proc
   _SET: C=R*$100+G*$10+B : S(CUR)=C : Return
End Proc
Procedure MN_SCREEN[T$,AD,XMIN,XMAX,YMIN,YMAX,RESX,RESY]
   X=Free
   A=Lowres : If RESX=2 : A=Hires : End If
   If RESY=2 : Add A,Laced : End If
   Screen Open 1,XMAX,YMAX,2,A : Screen Hide 1
   Screen Display 0,,,,16
   Curs Off : Cls 0 : Palette 0,$FF0
   For X=0 To XMAX Step 16 : Draw X,0 To X,YMAX : Next
   For Y=0 To YMAX Step 16 : Draw 0,Y To XMAX,Y : Next
   Wind Open 1,0,8,20,4,1 : Curs Off : Scroll Off
   SX=Deek(AD) : SY=Deek(AD+2)
   WX=Deek(AD+4) : WY=Deek(AD+6)
   Screen Display 1,WX,WY,SX/RESX,SY
   Screen To Front 0
   Vdialog$(1,0)=T$
   SETVDIA[16,Deek(AD+8),2,312,1]
   D=Dialog Run(1,7)
   Screen Show 1
   Repeat
      Multi Wait
      D=Dialog(1) : Exit If D=1
      If D=2 : M=1 : Clw : Gosub _DISP : End If
      If D=3 : M=2 : Clw : Gosub _DISP : End If
      If D=0
         If Mouse Key=1
            Dialog Freeze
            While Mouse Key
               If M=1
                  WX=X Mouse : WY=Y Mouse
               End If
               If M=2
                  SX=Max(Min(X Screen(1,X Mouse),XMAX),XMIN)
                  SY=Max(Min(Y Screen(1,Y Mouse),YMAX),YMIN)
                  If RESX=1
                     SX=SX and $FFFFFFF0
                  Else
                     SX=SX and $FFFFFFE0
                  End If
                  SY=SY and $FFFFFFF8
               End If
               Screen Display 1,WX,WY,SX/RESX,SY
               Gosub _DISP
               Wait Vbl
            Wend
            Dialog Unfreeze
         End If
      End If
   Until QUIT
   Screen Close 1
   Screen Display 0,,50,,ESY
   Doke AD,SX : Doke AD+2,SY
   Doke AD+4,WX : Doke AD+6,WY
   Doke AD+8,Vdialog(1,16)
   QUIT=-1
   Pop Proc
   _DISP:
   Home
   If M=1
      Print Resource$(48);WX;"  "
      Print Resource$(49);WY;"  "
   Else
      Print Resource$(50);SX;"  "
      Print Resource$(51);SY;"  "
   End If
   Return
End Proc
Procedure BANK_NEW
   ' Erase the current config from memory
   BNAME$=""
   For S=0 To STMX : ST$(S)="" : Next
   BKCHANGE=0
End Proc
Procedure SETVDIA[V,A,B,C,D]
   Vdialog(1,V)=A
   Vdialog(1,V+1)=B
   Vdialog(1,V+2)=C
   Vdialog(1,V+3)=D
End Proc
Procedure INIT_SCREEN
   Trap Resource Screen Open 0,ESX,ESY,0
   If Errtrap : OOMEM : End If
   Screen Hide 0
   Screen Display 0,XDI,YDI,,
   Curs Off : Flash Off : Cls 0
   GRB_EDITOR_PALETTE
   Paper 0 : Pen 1
   Limit Mouse 96,25 To 530,312
   On Error Goto ERR
   Trap Dialog Open 1,1,48,1024*4
   If Errtrap : OOMEM : End If
   Pop Proc
   ERR: Print "dialog error in position";Edialog;"." : Wait Key : End
End Proc
Procedure GRB_EDITOR_PALETTE
   ADAT=Leek(Dreg(3))
   If ADAT=0
      Palette 0,$6F,$77,$EEE,$F00,$DD,$AA,$FF3
   Else
      For C=0 To 7
         Colour C,Deek(ADAT+28+C*2)
      Next
      Colour 1,(Colour(2) and $EEE)/2
   End If
End Proc
Procedure OOMEM
   Trap Dialog Clr 1
   Trap Dialog Close
   Trap D=Dialog Box(1,2,Resource$(61))
   MN_QUIT
End Proc
Procedure MN_QUIT
   Dialog Close
   For I=7 To 1 Step -1
      Trap Screen Close I
   Next I
   Trap Screen 0
   If Errtrap=0
      For I=YSI To 0 Step -SOP
         Screen Display 0,,,,I
         Wait Vbl
      Next
      Screen Close 0
   End If
   Edit
End Proc
Procedure OPEN_SCREEN[S]
   If OPEN=False
      Trap Screen S
      If Errtrap : Pop Proc : End If
      Screen Display S,,,,1
      Screen Show S : Wait Vbl
      For I=1 To YSI Step SOP
         Screen Display S,,,,I
         Wait Vbl
      Next
      Screen Display S,,,,YSI
      Wait Vbl
      OPEN=True
   End If
End Proc