home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 36.dms / 36.adf / crayons.bas < prev    next >
BASIC Source File  |  1988-05-22  |  4KB  |  110 lines
  1. 10    'CRAYONS! - Robert Sawdey - 10/21/85
  2. 20    ' title1
  3. 30    screen 0,4,0:scnclr:print " "
  4. 40    rgb 0,0,0,0:rgb 1,0,0,0:rgb 2,12,0,12:rgb 3,5,13,0:rgb 4,0,0,0:rgb 15,0,0,0
  5. 50    peno 4:box(68,6;240,166),0:print at (11,9);"Created exclusively";at (19,11);"for";at (12,13);"Slipped Disk Inc."
  6. 60    pena 0:box(14,14;153,40),1:print at (4,4);"C R A Y O N S !"
  7. 70    box(166,136;288,158),1:print at (23,19);"Robert Sawdey"
  8. 80    pena 2:paint(95,50),1:rgb 4,15,15,2:pena 3:paint(16,16),1:paint(170,140),1:sleep(1000000)*5
  9. 90    for j%=0 to 15:for i%=2 to 4:ask rgb i%,r%,g%,b%
  10. 100   if r%>0 then r%=r%-1
  11. 110   if g%>0 then g%=g%-1
  12. 120   if b%>0 then b%=b%-1
  13. 130   rgb i%,r%,g%,b%:sleep(12000):next i%:next j%
  14. 140   '   setup pallet
  15. 150   rgb 0,0,0,0:' screen color
  16. 160   rgb 1,15,15,15:'  text color
  17. 170   rgb 2,0,0,15:'    border
  18. 180   rgb 3,0,15,7
  19. 190   rgb 4,15,15,0
  20. 200   rgb 5,15,10,0
  21. 210   rgb 6,15,0,0
  22. 220   rgb 7,15,0,15
  23. 230   rgb 15,15,15,15
  24. 240   '   initialize
  25. 250   pena 1:penb 1:peno 1:scnclr:print" "
  26. 260   print at (12,5);"C R A Y O N S !"
  27. 270   print at (6,7);"Point & Press to Select Mode"
  28. 280   print at (11,9);"Select * to Quit"
  29. 290   print at (5,11);"Press & release Two Points for"
  30. 300   print at (8,13);"Lines, Boxes, and Circles":print at (1,1);"";
  31. 310   sleep(1000000)*5:mode%=1:scnclr:goto 400
  32. 320   if x%<300 then mode%=5
  33. 330   if x%<257 then mode%=4
  34. 340   if x%<201 then mode%=3
  35. 350   if x%<169 then mode%=2
  36. 360   if x%<129 then mode%=1
  37. 370   if x%<89 and x%>46 then gosub 500:mode%=save%:goto 410
  38. 380   if x%<41 and x%>14 then scnclr:mode%=save%:goto 410
  39. 390   if x%<9 then goto 1070
  40. 400   save%=mode%
  41. 410   print at (1,1);"*";inverse(1);" New Color Draw Line Box Circle Fill"
  42. 420   if mode%=1 then print at (13,1);"Draw"
  43. 430   if mode%=2 then print at (18,1);"Line"
  44. 440   if mode%=3 then print at (23,1);"Box"
  45. 450   if mode%=4 then print at (27,1);"Circle"
  46. 460   if mode%=5 then print at (34,1);"Fill"
  47. 470   print at (1,1);"";
  48. 480   on mode% gosub 670,720,820,920,1010
  49. 490   goto 320
  50. 500   drawmode 0:'   COLOR
  51. 510   for i%=0 to 7
  52. 520   peno i%:pena i%:box(i%*37,0;i%*37+36,7),1
  53. 530   next
  54. 540   ask mouse x%,y%,b%:if b%<>0 then goto 540
  55. 550   ask mouse x%,y%,b%:if b%=0 then goto 550
  56. 560   if y%>9 then goto 550
  57. 570   if x%<295 then c%=7
  58. 580   if x%<258 then c%=6
  59. 590   if x%<221 then c%=5
  60. 600   if x%<184 then c%=4
  61. 610   if x%<147 then c%=3
  62. 620   if x%<110 then c%=2
  63. 630   if x%<73 then c%=1
  64. 640   if x%<36 then c%=0
  65. 650   pena c%:penb c%:peno c%
  66. 660   return
  67. 670   drawmode 0:'   DRAW
  68. 680   ask mouse x%,y%,b%:if b%<>0 then goto 680
  69. 690   ask mouse x%,y%,b%:if b%=0 then goto 690
  70. 700   if y%<9 then return
  71. 710   draw(x%,y%):goto 690
  72. 720   drawmode 2:'   RUBBER LINE
  73. 730   ask mouse x2%,y2%,b%:if b%<>0 then goto 730
  74. 740   ask mouse x1%,y1%,b%:if b%=0 then goto 740
  75. 750   ask mouse x1%,y1%,b%:if b%<>0 then goto 750
  76. 760   if y1%<9 then x%=x1%:y%=y1%:return
  77. 770   draw(x1%,y1%;x2%,y2%):draw(x1%,y1%;x2%,y2%)
  78. 780   ask mouse x2%,y2%,b%
  79. 790   if y2%<9 then goto 720
  80. 800   if b%=0 then goto 770
  81. 810   drawmode 0:draw(x1%,y1%;x2%,y2%):goto 720
  82. 820   drawmode 2:'   RUBBER BOX
  83. 830   ask mouse x2%,y2%,b%:if b%<>0 then goto 830
  84. 840   ask mouse x1%,y1%,b%:if b%=0 then goto 840
  85. 850   ask mouse x1%,y1%,b%:if b%<>0 then goto 850
  86. 860   if y1%<9 then x%=x1%:y%=y1%:return
  87. 870   box(x1%,y1%;x2%,y2%):box(x1%,y1%;x2%,y2%)
  88. 880   ask mouse x2%,y2%,b%
  89. 890   if y2%<9 then goto 820
  90. 900   if b%=0 then goto 870
  91. 910   drawmode 0:box(x1%,y1%;x2%,y2%):goto 820
  92. 920   drawmode 2:'   RUBBER CIRCLE
  93. 930   ask mouse x2%,y2%,b2%:if b2%<>0 then goto 930
  94. 940   ask mouse x1%,y1%,b1%:if b1%=0 then goto 940
  95. 950   if y1%<9 then x%=x1%:y%=y1%:return
  96. 960   circle(x1%,y1%),sqr((((x1%-x2%)^2)+((y1%-y2%)^2))),.9:circle(x1%,y1%),sqr((((x1%-x2%)^2)+((y1%-y2%)^2))),.9
  97. 970   ask mouse x2%,y2%,b2%
  98. 980   if y2%<9 then goto 920
  99. 990   if b2%=0 then goto 960
  100. 1000  drawmode 0:circle(x1%,y1%),sqr((((x1%-x2%)^2)+((y1%-y2%)^2))),.9:goto 920
  101. 1010  drawmode 0:'   FILL
  102. 1020  ask mouse x%,y%,b%:if b%<>0 then goto 1020
  103. 1030  ask mouse x%,y%,b%:if b%=0 then goto 1030
  104. 1040  if y%<9 then return
  105. 1050  paint(x%,y%),1:goto 1020
  106. 1060  ' CLEAN UP & GO HOME
  107. 1070  rgb 0,6,9,15:rgb 1,0,0,0:rgb 2,15,15,15:rgb 3,15,9,10:rgb 4,14,3,0:rgb 5,15,11,0:rgb 6,15,15,2:rgb 7,11,15,0
  108. 1080  rgb 8,5,13,0:rgb 9,0,14,13:rgb 10,7,13,15:rgb 11,12,0,14:rgb 12,15,2,14:rgb 13,15,13,11:rgb 14,12,9,8:rgb 15,11,11,11
  109. 1090  scnclr:print" "
  110.