home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 326-350 / apd347 / easybase.amos / easybase.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1992-09-02  |  9.0 KB  |  403 lines
  1. Rem                    ********
  2. Rem  ************** EasyBase1200 **************    
  3. Rem   ********** Bill Currie 1993 ***********    
  4. Rem             *******************  
  5. '
  6. Rem AMOS copyright notice  
  7. '
  8. AMOSC
  9. Procedure AMOSC
  10.    Screen Open 0,320,256,32,Lowres
  11.    Curs Off : Paper 0 : Cls 0 : CB[0]
  12.    Get Icon Palette 
  13.    Locate 0,1
  14.    Centre ">>> Program by Bill Currie <<<"
  15.    Flash 3,"(f00,32)(f80,32)(ff0,32)(0f0,32)(08f,32)(88f,32)(f0f,32)"
  16.    Pen 3 : Ink 3 : Box 50,40 To 270,150
  17.    Locate 0,11
  18.    Centre Border$("EasyBase",1)
  19.    Ink 0 : Pen 2
  20.    Paste Icon 230,20,2
  21.    _SMALL_COPYRIGHT[225]
  22. End Proc
  23. Procedure _SMALL_COPYRIGHT[YDISPLAY]
  24.    '
  25.    Auto View Off 
  26.    '  
  27.    Screen Open 7,320,24,16,0 : Curs Off : Flash Off : Cls 0
  28.    Screen Display 7,,-100,,
  29.    Paste Bob 260,3,1
  30.    Paper 0 : Pen 7 : Print At(1,1);"This program was written using"
  31.    Get Sprite Palette 
  32.    View : Wait Vbl 
  33.    '
  34.    For Y=1 To Screen Height/2
  35.       Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
  36.       Screen Offset 7,,Screen Height/2-Y
  37.       View : Wait Vbl 
  38.    Next 
  39.    '
  40.    Do 
  41.       If Mouse Key=1 Then Exit 
  42.    Loop 
  43.    '
  44.    For Y=Screen Height/2 To 0 Step -1
  45.       Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
  46.       Screen Offset 7,,Screen Height/2-Y
  47.       View : Wait Vbl 
  48.    Next 
  49.    '
  50.    Screen Close 7
  51.    Auto View On 
  52.    '
  53.    Cls 
  54. End Proc
  55. '
  56. Limit Mouse 
  57. EASYBASE
  58. Procedure EASYBASE
  59.    BEGINOVER:
  60.    Screen Open 0,320,256,4,Lowres
  61.    Curs Off : Colour 0,$77 : Paper 0 : Cls 0 : CB[0]
  62.    Locate 0,10 : Centre "Easy Base"
  63.    THEMENU
  64.    Do 
  65.       Menu Off 
  66.       Menu On 
  67.       BL=0
  68.       If Key State(95)=True Then HELP
  69.       If Choice<>-1 Then Goto NOCHOICE
  70.       If Choice(1)=1 and Choice(2)=1 Then MAKE_BASE : Goto BEGINOVER
  71.       If Choice(1)=1 and Choice(2)=2 Then SEE_BASE : Goto BEGINOVER
  72.       If Choice(1)=1 and Choice(2)=3 Then AMEND_BASE : Goto BEGINOVER
  73.       If Choice(1)=1 and Choice(2)=4 Then DELETE_BASE : Goto BEGINOVER
  74.       If Choice(1)=1 and Choice(2)=5 Then HELP : Goto BEGINOVER
  75.       If Choice(1)=1 and Choice(2)=6 Then AMOSC : End 
  76.       NOCHOICE:
  77.    Loop 
  78. End Proc
  79. Procedure THEMENU
  80.    Menu Del 
  81.    Menu$(1)=" Options "
  82.    Menu$(1,1)=' Make Base '
  83.    Menu$(1,2)=' See Base '
  84.    Menu$(1,3)=' Amend Base '
  85.    Menu$(1,4)=' Delete Base '
  86.    Menu$(1,5)=" Help      "
  87.    Menu$(1,6)=' Quit      '
  88.    Menu$(1,7)=' (in1,1)(lo8,0)(ss6)A(lo18,0)(ss0)A <> WB'
  89. End Proc
  90. '
  91. '
  92. Procedure BASE_SCREEN
  93.    Screen Open 0,640,256,8,Hires
  94.    Curs Off : Flash Off : Colour 3,$FF0 : Colour 0,$77 : Cls 0
  95.    Paper 0 : Pen 3 : Centre "Easy Base"
  96.    Paper 1
  97.    Wind Open 1,16,16,76,28
  98.    Clw 
  99.    Paper 0
  100.    Wind Open 2,32,32,72,1
  101.    Clw 
  102.    Wind Open 3,32,48,72,1
  103.    Clw 
  104.    Wind Open 4,32,64,72,1
  105.    Clw 
  106.    Wind Open 5,32,80,72,1
  107.    Clw 
  108.    Wind Open 6,32,96,72,1
  109.    Clw 
  110.    Wind Open 7,32,112,72,1
  111.    Clw 
  112.    Wind Open 8,32,128,72,1
  113.    Clw 
  114.    Wind Open 9,32,144,72,1
  115.    Clw 
  116.    Wind Open 10,32,160,72,1
  117.    Clw 
  118.    Wind Open 11,32,176,72,1
  119.    Clw 
  120.    Wind Open 12,32,192,72,1
  121.    Clw 
  122.    Wind Open 13,32,208,72,1
  123.    Clw 
  124. End Proc
  125. Procedure MAKE_BASE
  126.    BASE_SCREEN
  127.    Window 2 : Clw 
  128.    Input "Base File Name ";F$;
  129.    If F$="" Then Goto XIT
  130.    If Exist(F$)
  131.       Window 3 : Clw 
  132.       Print "File ";F$;" already exists!";
  133.       While Inkey$<>"" : Wend 
  134.       While Inkey$="" : Wend 
  135.       Goto XIT
  136.    End If 
  137.    Open Random 1,F$
  138.    Field 1,70 As A$,70 As B$,70 As C$,70 As D$,70 As E$,70 As F$,70 As G$,70 As H$,70 As I$,70 As J$
  139.    For I=1 To 50
  140.       A$=" " : B$=" " : C$=" " : D$=" " : E$=" "
  141.       F$=" " : G$=" " : H$=" " : I$=" " : J$=" "
  142.       Put 1,I
  143.    Next I
  144.    Do 
  145.       For I=3 To 13 : Window I : Clw : Next I
  146.       Window 3 : Clw 
  147.       Input "Record No {1 - 50, 0 to Exit} ";R;
  148.       Exit If R=0
  149.       Window 4 : Clw 
  150.       Input "";A$;
  151.       A$=Left$(A$,70)
  152.       Window 5 : Clw 
  153.       Input "";B$;
  154.       B$=Left$(B$,70)
  155.       Window 6 : Clw 
  156.       Input "";C$;
  157.       C$=Left$(C$,70)
  158.       Window 7 : Clw 
  159.       Input "";D$;
  160.       D$=Left$(D$,70)
  161.       Window 8 : Clw 
  162.       Input "";E$;
  163.       E$=Left$(E$,70)
  164.       Window 9 : Clw 
  165.       Input "";F$;
  166.       F$=Left$(F$,70)
  167.       Window 10 : Clw 
  168.       Input "";G$;
  169.       G$=Left$(G$,70)
  170.       Window 11 : Clw 
  171.       Input "";H$;
  172.       H$=Left$(H$,70)
  173.       Window 12 : Clw 
  174.       Input "";I$;
  175.       I$=Left$(I$,70)
  176.       Window 13 : Clw 
  177.       Input "";J$;
  178.       J$=Left$(J$,70)
  179.       Put 1,R
  180.    Loop 
  181.    Close 1
  182.    XIT:
  183. End Proc
  184. Procedure SEE_BASE
  185.    BASE_SCREEN
  186.    Window 2 : Clw 
  187.    Input "Base File Name ";F$;
  188.    If F$="" Then Goto XIT
  189.    If Not Exist(F$)
  190.       Print "File ";F$;" does not exist!";
  191.       While Inkey$<>"" : Wend 
  192.       While Inkey$="" : Wend 
  193.       Goto XIT
  194.    End If 
  195.    Open Random 1,F$
  196.    Field 1,70 As A$,70 As B$,70 As C$,70 As D$,70 As E$,70 As F$,70 As G$,70 As H$,70 As I$,70 As J$
  197.    Do 
  198.       For I=3 To 13 : Window I : Clw : Next I
  199.       Window 3 : Clw 
  200.       Input "Record No {1 - 50, 0 to Exit} ";R;
  201.       Exit If R=0
  202.       Get 1,R
  203.       Window 4 : Clw 
  204.       Print A$;
  205.       Window 5 : Clw 
  206.       Print B$;
  207.       Window 6 : Clw 
  208.       Print C$;
  209.       Window 7 : Clw 
  210.       Print D$;
  211.       Window 8 : Clw 
  212.       Print E$;
  213.       Window 9 : Clw 
  214.       Print F$;
  215.       Window 10 : Clw 
  216.       Print G$;
  217.       Window 11 : Clw 
  218.       Print H$;
  219.       Window 12 : Clw 
  220.       Print I$;
  221.       Window 13 : Clw 
  222.       Print J$;
  223.       Window 1 : Curs Off : Paper 1
  224.       Locate 0,26 : Centre "[P]rint    [next]"
  225.       CHOOSE:
  226.       K$="" : While K$="" : K$=Inkey$ : Wend 
  227.       If(K$="P") or(K$="p")
  228.          On Error Goto ER
  229.          Goto OK
  230.          ER:
  231.          ERR
  232.          Resume CHOOSE
  233.          OK:
  234.          Open Port 2,"Prt:"
  235.          On Error Goto ER2
  236.          Goto OK2
  237.          ER2:
  238.          ERR
  239.          Close 2
  240.          Resume CHOOSE
  241.          OK2:
  242.          Print #2,""
  243.          Print #2,A$
  244.          Print #2,B$
  245.          Print #2,C$
  246.          Print #2,D$
  247.          Print #2,E$
  248.          Print #2,F$
  249.          Print #2,G$
  250.          Print #2,H$
  251.          Print #2,I$
  252.          Print #2,J$
  253.          Print #2,""
  254.          Close 2
  255.          Goto CHOOSE
  256.       End If 
  257.       Cline 
  258.       Paper 0
  259.    Loop 
  260.    Close 1
  261.    XIT:
  262. End Proc
  263. '
  264. Procedure AMEND_BASE
  265.    BASE_SCREEN
  266.    Window 2 : Clw 
  267.    Input "Base File Name ";F$;
  268.    If F$="" Then Goto XIT
  269.    If Not Exist(F$)
  270.       Print "File ";F$;" does not exist!";
  271.       While Inkey$<>"" : Wend 
  272.       While Inkey$="" : Wend 
  273.       Goto XIT
  274.    End If 
  275.    Open Random 1,F$
  276.    Field 1,70 As A$,70 As B$,70 As C$,70 As D$,70 As E$,70 As F$,70 As G$,70 As H$,70 As I$,70 As J$
  277.    Do 
  278.       For I=3 To 13 : Window I : Clw : Next I
  279.       Window 3 : Clw 
  280.       Input "Record No {1 - 50, 0 to Exit} ";R;
  281.       Exit If R=0
  282.       Window 4 : Clw 
  283.       Input "";A$;
  284.       A$=Left$(A$,70)
  285.       Window 5 : Clw 
  286.       Input "";B$;
  287.       B$=Left$(B$,70)
  288.       Window 6 : Clw 
  289.       Input "";C$;
  290.       C$=Left$(C$,70)
  291.       Window 7 : Clw 
  292.       Input "";D$;
  293.       D$=Left$(D$,70)
  294.       Window 8 : Clw 
  295.       Input "";E$;
  296.       E$=Left$(E$,70)
  297.       Window 9 : Clw 
  298.       Input "";F$;
  299.       F$=Left$(F$,70)
  300.       Window 10 : Clw 
  301.       Input "";G$;
  302.       G$=Left$(G$,70)
  303.       Window 11 : Clw 
  304.       Input "";H$;
  305.       H$=Left$(H$,70)
  306.       Window 12 : Clw 
  307.       Input "";I$;
  308.       I$=Left$(I$,70)
  309.       Window 13 : Clw 
  310.       Input "";J$;
  311.       J$=Left$(J$,70)
  312.       Put 1,R
  313.    Loop 
  314.    Close 1
  315.    XIT:
  316. End Proc
  317. Procedure DELETE_BASE
  318.    BASE_SCREEN
  319.    Window 2 : Clw 
  320.    Input "Base File Name ";F$;
  321.    If F$="" Then Goto XIT
  322.    If Not Exist(F$)
  323.       Window 3 : Clw 
  324.       Print "File ";F$;" does not exist!";
  325.       While Inkey$<>"" : Wend 
  326.       While Inkey$="" : Wend 
  327.       Goto XIT
  328.    End If 
  329.    Window 3 : Clw 
  330.    Print "/!\ IRREVERSIBLE /!\ Delete ";F$;" Y/N ? ";
  331.    Do 
  332.       A$=Inkey$
  333.       If(A$="Y") or(A$="y") Then Kill F$ : Exit 
  334.       If(A$="N") or(A$="n") Then Exit 
  335.    Loop 
  336.    XIT:
  337. End Proc
  338. '
  339. Procedure HELP
  340.    Cls 0
  341.    On Error Goto ER
  342.    Goto OK
  343.    ER:
  344.    ERR
  345.    Resume XIT
  346.    OK:
  347.    Screen Open 2,640,256,4,Hires
  348.    Curs Off : Colour 0,$77 : Paper 0 : Cls 0 : CB[0]
  349.    Colour 1,$FF
  350.    Locate 0,5 : Centre " EasyBase "
  351.    Locate 0,10 : Centre "Free Form !!"
  352.    Locate 0,13 : Centre "50 Records"
  353.    Locate 0,16 : Centre "10 Items per Record"
  354.    Locate 0,19 : Centre "70 Characters per Item"
  355.    Ink 1 : Box 50,10 To 580,220
  356.    While Mouse Key<>0 : Wend 
  357.    While Key State(90)=True : Wend 
  358.    Do 
  359.       If(Mouse Key=1) or(Key State(95)) Then Exit 
  360.    Loop 
  361.    Screen Close 2
  362.    Wait 50
  363.    XIT:
  364. End Proc
  365. '
  366. Procedure ERR
  367.    On Error Goto ER
  368.    Goto OK
  369.    ER:
  370.    Resume XIT
  371.    OK:
  372.    Screen Open 3,320,48,4,Hires
  373.    Screen Display 3,200,100,320,48
  374.    Curs Off : Cls 1 : Colour 0,$70
  375.    Print : Centre "Error - Out of Memory/Range?"
  376.    Print 
  377.    Print : Centre "Press Left Mouse Key"
  378.    Wait 50
  379.    Do : Exit If Mouse Key=1 : Loop 
  380.    Screen Close 3
  381.    XIT:
  382. End Proc
  383. '
  384. Procedure CB[IV]
  385.    On Error Goto ER
  386.    Goto OK
  387.    ER:
  388.    ERR
  389.    Resume XIT
  390.    OK:
  391.    Colour Back(Colour(IV))
  392.    Rem Dummy Screen 
  393.    Screen Open 6,16,8,2,Lowres
  394.    Screen Display 6,0,0,16,8
  395.    Screen Close 6
  396.    Wait 50
  397.    XIT:
  398. End Proc
  399. '
  400. Rem
  401. Rem                    *********** 
  402. Rem                   **** End ****  
  403. Rem ***************************************************