home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 551-575 / apd571 / colourmonitorv1_1.amos / colourmonitorv1_1.amosSourceCode
AMOS Source Code  |  1994-01-01  |  14KB  |  530 lines
  1. '
  2. '               Colour Monitor V1.1  
  3. '                  by Ivor King  
  4. '
  5. ' Read the DOCS on this disk for more information
  6. '
  7. 'Screen Close 0
  8. Break Off 
  9. Hide 
  10. Global TIME,REGMODE,GRAND$,R,RREG,C
  11. TIME=70
  12. REGMODE=False
  13. RREG=1
  14. Screen Open 2,640,50,16,Hires
  15. Colour 1,0
  16. Curs Pen 0
  17. Screen Open 3,640,48,16,Hires
  18. Colour 1,0
  19. Writing 0
  20. Curs Pen 0
  21. Pen 5
  22. Screen Display 3,128,290,640,48
  23. Screen Open 1,320,200,4096,Lowres
  24. Screen Display 1,128,88,320,250
  25. Colour 1,0
  26. Curs Off 
  27. Pen 0
  28. Screen Open 4,640,260,16,Hires
  29. Colour 11,3816
  30. Colour 14,191
  31. Writing 0
  32. Colour 1,3
  33. Curs Pen 1
  34. INROD
  35. MENU_SETUP
  36. SCR3_SETUP
  37. CHOSE:
  38.    Screen 2
  39.       If Param=1
  40.          Screen Hide 4
  41.          DEMOMODE_A
  42.          MENU_SETUP
  43.          Goto CHOSE
  44.       Else 
  45.          If Param=2
  46.             Screen Hide 4
  47.             DEMOMODE_B
  48.             MENU_SETUP
  49.             Goto CHOSE
  50.          Else 
  51.             If Param=3
  52.                Screen Hide 4
  53.                MOUSE_MODE
  54.                MENU_SETUP
  55.                Goto CHOSE
  56.             Else 
  57.                If Param=4
  58.                   TIME_CHANGE
  59.                   MENU_SETUP
  60.                   Goto CHOSE
  61.                Else 
  62.                   If Param=5
  63.                      CHECK_MODE
  64.                      MENU_SETUP
  65.                      Goto CHOSE
  66.                   End If 
  67.                End If 
  68.             End If 
  69.          End If 
  70.       End If 
  71.    Screen Hide 4
  72.    Screen 1
  73.    Screen To Back 4
  74.    Screen To Front 1
  75.    Screen To Front 2
  76.    Screen To Front 3
  77.    Screen 2
  78.    Cls 
  79.    Print "You have entered normal mode... simply type in the value/register at the prompt:"
  80.    Pen 4 : Centre "hold down MB & press RETURN to return to menu"
  81.    Locate 0,4
  82.    Pen 2
  83.    Do 
  84.       Screen 2
  85.       If REGMODE=False
  86.          BEGGER1:
  87.             Input "Enter value: ";X
  88.             If Mouse Key<>0
  89.                MENU_SETUP : Goto CHOSE
  90.             End If 
  91.             If X>4096 or X<0
  92.                Print "Keep the value between 0 and 4096"
  93.                Goto BEGGER1
  94.             End If 
  95.             R=X
  96.             Screen 1
  97.             Colour 1,R
  98.       Else 
  99.          BEGGER2:
  100.             Input "Enter register: ";X
  101.             If Mouse Key<>0
  102.                MENU_SETUP : Goto CHOSE
  103.             End If 
  104.             If X>4096 or X<0
  105.                Print "Keep the register between 0 and 4096"
  106.                Goto BEGGER2
  107.             End If 
  108.             RREG=X
  109.             Screen 1
  110.             Cls RREG
  111.       End If 
  112.       C=Colour(RREG)
  113.       Screen 3
  114.       Pen 5
  115.       Locate 73,0
  116.       Print RREG;"      "
  117.       Locate 27,0
  118.       Print C;"   "
  119.       GRAND$=Hex$(C)
  120.       GRAND$=GRAND$-"$"
  121.       LEG=Len(GRAND$)
  122.       Locate 13,0
  123.       If LEG=1
  124.          Print "$00";GRAND$
  125.       Else 
  126.          If LEG=2
  127.             Print "$0";GRAND$
  128.          Else 
  129.             Print "$";GRAND$
  130.          End If 
  131.       End If 
  132.       If LEG=1
  133.          Locate 40,0 : Print "$0"
  134.          Locate 50,0 : Print "$0"
  135.          Locate 59,0 : Print "$";GRAND$
  136.       Else 
  137.          If LEG=2
  138.             Locate 40,0 : Print "$0"
  139.             Locate 50,0 : Print "$";GRAND$-Right$(GRAND$,1)
  140.             Locate 59,0 : Print "$";GRAND$-Left$(GRAND$,1)
  141.          Else 
  142.             Locate 40,0 : Print "$";Left$(GRAND$,1)
  143.             Locate 50,0 : Print "$";Mid$(GRAND$,2,1)
  144.             Locate 59,0 : Print "$";Right$(GRAND$,1)
  145.          End If 
  146.       End If 
  147.    Loop 
  148. '
  149. Procedure INROD
  150.    Under On 
  151.    Colour 12,3743
  152.    Pen 12
  153.    Locate 0,1
  154.    Centre "COLOUR MONITOR VERSION 1.1 "
  155.    Under Off 
  156.    Cdown : Cdown 
  157.    Colour 13,3874
  158.    Pen 13
  159.    Centre "by Ivor King"
  160.    Pen 2
  161.    Cdown : Cdown : Cdown : Centre "This program is public domain and can be used by anyone."
  162.    Cdown : Cdown : Cdown : Centre "This program is designed mainly for AMOS programmers, to allow"
  163.    Cdown : Centre "them to test colour values and registers for use in their programs."
  164.    Cdown : Cdown : Centre "It was programmed in AMOS and completed on the 13/7/92."
  165.    Home : Locate 4,14 : Print "Instructions for use:"
  166.    Cdown : Centre "At the prompt 'Enter value' type in the colour's value"
  167.    Cdown : Centre "in either;"
  168.    Cdown : Cdown : Pen 4 : Centre "HEXADECIMAL or INTEGER form." : Cdown 
  169.    Pen 2 : Cdown : Centre "(Note: hexadecimal numbers must be preceeded by a '$' sign) "
  170.    Cdown : Cdown : Centre "Read the DOCS on disk for more information, and if you copy this program,"
  171.    Cdown : Centre "PLEASE include them on your destination disk!"
  172.    Cdown : Cdown : Centre "I hope COMV1.1 is of some use to you."
  173.    Cdown : Cdown : Cdown : Pen 4 : Centre "MB to continue."
  174.    Repeat 
  175.    Until Mouse Key
  176. End Proc
  177. '
  178. Procedure MENU_SETUP
  179.    Screen 4
  180.    Screen To Front 4
  181.    Screen Show 4
  182.    Cls 
  183.    Under On 
  184.    Pen 12
  185.    Locate 0,1
  186.    Centre "M A I N   M E N U :"
  187.    For Z=1 To 23
  188.       Cleft 
  189.    Next Z
  190.    Locate 0,3
  191.    Pen 2 : Under Off 
  192.    Cdown : Cdown : Print "                   1  -  for demo mode A"
  193.    Cdown : Cdown : Print "                   2  -  for demo mode B"
  194.    Cdown : Cdown : Print "                   3  -  for mouse mode"
  195.    Cdown : Cdown : Print "                   4  -  to change pause time for demo modes A & B"
  196.    Cdown : Cdown : Print "                   5  -  to toggle colour register/value mode"
  197.    Pen 11
  198.    Cdown : Cdown : Print "              RETURN  -  default mode, as detailed on intro screen"
  199.    Pen 2
  200.    Cdown : Cdown : Print "                   6  -  to quit"
  201.    Locate 0,27
  202.    Pen 4
  203.    Print "(In mouse mode, make sure your printer is READY if you intend to print"
  204.    Print "or the computer will FREEZE UP!)"
  205.    Cdown 
  206.    Pen 14
  207.    If REGMODE
  208.       MOOD$="COLOUR REGISTER mode"
  209.    Else 
  210.       MOOD$="COLOUR VALUE mode"
  211.    End If 
  212.    Locate 0,29
  213.    Print "You are currently in ";MOOD$
  214.    Pen 2
  215.    Input "Type your choice: ";CHOOSER
  216.    If CHOOSER=6 Then End 
  217. End Proc[CHOOSER]
  218. '
  219. Procedure DEMOMODE_A
  220.    Screen 1
  221.    Screen To Back 4
  222.    Screen To Front 1
  223.    Screen To Front 2
  224.    Screen To Front 3
  225.    Screen 2
  226.    Cls 
  227.    Centre "You have entered demo mode A"
  228.    Cdown 
  229.    Locate 0,2 : Print "           The computer is randomly generating numbers between 1 and 4096"
  230.    Cdown 
  231.    Pen 4 : Centre "Press any key to return to menu" : Pen 2
  232.    Screen 3
  233.    Wait TIME
  234.    Do 
  235.       Screen 1
  236.       R1=Rnd(4096)
  237.       K$=Inkey$
  238.       If K$<>"" Then Pop Proc
  239.       Colour 1,R1
  240.       C=Colour(1)
  241.       Screen 3
  242.       Pen 5
  243.       Locate 27,0
  244.       Print C;"   "
  245.       GRAND$=Hex$(C)
  246.       GRAND$=GRAND$-"$"
  247.       LEG=Len(GRAND$)
  248.       Locate 13,0
  249.       If LEG=1
  250.          Print "$00";GRAND$
  251.       Else 
  252.          If LEG=2
  253.             Print "$0";GRAND$
  254.          Else 
  255.             Print "$";GRAND$
  256.          End If 
  257.       End If 
  258.       If LEG=1
  259.          Locate 40,0 : Print "$0"
  260.          Locate 50,0 : Print "$0"
  261.          Locate 59,0 : Print "$";GRAND$
  262.       Else 
  263.          If LEG=2
  264.             Locate 40,0 : Print "$0"
  265.             Locate 50,0 : Print "$";GRAND$-Right$(GRAND$,1)
  266.             Locate 59,0 : Print "$";GRAND$-Left$(GRAND$,1)
  267.          Else 
  268.             Locate 40,0 : Print "$";Left$(GRAND$,1)
  269.             Locate 50,0 : Print "$";Mid$(GRAND$,2,1)
  270.             Locate 59,0 : Print "$";Right$(GRAND$,1)
  271.          End If 
  272.       End If 
  273.       Wait TIME
  274.    Loop 
  275. End Proc
  276. '
  277. Procedure DEMOMODE_B
  278.    Screen 1
  279.    Screen To Back 4
  280.    Screen To Front 1
  281.    Screen To Front 2
  282.    Screen To Front 3
  283.    Screen 2
  284.    Cls 
  285.    Centre "You have entered demo mode B"
  286.    Cdown : Cdown : Centre "The computer is gradually incrementing the colour value by 1"
  287.    Cdown : Cdown 
  288.    Pen 4 : Centre "Press any key to return to menu"
  289.    Pen 2
  290.    CREG=0
  291.    Do 
  292.       Wait TIME
  293.       Screen 1
  294.       K$=Inkey$
  295.       If K$<>"" Then Pop Proc
  296.       Colour 1,CREG
  297.       C=Colour(1)
  298.       Screen 3
  299.       Pen 5
  300.       Locate 27,0
  301.       Print C;"   "
  302.       CREG=CREG+1
  303.       If CREG=4096 Then CREG=0
  304.       GRAND$=Hex$(C)
  305.       GRAND$=GRAND$-"$"
  306.       LEG=Len(GRAND$)
  307.       Locate 13,0
  308.       If LEG=1
  309.          Print "$00";GRAND$
  310.       Else 
  311.          If LEG=2
  312.             Print "$0";GRAND$
  313.          Else 
  314.             Print "$";GRAND$
  315.          End If 
  316.       End If 
  317.       If LEG=1
  318.          Locate 40,0 : Print "$0"
  319.          Locate 50,0 : Print "$0"
  320.          Locate 59,0 : Print "$";GRAND$
  321.       Else 
  322.          If LEG=2
  323.             Locate 40,0 : Print "$0"
  324.             Locate 50,0 : Print "$";GRAND$-Right$(GRAND$,1)
  325.             Locate 59,0 : Print "$";GRAND$-Left$(GRAND$,1)
  326.          Else 
  327.             Locate 40,0 : Print "$";Left$(GRAND$,1)
  328.             Locate 50,0 : Print "$";Mid$(GRAND$,2,1)
  329.             Locate 59,0 : Print "$";Right$(GRAND$,1)
  330.          End If 
  331.       End If 
  332.    Loop 
  333. End Proc
  334. '
  335. Procedure TIME_CHANGE
  336.    Screen 4
  337.    Cls 
  338.    Pen 2
  339.    Home 
  340.    STONT:
  341.    Input "How long would you like the new pause to be (it is currently 70 computer        seconds)? ";TIME
  342.    If TIME>300 or TIME<5 Then Print "Try again..." : Goto STONT
  343. End Proc
  344. '
  345. Procedure MOUSE_MODE
  346.    Screen 1
  347.    Screen To Back 4
  348.    Screen To Front 1
  349.    Screen To Front 2
  350.    Screen To Front 3
  351.    Screen 2
  352.    Cls 
  353.    Centre "You have entered mouse mode"
  354.    Cdown : Pen 4 : Cdown : Centre "Right MB to increase colour value/register by 1, Left MB to decrease it"
  355.    Cdown : Centre "`=' to increase value/register by 100, `-' to decrease it"
  356.    Cdown : Centre "`p' to print Hexadecimal, RGB, Integer and Register of the current colour"
  357.    Cdown 
  358.    Pen 6
  359.    Centre "press any key to return to menu"
  360.    Do 
  361.       LLOOP:
  362.          Repeat 
  363.             K$=Inkey$
  364.             MK=Mouse Key
  365.          Until K$<>"" or MK<>0
  366.          If K$="p"
  367.             GRAND$=Hex$(C)
  368.             GRAND$=GRAND$-"$"
  369.             LEG=Len(GRAND$)
  370.             If LEG=1
  371.                Lprint "Hexadecimal: ";"$00";GRAND$;"  Red: $0";"  Green: $0";"  Blue: $";GRAND$;"  Integer:";C;"  Register: ";RREG
  372.             Else 
  373.                If LEG=2
  374.                   Lprint "Hexadecimal: ";"$0";GRAND$;"  Red: $0";"  Green: $";GRAND$-Right$(GRAND$,1);"  Blue: $";GRAND$-Left$(GRAND$,1);"  Integer:";C;"  Register: ";RREG
  375.                Else 
  376.                   Lprint "Hexadecimal: ";"$";GRAND$;"  Red: $";Left$(GRAND$,1);"  Green: $";Mid$(GRAND$,2,1);"  Blue: $";Right$(GRAND$,1);"  Integer:";C;"  Register:";RREG
  377.                End If 
  378.             End If 
  379.             Goto LLOOP
  380.          End If 
  381.          If REGMODE=False
  382.             If K$="-"
  383.                R=R-100
  384.                Goto LABEL1
  385.             Else 
  386.                If K$="="
  387.                   R=R+100
  388.                   Goto LABEL1
  389.                Else 
  390.                   If K$<>""
  391.                      Pop Proc
  392.                   End If 
  393.                End If 
  394.             End If 
  395.          Else 
  396.             If K$="-"
  397.                If RREG-100>-1
  398.                   RREG=RREG-100
  399.                   Goto LABEL1
  400.                Else 
  401.                   Goto LLOOP
  402.                End If 
  403.             Else 
  404.                If K$="="
  405.                   If RREG+100<4097
  406.                      RREG=RREG+100
  407.                      Goto LABEL1
  408.                   Else 
  409.                      Goto LLOOP
  410.                   End If 
  411.                Else 
  412.                   If K$<>""
  413.                      Pop Proc
  414.                   End If 
  415.                End If 
  416.             End If 
  417.          End If 
  418.       LABEL1:
  419.          If REGMODE=False
  420.             If MK=1
  421.                R=R-1
  422.             Else 
  423.                R=R+1
  424.             End If 
  425.             Screen 1
  426.             Colour 1,R
  427.          Else 
  428.             If MK=1
  429.                If RREG-1>-1
  430.                   RREG=RREG-1
  431.                End If 
  432.             Else 
  433.                If RREG+1<4097
  434.                   RREG=RREG+1
  435.                End If 
  436.             End If 
  437.             Screen 1
  438.             Cls RREG
  439.          End If 
  440.          C=Colour(RREG)
  441.          Screen 3
  442.          Pen 5
  443.          Locate 73,0
  444.          Print RREG;"      "
  445.          Locate 27,0
  446.          Print C;"   "
  447.          GRAND$=Hex$(C)
  448.          GRAND$=GRAND$-"$"
  449.          LEG=Len(GRAND$)
  450.          Locate 13,0
  451.          If LEG=1
  452.             Print "$00";GRAND$
  453.          Else 
  454.             If LEG=2
  455.                Print "$0";GRAND$
  456.             Else 
  457.                Print "$";GRAND$
  458.             End If 
  459.          End If 
  460.          If LEG=1
  461.             Locate 40,0 : Print "$0"
  462.             Locate 50,0 : Print "$0"
  463.             Locate 59,0 : Print "$";GRAND$
  464.          Else 
  465.             If LEG=2
  466.                Locate 40,0 : Print "$0"
  467.                Locate 50,0 : Print "$";GRAND$-Right$(GRAND$,1)
  468.                Locate 59,0 : Print "$";GRAND$-Left$(GRAND$,1)
  469.             Else 
  470.                Locate 40,0 : Print "$";Left$(GRAND$,1)
  471.                Locate 50,0 : Print "$";Mid$(GRAND$,2,1)
  472.                Locate 59,0 : Print "$";Right$(GRAND$,1)
  473.             End If 
  474.          End If 
  475.    Loop 
  476. End Proc
  477. '
  478. Procedure CHECK_MODE
  479.    Screen 4
  480.    If REGMODE=False
  481.       Cls 
  482.       Locate 0,5
  483.       Centre "You have now entered into register mode."
  484.       Cdown : Centre "This will give you the default colour value corresponding to the register"
  485.       Cdown : Centre "you type in at the prompt.  These are the default colours"
  486.       Cdown : Centre "AMOS assigns to each register when a screen of the currently"
  487.       Cdown : Centre "used type is first opened."
  488.       Cdown : Cdown : Pen 4 : Centre "MB to continue."
  489.       Pen 2
  490.       Repeat : Until Mouse Key
  491.       REGMODE=True
  492.    Else 
  493.       Cls 
  494.       Locate 0,10
  495.       Centre "You have now exitted the register mode, and are back in normal mode"
  496.       Cdown : Cdown : Pen 4 : Centre "MB to continue."
  497.       Pen 2
  498.       Repeat : Until Mouse Key
  499.       REGMODE=False
  500.       RREG=1
  501.       Screen 1 : Cls 1
  502.    End If 
  503. End Proc
  504. '
  505. Procedure SCR3_SETUP
  506.    Screen 3
  507.    Pen 2
  508.    Home 
  509.    Print "Hexadecimal:"
  510.    Locate 19,0
  511.    Print "Integer:"
  512.    Locate 35,0
  513.    Print "Red:"
  514.    Locate 43,0
  515.    Print "Green:"
  516.    Locate 53,0
  517.    Print "Blue:"
  518.    Locate 64,0
  519.    Print "Register:"
  520.    If REGMODE=False
  521.       Locate 74,0
  522.       Pen 5
  523.       Print "1"
  524.    End If 
  525. End Proc
  526. '
  527. End 
  528. '
  529. '
  530. '(C) 1992 KING Software