home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 35.dms / 35.adf / toybox.bas < prev    next >
Encoding:
BASIC Source File  |  1988-05-22  |  5.5 KB  |  152 lines
  1. 10    '!TOYBOX! - Robert Sawdey - 10/21/85
  2. 20    ' title
  3. 30    screen 0,4,0:scnclr:print " "
  4. 40    rgb 0,0,0,0:rgb 1,0,0,0:rgb 2,0,0,15:rgb 3,15,0,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);"! T O Y B O X !"
  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 palette
  15. 150   rgb 0,0,0,0:' screen color
  16. 160   rgb 1,15,15,10:'  text color
  17. 170   rgb 2,15,10,15:'    border
  18. 180   rgb 3,15,0,15
  19. 190   rgb 4,15,0,10
  20. 200   rgb 5,15,0,5
  21. 210   rgb 6,15,0,0
  22. 220   rgb 7,15,5,5
  23. 230   rgb 8,5,0,10
  24. 240   rgb 9,0,0,15
  25. 250   rgb 10,5,5,15
  26. 260   rgb 11,0,10,5
  27. 270   rgb 12,5,15,5
  28. 280   rgb 13,10,15,5
  29. 290   rgb 14,15,15,5
  30. 300   rgb 15,15,15,15
  31. 310   '   menu
  32. 320   dim lines%(201,5)
  33. 330   scnclr:print" "
  34. 340   print at (12,2);"! T O Y B O X !"
  35. 350   print at (15,5);"0. Quit"
  36. 360   print at (15,6);"1. Lines1"
  37. 370   print at (15,7);"2. Lines2"
  38. 380   print at (15,8);"3. Lines3"
  39. 390   print at (15,9);"4. Boxes"
  40. 400   print at (15,10);"5. Circles"
  41. 410   print at (13,12);"                    "
  42. 420   print at (14,12);"";:input;"Selection";sel%:print
  43. 430   if sel%=0 then goto 1480
  44. 440   if sel%>5 then goto 410
  45. 450   on sel% gosub 470,690,920,1140,1300
  46. 460   goto 330
  47. 470   'LINES1
  48. 480   scnclr:randomize -1
  49. 490   x1%=rnd(1)*319:y1%=rnd(1)*199:x2%=rnd(1)*319:y2%=rnd(1)*199
  50. 500   x1i%=(5-rnd(1)*10):y1i%=(5-rnd(1)*10)
  51. 510   x2i%=(5-rnd(1)*10):y2i%=(5-rnd(1)*10)
  52. 520   c%=rnd(1)*15
  53. 530   x1%=x1%+x1i%:y1%=y1%+y1i%:x2%=x2%+x2i%:y2%=y2%+y2i%
  54. 540   if (x1%<0) then x1%=0:x1i%=x1i%*(-1)
  55. 550   if (x1%>319) then x1%=319:x1i%=x1i%*(-1)
  56. 560   if (y1%<0) then y1%=0:y1i%=y1i%*(-1)
  57. 570   if (y1%>199) then y1%=199:y1i%=y1i%*(-1)
  58. 580   if (x2%<0) then x2%=0:x2i%=x2i%*(-1)
  59. 590   if (x2%>319) then x2%=319:x2i%=x2i%*(-1)
  60. 600   if (y2%<0) then y2%=0:y2i%=y2i%*(-1)
  61. 610   if (y2%>199) then y2%=199:y2i%=y2i%*(-1)
  62. 620   draw(x1%,y1%;x2%,y2%),c%
  63. 630   ptr%=ptr%+1:if ptr%>20 then ptr%=1
  64. 640   lines%(ptr%,1)=x1%:lines%(ptr%,2)=y1%
  65. 650   lines%(ptr%,3)=x2%:lines%(ptr%,4)=y2%:lines%(ptr%,5)=c%
  66. 660   get a$:if a$<>"" then return
  67. 670   if ptr%=1 then goto 520 else goto 530
  68. 680   'LINES2
  69. 690   scnclr:randomize -1
  70. 700   x1%=rnd(1)*319:y1%=rnd(1)*199:x2%=rnd(1)*319:y2%=rnd(1)*199
  71. 710   x1i%=(5-rnd(1)*10):y1i%=(5-rnd(1)*10)
  72. 720   x2i%=(5-rnd(1)*10):y2i%=(5-rnd(1)*10)
  73. 730   c%=(rnd(1)*14)+1
  74. 740   x1%=x1%+x1i%:y1%=y1%+y1i%:x2%=x2%+x2i%:y2%=y2%+y2i%
  75. 750   if (x1%<0) then x1%=0:x1i%=x1i%*(-1)
  76. 760   if (x1%>319) then x1%=319:x1i%=x1i%*(-1)
  77. 770   if (y1%<0) then y1%=0:y1i%=y1i%*(-1)
  78. 780   if (y1%>199) then y1%=199:y1i%=y1i%*(-1)
  79. 790   if (x2%<0) then x2%=0:x2i%=x2i%*(-1)
  80. 800   if (x2%>319) then x2%=319:x2i%=x2i%*(-1)
  81. 810   if (y2%<0) then y2%=0:y2i%=y2i%*(-1)
  82. 820   if (y2%>199) then y2%=199:y2i%=y2i%*(-1)
  83. 830   draw(x1%,y1%;x2%,y2%),c%
  84. 840   ptr%=ptr%+1:if ptr%>200 then ptr%=1
  85. 850   draw(lines%(ptr%,1),lines%(ptr%,2);lines%(ptr%,3),lines%(ptr%,4)),0
  86. 860   lines%(ptr%,1)=x1%:lines%(ptr%,2)=y1%
  87. 870   lines%(ptr%,3)=x2%:lines%(ptr%,4)=y2%
  88. 880   get a$:if a$<>"" then return
  89. 890   if (ptr% mod 33)=0 then if (rnd(1)>.7) goto 710 else goto 730
  90. 900   goto 740
  91. 910   'LINES3
  92. 920   scnclr:randomize -1
  93. 930   x1%=rnd(1)*319:y1%=rnd(1)*199:x2%=rnd(1)*319:y2%=rnd(1)*199
  94. 940   x1i%=(5-rnd(1)*10):y1i%=(5-rnd(1)*10)
  95. 950   x2i%=(5-rnd(1)*10):y2i%=(5-rnd(1)*10)
  96. 960   c%=(rnd(1)*14)+1:linepat(rnd(1)*65535)
  97. 970   x1%=x1%+x1i%:y1%=y1%+y1i%:x2%=x2%+x2i%:y2%=y2%+y2i%
  98. 980   if (x1%<0) then x1%=0:x1i%=x1i%*(-1)
  99. 990   if (x1%>319) then x1%=319:x1i%=x1i%*(-1)
  100. 1000  if (y1%<0) then y1%=0:y1i%=y1i%*(-1)
  101. 1010  if (y1%>199) then y1%=199:y1i%=y1i%*(-1)
  102. 1020  if (x2%<0) then x2%=0:x2i%=x2i%*(-1)
  103. 1030  if (x2%>319) then x2%=319:x2i%=x2i%*(-1)
  104. 1040  if (y2%<0) then y2%=0:y2i%=y2i%*(-1)
  105. 1050  if (y2%>199) then y2%=199:y2i%=y2i%*(-1)
  106. 1060  draw(x1%,y1%;x2%,y2%),c%
  107. 1070  ptr%=ptr%+1:if ptr%>200 then ptr%=1
  108. 1080  draw(lines%(ptr%,1),lines%(ptr%,2);lines%(ptr%,3),lines%(ptr%,4)),0
  109. 1090  lines%(ptr%,1)=x1%:lines%(ptr%,2)=y1%
  110. 1100  lines%(ptr%,3)=x2%:lines%(ptr%,4)=y2%:lines%(ptr%,5)=c%
  111. 1110  get a$:if a$<>"" then return
  112. 1120  if (ptr% mod 33)=0 then if (rnd(1)>.7) goto 940 else goto 960
  113. 1130  goto 970
  114. 1140  ' box
  115. 1150  scnclr:randomize -1:drawmode 1
  116. 1160  ask window wx%,wy%
  117. 1170  x1%=rnd*wx%
  118. 1180  y1%=rnd*wy%
  119. 1190  x2%=rnd*wx%
  120. 1200  y2%=rnd*wy%
  121. 1210  for i%=0 to 7:a%(i%)=rnd*65535:next
  122. 1220  pa%=rnd*15:pb%=rnd*15
  123. 1230  if pb%=pa% then pb%=pa%+1
  124. 1240  pat%=rnd*8
  125. 1250  pattern pat%,a%()
  126. 1260  pena pa%:penb pb%
  127. 1270  box(x1%,y1%;x2%,y2%),1
  128. 1280  get a$:if a$<>"" then return
  129. 1290  goto 1160
  130. 1300  'CIRCLE
  131. 1310  a%(0)=&hffff
  132. 1320  pattern 1,a%
  133. 1330  scnclr:randomize -1
  134. 1340  for i% = 150 to 0 step -10
  135. 1350  c%=i%/10:peno c%
  136. 1360  circle (153,93),i%,.87
  137. 1370  next
  138. 1380  for j%=1 to 15
  139. 1390  ask rgb 15, r%,g%,b%
  140. 1400  for i% = 14 to 1 step -1
  141. 1410  ask rgb i%, r1%,g1%,b1%
  142. 1420  rgb i%+1,r1%,g1%,b1%
  143. 1430  next i%
  144. 1440  rgb 1,r%,g%,b%
  145. 1450  next j%
  146. 1460  get a$:if a$<>"" then return
  147. 1470  goto 1380
  148. 1480  ' reset rgb
  149. 1490  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
  150. 1500  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
  151. 1510  scnclr:print" "
  152.