home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 551-575 / apd573 / sharp2amiga / comms.amos / comms.amosSourceCode < prev    next >
AMOS Source Code  |  1993-12-02  |  5KB  |  213 lines
  1. SCRSETUP
  2. COPRBARS1
  3. 'Track Load "dh1:mods/mod.05",3: set thes e up to load your own music
  4. 'Track Play 3,0
  5. 'Track Loop On 
  6. '
  7. 'load "sprites.abk"
  8. On Error Goto XIT
  9. If Exist("defaults")
  10.    Open In 1,"defaults"
  11.    Line Input #1,BAUD,BITS,PARITY$,STP,DUP$
  12.    Close 
  13. Else 
  14.    BAUD=2400 : BITS=8 : PARITY$="N" : STP=1 : DUP$="F"
  15. End If 
  16. '
  17. Serial Open 0,0 : Serial Speed 0,BAUD
  18. Serial Bits 0,BITS,STP : Serial Parity 0,Instr("NEOS",PARITY$)-2
  19. Serial Buf 0,Max(512,512*BAUD/1200)
  20. While Mouse Key : Wend 
  21. '
  22. '
  23. Screen 3 : For I=0 To 7 : Print Using "#";I; : Print "----+----"; : Next 
  24. '
  25. Wait 300 : Screen 0 : Cls 0
  26. HELP
  27. TXT$=""
  28. MAIN:
  29. Do 
  30.    T=Free
  31.    If BAUD<9600
  32.       Screen 2 : Locate 40,0 : _DATE$ : Print Param$;"   ";
  33.       _TIME$ : Print Param$
  34.    End If 
  35.    '
  36.    T$="" : T$=Inkey$ : S=Scancode
  37.    Screen 1 : Ink 1 : Paper 0
  38.    If T$<>"" : Print T$; : TXT$=TXT$+T$ : End If 
  39.    If T$=Chr$(13)
  40.       If Left$(TXT$,3)="+++" : TXT$="+++" : End If 
  41.       Screen 0 : Pen 11 : Serial Send 0,TXT$ : Print TXT$ : Pen 9
  42.       If CAP_FLAG : Print #1,TXT$; : End If 
  43.       Gosub CHK
  44.       TXT$="" : Screen 1 : Cls 
  45.    End If 
  46.    If S=80 : Gosub CAP : End If 
  47.    If S=83 : FILE_OUT : End If 
  48.    If S=84 and BO=0 and M2=0 : Screen 0 : Cls 0 : Bob 1,72,35,10 : BO=1 : S=1 : End If 
  49.    If S=84 and BO=1 : Screen 0 : Cls 0 : Bob Off 1 : BO=0 : S=1 : End If 
  50.    If S=86 Then Track Play 3,0 : Track Loop On 
  51.    If S=87 Then Track Stop 
  52.    If S=88 and M2=0 and BO=0 Then GARBAGE
  53.    If S=89 : Goto XIT : End If 
  54.    If S=95 : HELP : End If 
  55.    M2=Chanmv(2)
  56.    If M2=0 Then Amal Off 2
  57.    '
  58.    CHECK=Serial Get(0)
  59.    Screen 0
  60.    If CHECK>0
  61.       Print Chr$(CHECK); : A=A+1
  62.       If CHECK=7 : Bell : End If 
  63.       If CHECK=13 or CHECK=10 : A=0 : Print : End If 
  64.       If CHECK=12 : Cls 0 : A=0 : End If 
  65.       If A>70 and CHECK=32 : Print Chr$(13) : A=0 : End If 
  66.       If CAP_FLAG : Print #1,Chr$(CHECK); : End If 
  67.    End If 
  68.    Gosub CHK
  69. Loop 
  70. '
  71. XIT:
  72. Serial Close 0
  73. Close 
  74. Default 
  75. End 
  76. '
  77. '
  78. CHK:
  79. While Not Serial Check(0) : Wend 
  80. Return 
  81. CAP:
  82. If CAP_FLAG=0
  83.    F$=Fsel$("**","","Select File","For DOWNLOAD")
  84.    If F$<>"" : Open Out 1,F$ : CAP_FLAG=1 : End If 
  85. Else 
  86.    Close 1 : CAP_FLAG=0
  87. End If 
  88. Return 
  89. '
  90. '
  91. Procedure FILE_OUT
  92.    F$=Fsel$("**","","Select File","For UPLOAD")
  93.    If F$<>"" : Open In 2,F$ : L=Lof(2) : DTA$=Input$(2,L) : Close 2
  94.       Screen 0
  95.       For I=1 To L : C$=Mid$(DTA$,I,1)
  96.          Print C$; : Serial Send 0,C$
  97.       Next : DTA$=""
  98.       Print : Print "<EOF>" : Bell 
  99.    End If 
  100. End Proc
  101. Procedure HELP
  102.    Screen 0 : Pen 9 : Paper 0
  103.    Print 
  104.    Print "<F1>  : Open/Close Capture      <F4>  : Send ASCII file"
  105.    Print "<F7>  : Play Music              <F8>  : Stop Music"
  106.    Print "<F9>  : Special"
  107.    Print "<F10> : EXIT PROGRAM            <Help>: Help"
  108. End Proc
  109. Procedure SCRSETUP
  110.    Screen Close 0
  111.    '
  112.    Unpack 5 To 0 : Locate 0,18
  113.    '   Screen Open 0,640,176,4,Hires
  114.    Screen Open 1,640,16,4,Hires : Ink 1 : Paper 0 : Cls 0
  115.    Screen Open 2,640,16,2,Hires : Screen To Back 2 : Curs Off 
  116.    Screen Open 3,640,16,2,Hires : Curs Off : Screen To Back 3
  117.    '
  118.    Screen Display 0,,59,,
  119.    Screen Display 1,,249,,
  120.    Screen Display 3,,240,,
  121. End Proc
  122. Procedure COPRBARS1
  123.    Rainbow Del 0 : Rainbow Del 1 : Rainbow Del 2 : Rainbow Del 3
  124.    Set Rainbow 0,0,16,"","","(1,2,7)(1,-2,7)" : Rainbow 0,0,46,16
  125.    Set Rainbow 1,0,16,"","","(1,2,7)(1,-2,7)" : Rainbow 1,3,239,10
  126.    Set Rainbow 2,0,32,"(1,1,15)(1,-1,15)","(1,1,15)(1,-1,15)",""
  127.    Rainbow 2,0,266,32
  128.    Screen 1 : Palette 0,0,$CCC
  129.    Screen 2 : Palette 0,$FF0 : Print "OZI-COMM V1.0"
  130.    Screen 3 : Palette 0,$FF0
  131. End Proc
  132. Procedure _DATE$
  133.    MTH$="JanFebMarAprMayJunJulAugSepOctNovDec"
  134.    '
  135.    ' Call DOS DateStamp function
  136.    T$=Space$(12)
  137.    Dreg(1)=Varptr(T$)
  138.    RIEN=Doscall(-192)
  139.    NJ=Leek(Varptr(T$))
  140.    '
  141.    ' Find this year's first day 
  142.    A=1978 : JOUR=7
  143.    Do 
  144.       BIS=0 : If(A and 3)=0 : BIS=1 : End If 
  145.       Exit If NJ-365-BIS<0
  146.       Add JOUR,1+BIS : If JOUR>7 : Add JOUR,-7 : End If 
  147.       Add NJ,-365-BIS
  148.       Inc A
  149.    Loop 
  150.    '
  151.    ' Find month 
  152.    M=1
  153.    Do 
  154.       Read N
  155.       Exit If NJ-N<0
  156.       Add NJ,-N : Inc M
  157.    Loop 
  158.    Inc NJ
  159.    '
  160.    ' Create the string
  161.    J$=Mid$(Str$(NJ),2) : If Len(J$)<2 : J$="0"+J$ : End If 
  162.    M$=Mid$(MTH$,(M-1)*3+1,3)
  163.    A$=Mid$(Str$(A),2)
  164.    '
  165.    ' Calculate day of week
  166.    '
  167.    Y=A : D=NJ
  168.    DAYTEXT$="SunMonTueWedThuFriSat"
  169.    M=M-2
  170.    If(M<1) or(M>10)
  171.       M=M+12 : Y=Y-1
  172.    End If 
  173.    C=Y/100
  174.    Y=Y mod 100
  175.    T=Int(2.6*M-0.19)+D+Y+(Y/4)
  176.    DAYNUM=(T+(C/4)-C-C) mod 7
  177.    If DAYNUM<0 Then DAYNUM=DAYNUM+7
  178.    D$=Mid$(DAYTEXT$,DAYNUM*3+1,3)
  179.    DATE$=D$+"  "+M$+" "+J$+", "+A$
  180.    '
  181.    ' Length of each month 
  182.    Data 31,28+BIS,31,30,31,30,31,31,30,31,30,31
  183.    '
  184. End Proc[DATE$]
  185. Procedure _TIME$
  186.    '
  187.    ' Call DOS function
  188.    T$=Space$(12)
  189.    Dreg(1)=Varptr(T$)
  190.    RIEN=Doscall(-192)
  191.    MN=Leek(Varptr(T$)+4)
  192.    SEC=Leek(Varptr(T$)+8)
  193.    '
  194.    ' Minutes calculation
  195.    H=MN/60 : H$=Mid$(Str$(H),2) : If Len(H$)<2 : H$="0"+H$ : End If 
  196.    M=MN mod 60 : M$=Mid$(Str$(M),2) : If Len(M$)<2 : M$="0"+M$ : End If 
  197.    '
  198.    ' Seconds calculation  
  199.    S=SEC/50 : S$=Mid$(Str$(S),2) : If Len(S$)<2 : S$="0"+S$ : End If 
  200.    '
  201.    ' Final string 
  202.    TIME$=H$+":"+M$+":"+S$
  203.    '
  204. End Proc[TIME$]
  205. Procedure GARBAGE
  206.    A$="A 0,(1,6)(2,6)(3,6)(1,6)(2,6)(3,6)(1,6)(2,6)(3,6)(1,6)(2,6)(3,6)(1,6)(2,6)(3,6)(4,3)(5,3)(7,3)(3,6);M -670,0,670"
  207.    Screen 0
  208.    Channel 2 To Bob 2
  209.    Bob 2,600,150,1
  210.    Amal 2,A$
  211.    Amal On 2
  212.    '
  213. End Proc